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 --- .gitignore | 2 + Makefile | 21 + README.rst | 46 + 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 + devel/debug-copy/1986.07.11/source-disk | 1 + devel/debug-copy/1986.07.11/src/copy files | 2977 +++++++++++++++++ devel/debug-ds4/1989/source-disk | 1 + devel/debug-ds4/1989/src/RUN load ds4 | 246 ++ devel/debug-ds4/1989/src/RUN save ds4 | 223 ++ devel/debug/1/source-disk | 1 + devel/debug/1/src/RUN dez <-> hex | 49 + devel/debug/1/src/all tracer | 10 + devel/debug/1/src/convert | 154 + devel/debug/1/src/disa | 454 +++ devel/debug/1/src/extended instr | 25 + devel/debug/1/src/gen.bulletin | 536 +++ devel/debug/1/src/gen.procheads | 89 + devel/debug/1/src/gen.trace | 23 + devel/debug/1/src/info | 371 +++ devel/debug/1/src/trace | 1020 ++++++ devel/debug/1/src/trace.dok | 387 +++ doc/porting-8086/8/doc/Port.8086 | 2483 ++++++++++++++ doc/porting-8086/8/source-disk | 1 + doc/porting-mc68k/1985.11.26/doc/Port.68000 | 2173 ++++++++++++ doc/porting-mc68k/1985.11.26/source-disk | 1 + doc/porting-z80/8/doc/Port.Z80 | 2484 ++++++++++++++ doc/porting-z80/8/source-disk | 1 + .../1.8.7/doc/programmierhandbuch.1 | 650 ++++ .../1.8.7/doc/programmierhandbuch.2a | 1845 +++++++++++ .../1.8.7/doc/programmierhandbuch.2b | 1395 ++++++++ .../1.8.7/doc/programmierhandbuch.3 | 728 ++++ .../1.8.7/doc/programmierhandbuch.4 | 1692 ++++++++++ .../1.8.7/doc/programmierhandbuch.5 | 1329 ++++++++ .../1.8.7/doc/programmierhandbuch.5b | 1481 +++++++++ .../1.8.7/doc/programmierhandbuch.6 | 1441 ++++++++ .../1.8.7/doc/programmierhandbuch.index | 449 +++ .../1.8.7/doc/programmierhandbuch.inhalt | 249 ++ .../1.8.7/doc/programmierhandbuch.titel | 52 + doc/programmer-manual/1.8.7/source-disk | 1 + doc/system-manual/1.8.7/doc/systemhandbuch.1 | 1685 ++++++++++ doc/system-manual/1.8.7/doc/systemhandbuch.2 | 1351 ++++++++ doc/system-manual/1.8.7/doc/systemhandbuch.3 | 1366 ++++++++ doc/system-manual/1.8.7/doc/systemhandbuch.4 | 1185 +++++++ doc/system-manual/1.8.7/source-disk | 1 + doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil1 | 924 ++++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil10 | 771 +++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil11 | 1072 ++++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil12 | 234 ++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil2 | 628 ++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil3 | 2097 ++++++++++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil4 | 2306 +++++++++++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil5 | 667 ++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6a | 1590 +++++++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6b | 1425 ++++++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil7 | 2469 ++++++++++++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil8 | 1345 ++++++++ doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil9 | 936 ++++++ doc/user-manual/1.7.3-pd/doc/source-disk | 1 + doc/user-manual/1.8.7/doc/benutzerhandbuch.1 | 580 ++++ doc/user-manual/1.8.7/doc/benutzerhandbuch.2 | 443 +++ doc/user-manual/1.8.7/doc/benutzerhandbuch.3 | 2019 ++++++++++++ doc/user-manual/1.8.7/doc/benutzerhandbuch.4 | 2242 +++++++++++++ doc/user-manual/1.8.7/doc/benutzerhandbuch.5a | 1446 ++++++++ doc/user-manual/1.8.7/doc/benutzerhandbuch.5b | 1632 +++++++++ doc/user-manual/1.8.7/doc/benutzerhandbuch.5c | 711 ++++ doc/user-manual/1.8.7/doc/benutzerhandbuch.5d | 211 ++ doc/user-manual/1.8.7/doc/benutzerhandbuch.5e | 223 ++ doc/user-manual/1.8.7/doc/benutzerhandbuch.6 | 474 +++ doc/user-manual/1.8.7/doc/benutzerhandbuch.anhang | 484 +++ doc/user-manual/1.8.7/doc/source-disk | 1 + lang/basic/1.8.7/doc/basic handbuch.1 | 1075 ++++++ lang/basic/1.8.7/doc/basic handbuch.2 | 2441 ++++++++++++++ lang/basic/1.8.7/doc/basic handbuch.3 | 698 ++++ lang/basic/1.8.7/doc/basic handbuch.index | 232 ++ lang/basic/1.8.7/source-disk | 1 + lang/basic/1.8.7/src/BASIC.Administration | 1886 +++++++++++ lang/basic/1.8.7/src/BASIC.Compiler | 2305 +++++++++++++ lang/basic/1.8.7/src/BASIC.Runtime | 1571 +++++++++ lang/basic/1.8.7/src/eumel coder 1.8.1 | 1 + lang/basic/1.8.7/src/eumel0 codes | Bin 0 -> 512 bytes lang/basic/1.8.7/src/gen.BASIC | 80 + lang/dynamo/1.8.7/doc/dynamo handbuch | 1826 ++++++++++ lang/dynamo/1.8.7/doc/dynamo handbuch.index | 69 + lang/dynamo/1.8.7/doc/dynamo handbuch.inhalt | 131 + lang/dynamo/1.8.7/source-disk | 1 + "lang/dynamo/1.8.7/src/\"15\"TAB1\"14\"" | Bin 0 -> 13312 bytes lang/dynamo/1.8.7/src/dyn.33 | 2073 ++++++++++++ lang/dynamo/1.8.7/src/dyn.abnahme | 19 + lang/dynamo/1.8.7/src/dyn.bev | 50 + lang/dynamo/1.8.7/src/dyn.cob | 19 + lang/dynamo/1.8.7/src/dyn.const | Bin 0 -> 1536 bytes lang/dynamo/1.8.7/src/dyn.delaytest | 8 + lang/dynamo/1.8.7/src/dyn.errors | 68 + lang/dynamo/1.8.7/src/dyn.forest | 47 + lang/dynamo/1.8.7/src/dyn.forst7 | 76 + lang/dynamo/1.8.7/src/dyn.gekoppeltependel | 19 + lang/dynamo/1.8.7/src/dyn.grashasenfuchs | 42 + lang/dynamo/1.8.7/src/dyn.help | 24 + lang/dynamo/1.8.7/src/dyn.inserter | 54 + lang/dynamo/1.8.7/src/dyn.mac | 44 + lang/dynamo/1.8.7/src/dyn.mehreredelays | 9 + lang/dynamo/1.8.7/src/dyn.natchez | 14 + lang/dynamo/1.8.7/src/dyn.oszillator | 26 + lang/dynamo/1.8.7/src/dyn.plot | 235 ++ lang/dynamo/1.8.7/src/dyn.plot+ | 729 ++++ lang/dynamo/1.8.7/src/dyn.print | 43 + lang/dynamo/1.8.7/src/dyn.proc | 160 + lang/dynamo/1.8.7/src/dyn.quadrat | 13 + lang/dynamo/1.8.7/src/dyn.rts | 376 +++ lang/dynamo/1.8.7/src/dyn.ruestungswettlauf | 32 + lang/dynamo/1.8.7/src/dyn.simon | 28 + lang/dynamo/1.8.7/src/dyn.std | 9 + lang/dynamo/1.8.7/src/dyn.steifedgl | 15 + lang/dynamo/1.8.7/src/dyn.tool | 217 ++ lang/dynamo/1.8.7/src/dyn.vec | 209 ++ lang/dynamo/1.8.7/src/dyn.wachstum | 19 + "lang/dynamo/1.8.7/src/dyn.wasser\303\266ko" | 64 + lang/dynamo/1.8.7/src/dyn.welt-forrester | 124 + lang/dynamo/1.8.7/src/dyn.wohnen | 105 + lang/dynamo/1.8.7/src/dyn.workfluc | 44 + lang/dynamo/1.8.7/src/dyn.wurzel | 14 + lang/dynamo/1.8.7/src/out.world | 43 + lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const | Bin 0 -> 1536 bytes lang/dynamo/1.8.7/src/stabileruestung.const | Bin 0 -> 1536 bytes lang/lisp/1.7.2/src/lisp.1 | 1305 ++++++++ lang/lisp/1.7.2/src/lisp.2 | 550 ++++ lang/lisp/1.7.2/src/lisp.3 | 142 + lang/lisp/1.7.2/src/lisp.4 | 766 +++++ lang/lisp/1.7.2/src/lisp.bootstrap | 117 + lang/lisp/1.8.7/doc/lisp handbuch | 2260 +++++++++++++ lang/lisp/1.8.7/source-disk | 1 + "lang/lisp/1.8.7/src/\"15\"TAB2\"14\"" | Bin 0 -> 22528 bytes lang/lisp/1.8.7/src/lisp.1 | 1306 ++++++++ lang/lisp/1.8.7/src/lisp.2 | 584 ++++ lang/lisp/1.8.7/src/lisp.3 | 767 +++++ lang/lisp/1.8.7/src/lisp.4 | 143 + lang/lisp/1.8.7/src/lisp.bootstrap | 118 + lang/prolog/1.8.7/doc/prolog handbuch | 581 ++++ lang/prolog/1.8.7/source-disk | 1 + lang/prolog/1.8.7/src/calc | 32 + lang/prolog/1.8.7/src/family | 29 + lang/prolog/1.8.7/src/permute | 15 + lang/prolog/1.8.7/src/prieks | 58 + lang/prolog/1.8.7/src/prolog | 2488 ++++++++++++++ lang/prolog/1.8.7/src/prolog installation | 117 + lang/prolog/1.8.7/src/puzzle | 24 + lang/prolog/1.8.7/src/quicksort | 14 + lang/prolog/1.8.7/src/standard | 35 + lang/prolog/1.8.7/src/sum | 13 + lang/prolog/1.8.7/src/thesaurus | 360 ++ lang/prolog/1.8.7/src/topographie | 59 + system/base/1.7.5/source-disk | 1 + system/base/1.7.5/src/advertising | 35 + system/base/1.7.5/src/basic transput | 177 + system/base/1.7.5/src/bits | 78 + system/base/1.7.5/src/bool | 16 + system/base/1.7.5/src/command dialogue | 123 + system/base/1.7.5/src/command handler | 290 ++ system/base/1.7.5/src/dataspace | 74 + system/base/1.7.5/src/date handling | 303 ++ system/base/1.7.5/src/editor | 2959 +++++++++++++++++ system/base/1.7.5/src/elan do interface | 57 + system/base/1.7.5/src/error handling | 142 + system/base/1.7.5/src/eumel coder part 1 | 866 +++++ system/base/1.7.5/src/file | 2122 ++++++++++++ system/base/1.7.5/src/functions | 760 +++++ system/base/1.7.5/src/init | 251 ++ system/base/1.7.5/src/integer | 265 ++ system/base/1.7.5/src/local manager | 373 +++ system/base/1.7.5/src/local manager 2 | 41 + system/base/1.7.5/src/mathlib | 268 ++ system/base/1.7.5/src/pattern match | 768 +++++ system/base/1.7.5/src/pcb control | 79 + system/base/1.7.5/src/real | 442 +++ system/base/1.7.5/src/scanner | 325 ++ system/base/1.7.5/src/screen | 33 + system/base/1.7.5/src/std transput | 264 ++ system/base/1.7.5/src/tasten | 113 + system/base/1.7.5/src/text | 391 +++ system/base/1.7.5/src/texter errors | 284 ++ system/base/1.7.5/src/thesaurus | 332 ++ system/dos/1.8.7/doc/dos-dat-handbuch | 650 ++++ system/dos/1.8.7/source-disk | 1 + system/dos/1.8.7/src/block i-o | 180 + system/dos/1.8.7/src/bpb ds | Bin 0 -> 2048 bytes system/dos/1.8.7/src/dir.dos | 693 ++++ system/dos/1.8.7/src/disk descriptor.dos | 339 ++ system/dos/1.8.7/src/dos hd inserter | 41 + system/dos/1.8.7/src/dos inserter | 59 + system/dos/1.8.7/src/dump | 49 + system/dos/1.8.7/src/eu disk descriptor | 107 + system/dos/1.8.7/src/fat.dos | 369 +++ system/dos/1.8.7/src/fetch | 371 +++ system/dos/1.8.7/src/fetch save interface | 70 + system/dos/1.8.7/src/get put interface.dos | 368 +++ system/dos/1.8.7/src/insert.dos | 14 + system/dos/1.8.7/src/konvert | 75 + system/dos/1.8.7/src/manager-M.dos | 211 ++ system/dos/1.8.7/src/manager-S.dos | 268 ++ system/dos/1.8.7/src/name conversion.dos | 77 + system/dos/1.8.7/src/open | 66 + system/dos/1.8.7/src/save | 233 ++ system/dos/1.8.7/src/shard interface | 20 + system/eumel-coder/1.8.0/src/eumel coder 1.8.0 | 2594 +++++++++++++++ system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod | 2043 ++++++++++++ system/eumel-coder/1.8.0/src/eumel0 codes | 50 + system/eumel-coder/1.8.1/source-disk | 1 + system/eumel-coder/1.8.1/src/eumel coder 1.8.1 | 3086 +++++++++++++++++ system/multiuser/1.7.5/source-disk | 2 + system/multiuser/1.7.5/src/archive | 92 + system/multiuser/1.7.5/src/archive manager | 670 ++++ system/multiuser/1.7.5/src/basic archive | 401 +++ system/multiuser/1.7.5/src/canal | 227 ++ system/multiuser/1.7.5/src/configuration manager | 553 ++++ system/multiuser/1.7.5/src/eumel printer | 3066 +++++++++++++++++ system/multiuser/1.7.5/src/font store | 695 ++++ system/multiuser/1.7.5/src/global manager | 683 ++++ system/multiuser/1.7.5/src/indexer | 1142 +++++++ system/multiuser/1.7.5/src/konfigurieren | 254 ++ system/multiuser/1.7.5/src/liner | 3079 +++++++++++++++++ system/multiuser/1.7.5/src/macro store | 298 ++ system/multiuser/1.7.5/src/multi user monitor | 93 + system/multiuser/1.7.5/src/nameset | 355 ++ system/multiuser/1.7.5/src/pager | 2451 ++++++++++++++ system/multiuser/1.7.5/src/print cmd | 29 + system/multiuser/1.7.5/src/priv ops | 268 ++ system/multiuser/1.7.5/src/silbentrennung | 1166 +++++++ system/multiuser/1.7.5/src/spool manager | 887 +++++ system/multiuser/1.7.5/src/supervisor | 774 +++++ system/multiuser/1.7.5/src/sysgen off | 9 + system/multiuser/1.7.5/src/system info | 342 ++ system/multiuser/1.7.5/src/system manager | 117 + system/multiuser/1.7.5/src/tasks | 978 ++++++ system/multiuser/1.7.5/src/ur start | 40 + system/net/1.7.5/doc/EUMEL Netz | 832 +++++ system/net/1.7.5/src/basic net | 840 +++++ system/net/1.7.5/src/callee | 14 + system/net/1.7.5/src/net inserter | 50 + system/net/1.7.5/src/net manager-M | 302 ++ system/net/1.7.5/src/net report-M | 29 + system/net/1.8.7/doc/netzhandbuch | 2045 ++++++++++++ system/net/1.8.7/doc/netzhandbuch.anhang | 58 + system/net/1.8.7/doc/netzhandbuch.index | 259 ++ system/net/1.8.7/source-disk | 1 + system/net/1.8.7/src/basic net | 1148 +++++++ system/net/1.8.7/src/net files-M | 5 + system/net/1.8.7/src/net hardware interface | 389 +++ system/net/1.8.7/src/net inserter | 145 + system/net/1.8.7/src/net manager | 797 +++++ system/net/1.8.7/src/net report | 41 + system/net/1.8.7/src/netz | 20 + system/net/1.8.7/src/port server | 164 + system/net/1.8.7/src/printer server | 99 + system/net/1.8.7/src/spool cmd | 112 + system/net/1.8.7/src/spool manager | 915 ++++++ system/net/unknown/doc/EUMEL Netz | 829 +++++ system/printer-24nadel/0.9/doc/readme | 320 ++ system/printer-24nadel/0.9/source-disk | 3 + system/printer-24nadel/0.9/src/beschreibungen24 | 62 + system/printer-24nadel/0.9/src/fonttab.brother | Bin 0 -> 38400 bytes .../printer-24nadel/0.9/src/fonttab.epson.lq1500 | Bin 0 -> 35840 bytes system/printer-24nadel/0.9/src/fonttab.epson.lq850 | Bin 0 -> 38400 bytes system/printer-24nadel/0.9/src/fonttab.nec.p5 | Bin 0 -> 39936 bytes system/printer-24nadel/0.9/src/fonttab.nec.p5.new | Bin 0 -> 39936 bytes system/printer-24nadel/0.9/src/fonttab.nec.p6+ | Bin 0 -> 48128 bytes system/printer-24nadel/0.9/src/fonttab.oki | Bin 0 -> 38400 bytes .../printer-24nadel/0.9/src/fonttab.toshiba.p321 | Bin 0 -> 15872 bytes system/printer-24nadel/0.9/src/inserter | 793 +++++ system/printer-24nadel/0.9/src/module24 | 1554 +++++++++ system/printer-24nadel/0.9/src/printer.24.nadel | 776 +++++ .../printer-24nadel/schulis-mathe-1.0/doc/readme | 320 ++ .../schulis-mathe-1.0/src/beschreibungen24 | 62 + .../schulis-mathe-1.0/src/fonttab.brother | Bin 0 -> 38400 bytes .../schulis-mathe-1.0/src/fonttab.epson.lq1500 | Bin 0 -> 35840 bytes .../schulis-mathe-1.0/src/fonttab.epson.lq850 | Bin 0 -> 38400 bytes .../schulis-mathe-1.0/src/fonttab.nec.p5 | Bin 0 -> 39936 bytes .../schulis-mathe-1.0/src/fonttab.nec.p5.new | Bin 0 -> 39936 bytes .../schulis-mathe-1.0/src/fonttab.nec.p6+ | Bin 0 -> 48128 bytes .../schulis-mathe-1.0/src/fonttab.oki | Bin 0 -> 38400 bytes .../schulis-mathe-1.0/src/fonttab.toshiba.p321 | Bin 0 -> 15872 bytes .../printer-24nadel/schulis-mathe-1.0/src/inserter | 793 +++++ .../printer-24nadel/schulis-mathe-1.0/src/module24 | 1554 +++++++++ .../schulis-mathe-1.0/src/printer.24.nadel | 776 +++++ system/printer-24nadel/schulis-sim-3.0 | 1 + system/printer-9nadel/0.9/doc/readme | 324 ++ system/printer-9nadel/0.9/source-disk | 1 + system/printer-9nadel/0.9/src/beschreibungen9 | 97 + system/printer-9nadel/0.9/src/fonttab.1 | Bin 0 -> 11264 bytes system/printer-9nadel/0.9/src/fonttab.10 | Bin 0 -> 15872 bytes system/printer-9nadel/0.9/src/fonttab.20 | Bin 0 -> 36864 bytes system/printer-9nadel/0.9/src/fonttab.20.lc | Bin 0 -> 36864 bytes system/printer-9nadel/0.9/src/fonttab.20.lx | Bin 0 -> 24576 bytes system/printer-9nadel/0.9/src/fonttab.7 | Bin 0 -> 46080 bytes system/printer-9nadel/0.9/src/fonttab.7.cxp | Bin 0 -> 46080 bytes system/printer-9nadel/0.9/src/fonttab.7.fuj | Bin 0 -> 56832 bytes system/printer-9nadel/0.9/src/fonttab.7.mt | Bin 0 -> 46080 bytes system/printer-9nadel/0.9/src/module9 | 1099 +++++++ system/printer-9nadel/0.9/src/printer.neun.nadel | 1129 +++++++ system/printer-laser/4/doc/readme | 155 + system/printer-laser/4/source-disk | 1 + .../printer-laser/4/src/fonttab.apple.laserwriter | Bin 0 -> 100864 bytes system/printer-laser/4/src/fonttab.canon.lbp-8 | Bin 0 -> 58368 bytes system/printer-laser/4/src/fonttab.epson.sq | Bin 0 -> 29696 bytes system/printer-laser/4/src/fonttab.hp.laserjet | Bin 0 -> 24064 bytes system/printer-laser/4/src/fonttab.kyocera.f-1010 | Bin 0 -> 71168 bytes system/printer-laser/4/src/fonttab.nec.lc-08 | Bin 0 -> 38400 bytes .../4/src/genfont.kyocera.f-1010.dynamic1 | 30 + .../4/src/genfont.kyocera.f-1010.dynamic2 | 30 + system/printer-laser/4/src/laser.inserter | 275 ++ .../printer-laser/4/src/printer.apple.laserwriter | 770 +++++ system/printer-laser/4/src/printer.canon.lbp-8 | 327 ++ system/printer-laser/4/src/printer.epson.sq | 585 ++++ system/printer-laser/4/src/printer.hp.laserjet | 417 +++ system/printer-laser/4/src/printer.kyocera.f-1010 | 373 +++ system/printer-laser/4/src/printer.nec.lc-08 | 626 ++++ system/setup/3.1/source-disk | 1 + system/setup/3.1/src/AT-4.x | Bin 0 -> 1024 bytes system/setup/3.1/src/SHARD | Bin 0 -> 7680 bytes system/setup/3.1/src/SHard Basis | Bin 0 -> 7680 bytes system/setup/3.1/src/bootblock | Bin 0 -> 4608 bytes system/setup/3.1/src/configuration | 2 + system/setup/3.1/src/neu | 34 + .../3.1/src/setup eumel -1: mini eumel dummies | 28 + system/setup/3.1/src/setup eumel 0: -M | 32 + system/setup/3.1/src/setup eumel 0: -S | 35 + .../setup/3.1/src/setup eumel 1: basisoperationen | 1071 ++++++ system/setup/3.1/src/setup eumel 2: modulzugriffe | 441 +++ .../3.1/src/setup eumel 3: modulkonfiguration | 854 +++++ .../setup/3.1/src/setup eumel 4: dienstprogramme | 218 ++ .../setup/3.1/src/setup eumel 5: partitionierung | 435 +++ system/setup/3.1/src/setup eumel 6: shardmontage | 389 +++ system/setup/3.1/src/setup eumel 7: setupeumel | 1238 +++++++ system/setup/3.1/src/setup eumel erzeugen | 15 + system/setup/3.1/src/setup eumel erzeugen-M | 14 + system/setup/3.1/src/shget.exe | Bin 0 -> 1536 bytes .../1.8.7/doc/Altes Handbuch - Teil 10 - Graphik | 831 +++++ system/std.graphik/1.8.7/doc/GRAPHIK.book | 897 +++++ system/std.graphik/1.8.7/doc/graphik beschreibung | 661 ++++ system/std.graphik/1.8.7/source-disk | 1 + system/std.graphik/1.8.7/src/Beispiel.Kreuz | 41 + system/std.graphik/1.8.7/src/Beispiel.Sinus | 45 + system/std.graphik/1.8.7/src/GRAPHIK.Picfile | 738 +++++ system/std.graphik/1.8.7/src/GRAPHIK.Plot | 285 ++ system/std.graphik/1.8.7/src/GRAPHIK.Plotter | 247 ++ system/std.graphik/1.8.7/src/GRAPHIK.Server | 97 + system/std.graphik/1.8.7/src/GRAPHIK.Transform | 366 +++ system/std.graphik/1.8.7/src/GRAPHIK.vektor plot | 506 +++ system/std.graphik/1.8.7/src/HP7475.plot | 254 ++ system/std.graphik/1.8.7/src/PC.plot | 758 +++++ system/std.graphik/1.8.7/src/ZEICHENSATZ | Bin 0 -> 11776 bytes system/std.graphik/1.8.7/src/gen Graphik | 16 + system/std.graphik/1.8.7/src/gen Plotter | 16 + system/std.graphik/1.8.7/src/graphik editor | 324 ++ system/std.zusatz/1.8.7/source-disk | 1 + system/std.zusatz/1.8.7/src/AT Generator | 135 + system/std.zusatz/1.8.7/src/AT Utilities | 1057 ++++++ system/std.zusatz/1.8.7/src/AT install | 93 + system/std.zusatz/1.8.7/src/complex | 115 + system/std.zusatz/1.8.7/src/crypt | 138 + system/std.zusatz/1.8.7/src/eumel printer.5 | 3473 ++++++++++++++++++++ system/std.zusatz/1.8.7/src/eumelmeter | 131 + system/std.zusatz/1.8.7/src/font convertor 9 | 1095 ++++++ system/std.zusatz/1.8.7/src/free channel | 430 +++ system/std.zusatz/1.8.7/src/longint | 423 +++ system/std.zusatz/1.8.7/src/matrix | 482 +++ system/std.zusatz/1.8.7/src/port server | 164 + system/std.zusatz/1.8.7/src/printer server | 99 + system/std.zusatz/1.8.7/src/purge | 85 + system/std.zusatz/1.8.7/src/referencer | 1077 ++++++ system/std.zusatz/1.8.7/src/reporter | 531 +++ system/std.zusatz/1.8.7/src/scheduler | 420 +++ system/std.zusatz/1.8.7/src/spool cmd | 178 + system/std.zusatz/1.8.7/src/spool manager | 1058 ++++++ system/std.zusatz/1.8.7/src/std analysator | 68 + system/std.zusatz/1.8.7/src/vector | 213 ++ tools/highlight.py | 55 + tools/makeindex.py | 53 + 1373 files changed, 321485 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 README.rst 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 create mode 100644 devel/debug-copy/1986.07.11/source-disk create mode 100644 devel/debug-copy/1986.07.11/src/copy files create mode 100644 devel/debug-ds4/1989/source-disk create mode 100644 devel/debug-ds4/1989/src/RUN load ds4 create mode 100644 devel/debug-ds4/1989/src/RUN save ds4 create mode 100644 devel/debug/1/source-disk create mode 100644 devel/debug/1/src/RUN dez <-> hex create mode 100644 devel/debug/1/src/all tracer create mode 100644 devel/debug/1/src/convert create mode 100644 devel/debug/1/src/disa create mode 100644 devel/debug/1/src/extended instr create mode 100644 devel/debug/1/src/gen.bulletin create mode 100644 devel/debug/1/src/gen.procheads create mode 100644 devel/debug/1/src/gen.trace create mode 100644 devel/debug/1/src/info create mode 100644 devel/debug/1/src/trace create mode 100644 devel/debug/1/src/trace.dok create mode 100644 doc/porting-8086/8/doc/Port.8086 create mode 100644 doc/porting-8086/8/source-disk create mode 100644 doc/porting-mc68k/1985.11.26/doc/Port.68000 create mode 100644 doc/porting-mc68k/1985.11.26/source-disk create mode 100644 doc/porting-z80/8/doc/Port.Z80 create mode 100644 doc/porting-z80/8/source-disk create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.1 create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.2a create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.2b create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.3 create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.4 create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.5 create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.5b create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.6 create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.index create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.inhalt create mode 100644 doc/programmer-manual/1.8.7/doc/programmierhandbuch.titel create mode 100644 doc/programmer-manual/1.8.7/source-disk create mode 100644 doc/system-manual/1.8.7/doc/systemhandbuch.1 create mode 100644 doc/system-manual/1.8.7/doc/systemhandbuch.2 create mode 100644 doc/system-manual/1.8.7/doc/systemhandbuch.3 create mode 100644 doc/system-manual/1.8.7/doc/systemhandbuch.4 create mode 100644 doc/system-manual/1.8.7/source-disk create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil1 create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil10 create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil11 create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil12 create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil2 create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil3 create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil4 create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil5 create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6a create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6b create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil7 create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil8 create mode 100644 doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil9 create mode 100644 doc/user-manual/1.7.3-pd/doc/source-disk create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.1 create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.2 create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.3 create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.4 create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.5a create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.5b create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.5c create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.5d create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.5e create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.6 create mode 100644 doc/user-manual/1.8.7/doc/benutzerhandbuch.anhang create mode 100644 doc/user-manual/1.8.7/doc/source-disk create mode 100644 lang/basic/1.8.7/doc/basic handbuch.1 create mode 100644 lang/basic/1.8.7/doc/basic handbuch.2 create mode 100644 lang/basic/1.8.7/doc/basic handbuch.3 create mode 100644 lang/basic/1.8.7/doc/basic handbuch.index create mode 100644 lang/basic/1.8.7/source-disk create mode 100644 lang/basic/1.8.7/src/BASIC.Administration create mode 100644 lang/basic/1.8.7/src/BASIC.Compiler create mode 100644 lang/basic/1.8.7/src/BASIC.Runtime create mode 120000 lang/basic/1.8.7/src/eumel coder 1.8.1 create mode 100644 lang/basic/1.8.7/src/eumel0 codes create mode 100644 lang/basic/1.8.7/src/gen.BASIC create mode 100644 lang/dynamo/1.8.7/doc/dynamo handbuch create mode 100644 lang/dynamo/1.8.7/doc/dynamo handbuch.index create mode 100644 lang/dynamo/1.8.7/doc/dynamo handbuch.inhalt create mode 100644 lang/dynamo/1.8.7/source-disk create mode 100644 "lang/dynamo/1.8.7/src/\"15\"TAB1\"14\"" create mode 100644 lang/dynamo/1.8.7/src/dyn.33 create mode 100644 lang/dynamo/1.8.7/src/dyn.abnahme create mode 100644 lang/dynamo/1.8.7/src/dyn.bev create mode 100644 lang/dynamo/1.8.7/src/dyn.cob create mode 100644 lang/dynamo/1.8.7/src/dyn.const create mode 100644 lang/dynamo/1.8.7/src/dyn.delaytest create mode 100644 lang/dynamo/1.8.7/src/dyn.errors create mode 100644 lang/dynamo/1.8.7/src/dyn.forest create mode 100644 lang/dynamo/1.8.7/src/dyn.forst7 create mode 100644 lang/dynamo/1.8.7/src/dyn.gekoppeltependel create mode 100644 lang/dynamo/1.8.7/src/dyn.grashasenfuchs create mode 100644 lang/dynamo/1.8.7/src/dyn.help create mode 100644 lang/dynamo/1.8.7/src/dyn.inserter create mode 100644 lang/dynamo/1.8.7/src/dyn.mac create mode 100644 lang/dynamo/1.8.7/src/dyn.mehreredelays create mode 100644 lang/dynamo/1.8.7/src/dyn.natchez create mode 100644 lang/dynamo/1.8.7/src/dyn.oszillator create mode 100644 lang/dynamo/1.8.7/src/dyn.plot create mode 100644 lang/dynamo/1.8.7/src/dyn.plot+ create mode 100644 lang/dynamo/1.8.7/src/dyn.print create mode 100644 lang/dynamo/1.8.7/src/dyn.proc create mode 100644 lang/dynamo/1.8.7/src/dyn.quadrat create mode 100644 lang/dynamo/1.8.7/src/dyn.rts create mode 100644 lang/dynamo/1.8.7/src/dyn.ruestungswettlauf create mode 100644 lang/dynamo/1.8.7/src/dyn.simon create mode 100644 lang/dynamo/1.8.7/src/dyn.std create mode 100644 lang/dynamo/1.8.7/src/dyn.steifedgl create mode 100644 lang/dynamo/1.8.7/src/dyn.tool create mode 100644 lang/dynamo/1.8.7/src/dyn.vec create mode 100644 lang/dynamo/1.8.7/src/dyn.wachstum create mode 100644 "lang/dynamo/1.8.7/src/dyn.wasser\303\266ko" create mode 100644 lang/dynamo/1.8.7/src/dyn.welt-forrester create mode 100644 lang/dynamo/1.8.7/src/dyn.wohnen create mode 100644 lang/dynamo/1.8.7/src/dyn.workfluc create mode 100644 lang/dynamo/1.8.7/src/dyn.wurzel create mode 100644 lang/dynamo/1.8.7/src/out.world create mode 100644 lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const create mode 100644 lang/dynamo/1.8.7/src/stabileruestung.const create mode 100644 lang/lisp/1.7.2/src/lisp.1 create mode 100644 lang/lisp/1.7.2/src/lisp.2 create mode 100644 lang/lisp/1.7.2/src/lisp.3 create mode 100644 lang/lisp/1.7.2/src/lisp.4 create mode 100644 lang/lisp/1.7.2/src/lisp.bootstrap create mode 100644 lang/lisp/1.8.7/doc/lisp handbuch create mode 100644 lang/lisp/1.8.7/source-disk create mode 100644 "lang/lisp/1.8.7/src/\"15\"TAB2\"14\"" create mode 100644 lang/lisp/1.8.7/src/lisp.1 create mode 100644 lang/lisp/1.8.7/src/lisp.2 create mode 100644 lang/lisp/1.8.7/src/lisp.3 create mode 100644 lang/lisp/1.8.7/src/lisp.4 create mode 100644 lang/lisp/1.8.7/src/lisp.bootstrap create mode 100644 lang/prolog/1.8.7/doc/prolog handbuch create mode 100644 lang/prolog/1.8.7/source-disk create mode 100644 lang/prolog/1.8.7/src/calc create mode 100644 lang/prolog/1.8.7/src/family create mode 100644 lang/prolog/1.8.7/src/permute create mode 100644 lang/prolog/1.8.7/src/prieks create mode 100644 lang/prolog/1.8.7/src/prolog create mode 100644 lang/prolog/1.8.7/src/prolog installation create mode 100644 lang/prolog/1.8.7/src/puzzle create mode 100644 lang/prolog/1.8.7/src/quicksort create mode 100644 lang/prolog/1.8.7/src/standard create mode 100644 lang/prolog/1.8.7/src/sum create mode 100644 lang/prolog/1.8.7/src/thesaurus create mode 100644 lang/prolog/1.8.7/src/topographie create mode 100644 system/base/1.7.5/source-disk create mode 100644 system/base/1.7.5/src/advertising create mode 100644 system/base/1.7.5/src/basic transput create mode 100644 system/base/1.7.5/src/bits create mode 100644 system/base/1.7.5/src/bool create mode 100644 system/base/1.7.5/src/command dialogue create mode 100644 system/base/1.7.5/src/command handler create mode 100644 system/base/1.7.5/src/dataspace create mode 100644 system/base/1.7.5/src/date handling create mode 100644 system/base/1.7.5/src/editor create mode 100644 system/base/1.7.5/src/elan do interface create mode 100644 system/base/1.7.5/src/error handling create mode 100644 system/base/1.7.5/src/eumel coder part 1 create mode 100644 system/base/1.7.5/src/file create mode 100644 system/base/1.7.5/src/functions create mode 100644 system/base/1.7.5/src/init create mode 100644 system/base/1.7.5/src/integer create mode 100644 system/base/1.7.5/src/local manager create mode 100644 system/base/1.7.5/src/local manager 2 create mode 100644 system/base/1.7.5/src/mathlib create mode 100644 system/base/1.7.5/src/pattern match create mode 100644 system/base/1.7.5/src/pcb control create mode 100644 system/base/1.7.5/src/real create mode 100644 system/base/1.7.5/src/scanner create mode 100644 system/base/1.7.5/src/screen create mode 100644 system/base/1.7.5/src/std transput create mode 100644 system/base/1.7.5/src/tasten create mode 100644 system/base/1.7.5/src/text create mode 100644 system/base/1.7.5/src/texter errors create mode 100644 system/base/1.7.5/src/thesaurus create mode 100644 system/dos/1.8.7/doc/dos-dat-handbuch create mode 100644 system/dos/1.8.7/source-disk create mode 100644 system/dos/1.8.7/src/block i-o create mode 100644 system/dos/1.8.7/src/bpb ds create mode 100644 system/dos/1.8.7/src/dir.dos create mode 100644 system/dos/1.8.7/src/disk descriptor.dos create mode 100644 system/dos/1.8.7/src/dos hd inserter create mode 100644 system/dos/1.8.7/src/dos inserter create mode 100644 system/dos/1.8.7/src/dump create mode 100644 system/dos/1.8.7/src/eu disk descriptor create mode 100644 system/dos/1.8.7/src/fat.dos create mode 100644 system/dos/1.8.7/src/fetch create mode 100644 system/dos/1.8.7/src/fetch save interface create mode 100644 system/dos/1.8.7/src/get put interface.dos create mode 100644 system/dos/1.8.7/src/insert.dos create mode 100644 system/dos/1.8.7/src/konvert create mode 100644 system/dos/1.8.7/src/manager-M.dos create mode 100644 system/dos/1.8.7/src/manager-S.dos create mode 100644 system/dos/1.8.7/src/name conversion.dos create mode 100644 system/dos/1.8.7/src/open create mode 100644 system/dos/1.8.7/src/save create mode 100644 system/dos/1.8.7/src/shard interface create mode 100644 system/eumel-coder/1.8.0/src/eumel coder 1.8.0 create mode 100644 system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod create mode 100644 system/eumel-coder/1.8.0/src/eumel0 codes create mode 100644 system/eumel-coder/1.8.1/source-disk create mode 100644 system/eumel-coder/1.8.1/src/eumel coder 1.8.1 create mode 100644 system/multiuser/1.7.5/source-disk create mode 100644 system/multiuser/1.7.5/src/archive create mode 100644 system/multiuser/1.7.5/src/archive manager create mode 100644 system/multiuser/1.7.5/src/basic archive create mode 100644 system/multiuser/1.7.5/src/canal create mode 100644 system/multiuser/1.7.5/src/configuration manager create mode 100644 system/multiuser/1.7.5/src/eumel printer create mode 100644 system/multiuser/1.7.5/src/font store create mode 100644 system/multiuser/1.7.5/src/global manager create mode 100644 system/multiuser/1.7.5/src/indexer create mode 100644 system/multiuser/1.7.5/src/konfigurieren create mode 100644 system/multiuser/1.7.5/src/liner create mode 100644 system/multiuser/1.7.5/src/macro store create mode 100644 system/multiuser/1.7.5/src/multi user monitor create mode 100644 system/multiuser/1.7.5/src/nameset create mode 100644 system/multiuser/1.7.5/src/pager create mode 100644 system/multiuser/1.7.5/src/print cmd create mode 100644 system/multiuser/1.7.5/src/priv ops create mode 100644 system/multiuser/1.7.5/src/silbentrennung create mode 100644 system/multiuser/1.7.5/src/spool manager create mode 100644 system/multiuser/1.7.5/src/supervisor create mode 100644 system/multiuser/1.7.5/src/sysgen off create mode 100644 system/multiuser/1.7.5/src/system info create mode 100644 system/multiuser/1.7.5/src/system manager create mode 100644 system/multiuser/1.7.5/src/tasks create mode 100644 system/multiuser/1.7.5/src/ur start create mode 100644 system/net/1.7.5/doc/EUMEL Netz create mode 100644 system/net/1.7.5/src/basic net create mode 100644 system/net/1.7.5/src/callee create mode 100644 system/net/1.7.5/src/net inserter create mode 100644 system/net/1.7.5/src/net manager-M create mode 100644 system/net/1.7.5/src/net report-M create mode 100644 system/net/1.8.7/doc/netzhandbuch create mode 100644 system/net/1.8.7/doc/netzhandbuch.anhang create mode 100644 system/net/1.8.7/doc/netzhandbuch.index create mode 100644 system/net/1.8.7/source-disk create mode 100644 system/net/1.8.7/src/basic net create mode 100644 system/net/1.8.7/src/net files-M create mode 100644 system/net/1.8.7/src/net hardware interface create mode 100644 system/net/1.8.7/src/net inserter create mode 100644 system/net/1.8.7/src/net manager create mode 100644 system/net/1.8.7/src/net report create mode 100644 system/net/1.8.7/src/netz create mode 100644 system/net/1.8.7/src/port server create mode 100644 system/net/1.8.7/src/printer server create mode 100644 system/net/1.8.7/src/spool cmd create mode 100644 system/net/1.8.7/src/spool manager create mode 100644 system/net/unknown/doc/EUMEL Netz create mode 100644 system/printer-24nadel/0.9/doc/readme create mode 100644 system/printer-24nadel/0.9/source-disk create mode 100644 system/printer-24nadel/0.9/src/beschreibungen24 create mode 100644 system/printer-24nadel/0.9/src/fonttab.brother create mode 100644 system/printer-24nadel/0.9/src/fonttab.epson.lq1500 create mode 100644 system/printer-24nadel/0.9/src/fonttab.epson.lq850 create mode 100644 system/printer-24nadel/0.9/src/fonttab.nec.p5 create mode 100644 system/printer-24nadel/0.9/src/fonttab.nec.p5.new create mode 100644 system/printer-24nadel/0.9/src/fonttab.nec.p6+ create mode 100644 system/printer-24nadel/0.9/src/fonttab.oki create mode 100644 system/printer-24nadel/0.9/src/fonttab.toshiba.p321 create mode 100644 system/printer-24nadel/0.9/src/inserter create mode 100644 system/printer-24nadel/0.9/src/module24 create mode 100644 system/printer-24nadel/0.9/src/printer.24.nadel create mode 100644 system/printer-24nadel/schulis-mathe-1.0/doc/readme create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/beschreibungen24 create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/fonttab.brother create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq1500 create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq850 create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5 create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5.new create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p6+ create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/fonttab.oki create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/fonttab.toshiba.p321 create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/inserter create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/module24 create mode 100644 system/printer-24nadel/schulis-mathe-1.0/src/printer.24.nadel create mode 120000 system/printer-24nadel/schulis-sim-3.0 create mode 100644 system/printer-9nadel/0.9/doc/readme create mode 100644 system/printer-9nadel/0.9/source-disk create mode 100644 system/printer-9nadel/0.9/src/beschreibungen9 create mode 100644 system/printer-9nadel/0.9/src/fonttab.1 create mode 100644 system/printer-9nadel/0.9/src/fonttab.10 create mode 100644 system/printer-9nadel/0.9/src/fonttab.20 create mode 100644 system/printer-9nadel/0.9/src/fonttab.20.lc create mode 100644 system/printer-9nadel/0.9/src/fonttab.20.lx create mode 100644 system/printer-9nadel/0.9/src/fonttab.7 create mode 100644 system/printer-9nadel/0.9/src/fonttab.7.cxp create mode 100644 system/printer-9nadel/0.9/src/fonttab.7.fuj create mode 100644 system/printer-9nadel/0.9/src/fonttab.7.mt create mode 100644 system/printer-9nadel/0.9/src/module9 create mode 100644 system/printer-9nadel/0.9/src/printer.neun.nadel create mode 100644 system/printer-laser/4/doc/readme create mode 100644 system/printer-laser/4/source-disk create mode 100644 system/printer-laser/4/src/fonttab.apple.laserwriter create mode 100644 system/printer-laser/4/src/fonttab.canon.lbp-8 create mode 100644 system/printer-laser/4/src/fonttab.epson.sq create mode 100644 system/printer-laser/4/src/fonttab.hp.laserjet create mode 100644 system/printer-laser/4/src/fonttab.kyocera.f-1010 create mode 100644 system/printer-laser/4/src/fonttab.nec.lc-08 create mode 100644 system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1 create mode 100644 system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2 create mode 100644 system/printer-laser/4/src/laser.inserter create mode 100644 system/printer-laser/4/src/printer.apple.laserwriter create mode 100644 system/printer-laser/4/src/printer.canon.lbp-8 create mode 100644 system/printer-laser/4/src/printer.epson.sq create mode 100644 system/printer-laser/4/src/printer.hp.laserjet create mode 100644 system/printer-laser/4/src/printer.kyocera.f-1010 create mode 100644 system/printer-laser/4/src/printer.nec.lc-08 create mode 100644 system/setup/3.1/source-disk create mode 100644 system/setup/3.1/src/AT-4.x create mode 100644 system/setup/3.1/src/SHARD create mode 100644 system/setup/3.1/src/SHard Basis create mode 100644 system/setup/3.1/src/bootblock create mode 100644 system/setup/3.1/src/configuration create mode 100644 system/setup/3.1/src/neu create mode 100644 system/setup/3.1/src/setup eumel -1: mini eumel dummies create mode 100644 system/setup/3.1/src/setup eumel 0: -M create mode 100644 system/setup/3.1/src/setup eumel 0: -S create mode 100644 system/setup/3.1/src/setup eumel 1: basisoperationen create mode 100644 system/setup/3.1/src/setup eumel 2: modulzugriffe create mode 100644 system/setup/3.1/src/setup eumel 3: modulkonfiguration create mode 100644 system/setup/3.1/src/setup eumel 4: dienstprogramme create mode 100644 system/setup/3.1/src/setup eumel 5: partitionierung create mode 100644 system/setup/3.1/src/setup eumel 6: shardmontage create mode 100644 system/setup/3.1/src/setup eumel 7: setupeumel create mode 100644 system/setup/3.1/src/setup eumel erzeugen create mode 100644 system/setup/3.1/src/setup eumel erzeugen-M create mode 100644 system/setup/3.1/src/shget.exe create mode 100644 system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik create mode 100644 system/std.graphik/1.8.7/doc/GRAPHIK.book create mode 100644 system/std.graphik/1.8.7/doc/graphik beschreibung create mode 100644 system/std.graphik/1.8.7/source-disk create mode 100644 system/std.graphik/1.8.7/src/Beispiel.Kreuz create mode 100644 system/std.graphik/1.8.7/src/Beispiel.Sinus create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Picfile create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Plot create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Plotter create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Server create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Transform create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.vektor plot create mode 100644 system/std.graphik/1.8.7/src/HP7475.plot create mode 100644 system/std.graphik/1.8.7/src/PC.plot create mode 100644 system/std.graphik/1.8.7/src/ZEICHENSATZ create mode 100644 system/std.graphik/1.8.7/src/gen Graphik create mode 100644 system/std.graphik/1.8.7/src/gen Plotter create mode 100644 system/std.graphik/1.8.7/src/graphik editor create mode 100644 system/std.zusatz/1.8.7/source-disk create mode 100644 system/std.zusatz/1.8.7/src/AT Generator create mode 100644 system/std.zusatz/1.8.7/src/AT Utilities create mode 100644 system/std.zusatz/1.8.7/src/AT install create mode 100644 system/std.zusatz/1.8.7/src/complex create mode 100644 system/std.zusatz/1.8.7/src/crypt create mode 100644 system/std.zusatz/1.8.7/src/eumel printer.5 create mode 100644 system/std.zusatz/1.8.7/src/eumelmeter create mode 100644 system/std.zusatz/1.8.7/src/font convertor 9 create mode 100644 system/std.zusatz/1.8.7/src/free channel create mode 100644 system/std.zusatz/1.8.7/src/longint create mode 100644 system/std.zusatz/1.8.7/src/matrix create mode 100644 system/std.zusatz/1.8.7/src/port server create mode 100644 system/std.zusatz/1.8.7/src/printer server create mode 100644 system/std.zusatz/1.8.7/src/purge create mode 100644 system/std.zusatz/1.8.7/src/referencer create mode 100644 system/std.zusatz/1.8.7/src/reporter create mode 100644 system/std.zusatz/1.8.7/src/scheduler create mode 100644 system/std.zusatz/1.8.7/src/spool cmd create mode 100644 system/std.zusatz/1.8.7/src/spool manager create mode 100644 system/std.zusatz/1.8.7/src/std analysator create mode 100644 system/std.zusatz/1.8.7/src/vector create mode 100755 tools/highlight.py create mode 100755 tools/makeindex.py diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e81d4a3 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +_build +*.sw? diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..a986f6c --- /dev/null +++ b/Makefile @@ -0,0 +1,21 @@ +all: _build/index.html + +_build: + mkdir -p $@ + find app devel doc/ lang system -mindepth 4 -type f | grep '/src/' | parallel 'tools/highlight.py {}' + +_build/packages.rst: | _build + tools/makeindex.py > $@ + +_build/index.html: README.rst _build/packages.rst + rst2html5.py --cloak-email-addresses --math-output=mathjax \ + --syntax-highlight=short --link-stylesheet \ + --stylesheet=../../style.min.css \ + --template=./template.txt \ + --footnote-references=superscript < README.rst > $@ + +.PHONY: clean _build/packages.rst + +clean: + $(RM) -r _build + diff --git a/README.rst b/README.rst new file mode 100644 index 0000000..f9dba99 --- /dev/null +++ b/README.rst @@ -0,0 +1,46 @@ +EUMEL source code +================= + +Source code and documentation for the `EUMEL operating system`_. Most files +have been extracted from archive disks using `EUMEL utilities`_. + +.. _EUMEL operating system: https://6xq.net/eumel/ +.. _EUMEL utilities: https://github.com/PromyLOPh/eumel-tools + +`This repository`_ is organized as follows: + +.. _This repository: https://github.com/PromyLOPh/eumel-src + +``///{data,doc,src}`` + +*Category* is one of these: + +app + User applications +devel + Developer tools, mainly for debugging the system +doc + Documentation for EUMEL, not belonging to any package +lang + Programming language support (BASIC, PROLOG, LISP, DYNAMO) +system + System packages (base, printer, …) + +*Package* is the software’s name (not to be confused by EUMEL’s packet +concept), *version* is the package’s version (sometimes a best-guess) and these +subdirectories may exist inside each version directory: + +data + Supplementary dataspaces +doc + Documentation, usually EUMEL text files +src + Source code, usually ELAN or assembly + +.. contents:: + +Packages +-------- + +.. include:: _build/packages.rst + 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 . + diff --git a/devel/debug-copy/1986.07.11/source-disk b/devel/debug-copy/1986.07.11/source-disk new file mode 100644 index 0000000..cafd9fe --- /dev/null +++ b/devel/debug-copy/1986.07.11/source-disk @@ -0,0 +1 @@ +debug/debug-copy.img diff --git a/devel/debug-copy/1986.07.11/src/copy files b/devel/debug-copy/1986.07.11/src/copy files new file mode 100644 index 0000000..83b6f68 --- /dev/null +++ b/devel/debug-copy/1986.07.11/src/copy files @@ -0,0 +1,2977 @@ +PACKET copy worker DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + copy worker, (* 11.07.86 *) + ds page nr feld, + block nr feld, + anzahl feld, + size feld, + check pointer feld, + check vektor start feld, + check vektor laenge: + +LET continue channel code = 200, + archive blocks code = 201, + format disk code = 202, + read code = 203, + write code = 204, + check read code = 205, + init rerun test code = 206; + +INT CONST ds page nr feld :: 1, + block nr feld :: 2, + anzahl feld :: 3, + size feld :: 4, + check pointer feld :: 9, + check vektor start feld :: 10, + + check vektor laenge :: 19; + +LET ack = 0; + +BOUND ROW 252 INT VAR align; + +BOUND STRUCT (ALIGN dummy, ROW 256 INT check row) VAR check struct; +DATASPACE VAR check ds; +INITFLAG VAR check ds initialisiert := FALSE; + +INT VAR old session; + +PROC copy worker: + access catalogue; + global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) copy worker) + +END PROC copy worker; + +PROC copy worker (DATASPACE VAR ds, INT CONST order, phase, TASK CONST order task): + enable stop; + INT VAR dummy; dummy := phase; (* so schalte ich eine warnung ab *) + ueberpruefe zugriffsberechtigung von order task; + SELECT order OF + CASE continue channel code: do continue channel (ds, order task) + CASE archive blocks code: do archive blocks (ds, order task) + CASE format disk code: do format disk (ds, order task) + CASE read code: do read (ds, order task) + CASE write code: do write (ds, order task) + CASE check read code: do check read (ds, order task) + CASE init rerun test code: do init rerun test (ds, order task) + OTHERWISE error stop ("falscher Auftrag") + END SELECT. + +ueberpruefe zugriffsberechtigung von order task: + IF NOT (order task = father (myself)) + THEN error stop ("Unerlaubter Zugriff") + FI. + +END PROC copy worker; + +PROC do continue channel (DATASPACE VAR ds, TASK CONST order task): + BOUND INT VAR channel nr := ds; + continue channel (channel nr + 0); (* + 0 --> keine Seiteneffekte *) + send (order task, ack, ds). + +END PROC do continue channel; + +PROC do archive blocks (DATASPACE VAR ds, TASK CONST order task): + enable stop; + check rerun; + BOUND INT VAR archive size := ds; + archive size := size (archive size); + send (order task, ack, ds). + +END PROC do archive blocks; + +PROC do init rerun test (DATASPACE VAR ds, TASK CONST order task): + old session := session; + send (order task, ack, ds). + +END PROC do init rerun test; + +PROC do format disk (DATASPACE VAR ds, TASK CONST order task): + enable stop; + check rerun; + BOUND INT VAR format code := ds; + format archive (format code); + send (order task, ack, ds). + +END PROC do format disk; + +PROC do read (DATASPACE VAR ds, TASK CONST order task): + enable stop; + align := ds; + INT CONST ds start :: align [ds page nr feld], + disk start :: align [block nr feld], + anzahl :: align [anzahl feld]; + INT VAR return code, index; + FOR index FROM 0 UPTO anzahl - 1 REP + check rerun; + read block (ds, ds page nr, disk block nr, return code); + pruefe ob lesefehler + PER; + send (order task, ack, ds). + +pruefe ob lesefehler: + IF return code <> 0 + THEN fehler melden + FI. + +fehler melden: + SELECT return code OF + CASE 1: errorstop ("Laufwerk nicht betriebsbereit") + CASE 2: errorstop ("Lesefehler bei Block " + text (disk block nr)) + CASE 3: errorstop ("Blocknummer zu hoch " + text (disk block nr)) + CASE 4: errorstop ("Block nicht lesbar " + text (disk block nr)) + OTHERWISE errorstop ("Lesefehler " + text (return code)) + END SELECT. + +ds page nr: + ds start + index. + +disk block nr: + disk start + index. + +END PROC do read; + +PROC do write (DATASPACE VAR ds, TASK CONST order task): + enable stop; + align := ds; + INT CONST ds start :: align [ds page nr feld], + disk start :: align [block nr feld], + anzahl :: align [anzahl feld]; + INT VAR return code, index; + FOR index FROM 0 UPTO anzahl - 1 REP + check rerun; + write block (ds, ds page nr, 0, disk block nr, return code); + pruefe ob schreibfehler + PER; + send (order task, ack, ds). + +pruefe ob schreibfehler: + IF return code <> 0 + THEN fehler melden + FI. + +fehler melden: + SELECT return code OF + CASE 1: errorstop ("Laufwerk nicht betriebsbereit") + CASE 2: errorstop ("Schreibfehler bei Block " + text (disk block nr)) + CASE 3: errorstop ("Blocknummer zu hoch " + text (disk block nr)) + OTHERWISE errorstop ("Schreibfehler " + text (return code)) + END SELECT. + +ds page nr: + ds start + index. + +disk block nr: + disk start + index. + +END PROC do write; + +PROC do check read (DATASPACE VAR ds, TASK CONST order task): + enable stop; + IF NOT initialized (check ds initialisiert) + THEN check ds := nilspace; + check struct := check ds + FI; + align := ds; + INT CONST disk start :: align [block nr feld], + anzahl :: align [anzahl feld]; + INT VAR index; + INT VAR return code; + FOR index FROM 0 UPTO anzahl - 1 REP + check rerun; + read block (check ds, 2, disk block nr, return code); + pruefe ob lesefehler; + do check block + PER; + send (order task, ack, ds). + +pruefe ob lesefehler: + IF return code <> 0 + THEN fehler melden + FI. + +fehler melden: + SELECT return code OF + CASE 1: errorstop ("Laufwerk nicht betriebsbereit") + CASE 2: errorstop ("Lesefehler bei Block " + text (disk block nr)) + CASE 3: errorstop ("Blocknummer zu hoch " + text (disk block nr)) + CASE 4: errorstop ("Block nicht lesbar " + text (disk block nr)) + OTHERWISE errorstop ("Lesefehler " + text (return code)) + END SELECT. + +disk block nr: + disk start + index. + +do check block: + INT VAR block index; + FOR block index FROM 1 UPTO 256 REP + check vektor eintrag := check vektor eintrag XOR block eintrag; + incr check vektor pointer + PER. + +check vektor eintrag: + align [check vektor start feld + check pointer]. + +check pointer: + align [check pointer feld]. + +block eintrag: + check struct.check row [block index]. + +incr check vektor pointer: + check pointer INCR 1; + IF check pointer = check vektor laenge + THEN check pointer := 0 + FI. + +END PROC do check read; + +PROC check rerun: + IF session <> old session + THEN error stop ("Abbruch wegen RERUN") + FI. + +END PROC check rerun; + +END PACKET copy worker; +PACKET copy io interface DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + (* 21.11.86 *) + copy channel, + start copy worker, + initialisiere rerun test, + initialisiere diskettenzugriff, + formatiere diskette, + read, + check read, + write, + stop copy worker: + +LET ack = 0, + error nak = 2, + free code = 20; + +LET continue channel code = 200, + archive blocks code = 201, + format disk code = 202, + read code = 203, + write code = 204, + check read code = 205, + init rerun test code = 206; + +INT VAR reply; +DATASPACE VAR ds := nilspace; forget (ds); + +BOUND ROW 252 INT VAR align; + +TASK VAR worker := niltask; +INT VAR worker channel := 31; + +INT PROC copy channel: + worker channel + +END PROC copy channel; + +PROC copy channel (INT CONST channel nr): + worker channel := channel nr + +END PROC copy channel; + +PROC initialisiere rerun test: + forget (ds); + ds := nilspace; + call (worker, init rerun test code, ds, reply); + forget (ds). + +END PROC initialisiere rerun test; + +PROC start copy worker: + stop copy worker; + bestimme worker name; + starte worker; + kopple worker an kanal. + +bestimme worker name: + TEXT VAR worker name := "copy worker"; + access catalogue; + BOUND THESAURUS CONST system catalogue :: syscat; + WHILE system catalogue CONTAINS worker name REP + worker name CAT "." + PER. + +starte worker: + begin (worker name, PROC copy worker, worker). + +kopple worker an kanal: + kanal freigeben falls diese task copy channel belegt; + forget (ds); + ds := nilspace; + BOUND INT VAR nr := ds; + nr := worker channel; + call (worker, continue channel code, ds, reply); + IF reply = error nak + THEN end (worker); + worker := niltask; + show error (ds) + ELIF reply <> ack + THEN end (worker); + worker := niltask; + forget (ds); + error stop ("copy worker nicht an Kanal " + text (worker channel) + + " ankoppelbar") + FI; + forget (ds). + +kanal freigeben falls diese task copy channel belegt: + TASK CONST channel owner := task (copy channel); + IF NOT is niltask (channel owner) AND NOT (myself = channel owner) + THEN forget (ds); + ds := nilspace; + pingpong (channel owner, free code, ds, reply); + forget (ds) + FI. + +END PROC start copy worker; + +PROC initialisiere diskettenzugriff: + INT VAR dummy; + initialisiere diskettenzugriff (dummy) + +END PROC initialisiere diskettenzugriff; + +PROC initialisiere diskettenzugriff (INT VAR size): + initialisiere diskettenzugriff (0, size) + +END PROC initialisiere diskettenzugriff; + +PROC initialisiere diskettenzugriff (INT CONST mode, INT VAR size): + enable stop; + size := 0; + forget (ds); + ds := nilspace; + BOUND INT VAR i := ds; + i := mode; + call (worker, archive blocks code, ds, reply); + IF reply = error nak + THEN show error (ds) + ELSE i := ds; + size := i + FI; + forget (ds). + +END PROC initialisiere diskettenzugriff; + +PROC formatiere diskette (INT CONST modus): + enable stop; + forget (ds); + ds := nilspace; + BOUND INT VAR format param := ds; + format param := modus; + call (worker, format disk code, ds, reply); + IF reply = error nak + THEN show error (ds) + FI; + forget (ds). + + +END PROC formatiere diskette; + +PROC read (DATASPACE VAR in ds, INT CONST erste ds seite, erster disk block, + anzahl bloecke): + enable stop; + align := in ds; + align [ds page nr feld] := erste ds seite; + align [block nr feld] := erster disk block; + align [anzahl feld] := anzahl bloecke; + call (worker, read code, in ds, reply); + IF reply = error nak + THEN show error (in ds) + FI. + +END PROC read; + +PROC write (DATASPACE VAR aus ds, INT CONST erste ds seite, erster disk block, + anzahl bloecke): + enable stop; + align := aus ds; + align [ds page nr feld] := erste ds seite; + align [block nr feld] := erster disk block; + align [anzahl feld] := anzahl bloecke; + call (worker, write code, aus ds, reply); + IF reply = error nak + THEN show error (aus ds) + FI. + +END PROC write; + +PROC check read (DATASPACE VAR in ds, INT CONST erster disk block, + anzahl bloecke): + enable stop; + align := in ds; + align [block nr feld] := erster disk block; + align [anzahl feld] := anzahl bloecke; + call (worker, check read code, in ds, reply); + IF reply = error nak + THEN show error (in ds) + FI. + +END PROC check read; + +PROC stop copy worker: + IF NOT (worker = niltask) + THEN disable stop; + end (worker); + worker := niltask; + clear error + FI. + +END PROC stop copy worker; + +PROC show error (DATASPACE CONST error ds): + BOUND TEXT VAR error msg := error ds; + error stop (error msg). + +END PROC show error; + +END PACKET copy io interface; +PACKET copy utilities DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + (* 21.11.86 *) + ds start, + hg type, + disk type, + urlader type, + diskette anfordern, + disketten groesse zeigen, + ds name eingabe, + initialisiere check read, + check summe abspeichern, + check summen vergleichen, + some, + list, + evtl diskette formatieren, + read and retry, + write and retry, + check read and retry: + +INT CONST hg type :: 801, + disk type :: 802, + urlader type :: 803; + +INT CONST ds start :: 2; + +DATASPACE VAR list ds := nilspace; forget (list ds); +DATASPACE VAR save ds := nilspace; forget (save ds); + +PROC diskette anfordern (TEXT CONST prompt): + WHILE NOT online REP pause (20) PER; + command dialogue (TRUE); + IF no (prompt) + THEN error stop ("Diskette nicht eingelegt") + FI; + line. + +END PROC diskette anfordern; + +PROC disketten groesse zeigen (INT CONST blocks): + putline ("die eingelegte Diskette enthält " + text (blocks DIV 2) + " KB"); + line. + +END PROC disketten groesse zeigen; + +PROC ds name eingabe (TEXT VAR name, TEXT CONST name pre, + BOOL CONST soll existieren, + TEXT CONST type vektor): + enable stop; + IF soll existieren + THEN name eines existierenden ds bestimmen + ELSE name eines neuen ds bestimmen + FI. + +name eines existierenden ds bestimmen: + IF NOT name gueltig + THEN name := name pre + FI; + editget (name); + line; + WHILE NOT name gueltig REP + fehler zeigen; + IF yes ("neuen Namen angeben (sonst Abbruch)") + THEN put ("Eingabe:"); + editget (name); + line + ELSE errorstop ("Abbruch, da Name fehlerhaft") + FI; + PER. + +name gueltig: + (name <> "") CAND (exists (name)) CAND type ok. + +type ok: + IF LENGTH type vektor = 0 + THEN TRUE + ELSE INT CONST ds type := type (old (name)); + INT VAR p; + FOR p FROM 1 UPTO length (type vektor) DIV 2 REP + IF ds type = (type vektor ISUB p) + THEN LEAVE type ok WITH TRUE + FI + PER; + FALSE + FI. + +fehler zeigen: + IF name = "" + THEN putline ("Kein Name angegeben") + ELIF NOT exists (name) + THEN putline ("""" + name + """ gibt es nicht") + ELSE putline ("""" + name + """ hat falschen Typ") + FI. + +name eines neuen ds bestimmen: + name := name pre; + editget (name); + line; + WHILE exists (name) OR (name = "") REP + IF name = "" + THEN put ("Kein Name eingegeben, Eingabe:"); + editget (name); + line + ELIF yes ("alten Datenraum """ + name + """ löschen") + THEN forget (name, quiet) + ELIF yes ("neuen Namen angeben (sonst Abbruch)") + THEN put ("bitte Datenraumnamen angeben:"); + editget (name); + line + ELSE error stop ("""" + name + """ existiert schon") + FI + PER. + +END PROC ds name eingabe; + +PROC initialisiere check read (DATASPACE VAR check read ds): + enable stop; + BOUND ROW 252 INT VAR align; + align := check read ds; + align [check pointer feld] := check vektor start feld; + INT VAR i; + FOR i FROM 0 UPTO check vektor laenge - 1 REP + align [check vektor start feld + i] := i + PER. + +END PROC initialisiere check read; + +PROC check summe abspeichern (TEXT CONST file name, DATASPACE CONST ds): + BOUND ROW 252 INT VAR align := ds; + FILE VAR f := sequential file (output, file name); + putline (f, "Prüfsumme"); + INT VAR i; + FOR i FROM 0 UPTO check vektor laenge - 1 REP + putline (f, text (align [check vektor start feld + i])) + PER. + +END PROC check summe abspeichern; + +TEXT VAR edit type vektor := " "; replace (edit type vektor, 1, 1003); + +PROC check summen vergleichen: + enable stop; + datei namen erfragen; + dateien vergleichen. + +datei namen erfragen: + TEXT VAR name1 := "prüf.", + name2 := "prüf."; + put ("Bitte Dateinamen der ersten Prüfsummendatei eingeben:"); + ds name eingabe (name1, "prüf.", TRUE, edit type vektor); + line; + put ("Bitte Dateinamen der zweiten Prüfsummendatei eingeben:"); + ds name eingabe (name2, "prüf.", TRUE, edit type vektor); + line. + +dateien vergleichen: + FILE VAR f1 := sequential file (modify, name1); + FILE VAR f2 := sequential file (modify, name2); + INT VAR i; + FOR i FROM 1 UPTO check vektor laenge + 1 REP + vergleiche zeilen + PER; + putline ("Die Prüfsummen stimmen überein"). + +vergleiche zeilen: + TEXT VAR zeile1, zeile2; + to line (f1, i); + to line (f2, i); + read record (f1, zeile1); + read record (f2, zeile2); + IF zeile1 <> zeile2 + THEN putline (""7"FEHLER: UNTERSCHIEDLICHE PRÜFSUMMEN"); + LEAVE check summen vergleichen + FI. + +END PROC check summen vergleichen; + +THESAURUS PROC some (THESAURUS CONST ur, INT CONST ds type): + THESAURUS VAR ziel := empty thesaurus; + TEXT VAR name; + INT VAR index := 0; + get (ur, name, index); + WHILE index > 0 REP + IF type (old (name)) = ds type + THEN insert (ziel, name) + FI; + get (ur, name, index); + PER; + ziel. + +END PROC some; + +PROC list (THESAURUS CONST list thes, TEXT CONST head text): + disable stop; + forget (list ds); + list ds := nilspace; + FILE VAR list file := sequential file (output, list ds); + headline (list file, head text); + INT VAR index := 0; + TEXT VAR name; + get (list thes, name, index); + WHILE index > 0 REP + putline (list file, name); + get (list thes, name, index); + PER; + show (list file); + forget (list ds). + +END PROC list; + +PROC read and retry (DATASPACE VAR in ds, INT CONST erste ds seite, erster disk block, + anzahl bloecke): + disable stop; + forget (save ds); + save ds := in ds; + read (in ds, erste ds seite, erster disk block, anzahl bloecke); + WHILE is error REP + putline (""4"" + error message); + forget (in ds); + in ds := save ds; + IF yes ("noch ein Versuch") + THEN clear error; + read (in ds, erste ds seite, erster disk block, anzahl bloecke); + ELSE forget (save ds); enable stop + FI; + line + PER; + forget (save ds). + + +END PROC read and retry; + +PROC write and retry (DATASPACE VAR out ds, INT CONST erste ds seite, erster disk block, + anzahl bloecke): + disable stop; + forget (save ds); + save ds := out ds; + write (out ds, erste ds seite, erster disk block, anzahl bloecke); + WHILE is error REP + putline (""4"" + error message); + forget (out ds); + out ds := save ds; + IF yes ("noch ein Versuch") + THEN clear error; + write (out ds, erste ds seite, erster disk block, anzahl bloecke); + ELSE forget (save ds); enable stop + FI; + line + PER; + forget (save ds). + +END PROC write and retry; + +PROC check read and retry (DATASPACE VAR in ds, INT CONST erster disk block, + anzahl bloecke): + disable stop; + forget (save ds); + save ds := in ds; + check read (in ds, erster disk block, anzahl bloecke); + WHILE is error REP + putline (""4"" + error message); + forget (in ds); + in ds := save ds; + IF yes ("noch ein Versuch") + THEN clear error; + check read (in ds, erster disk block, anzahl bloecke); + ELSE enable stop + FI; + line + PER. + +END PROC check read and retry; + +TEXT VAR formatierschluessel := "0"; + +PROC evtl diskette formatieren: + command dialogue (TRUE); + IF yes ("Diskette zuerst formatieren") + THEN disable stop; + put ("Formatiercode:"); edit get (formatierschluessel); + formatiere diskette (int (formatierschluessel)); + line; + WHILE is error REP + putline (""4"" + error message); + IF yes ("noch ein Versuch") + THEN clear error; + put ("Formatiercode:"); edit get (formatierschluessel); + formatiere diskette (int (formatierschluessel)); + line + ELSE enable stop + FI; + PER; + enable stop; + FI; + line. + +END PROC evtl diskette formatieren; + +END PACKET copy utilities; +PACKET info DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + (* 20.08.86 *) + informationen ausgeben, + urlader informationen von diskette ausgeben, + urlader informationen von datenraum ausgeben, + hg informationen von diskette ausgeben, + hg informationen von datenraum ausgeben: + +TEXT VAR hg vektor := " "; replace (hg vektor, 1, hg type); + +TEXT VAR hg urlader vektor := " "; replace (hg urlader vektor, 1, hg type); + replace (hg urlader vektor, 2, urlader type); + + +BOUND STRUCT (ROW 252 INT align, ROW 10240 INT row) VAR ds struct; +DATASPACE VAR ds work := nilspace; forget (ds work); + +INT VAR disk size; + +TEXT VAR versions nr; + +TEXT CONST eumel kennzeichen :: "EUMEL-"; +INT CONST eumel kennzeichen wort 0 :: eumel kennzeichen ISUB 1, + eumel kennzeichen wort 1 :: eumel kennzeichen ISUB 2, + eumel kennzeichen wort 2 :: (eumel kennzeichen ISUB 3) AND 255; + +TEXT VAR ds name := ""; + +PROC hg informationen von diskette ausgeben: + disable stop; + enable hg informationen von diskette ausgeben; + forget (ds work). + +END PROC hg informationen von diskette ausgeben; + +PROC enable hg informationen von diskette ausgeben: + enable stop; + initialisiere rerun test; + ds work := nilspace; + erste diskette anfordern; + relevante bloecke lesen; + informationen ausgeben (ds work, TRUE, TRUE). + +erste diskette anfordern: + command dialogue (TRUE); + diskette anfordern ("erste Hintergrunddiskette eingelegt"); + cursor (1, 19); out (""4""). + +relevante bloecke lesen: + initialisiere disketten zugriff (0, disk size); + read (ds work, ds start, 0, 1); + read (ds work, ds start + 10, 10, 1). + +END PROC enable hg informationen von diskette ausgeben; + +PROC urlader informationen von diskette ausgeben: + disable stop; + enable urlader informationen von diskette ausgeben; + forget (ds work). + +END PROC urlader informationen von diskette ausgeben; + +PROC enable urlader informationen von diskette ausgeben: + enable stop; + initialisiere rerun test; + ds work := nilspace; + erste diskette anfordern; + relevante bloecke lesen; + informationen ausgeben (ds work, FALSE, TRUE). + +erste diskette anfordern: + diskette anfordern ("Urlader-Diskette eingelegt"); + cursor (1, 19); out (""4""). + +relevante bloecke lesen: + initialisiere disketten zugriff (0, disk size); + read (ds work, ds start + 10, 10, 1). + +END PROC enable urlader informationen von diskette ausgeben; + +PROC hg informationen von datenraum ausgeben: + disable stop; + hg ds namen bestimmen; + ds work := old (ds name); + informationen ausgeben (ds work, TRUE, TRUE); + forget (ds work). + +hg ds namen bestimmen: + put ("Bitte Datenraumnamen eingeben:"); + ds name eingabe (ds name, "HG", TRUE, hg vektor); + cursor (1, 19); out (""4""). + +END PROC hg informationen von datenraum ausgeben; + +PROC urlader informationen von datenraum ausgeben: + disable stop; + urlader ds namen bestimmen; + ds work := old (ds name); + informationen ausgeben (ds work, FALSE, TRUE); + forget (ds work). + +urlader ds namen bestimmen: + put ("Bitte Datenraumnamen eingeben:"); + ds name eingabe (ds name, "", TRUE, hg urlader vektor); + cursor (1, 19); out (""4""). + +END PROC urlader informationen von datenraum ausgeben; + +PROC informationen ausgeben (DATASPACE CONST ds, + BOOL CONST hg info, urlader info): + enable stop; + ds struct := ds; + IF hg info + THEN hg info ausgeben + FI; + IF urlader info + THEN urlader info ausgeben + FI. + +hg info ausgeben: + teste eumelkennzeichen; + versionsnummer ausgeben; + hg groesse ausgeben. + +teste eumelkennzeichen: + IF (eumelkennzeichen wort 0 <> ds struct.row [1]) OR + (eumelkennzeichen wort 1 <> ds struct.row [2]) OR + (eumelkennzeichen wort 2 <> (ds struct.row [3] AND 255)) OR + (NOT no plus hg AND (ds struct.row [43] <> 0)) + (* ds struct.row [43] <--> Sequenznummer *) + THEN error stop ("die Diskette ist nicht die erste Diskette eines EUMEL Hintergrundes") + FI. + +versionsnummer ausgeben: + versions nr := 6 * " "; + replace (versions nr, 1, ds struct.row [4]); + replace (versions nr, 2, ds struct.row [5]); + replace (versions nr, 3, ds struct.row [6]); + put ("EUMEL Hintergrund-Versionsnummer: " + versions nr); + IF NOT no plus hg + THEN put (" (grosse Speicherverwaltung)"); + FI; + line. + +hg groesse ausgeben: + IF no plus hg + THEN putline (" Hintergrund-Größe: " + text (4 * ds struct.row [19]) + " KB") + ELSE putline (" Hintergrund-Größe: " + text ((ds struct.row [41] + 1) DIV 2) + " KB") + FI. + +no plus hg: + (ds struct.row [41] = 1) AND (ds struct.row [42] = 0). + +urladerinfo ausgeben: + IF diskette enthaelt urlader + THEN urlader informationen vorhanden + ELIF hg info + THEN putline ("Diskette enthält keinen Urlader") + ELSE error stop ("Diskette enthält keinen Urlader") + FI. + +diskette enthaelt urlader: + (eumelkennzeichen wort 0 = ds struct.row [2561]) AND + (eumelkennzeichen wort 1 = ds struct.row [2562]) AND + (eumelkennzeichen wort 2 = (ds struct.row [2563] AND 255)). + +urlader informationen vorhanden: + urlader format bestimmen; + put (" Urladerversion: "); put (urlader version); line; + put (" Urlader-CPU-Type:"); put (cpu type); line; + put (" SHardversion min:"); put (shard version min); line; + put (" SHardversion max:"); put (shard version max); + put (" "). + +urladerformat bestimmen: + BOOL VAR motorola format := (ds struct.row [2571] = 1024). + +urlader version: + INT VAR dummy := ds struct.row [2572]; + TEXT VAR ur ver := ""; + IF motorola format + THEN rotate (dummy, 8); + INT CONST monate :: dummy DIV 100, + tag :: dummy MOD 100; + ur ver := text (tag); + ur ver CAT "."; + ur ver CAT text (m68000 monat); + ur ver CAT "."; + ur ver CAT text (84 + (monate - 1) DIV 12) + ELSE ur ver := "#" + text (dummy) + FI; + ur ver. + +m68000 monat: + IF monate MOD 12 = 0 + THEN 12 + ELSE monate MOD 12 + FI. + +shard version min: + IF motorola format + THEN dummy := ds struct.row [2573]; + rotate (dummy, 8) + ELSE dummy := ds struct.row [2574]; + FI; + dummy. + +shard version max: + IF motorola format + THEN dummy := ds struct.row [2574]; + rotate (dummy, 8) + ELSE dummy := ds struct.row [2575]; + FI; + dummy. + +cpu type: + INT CONST cpu int :: ds struct.row [2571]; + IF cpu int = 1 + THEN "Z 80" + ELIF cpu int = 3 + THEN "INTEL 8086 / 8088" + ELIF cpu int = 1024 + THEN "Motorola 68000" + ELSE text (cpu int) + FI. + +END PROC informationen ausgeben; + +END PACKET info; +PACKET gigads DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + GIGADS, (* 11.07.86 *) + + giga ds size, + :=, + old zuweisen, + main, + forget, + copy, + read and retry, + write and retry, + informationen ausgeben, + type: + +LET max ds no = 10; + +TYPE GIGADS = ROW max ds no DATASPACE; + +INT VAR xgigads size; + +PROC gigads size (INT CONST max block no): + xgigads size := max block no + +END PROC giga ds size; + +INT PROC last used ds: + (xgigads size DIV 2000) + 1 + +END PROC last used ds; + +INT PROC ds no (INT CONST page no): + (page no DIV 2000) + 1. + +END PROC ds no; + +INT PROC ds page no (INT CONST page no): + IF ds no (page no) = 1 + THEN page no + ELSE (page no MOD 2000) + 2 + FI. + +END PROC ds page no; + +TEXT PROC name (TEXT CONST pre, INT CONST no): + IF no = 1 + THEN pre + ELSE pre + ".hintergrund datenraum extension nummer " + text (no - 1) + FI. + +END PROC name; + +OP := (GIGADS VAR gig, DATASPACE CONST ds): + gig [1] := ds; + INT VAR count; + FOR count FROM 2 UPTO max ds no REP + gig [count] := nilspace + PER + +END OP :=; + +DATASPACE PROC main (GIGADS CONST gig): + gig [1] + +END PROC main; + +PROC type (GIGADS VAR gig, INT CONST value): + INT VAR count; + FOR count FROM 1 UPTO max ds no REP + type (gig [count], value) + PER. + +END PROC type; + +INT PROC type (GIGADS CONST gig): + INT CONST value :: type (gig [1]); + INT VAR count; + FOR count FROM 2 UPTO max ds no REP + IF type (gig [count]) <> value + THEN error stop ("GIGADS inconsistent") + FI + PER; + value. + +END PROC type; + +PROC forget (GIGADS VAR gig): + INT VAR count; + FOR count FROM 1 UPTO max ds no REP + forget (gig [count]) + PER. + +END PROC forget; + +PROC copy (GIGADS CONST gig, TEXT CONST name0): + IF exists (name 0) + THEN error stop ("""" + name0 + """ existiert schon") + FI; + INT VAR count; + FOR count FROM 1 UPTO last used ds REP + forget (name (name 0, count), quiet); + copy (gig [count], name (name 0, count)) + PER + +END PROC copy; + +PROC old zuweisen (GIGADS VAR gig, TEXT CONST name0): + gig [1] := old (name0); + INT VAR count; + FOR count FROM 2 UPTO max ds no REP + IF exists (name (name0, count)) + THEN gig [count] := old (name (name0, count)) + ELSE gig [count] := nilspace + FI + PER. + +END PROC old zuweisen; + +PROC read and retry (GIGADS VAR gig, + INT CONST erste ds seite, erster disk block, anzahl bloecke): + INT CONST no1 :: ds no (erste ds seite), + no2 :: ds no (erste ds seite + anzahl bloecke - 1); + IF no1 = no2 + THEN read and retry (gig [no1], ds page no (erste ds seite), + erster disk block, anzahl bloecke) + ELSE INT VAR count; + FOR count FROM 0 UPTO anzahl bloecke - 1 REP + read and retry (gig [ds no (erste ds seite + count)], + ds page no (erste ds seite + count), + erster disk block + count, 1); + PER + FI. + +END PROC read and retry; + +PROC write and retry (GIGADS VAR gig, INT CONST erste ds seite, erster disk block, + anzahl bloecke): + INT CONST no1 :: ds no (erste ds seite), + no2 :: ds no (erste ds seite + anzahl bloecke - 1); + IF no1 = no2 + THEN write and retry (gig [no1], ds page no (erste ds seite), + erster disk block, anzahl bloecke) + ELSE INT VAR count; + FOR count FROM 0 UPTO anzahl bloecke - 1 REP + write and retry (gig [ds no (erste ds seite + count)], + ds page no (erste ds seite + count), + erster disk block + count, 1) + PER + FI. + +END PROC write and retry; + +PROC informationen ausgeben (GIGADS CONST gig, BOOL CONST b1, b2): + informationen ausgeben (gig [1], b1, b2) + +END PROC informationen ausgeben; + +END PACKET gigads; + +PACKET copy hg DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + hg lesen, (* 11.07.86 *) + hg schreiben, + hg check sum: + +TEXT VAR hg vektor := " "; replace (hg vektor, 1, hg type); + +TEXT VAR ds name := ""; + +INT VAR disk size, + hg bloecke verarbeitet, + hg bloecke zu verarbeiten, + disk bloecke verarbeitet; + +BOUND STRUCT (ROW 252 INT align, ROW 10240 INT row) VAR ds work struct; +GIGADS VAR ds work := nilspace; forget (ds work); + +DATASPACE VAR check ds := nilspace; forget (check ds); + +PROC hg lesen: + disable stop; + enable hg lesen; + forget (ds work). + +END PROC hg lesen; + +PROC enable hg lesen: + enable stop; + initialisiere rerun test; + ds work := nilspace; + ds work struct := main (ds work); + type (ds work, hg type); + diskette anfordern ("erste zu lesende Hintergrunddiskette eingelegt"); + initialisiere disketten zugriff (0, disk size); + header bloecke lesen; + informationen ausgeben (ds work, TRUE, TRUE); + line (2); + ds work namen bestimmen; + IF plus version + THEN hintergrund rest lesen plus version + ELSE hintergrundrest lesen no plus version + FI; + copy (ds work, ds name). + +header bloecke lesen: + read and retry (ds work, ds start, 0, 1); + read and retry (ds work, ds start + 10, 10, 1); + hg bloecke verarbeitet := 1; + disk bloecke verarbeitet := 1. + +ds work namen bestimmen: + put ("bitte Datenraumnamen angeben:"); + ds name eingabe (ds name, "HG", FALSE, ""); + line. + +plus version: + NOT ((ds work struct.row [41] = 1) AND (ds work struct.row [42] = 0)). + +END PROC enable hg lesen; + +PROC hintergrund rest lesen no plus version: + disketten groesse zeigen (disk size); + hg bloecke zu verarbeiten := 8 * ds work struct.row [19]; + giga ds size (hg bloecke zu verarbeiten + ds start); + status zeigen; + WHILE hg bloecke verarbeitet < hg bloecke zu verarbeiten REP + IF disk bloecke verarbeitet = disk size + THEN neue diskette anfordern + FI; + naechsten satz bloecke lesen; + status zeigen + PER. + +neue diskette anfordern: + diskette anfordern (""4"nächste zu lesende Hintergrunddiskette eingelegt"); + initialisiere disketten zugriff (0, disk size); + line; + disketten groesse zeigen (disk size); + disk bloecke verarbeitet := 0. + +naechsten satz bloecke lesen: + bestimme anzahl zu lesender bloecke; + read and retry (ds work, ds start + hg bloecke verarbeitet, + disk bloecke verarbeitet, anzahl zu lesender bloecke); + hg bloecke verarbeitet INCR anzahl zu lesender bloecke; + disk bloecke verarbeitet INCR anzahl zu lesender bloecke. + +bestimme anzahl zu lesender bloecke: + INT CONST anzahl zulesender bloecke :: min (moegliche hg bloecke auf disk, 20). + +moegliche hg bloecke auf disk: + min (hg bloecke zu verarbeiten - hg bloecke verarbeitet, + disk size - disk bloecke verarbeitet). + +status zeigen: + IF online + THEN out (""13""); + putline ("Hintergrund: " + text (hg bloecke verarbeitet DIV 2, 4) + " KB gelesen"); + putline ("aktuelle Diskette: " + text (disk bloecke verarbeitet DIV 2, 4) + " KB gelesen"); + out (""3""3""13"") + FI. + +END PROC hintergrund rest lesen no plus version; + +PROC hintergrundrest lesen plus version: + BOOL VAR letzte diskette gelesen; + TEXT VAR sequenz nr map := 100 * " "; + INT VAR letzte sequenz nr; + hg bloecke zu verarbeiten := ds work struct.row [41] + 1; + giga ds size (hg bloecke zu verarbeiten + ds start); + hg bloecke verarbeitet := 1; + hg etikett merken; + lies diskette; + WHILE NOT ganzer hg gelesen REP + naechste diskette anfordern; + lies diskette + PER; + hg etikett herstellen. + +hg etikett merken: + TEXT VAR null etikett := 512 * " "; + INT VAR i; + FOR i FROM 1 UPTO 256 REP + replace (null etikett, i, ds work struct.row [i]) + PER. + +hg etikett herstellen: + FOR i FROM 1 UPTO 256 REP + ds work struct.row [i] := null etikett ISUB i + PER. + +ganzer hg gelesen: + letzte diskette gelesen CAND + (subtext (sequenz nr map, 1, letzte sequenz nr) = (letzte sequenz nr * "R")). + +naechste diskette anfordern: + diskette anfordern (""4"naechste zu lesende Hintergrunddiskette eingelegt"); + initialisiere diskettenzugriff (0, disk size); + line; + IF NOT etikett kompatibel zu null etikett + THEN error stop ("Diskette gehoert nicht zu dem bisher verarbeiteten Hintergrund") + FI. + +etikett kompatibel zu null etikett: + read and retry (ds work, ds start, 0, 1); + FOR i FROM 1 UPTO 40 REP + IF ds work struct.row [i] <> (null etikett ISUB i) + THEN LEAVE etikett kompatibel zu null etikett WITH FALSE + FI + PER; + FOR i FROM 46 UPTO 256 REP + IF ds work struct.row [i] <> (null etikett ISUB i) + THEN LEAVE etikett kompatibel zu null etikett WITH FALSE + FI + PER; + TRUE. + +lies diskette: + disketten groesse zeigen (disk size); + disk bloecke verarbeitet := 1; + INT CONST verschiebung :: ds work struct.row [44]; + INT CONST letzter disk block :: min (disk size - 1, hg bloecke zu verarbeiten - verschiebung - 1); + status zeigen; + WHILE disk bloecke verarbeitet <= letzter disk block REP + naechsten satz bloecke lesen; + status zeigen + PER; + INT CONST sequenz nr := ds work struct.row [43]; + replace (sequenz nr map, sequenz nr, "R"); + IF verschiebung + letzter disk block + 1 = hg bloecke zu verarbeiten + THEN letzte diskette gelesen := TRUE; + letzte sequenz nr := sequenz nr + FI. + +naechsten satz bloecke lesen: + read and retry (ds work, ds start + verschiebung + disk bloecke verarbeitet, + disk bloecke verarbeitet, anzahl zu lesender bloecke); + hg bloecke verarbeitet INCR anzahl zu lesender bloecke; + disk bloecke verarbeitet INCR anzahl zu lesender bloecke. + +anzahl zu lesender bloecke: + min (letzter disk block - disk bloecke verarbeitet + 1, 20). + +status zeigen: + IF online + THEN out (""13""); + putline ("Hintergrund: " + text (hg bloecke verarbeitet DIV 2, 4) + " KB gelesen"); + putline ("aktuelle Diskette: " + text (disk bloecke verarbeitet DIV 2, 4) + " KB gelesen"); + out (""3""3""13"") + FI. + +END PROC hintergrund rest lesen plus version; + +PROC hg schreiben: + disable stop; + enable hg schreiben; + forget (ds work). + +END PROC hg schreiben; + +PROC enable hg schreiben: + enable stop; + initialisiere rerun test; + hg ds namen bestimmen; + old zuweisen (ds work, ds name); + ds work struct := main (ds work); + BOOL CONST plus version :: NOT ((ds work struct.row [41] = 1) AND (ds work struct.row [42] = 0)); + informationen ausgeben (ds work, TRUE, TRUE); + line (2); + diskette anfordern ("erste zu beschreibende Diskette eingelegt"); + evtl diskette formatieren; + initialisiere diskettenzugriff (0, disk size); + disketten groesse zeigen (disk size); + hintergrund schreiben; + bei plus version ersten hg block restaurieren. + +bei plus version ersten hg block restaurieren: + ds work struct.row [43] := 0; + ds work struct.row [44] := 0; + ds work struct.row [45] := 0. + +hg ds namen bestimmen: + put ("Bitte Datenraumnamen eingeben:"); + ds name eingabe (ds name, "HG", TRUE, hg vektor); + line. + +hintergrund schreiben: + INT VAR sequenz nr := 0; + hg bloecke verarbeitet := 0; + disk bloecke verarbeitet := 0; + IF plus version + THEN hg bloecke zu verarbeiten := ds work struct.row [41] + 1 + ELSE hg bloecke zu verarbeiten := 8 * ds work struct.row [19] + FI; + giga ds size (hg bloecke zu verarbeiten + ds start); + status zeigen; + WHILE hg bloecke verarbeitet < hg bloecke zu verarbeiten REP + IF disk bloecke verarbeitet = disk size + THEN neue diskette anfordern; + bei plus version etikett schreiben + FI; + naechsten satz bloecke schreiben; + status zeigen + PER. + +neue diskette anfordern: + diskette anfordern (""4"nächste zu beschreibende Diskette eingelegt"); + evtl diskette formatieren; + initialisiere disketten zugriff (0, disk size); + disketten groesse zeigen (disk size); + disk bloecke verarbeitet := 0. + +bei plus version etikett schreiben: + IF plus version + THEN sequenz nr INCR 1; + ds work struct.row [43] := sequenz nr; + ds work struct.row [44] := hg bloecke verarbeitet - 1; + ds work struct.row [45] := 0; + write and retry (ds work, ds start, 0, 1); + disk bloecke verarbeitet := 1 + FI. + +naechsten satz bloecke schreiben: + bestimme anzahl zu schreibender bloecke; + write and retry (ds work, ds start + hg bloecke verarbeitet, + disk bloecke verarbeitet, anzahl zu schreibender bloecke); + hg bloecke verarbeitet INCR anzahl zu schreibender bloecke; + disk bloecke verarbeitet INCR anzahl zu schreibender bloecke. + +bestimme anzahl zu schreibender bloecke: + INT CONST anzahl zuschreibender bloecke :: min (moegliche hg bloecke auf disk, 20). + +moegliche hg bloecke auf disk: + min (hg bloecke zu verarbeiten - hg bloecke verarbeitet, + disk size - disk bloecke verarbeitet). + +status zeigen: + IF online + THEN out (""13""); + putline ("Hintergrund: " + text (hg bloecke verarbeitet DIV 2, 4) + " KB geschrieben"); + putline ("aktuelle Diskette: " + text (disk bloecke verarbeitet DIV 2, 4) + " KB geschrieben"); + out (""3""3""13"") + FI. + +END PROC enable hg schreiben; + +PROC hg check sum: + disable stop; + enable hg check sum; + forget (check ds). + +END PROC hg check sum; + +PROC enable hg check sum: + enable stop; + initialisiere rerun test; + check ds := nilspace; + ds work struct := check ds; + diskette anfordern ("erste Hintergrunddiskette eingelegt"); + initialisiere disketten zugriff (0, disk size); + relevante bloecke lesen; + hg etikett merken; + informationen ausgeben (check ds, TRUE, TRUE); + line (2); + check sum namen bestimmen; + hintergrund check sum berechnen; + check summe abspeichern (ds name, check ds). + +relevante bloecke lesen: + read and retry (check ds, ds start, 0, 1); + read and retry (check ds, ds start + 10, 10, 1). + +hg etikett merken: + TEXT VAR null etikett := 512 * " "; + INT VAR i; + FOR i FROM 1 UPTO 256 REP + replace (null etikett, i, ds work struct.row [i]) + PER. + +check sum namen bestimmen: + putline ("bitte Dateinamen zum abspeichern der Prüf-Summe angeben:"); + ds name eingabe (ds name, "prüf.HG", FALSE, ""); + line. + +hintergrund check sum berechnen: + BOOL CONST plus version :: NOT ((ds work struct.row [41] = 1) AND (ds work struct.row [42] = 0)); + IF plus version + THEN hg bloecke zu verarbeiten := ds work struct.row [41] + 1 + ELSE hg bloecke zu verarbeiten := 8 * ds work struct.row [19] + FI; + INT VAR sequenz nr := 0; + hg bloecke verarbeitet := 0; + disk bloecke verarbeitet := 0; + initialisiere check read (check ds); + disketten groesse zeigen (disk size); + status zeigen; + WHILE hg bloecke verarbeitet < hg bloecke zu verarbeiten REP + IF disk bloecke verarbeitet = disk size + THEN neue diskette anfordern + FI; + naechsten satz bloecke lesen; + status zeigen + PER. + +neue diskette anfordern: + diskette anfordern (""4"nächste Hintergrunddiskette eingelegt"); + initialisiere disketten zugriff (0, disk size); + line; + disketten groesse zeigen (disk size); + sequenz nr INCR 1; + IF plus version + THEN disk bloecke verarbeitet := 1; + read and retry (check ds, ds start, 0, 1); + IF NOT etikett kompatibel zu null etikett + THEN error stop ("Diskette gehoert nicht zu dem bisher verarbeiteten Hintergrund") + FI; + IF ds work struct.row [43] <> sequenz nr + THEN error stop ("Falsche Reihenfolge der HG Disketten") + FI + ELSE disk bloecke verarbeitet := 0 + FI. + +etikett kompatibel zu null etikett: + read and retry (check ds, ds start, 0, 1); + FOR i FROM 1 UPTO 40 REP + IF ds work struct.row [i] <> (null etikett ISUB i) + THEN LEAVE etikett kompatibel zu null etikett WITH FALSE + FI + PER; + FOR i FROM 46 UPTO 256 REP + IF ds work struct.row [i] <> (null etikett ISUB i) + THEN LEAVE etikett kompatibel zu null etikett WITH FALSE + FI + PER; + TRUE. + +naechsten satz bloecke lesen: + bestimme anzahl zu lesender bloecke; + check read and retry (check ds, disk bloecke verarbeitet, anzahl zu lesender bloecke); + hg bloecke verarbeitet INCR anzahl zu lesender bloecke; + disk bloecke verarbeitet INCR anzahl zu lesender bloecke. + +bestimme anzahl zu lesender bloecke: + INT CONST anzahl zulesender bloecke :: min (moegliche hg bloecke auf disk, 20). + +moegliche hg bloecke auf disk: + min (hg bloecke zu verarbeiten - hg bloecke verarbeitet, + disk size - disk bloecke verarbeitet). + +status zeigen: + IF online + THEN out (""13""); + putline ("Hintergrund: " + text (hg bloecke verarbeitet DIV 2, 4) + " KB verarbeitet"); + putline ("aktuelle Diskette: " + text (disk bloecke verarbeitet DIV 2, 4) + " KB verarbeitet"); + out (""3""3""13"") + FI. + +END PROC enable hg check sum; + +END PACKET copy hg; +PACKET urlader copy DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + (* 22.08.86 *) + urlader check sum, + urlader von datenraum auf leere diskette schreiben, + urlader von datenraum auf hg diskette schreiben, + urlader von diskette in hg datenraum lesen, + urlader von diskette in leeren datenraum lesen: + +TEXT VAR ds name := ""; + +TEXT VAR hg urlader vektor := " "; replace (hg urlader vektor, 1, hg type); + replace (hg urlader vektor, 2, urlader type); + +INT VAR disk size; + +BOUND STRUCT (ROW 252 INT align, ROW 10240 INT row) VAR ds struct; +DATASPACE VAR ds work := nilspace; forget (ds work); +DATASPACE VAR ds test := nilspace; forget (ds test); + +PROC urlader von diskette in hg datenraum lesen: + urlader lesen (FALSE) + +END PROC urlader von diskette in hg datenraum lesen; + +PROC urlader von diskette in leeren datenraum lesen: + urlader lesen (TRUE) + +END PROC urlader von diskette in leeren datenraum lesen; + +PROC urlader lesen (BOOL CONST in leeren ds): + disable stop; + enable urlader lesen (in leeren ds); + forget (ds work). + +END PROC urlader lesen; + +PROC enable urlader lesen (BOOL CONST in leeren ds): + enable stop; + initialisiere rerun test; + diskette anfordern ("Urlader-Diskette eingelegt"); + ersten urlader block lesen; + informationen ausgeben (ds work, FALSE, TRUE); + INT VAR urlader blocks := ds struct.row [2569]; + IF motorola format + THEN rotate (urlader blocks, 8) + FI; + line (2); + ds work namen bestimmen; + ds work neu initialisieren; + urlader rest lesen; + IF exists (ds name) THEN forget (ds name, quiet) FI; + copy (ds work, ds name). + +ersten urlader block lesen: + ds work := nilspace; + ds struct := ds work; + initialisiere disketten zugriff (0, disk size); + read (ds work, ds start + 10, 10, 1). + +motorola format: + ds struct.row [2571] = 1024. + +ds work namen bestimmen: + put ("bitte Datenraumnamen angeben:"); + IF in leeren ds + THEN ds name eingabe (ds name, "URLADER", FALSE, "") + ELSE ds name eingabe (ds name, "", TRUE, hg urlader vektor) + FI; + line. + +ds work neu initialisieren: + IF NOT in leeren ds + THEN forget (ds work); + ds work := old (ds name); + ds struct := ds work; + INT VAR space := ds struct.row [2569]; + IF motorola format + THEN rotate (space, 8) + FI; + IF space < urlader blocks + THEN error stop ("Lücke für Urlader im Datenraum zu klein") + FI + ELSE type (ds work, urlader type) + FI. + +urlader rest lesen: + INT VAR urlader bloecke verarbeitet := 0; + status zeigen; + WHILE urlader bloecke verarbeitet < urlader blocks REP + naechsten satz bloecke lesen; + status zeigen + PER. + +naechsten satz bloecke lesen: + read and retry (ds work, ds start + 10 + urlader bloecke verarbeitet, + 10 + urlader bloecke verarbeitet, anzahl zu lesender bloecke); + urlader bloecke verarbeitet INCR anzahl zu lesender bloecke. + +anzahl zu lesender bloecke: + min (urlader blocks - urlader bloecke verarbeitet, 20). + +status zeigen: + IF online + THEN out (""13""); + putline (text (urlader bloecke verarbeitet DIV 2, 4) + " KB gelesen"); + out (""3""13"") + FI. + +END PROC enable urlader lesen; + +PROC urlader von datenraum auf leere diskette schreiben: + urlader schreiben (TRUE) + +END PROC urlader von datenraum auf leere diskette schreiben; + +PROC urlader von datenraum auf hg diskette schreiben: + urlader schreiben (FALSE) + +END PROC urlader von datenraum auf hg diskette schreiben; + +PROC urlader schreiben (BOOL CONST auf leere disk): + disable stop; + enable urlader schreiben (auf leere disk); + forget (ds test); + forget (ds work). + +END PROC urlader schreiben; + +PROC enable urlader schreiben (BOOL CONST auf leere disk): + enable stop; + initialisiere rerun test; + urlader ds namen bestimmen; + ds work := old (ds name); + ds struct := ds work; + INT VAR urlader blocks := ds struct.row [2569]; + IF motorola format + THEN rotate (urlader blocks, 8) + FI; + informationen ausgeben (ds work, FALSE, TRUE); + line (2); + diskette anfordern ("zu beschreibende Diskette eingelegt"); + IF auf leere disk + THEN evtl diskette formatieren; + initialisiere diskettenzugriff (0, disk size) + ELSE initialisiere diskettenzugriff (0, disk size); + platz fuer urlader ueberpruefen + FI; + urlader schreiben. + +urlader ds namen bestimmen: + put ("Bitte Datenraumnamen eingeben:"); + ds name eingabe (ds name, "", TRUE, hg urlader vektor); + line. + +motorola format: + ds struct.row [2571] = 1024. + +platz fuer urlader ueberpruefen: + TEXT CONST eumel kennzeichen :: "EUMEL-"; + INT CONST eumel kennzeichen wort 0 :: eumel kennzeichen ISUB 1, + eumel kennzeichen wort 1 :: eumel kennzeichen ISUB 2, + eumel kennzeichen wort 2 :: (eumel kennzeichen ISUB 3) AND 255; + ds test := nilspace; + ds struct := ds test; + read and retry (ds test, 2, 0, 1); + IF plus hg CAND sequenznummer falsch + THEN error stop ("Die eingelegte Diskette ist nicht erste Diskette eines Hintergrundes") + FI; + read and retry (ds test, 2, 10, 1); + IF NOT diskette enthaelt urlader COR luecke zu klein + THEN error stop ("Nicht genug Platz auf der Diskette; Urlader kann nicht geschrieben werden.") + FI. + +plus hg: + NOT ((ds struct.row [41] = 1) AND (ds struct.row [42] = 0)). + +sequenznummer falsch: + ds struct.row [43] <> 0. + +diskette enthaelt urlader: + (eumelkennzeichen wort 0 = ds struct.row [1]) AND + (eumelkennzeichen wort 1 = ds struct.row [2]) AND + (eumelkennzeichen wort 2 = (ds struct.row [3] AND 255)). + +luecke zu klein: + urlader blocks > ds struct.row [9]. + +urlader schreiben: + INT VAR urlader bloecke verarbeitet := 0; + status zeigen; + WHILE urlader bloecke verarbeitet < urlader blocks REP + naechsten satz bloecke schreiben; + status zeigen + PER. + +naechsten satz bloecke schreiben: + write and retry (ds work, ds start + 10 + urlader bloecke verarbeitet, + 10 + urlader bloecke verarbeitet, anzahl zu schreibender bloecke); + + urlader bloecke verarbeitet INCR anzahl zu schreibender bloecke. + +anzahl zu schreibender bloecke: + min (urlader blocks - urlader bloecke verarbeitet, 20). + +status zeigen: + IF online + THEN out (""13""); + putline (text (urlader bloecke verarbeitet DIV 2, 4) + " KB geschrieben"); + out (""3""13"") + FI. + +END PROC enable urlader schreiben; + +PROC urlader check sum: + disable stop; + enable urlader check sum; + forget (ds work). + +END PROC urlader check sum; + +PROC enable urlader check sum: + enable stop; + initialisiere rerun test; + ds work := nilspace; + ds struct := ds work; + diskette anfordern ("zu überprüfende Diskette eingelegt"); + relevante bloecke lesen; + INT VAR urlader blocks := ds struct.row [2569]; + IF motorola format + THEN rotate (urlader blocks, 8) + FI; + informationen ausgeben (ds work, FALSE, TRUE); + line (2); + check sum namen bestimmen; + urlader check sum berechnen; + check summe abspeichern (ds name, ds work). + +motorola format: + ds struct.row [2571] = 1024. + +relevante bloecke lesen: + initialisiere disketten zugriff (0, disk size); + read (ds work, ds start + 10, 10, 1). + +check sum namen bestimmen: + putline ("bitte Dateinamen zum abspeichern der Prüf-Summe angeben:"); + ds name eingabe (ds name, "prüf.URLADER", FALSE, ""). + +urlader check sum berechnen: + line; + INT VAR urlader bloecke verarbeitet := 0; + initialisiere check read (ds work); + status zeigen; + WHILE urlader bloecke verarbeitet < urlader blocks REP + naechsten satz bloecke lesen; + status zeigen + PER. + +naechsten satz bloecke lesen: + check read and retry (ds work, 10 + urlader bloecke verarbeitet, + anzahl zu lesender bloecke); + urlader bloecke verarbeitet INCR anzahl zu lesender bloecke. + +anzahl zu lesender bloecke: + min (urlader blocks - urlader bloecke verarbeitet, 20). + +status zeigen: + IF online + THEN out (""13""); + putline (text (urlader bloecke verarbeitet DIV 2, 4) + " KB gelesen"); + out (""3""13"") + FI. + +END PROC enable urlader check sum; + +END PACKET urlader copy; +PACKET copy dump DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + show blocks: (* 11.07.86 *) + +TYPE BLOCK = BOUND STRUCT (ALIGN dummy, ROW 64 REAL block row); + +BLOCK VAR block; + +DATASPACE VAR block ds; + +TEXT VAR line text := 16 * "*"; + +INITFLAG VAR this packet := FALSE; + +INT VAR disk size; + +INT VAR block nr; + +TEXT VAR command; + +PROC show blocks: + enable stop; + initialisiere rerun test; + access block space; + block nr := 0; + diskette anfordern ("Diskette eingelegt"); + initialisiere diskettenzugriff (0, disk size); + disketten groesse zeigen (disk size); + REP get command; + execute command + UNTIL end command + PER. + +access block space: + IF NOT initialized (this packet) + THEN block ds := nilspace + FI. + +get command: + line; + putline ("'+' nächsten Block zeigen 'q' Dump-Modus verlassen"); + putline ("'-' vorhergehenden Block zeigen Block zeigen"); + put (">"); + get (command); + command := compress (command); + line. + +end command: + ((command SUB 1) = "q") OR ((command SUB 1) = "Q"). + +execute command: + IF (command SUB 1) = "+" + THEN block nr INCR 1; + block zeigen + ELIF (command SUB 1) = "-" + THEN block nr DECR 1; + block zeigen; + ELIF (command SUB 1) = "q" OR (command SUB 1) = "Q" + THEN (* no op *) + ELSE INT VAR dummy := int (command); + IF last conversion ok + THEN block nr := dummy; + block zeigen + ELSE putline ("unzulässiges Kommando"); + line + FI + FI. + +END PROC show blocks; + +PROC block zeigen: + block nr ueberpruefen; + block lesen; + CONCR (block) := block ds; + INT VAR zeile; + FOR zeile FROM 0 UPTO 31 REP + zeile zeigen + PER. + +block nr ueberpruefen: + IF block nr >= disk size + THEN putline ("Blocknummer zu hoch (maximal " + text (disk size -1) + ")"); + block nr := disk size - 1; + LEAVE block zeigen + ELIF block nr < 0 + THEN putline ("negative Blocknummer ist nicht erlaubt"); + block nr := 0; + LEAVE block zeigen + FI. + +block lesen: + read and retry (block ds, 2, block nr, 1). + +zeile zeigen: + replace (line text, 1, block.block row [2 * zeile + 1]); + replace (line text, 2, block.block row [2 * zeile + 2]); + TEXT VAR dump line := text (block nr, 4) + ":" + text (zeile * 16, 3) + " "; + TEXT VAR char line := ""; + INT VAR spalte; + FOR spalte FROM 1 UPTO 8 REP + cat char; + dump line CAT " " + PER; + dump line CAT " "; + FOR spalte FROM 9 UPTO 16 REP + cat char; + dump line CAT " " + PER; + dump line CAT " "; + dump line CAT charline; + IF incharety = ""27"" + THEN LEAVE block zeigen + FI; + putline (dump line). + +cat char: + INT CONST char code := code (char); + LET hex chars = "0123456789ABCDEF"; + dumpline CAT (hex chars SUB (char code DIV 16 + 1)); + dumpline CAT (hex chars SUB (char code MOD 16 + 1)); + charline CAT show char. + +show char: + IF (char code > 31 AND char code < 127) + THEN code (char code) + ELSE "." + FI. + +char: + line text SUB spalte. + +END PROC block zeigen; + +END PACKET copy dump; +PACKET copy diskette DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + diskette lesen, (* 11.07.86 *) + diskette schreiben, + diskette check sum: + +TEXT VAR disk type vektor := " "; replace (disk type vektor, 1, disk type); + +TEXT VAR ds name := ""; + +INT VAR disk size; + +BOUND ROW 252 INT VAR ds work row; +DATASPACE VAR ds work := nilspace; forget (ds work); + +PROC diskette lesen: + disable stop; + enable diskette lesen; + forget (ds work). + +END PROC diskette lesen; + +PROC enable diskette lesen: + enable stop; + initialisiere rerun test; + ds work := nilspace; + ds work row := ds work; + type (ds work, disk type); + diskette anfordern ("zu lesende Diskette eingelegt"); + initialisiere disketten zugriff (0, disk size); + disketten groesse zeigen (disk size); + ds work namen bestimmen; + diskette lesen; + size feld schreiben; + copy (ds work, ds name). + +size feld schreiben: + ds work row := ds work; + ds work row [size feld] := disk size. + +ds work namen bestimmen: + ds name := ""; + put ("bitte Datenraumnamen angeben:"); + ds name eingabe (ds name, "", FALSE, ""); + line. + +diskette lesen: + INT VAR disk bloecke verarbeitet := 0; + status zeigen; + WHILE disk bloecke verarbeitet < disk size REP + naechsten satz bloecke lesen; + status zeigen + PER. + +naechsten satz bloecke lesen: + read and retry (ds work, ds start + disk bloecke verarbeitet, disk bloecke verarbeitet, + anzahl zu lesender bloecke); + disk bloecke verarbeitet INCR anzahl zu lesender bloecke. + +anzahl zu lesender bloecke: + min (disk size - disk bloecke verarbeitet, 20). + +status zeigen: + IF online + THEN out (""13""); + putline (text (disk bloecke verarbeitet DIV 2, 4) + " KB gelesen"); + out (""3""13"") + FI. + +END PROC enable diskette lesen; + +PROC diskette schreiben: + disable stop; + enable diskette schreiben; + forget (ds work). + +END PROC diskette schreiben; + +PROC enable diskette schreiben: + enable stop; + initialisiere rerun test; + disk ds namen bestimmen; + ds work := old (ds name); + ds work row := ds work; + diskette anfordern ("zu beschreibende Diskette eingelegt"); + evtl diskette formatieren; + initialisiere diskettenzugriff (0, disk size); + disketten groesse zeigen (disk size); + diskettengroesse ueberpruefen; + diskette schreiben. + +disk ds namen bestimmen: + put ("Bitte Datenraumnamen eingeben:"); + ds name eingabe (ds name, "", TRUE, disk type vektor); + line. + +diskettengroesse ueberpruefen: + IF ds work row [size feld] <> disk size + THEN putline (""7"ERROR: Datenraum enthält nicht genau eine Diskette"); + putline (" evtl. Menuepunkt 'Teil einer Diskette kopieren' verwenden"); + pause (30); + error stop ("Datenraum enthält nicht genau eine Diskette") + FI. + +diskette schreiben: + INT VAR disk bloecke verarbeitet := 0; + status zeigen; + WHILE disk bloecke verarbeitet < ds work row [size feld] REP + naechsten satz bloecke schreiben; + status zeigen + PER. + +naechsten satz bloecke schreiben: + write and retry (ds work, ds start + disk bloecke verarbeitet, disk bloecke verarbeitet, + anzahl zu schreibender bloecke); + disk bloecke verarbeitet INCR anzahl zu schreibender bloecke. + +anzahl zu schreibender bloecke: + min (ds work row [size feld] - disk bloecke verarbeitet, 20). + +status zeigen: + IF online + THEN out (""13""); + putline (text (disk bloecke verarbeitet DIV 2, 4) + " KB geschrieben"); + out (""3""13"") + FI. + +END PROC enable diskette schreiben; + +PROC diskette check sum: + disable stop; + enable diskette check sum; + forget (ds work). + +END PROC diskette check sum; + +PROC enable diskette check sum: + enable stop; + ds work := nilspace; + ds work row := ds work; + TEXT VAR name := ""; + initialisiere rerun test; + diskette anfordern ("zu überprüfende Diskette eingelegt"); + check sum namen bestimmen; + initialisiere diskettenzugriff (0, disk size); + disketten groesse zeigen (disk size); + check summe berechnen; + check summe abspeichern (name, ds work). + +check sum namen bestimmen: + putline ("bitte Dateinamen zum abspeichern der Prüfsumme angeben:"); + ds name eingabe (name, "prüf.", FALSE, ""); + line. + +check summe berechnen: + INT VAR disk bloecke verarbeitet := 0; + status zeigen; + initialisiere check read (ds work); + WHILE disk bloecke verarbeitet < disk size REP + naechsten satz bloecke lesen; + status zeigen + PER. + +naechsten satz bloecke lesen: + check read and retry (ds work, disk bloecke verarbeitet, anzahl zu lesender bloecke); + disk bloecke verarbeitet INCR anzahl zu lesender bloecke. + +anzahl zu lesender bloecke: + min (disk size - disk bloecke verarbeitet, 20). + +status zeigen: + IF online + THEN out (""13""); + putline (text (disk bloecke verarbeitet DIV 2, 4) + " KB verarbeitet"); + out (""3""13"") + FI. + +END PROC enable diskette check sum; + +END PACKET copy diskette; +PACKET copy disk part DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + disk part lesen, (* 31.07.86 *) + disk part schreiben, + disk part check sum: + +TEXT VAR disk type vektor := " "; replace (disk type vektor, 1, disk type); + +TEXT VAR ds name := ""; + +INT VAR disk size; +INT VAR von sektor, bis sektor; + +BOUND ROW 252 INT VAR ds work row; +DATASPACE VAR ds work := nilspace; forget (ds work); + +PROC disk part lesen: + disable stop; + enable disk part lesen; + forget (ds work). + +END PROC disk part lesen; + +PROC enable disk part lesen: + enable stop; + initialisiere rerun test; + ds work := nilspace; + ds work row := ds work; + type (ds work, disk type); + diskette anfordern ("zu lesende Diskette eingelegt"); + initialisiere disketten zugriff (0, disk size); + disketten groesse zeigen (disk size); + grenzen bestimmen (disk size); + ds work namen bestimmen; + disk part lesen; + size feld schreiben; + copy (ds work, ds name). + +ds work namen bestimmen: + ds name := ""; + put ("bitte Datenraumnamen angeben:"); + ds name eingabe (ds name, "", FALSE, ""); + line. + +size feld schreiben: + ds work row := ds work; + ds work row [size feld] := bis sektor - von sektor + 1. + +disk part lesen: + INT VAR disk bloecke verarbeitet := 0; + status zeigen; + WHILE disk bloecke verarbeitet < bis sektor - von sektor + 1 REP + naechsten satz bloecke lesen; + status zeigen + PER. + +naechsten satz bloecke lesen: + read and retry (ds work, ds start + disk bloecke verarbeitet, von sektor + disk bloecke verarbeitet, + anzahl zu lesender bloecke); + disk bloecke verarbeitet INCR anzahl zu lesender bloecke. + +anzahl zu lesender bloecke: + min (bis sektor - von sektor + 1 - disk bloecke verarbeitet, 20). + +status zeigen: + IF online + THEN out (""13""); + putline (text (disk bloecke verarbeitet, 4) + " Sektoren gelesen"); + out (""3""13"") + FI. + +END PROC enable disk part lesen; + +PROC disk part schreiben: + disable stop; + enable disk part schreiben; + forget (ds work). + +END PROC disk part schreiben; + +PROC enable disk part schreiben: + enable stop; + initialisiere rerun test; + disk ds namen bestimmen; + ds work := old (ds name); + ds work row := ds work; + diskette anfordern ("zu beschreibende Diskette eingelegt"); + evtl diskette formatieren; + initialisiere diskettenzugriff (0, disk size); + disketten groesse zeigen (disk size); + grenzen bestimmen (ds work row [size feld]); + disk part schreiben. + +disk ds namen bestimmen: + put ("Bitte Datenraumnamen eingeben:"); + ds name eingabe (ds name, "", TRUE, disk type vektor); + line. + +disk part schreiben: + INT VAR disk bloecke verarbeitet := 0; + INT CONST disk bloecke zu verarbeiten :: bis sektor - von sektor + 1; + status zeigen; + WHILE disk bloecke verarbeitet < disk bloecke zu verarbeiten REP + naechsten satz bloecke schreiben; + status zeigen + PER. + +naechsten satz bloecke schreiben: + write and retry (ds work, ds start + disk bloecke verarbeitet, von sektor + disk bloecke verarbeitet, + anzahl zu schreibender bloecke); + disk bloecke verarbeitet INCR anzahl zu schreibender bloecke. + +anzahl zu schreibender bloecke: + min (disk bloecke zu verarbeiten - disk bloecke verarbeitet, 20). + +status zeigen: + IF online + THEN out (""13""); + putline (text (disk bloecke verarbeitet, 4) + " Sektoren geschrieben"); + out (""3""13"") + FI. + +END PROC enable disk part schreiben; + +PROC disk part check sum: + disable stop; + enable disk part check sum; + forget (ds work). + +END PROC disk part check sum; + +PROC enable disk part check sum: + enable stop; + initialisiere rerun test; + ds work := nilspace; + diskette anfordern ("zu überprüfende Diskette eingelegt"); + initialisiere disketten zugriff (0, disk size); + disketten groesse zeigen (disk size); + grenzen bestimmen (disk size); + check sum namen bestimmen; + check sum berechnen; + check summe abspeichern (ds name, ds work). + +check sum namen bestimmen: + putline ("bitte Dateinamen zum abspeichern der Prüf-Summe angeben:"); + ds name eingabe (ds name, "prüf.", FALSE, ""); + line. + +check sum berechnen: + INT VAR disk bloecke verarbeitet := 0; + initialisiere check read (ds work); + status zeigen; + WHILE disk bloecke verarbeitet < bis sektor - von sektor + 1 REP + naechsten satz bloecke lesen; + status zeigen + PER. + +naechsten satz bloecke lesen: + check read and retry (ds work, von sektor + disk bloecke verarbeitet, anzahl zu lesender bloecke); + disk bloecke verarbeitet INCR anzahl zu lesender bloecke. + +anzahl zu lesender bloecke: + min (bis sektor - von sektor + 1 - disk bloecke verarbeitet, 20). + +status zeigen: + IF online + THEN out (""13""); + putline (text (disk bloecke verarbeitet, 4) + " Sektoren gelesen"); + out (""3""13"") + FI. + +END PROC enable disk part check sum; + +PROC disketten groesse zeigen (INT CONST blocks): + putline ("die eingelegte Diskette enthält die Sektoren 0 bis " + text (blocks - 1)); + line. + +END PROC disketten groesse zeigen; + +PROC grenzen bestimmen (INT CONST max anz bloecke): + INT VAR x,y; + REP + TEXT VAR ein := "0"; + put ("erster Sektor:"); + get cursor (x, y); + editget (ein); + von sektor := max (0, int (ein)); + cursor (x, y); + out (""5""); + put (von sektor); + line; + put ("letzter Sektor:"); + get cursor (x, y); + ein := text (min (disk size - 1, von sektor + max anz bloecke - 1)); + editget (ein); +(**)bis sektor := min (von sektor + max anz bloecke - 1, int (ein)); +(**)bis sektor := min (disk size - 1, bis sektor); + cursor (x, y); + out (""5""); + put (bis sektor); + line + UNTIL yes ("Eingaben richtig") + PER; + line. + +END PROC grenzen bestimmen; + +END PACKET copy disk part; +PACKET menu handler DEFINES (* Autor: J.Liedtke *) + (* R.Ruland *) + (* Stand: 13.05.86 *) + menu monitor , + menu out , + next menu , + menu param , + set menu param , + additional param , + clear free lines , + show key functions : + + +LET menu width = 77 , + date pos = 50 , + time pos = 63 , + menu indent = 6 , + separate line = 18 , + first free line = 19 , + max number of menu cases = 17 , + + blank = " " , + left = ""8"" , + up = ""3"" , + down = ""10"" , + return= ""13"" , + hop = ""1"" , + bell = ""7"" , + quote = """" , + clear to end of line = ""5"" , + clear to end of page = ""4"" ; + +TEXT VAR param 1 := "" , param 2 , + menu case list := "" , + menu case := "", char := "", + last date := ""; + +BOOL VAR screen changed, show keys ; + + +PROC next menu : + + screen changed := TRUE + +ENDPROC next menu ; + +PROC next menu (TEXT CONST key list) : + + next menu (key list, "") + +ENDPROC next menu ; + +PROC next menu (TEXT CONST key list, std case) : + + IF pos (key list, code (33), code (255), 1) > 0 + OR pos (key list, code (0), code (31), 1) > 0 + THEN menu case list := subtext (key list, 1, max number of menu cases) ; + FI; + menu case := std case ; + screen changed := TRUE ; + +ENDPROC next menu ; + + +PROC clear free lines : + + cursor (1, first free line) ; + out (clear to end of page) . + +ENDPROC clear free lines; + + +PROC show key functions : + + show keys := TRUE; + +END PROC show key functions; + + +PROC menu monitor (PROC (TEXT CONST) board , + PROC (TEXT CONST) execute , + TEXT CONST escape char) : + + disable stop ; + page ; + next menu ; + show key functions; + REP + show menu (PROC (TEXT CONST) board) ; + screen changed := FALSE ; + show keys := FALSE; + select menu case (escape char) ; + clear free lines ; + IF is valid menu case AND char <> hop + THEN menu execute (PROC (TEXT CONST) execute) + FI + UNTIL menu escape occurred PER . + +is valid menu case : pos (menu case list, menu case) > 0 . + +menu escape occurred : menu case = escape char . + +ENDPROC menu monitor ; + + +PROC show menu (PROC (TEXT CONST) board) : + + IF is error + THEN show error ; + clear error + FI ; + IF screen changed + THEN show menu cases + FI ; + IF show keys + THEN explain keys; + FI . + +show error : + IF less than three lines left + THEN screen changed := TRUE + FI ; + clear free lines ; + put error . + +less than three lines left : + INT VAR x, y; + get cursor (x, y) ; + y >= 22 . + +show menu cases : + clear board ; + INT VAR i ; + FOR i FROM 1 UPTO LENGTH menu case list REP + cursor (menu indent, i) ; + IF (menu case list SUB i) <> " " THEN board (menu case list SUB i) FI; + PER ; + out (hop) ; + 4 TIMESOUT " " . + +clear board : + out (hop) ; + FOR i FROM 1 UPTO max number of menu cases REP + out (clear to end of line) ; + out (down) + PER ; + cursor (1, separate line); + out (clear to end of line) ; + menu width TIMESOUT "-" ; + put date ; + put time . + +ENDPROC show menu ; + +PROC menu out (TEXT CONST menu line) : + + tab cursor ; + INT VAR from := 1, to := pos (menu line, quote) - 1 ; + IF param 1 <> "" + THEN WHILE to >= 0 REP + menu outsubtext (menu line, from, to) ; + menu outsubtext (quote, 1, 1) ; + menu outsubtext (param 1, 1, LENGTH param 1) ; + menu outsubtext (quote, 1, 1) ; + from := to + 2 ; + to := pos (menu line, quote, from) - 1 + PER ; + FI; + menu outsubtext (menu line, from, LENGTH menu line) ; + out (blank) . + +tab cursor : + INT VAR x, y; + get cursor (x, y) ; + IF x > menu indent AND x < menu width - 15 + THEN cursor ( (x-menu indent+14) DIV 15 * 15 + menu indent, y) + FI . + +ENDPROC menu out ; + +PROC menu outsubtext (TEXT CONST t, INT CONST from, to) : + + outsubtext (t, from, min (menu width-cursor x, to-from) + from) . + +cursor x : + INT VAR x, y ; + get cursor (x, y) ; + x . + +ENDPROC menu outsubtext ; + +PROC put date : + + INT VAR x, y; + get cursor (x, y); + cursor (date pos, separate line); + last date := date; + out (" "); + out (date); + out (" "); + cursor (x, y); + +END PROC put date; + +PROC put time : + + INT VAR x, y; + get cursor (x, y); + cursor (time pos, separate line); + out (" "); + out (time of day); + out (" "); + IF last date <> date THEN put date FI; + cursor (x, y); + +END PROC put time; + +PROC select menu case (TEXT CONST escape char) : + + enable stop; + INT VAR menu index := pos (menu case list, menu case); + get default menu case ; + REP + REP UNTIL incharety = "" PER; + point to case ; + get char ; + IF char = blank OR char = down THEN menu down + ELIF char = up THEN menu up + ELIF char = return THEN leave and execute + ELIF char = hop THEN leave and show new board + ELIF char = escape char OR + pos (menu case list, char) > 0 THEN menu index := + pos (menu case list, char); + menu case := char ; + leave and execute + ELSE not allowed key + FI + PER . + +get default menu case : + IF LENGTH menu case <> 1 OR menu case = " " OR menu index = 0 + THEN menu index := 0; + WHILE menu index < LENGTH menu case list + REP menu index INCR 1; + menu case := menu case list SUB menu index; + IF menu case <> " " THEN LEAVE get default menu case FI; + PER; + FI . + +get char : + REP char := incharety (600) ; + put time ; + UNTIL char <> "" PER . + +menu down : + REP menu index := menu index MOD cases + 1; + menu case := menu case list SUB menu index; + UNTIL menu case <> " " PER . + +menu up : + REP menu index := (menu index - 2) MOD cases + 1; + menu case := menu case list SUB menu index; + UNTIL menu case <> " " PER . + +cases : LENGTH menu case list . + +point to case : + 4 TIMESOUT left ; 4 TIMESOUT blank ; + cursor (menu indent-4, menu index) ; + out ("--> ") . + +leave and execute : + point to case ; + cursor (menu indent, first free line) ; + LEAVE select menu case . + +leave and show new board : + next menu ; + show key functions; + LEAVE select menu case . + +not allowed key : + out (bell) ; + explain keys . + +ENDPROC select menu case ; + + +PROC explain keys : + clear free lines; + putline ("""-->"" - Funktion ausfuehren : ") ; + putline ("andere Funktion anwaehlen : ") ; + out ("direkt anwaehlen und ausfuehren :") ; + show menu case list ; + putline ("Menutafel neu aufbauen : ") ; + out (hop) ; + 4 TIMESOUT " " . + +show menu case list : + INT VAR i, j := 0; + FOR i FROM 1 UPTO LENGTH menu case list REP + IF j = 8 + THEN line ; 33 TIMESOUT blank; j INCR 1; + FI ; + show one menu case + PER ; + line . + +show one menu case : + IF (menu case list SUB i) > " " + THEN out (" <") ; out (menu case list SUB i) ; out (">") ; j INCR 1 + FI . + +END PROC explain keys; + + +PROC menu execute (PROC (TEXT CONST) execute) : + + enable stop ; + execute (menu case) + +ENDPROC menu execute ; + + +TEXT PROC menu param : + + param 1 + +ENDPROC menu param ; + +PROC set menu param (TEXT CONST param) : + + param 1 := param + +ENDPROC set menu param ; + +TEXT PROC menu param (TEXT CONST prompt) : + + get param (prompt, param 1) ; + param 1 + +ENDPROC menu param ; + +TEXT PROC additional param (TEXT CONST prompt) : + + param 2 := "" ; + get param (prompt, param 2) ; + param 2 + +ENDPROC additional param ; + +PROC additional param (TEXT CONST prompt, TEXT VAR param) : + + get param (prompt, param) ; + param 2 := param; + +ENDPROC additional param ; + +PROC get param (TEXT CONST prompt, TEXT VAR param) : + + cursor (menu indent, first free line) ; + out prompt ; + out (blank) ; + in param ; + cursor (menu indent, first free line) ; + out (clear to end of line) . + +out prompt : + INT CONST + prompt length := min (LENGTH prompt, menu width DIV 2 - menu indent) ; + outsubtext (prompt, 1, prompt length) . + +in param : + editget (param, 255, menu width - menu indent - prompt length - 2) . + +ENDPROC get param ; + +ENDPACKET menu handler ; +PACKET copy menu DEFINES copy: (* Copyright (C) 1986 *) + (* Frank Klapper *) +LET haupt menu = 1, (* 11.07.86 *) + copy hg menu = 2, + disk copy menu = 3, + disk part copy menu = 4, + urlader copy menu = 5; + +LET MENU = STRUCT (TEXT board keys, board); + +ROW 5 MENU VAR menu; + +menu [haupt menu] := MENU: ("hudtDke"9"", " hu dt D k e "9" "); +menu [copy hg menu] := MENU: ("lspPLiI"9"", " ls pP L iI "9" "); +menu [urlader copy menu] := MENU: ("lLsSpPziI"9"", " lL sS pP z iI "9""); +menu [disk copy menu] := MENU: ("lspPL"9"", " ls pP L "9" "); +menu [disk part copy menu] := MENU: ("lspPL"9"", " ls pP L "9" "); + +INT VAR board index; + +TEXT VAR kommando := ""; + +PROC copy: + enable stop; + start copy worker; + board index := haupt menu; + next menu (menu [board index].board, "h"); + menu monitor (PROC (TEXT CONST) menu board, + PROC (TEXT CONST) menu operations, ""9""). + +END PROC copy; + +PROC menu board (TEXT CONST input key): + SELECT board index OF + CASE haupt menu : main menu board (input key) + CASE urlader copy menu : urlader copy menu board (input key) + CASE copy hg menu : copy hg menu board (input key) + CASE disk copy menu : disk copy menu board (input key) + CASE disk part copy menu: disk part copy menu board (input key) + OTHERWISE + END SELECT. + +END PROC menu board; + +PROC main menu board (TEXT CONST input key): + SELECT pos (menu [board index].board keys, input key) OF + CASE 1: menu out ("h EUMEL-Hintergrund kopieren") + CASE 2: menu out ("u EUMEL-Urlader kopieren") + CASE 3: menu out ("d Diskette kopieren") + CASE 4: menu out ("t Teil einer Diskette kopieren") + CASE 5: menu out ("D Diskette dumpen") + CASE 6: menu out ("k Kopierkanal einstellen (zur Zeit " + text (copy channel) + ")") + CASE 7: menu out ("e beliebiges EUMEL-Kommando ausführen") + CASE 8: menu out ("TAB Kopiermenu verlassen") + OTHERWISE + END SELECT. + +END PROC main menu board; + +PROC copy hg menu board (TEXT CONST input key): + SELECT pos (menu [board index].board keys, input key) OF + CASE 1: menu out ("l EUMEL-Hintergrund von Diskette in Datenraum lesen") + CASE 2: menu out ("s EUMEL-Hintergrund vom Datenraum auf Diskette schreiben") + CASE 3: menu out ("p Prüfsumme über EUMEL-Hintergrunddisketten bilden") + CASE 4: menu out ("P Prüfsummen vergleichen") + CASE 5: menu out ("L Liste der Datenräume, die einen EUMEL-Hintergrund enthalten") + CASE 6: menu out ("i Informationen über EUMEL-Hintergrund auf Diskette") + CASE 7: menu out ("I Informationen über EUMEL-Hintergrund im Datenraum") + CASE 8: menu out ("TAB Hintergrund-Kopiermenu verlassen") + OTHERWISE + END SELECT. + +END PROC copy hg menu board; + +PROC urlader copy menu board (TEXT CONST input key): + SELECT pos (menu [board index].board keys, input key) OF + CASE 1: menu out ("l Urlader von Diskette in LEEREN Datenraum lesen") + CASE 2: menu out ("L Urlader von Diskette in Datenraum mit EUMEL-HG lesen") + CASE 3: menu out ("s Urlader vom Datenraum auf LEERE Diskette schreiben") + CASE 4: menu out ("S Urlader vom Datenraum auf Diskette mit EUMEL-HG schreiben") + CASE 5: menu out ("p Prüfsumme über Urlader auf Diskette bilden") + CASE 6: menu out ("P Prüfsummen vergleichen") + CASE 7: menu out ("z Liste der Datenräume, die einen EUMEL-Urlader enthalten") + CASE 8: menu out ("i Informationen über EUMEL-Urlader auf Diskette") + CASE 9: menu out ("I Informationen über EUMEL-Urlader im Datenraum") + CASE10: menu out ("TAB Urlader-Kopiermenu verlassen") + OTHERWISE + END SELECT. + +END PROC urlader copy menu board; + +PROC disk copy menu board (TEXT CONST input key): + SELECT pos (menu [board index].board keys, input key) OF + CASE 1: menu out ("l Diskette in Datenraum lesen") + CASE 2: menu out ("s Datenraum auf Diskette schreiben") + CASE 3: menu out ("p Prüfsumme über Diskette bilden") + CASE 4: menu out ("P Prüfsummen vergleichen") + CASE 5: menu out ("L Liste der Datenräume, die einen Disketteninhalt enthalten können") + CASE 6: menu out ("TAB Disketten-Kopiermenu verlassen") + OTHERWISE + END SELECT. + +END PROC disk copy menu board; + +PROC disk part copy menu board (TEXT CONST input key): + SELECT pos (menu [board index].board keys, input key) OF + CASE 1: menu out ("l Diskettenbereich in Datenraum lesen") + CASE 2: menu out ("s Datenraum in Diskettenbereich schreiben") + CASE 3: menu out ("p Prüfsumme über Diskettenbereich bilden") + CASE 4: menu out ("P Prüfsummen vergleichen") + CASE 5: menu out ("L Liste der Datenräume, die einen Diskettenbereich enthalten") + CASE 6: menu out ("TAB Disketten-Kopiermenu verlassen") + OTHERWISE + END SELECT. + +END PROC disk part copy menu board; + +PROC menu operations (TEXT CONST input key): + SELECT board index OF + CASE haupt menu : main menu operations (input key) + CASE urlader copy menu : urlader copy operations (input key) + CASE copy hg menu : copy hg menu operations (input key) + CASE disk copy menu : disk copy menu operations (input key) + CASE disk part copy menu: disk part copy menu operations (input key) + OTHERWISE + END SELECT. + +END PROC menu operations; + +PROC main menu operations (TEXT CONST input key): + SELECT pos (menu [board index].board keys, input key) OF + CASE 1: copy hg menu aufrufen + CASE 2: urlader copy menu aufrufen + CASE 3: disk copy menu aufrufen + CASE 4: disk part copy menu aufrufen + CASE 5: disable stop; show blocks; refresh + CASE 6: kopier kanal einstellen + CASE 7: eumel kommando ausfuehren + CASE 8: stop copy worker + OTHERWISE error stop ("noch nicht implementiert") + END SELECT. + +copy hg menu aufrufen: + board index := copy hg menu; + next menu (menu [board index].board, "L"). + +urlader copy menu aufrufen: + board index := urlader copy menu; + next menu (menu [board index].board, "z"). + +disk copy menu aufrufen: + board index := disk copy menu; + next menu (menu [board index].board, "L"). + +disk part copy menu aufrufen: + board index := disk part copy menu; + next menu (menu [board index].board, "L"). + +kopier kanal einstellen: + enable stop; + TEXT VAR kanal := text (copy channel); + put ("Kanalnummer für den Diskettenzugriff:"); + editget (kanal); + IF int (kanal) <> copy channel + THEN disable stop; + stop copy worker; + copy channel (int (kanal)); + start copy worker; + IF is error + THEN push (""9""); + line; + putline (""7"ERROR: " + error message); + clear error; + pause (100); + copy channel (31) + ELSE refresh + FI; + enable stop + FI. + +eumel kommando ausfuehren: + putline ("gib kommando:"); + editget (kommando); + line; + do (kommando); + IF NOT is error + THEN kommando := "" + FI; + next menu. + +END PROC main menu operations; + +PROC copy hg menu operations (TEXT CONST input key): + SELECT pos (menu [board index].board keys, input key) OF + CASE 1: disable stop; hg lesen; refresh + CASE 2: disable stop; hg schreiben; refresh + CASE 3: disable stop; hg check sum; refresh + CASE 4: check summen vergleichen + CASE 5: list (some (all, hg type), "EUMEL-Hintergrund-Datenräume"); refresh + CASE 6: hg informationen von diskette ausgeben + CASE 7: hg informationen von datenraum ausgeben + CASE 8: menu verlassen + OTHERWISE + END SELECT. + +menu verlassen: + board index := haupt menu; + next menu (menu [board index].board, "h"). + +END PROC copy hg menu operations; + +PROC urlader copy operations (TEXT CONST input key): + SELECT pos (menu [board index].board keys, input key) OF + CASE 1: disable stop; urlader von diskette in leeren datenraum lesen; refresh + CASE 2: disable stop; urlader von diskette in hg datenraum lesen; refresh + CASE 3: disable stop; urlader von datenraum auf leere diskette schreiben; refresh + CASE 4: disable stop; urlader von datenraum auf hg diskette schreiben; refresh + CASE 5: disable stop; urlader check sum; refresh + CASE 6: check summen vergleichen + CASE 7: list (some (all, hg type) + some (all, urlader type), "EUMEL-Urlader-Datenräume"); refresh + CASE 8: urlader informationen von diskette ausgeben + CASE 9: urlader informationen von datenraum ausgeben + CASE10: menu verlassen + OTHERWISE + END SELECT. + +menu verlassen: + board index := haupt menu; + next menu (menu [board index].board, "u"). + +END PROC urlader copy operations; + +PROC disk copy menu operations (TEXT CONST input key): + SELECT pos (menu [board index].board keys, input key) OF + CASE 1: disable stop; diskette lesen; refresh + CASE 2: disable stop; diskette schreiben; refresh + CASE 3: disable stop; diskette check sum; refresh + CASE 4: check summen vergleichen + CASE 5: list (some (all, disk type), "Datenräume mit Disketteninhalt"); refresh + CASE 6: menu verlassen + OTHERWISE + END SELECT. + +menu verlassen: + board index := haupt menu; + next menu (menu [board index].board, "d"). + +END PROC disk copy menu operations; + +PROC disk part copy menu operations (TEXT CONST input key): + SELECT pos (menu [board index].board keys, input key) OF + CASE 1: disable stop; disk part lesen; refresh + CASE 2: disable stop; disk part schreiben; refresh + CASE 3: disable stop; disk part check sum; refresh + CASE 4: check summen vergleichen + CASE 5: list (some (all, disk type), "Datenräume mit Disketteninhalt"); refresh + CASE 6: menu verlassen + OTHERWISE + END SELECT. + +menu verlassen: + board index := haupt menu; + next menu (menu [board index].board, "t"). + +END PROC disk part copy menu operations; + +PROC refresh: + clear free lines; + next menu. + +END PROC refresh; + +END PACKET copy menu; + + diff --git a/devel/debug-ds4/1989/source-disk b/devel/debug-ds4/1989/source-disk new file mode 100644 index 0000000..a1795f1 --- /dev/null +++ b/devel/debug-ds4/1989/source-disk @@ -0,0 +1 @@ +debug/debug-copy-std-ds.img diff --git a/devel/debug-ds4/1989/src/RUN load ds4 b/devel/debug-ds4/1989/src/RUN load ds4 new file mode 100644 index 0000000..51d9a1f --- /dev/null +++ b/devel/debug-ds4/1989/src/RUN load ds4 @@ -0,0 +1,246 @@ +(* COPYRIGHT: digitron GmbH, Bielefeld 1989 *) + +(* +EUMEL0: +modul: 2047 start: 3 0 code: 3 0 1 -257 32604 32588 32573 3 32666 1 +3 4 0 32667 2 3 4 0 3076 11268 5 28678 32573 6 32666 1 6 7 0 32667 2 6 7 0 +3079 11271 8 28694 32573 9 32666 1 9 10 0 32667 2 9 10 0 3082 11274 11 28710 +32573 12 32666 1 12 13 0 32667 2 12 13 0 3085 11277 14 28726 32573 15 32666 +1 16 17 18 32592 17 19 32666 1 22 18 0 32667 2 22 19 0 3090 3091 3092 11284 +21 28750 32587 32583 1 32512 endc pbase: -256 0 0 0 0 1792 -256 1 0 0 3 256 +0 5 0 -32768 9999 7 25 0 0 0 4 1 endp +*) +PACKET ds accesses DEFINES + do, + ds nr, + forget all but not, + set modul start ic, + read ds, + write ds, +: +INT CONST stdds := 4 + index(myself) * 256; +INT PROC read ds (INT CONST drid, add hi, add lo): + EXTERNAL 154 +END PROC read ds; +INT PROC read ds (DATASPACE CONST drid, INT CONST add hi, add lo): + EXTERNAL 154 +END PROC read ds; +PROC write ds (INT CONST drid, add hi, add lo, data): + EXTERNAL 155 +END PROC write ds; +PROC write ds (DATASPACE CONST drid, INT CONST add hi, add lo, data): + EXTERNAL 155 +END PROC write ds; +PROC forget (INT CONST ds): + EXTERNAL 71 +END PROC forget; +OP := (INT VAR left, DATASPACE CONST right): + EXTERNAL 260 +END OP :=; +PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, + INT VAR modul nr, BOOL CONST ins, lst, rt check, ser): + EXTERNAL 256 +END PROC elan; +PROC do (INT CONST modul nr): + INT VAR modul no:= modul nr; + DATASPACE VAR source; + elan (4, source, "", modul no, FALSE, FALSE, FALSE, FALSE); +END PROC do; +INT PROC ds nr (TEXT CONST name): + INT VAR nr := old (name); nr +END PROC ds nr; +PROC forget all but not (INT CONST ds): + INT VAR i, a; + FOR i FROM 5 UPTO 255 REP + a := i + 256 * index (myself); + IF i <> ds MOD 256 THEN + cout (i); forget (a); + FI; + PER +END PROC forget all but not; +PROC set modul start ic (INT CONST modul nr, ic hi, ic lo): + IF ic hi < 2 OR ic hi > 3 THEN error stop ("Falscher Instruction Counter") FI; + IF (modul nr >= 1280 AND ic hi = 3) OR (modul nr <= 1280 AND ic hi = 2) THEN + write ds (stdds, 0, modul nr + 512, ic lo); + ELSE + error stop ("Falsche Modulnummer: " + text (modul nr)); + FI; +END PROC set modul start ic; +END PACKET ds accesses; +PACKET lader DEFINES + lade, +: +INT CONST stdds := 4 + index (myself) * 256; +PROC check task index (TEXT CONST name): + IF index (myself) = index copytask (old(name)) THEN + putline ("Leider haben sie den gleichen Taskindex wie bei der Quelltask erwischt!"); + errorstop("Bitte versuchen sie es mit einer neuen Task!"); + FI; +END PROC check task index; +INT PROC index copytask (DATASPACE CONST ds): + read ds (ds, 7, 9) +END PROC index copytask; +PROC get ic (FILE VAR f, INT VAR ic hi, ic lo): + find text (f,"start:"); + get int (f,ic hi); get int (f,ic lo); + IF ic hi <> 3 THEN error stop ("Falscher Start IC") FI; +END PROC get ic; +PROC get pbase (FILE VAR f, INT VAR ps): + find text (f, "pbase:"); + get int (f, ps); + IF ps MOD 256 <> 0 THEN error stop ("Falsche Packet Basis") FI; +END PROC get pbase; +PROC get modul (FILE VAR f, INT VAR modul nr): + find text (f, "modul:"); + get int (f, modul nr); +END PROC get modul; +PROC load code (FILE VAR f): + INT VAR add hi, add lo, code wert; + TEXT VAR code ende; + check end code (f); + get code add (f, add hi, add lo); + REP + get code (f, code wert, code ende); + IF code ende = "end" THEN LEAVE load code FI; + write ds (stdds, add hi, add lo, code wert); + add lo INCR 1; + PER +END PROC load code; +PROC load pbase (FILE VAR f): + INT VAR pbase add, pbase wert; + TEXT VAR pbase ende; + check end pbase (f); + get pbase (f, pbase add); + REP + get pbase (f, pbase wert, pbase ende); + IF pbase ende = "end" THEN LEAVE load pbase FI; + write ds (stdds, 0, pbase add, pbase wert); + pbase add INCR 1; + PER +END PROC load pbase; +INT PROC read pbase var (FILE VAR f, INT CONST index): + INT VAR pbase add; + get pbase (f, pbase add); + read ds (stdds, 0, pbase add+index) +END PROC read pbase var; +PROC write pbase var (FILE VAR f, INT CONST index, var): + INT VAR pbase add; + get pbase (f, pbase add); + write ds (stdds, 0, pbase add+index, var); +END PROC write pbase var; +PROC get code add (FILE VAR f, INT VAR add hi, add lo): + find text (f, "code:"); + get int (f, add hi); get int (f, add lo); + IF add hi <> 3 THEN error stop ("Falsche Code-Adresse") FI; +END PROC get code add; +PROC get int (FILE VAR f, INT VAR value): + IF eof (f) THEN error stop ("Daten fehlen") FI; + TEXT VAR daten; + get (f, daten); + IF daten = "-32768" THEN + value := -maxint-1; + ELSE + value := int (daten); + ENDIF; +END PROC get int; +PROC get code (FILE VAR f, INT VAR value, TEXT VAR ende ): + IF eof(f) THEN error stop ("'End Code'-Kennung fehlt") FI; + TEXT VAR daten ; + get (f, daten); + IF daten = "endc" THEN + ende := "end" + ELSE + IF daten = "-32768" THEN + value := -maxint-1; + ELSE + value := int (daten); + ENDIF; + ende := "no end" + FI; +END PROC get code; +PROC check end code (FILE VAR f): + find text (f, "endc"); +END PROC check end code; +PROC get pbase (FILE VAR f,INT VAR value, TEXT VAR ende): + IF eof (f) THEN error stop ("'End Pbase'-Kennung fehlt") FI; + TEXT VAR daten ; + get (f, daten); + IF daten = "endp" THEN + ende := "end" + ELSE + IF daten = "-32768" THEN + value := -maxint-1; + ELSE + value := int (daten); + ENDIF; + ende := "no end" + FI; +END PROC get pbase; +PROC check end pbase (FILE VAR f): + find text (f, "endp"); +END PROC check end pbase; +PROC find text (FILE VAR f, TEXT CONST suchtext): + TEXT VAR t; + go start (f); + WHILE NOT eof (f) REP + get (f, t); + IF t = suchtext THEN LEAVE find text FI; + PER; + error stop (suchtext + " fehlt") +END PROC find text; +PROC go start (FILE VAR f): + TEXT VAR t; + reset (f); + WHILE NOT eof (f) REP + get (f, t); + IF t = "EUMEL0:" THEN LEAVE go start FI + PER; + error stop ("EUMEL0-Code nicht gefunden"); +END PROC go start; +PROC run code (INT VAR ic hi, ic lo, modul nr): + set modul start ic (modul nr, ic hi, ic lo); + do push (modul nr); +END PROC run code; +PROC do push (INT CONST modul nr): + IF lbase < 30000 THEN + do push (modul nr); + ELSE + do (modul nr); LEAVE do push; + FI; +END PROC do push; +INT PROC lbase: + pcb (25) +END PROC lbase; +PROC lade (TEXT CONST datei name): + INT VAR ic hi, ic lo, modul nr; + line; + putline ("Achtung: ALLE bis jetzt insertierten Packete der Task gehen verloren!"); + IF NOT yes ("Wollen sie den Standarddatenraum ersetzen") THEN LEAVE lade FI; + check task index (datei name); + FILE VAR f := sequentialfile (input, dateiname); + get ic (f, ic hi, ic lo); + get modul (f, modul nr); + load code (f); + load pbase (f); + load pbase var (f); + run code (ic hi, ic lo, modul nr); +END PROC lade; +PROC load pbase var (FILE VAR f): + INT VAR dss, dst; TEXT VAR name := "STD DS4"; + line; + put ("Wie heißt der Quelldatenraum:"); + editget (name); + line; + IF NOT exists (name) THEN errorstop("Datei " + name + " gibt es nicht."); FI; + dst := 4 + 256 * index (myself); + dss := ds nr (name); + write pbase var (f, 1, dss); + write pbase var (f, 2, dst); + forget all but not (dss); +END PROC load pbase var; +PROC lade: + lade ("RUN load ds4"); +END PROC lade; +END PACKET lader; +lade; + diff --git a/devel/debug-ds4/1989/src/RUN save ds4 b/devel/debug-ds4/1989/src/RUN save ds4 new file mode 100644 index 0000000..1fd542b --- /dev/null +++ b/devel/debug-ds4/1989/src/RUN save ds4 @@ -0,0 +1,223 @@ +(* COPYRIGHT: digitron GmbH, Bielefeld 1989 *) + +(* +EUMEL0: +modul: 2047 start: 3 0 code: 3 0 1 -257 32604 32588 32573 3 32666 1 +3 4 0 32667 2 3 4 0 3076 11268 5 28678 32573 6 32666 1 6 7 0 32667 2 6 7 0 +3079 11271 8 28694 32573 9 32666 1 9 10 0 32667 2 9 10 0 3082 11274 11 28710 +32573 12 32666 1 12 13 0 32667 2 12 13 0 3085 11277 14 28726 32573 15 32592 +15 0 32667 2 17 15 0 3087 11279 16 28740 32587 32512 endc pbase: -256 0 0 0 +0 1792 -256 1 0 0 3 256 0 5 0 -32768 0 32 7 endp +*) +PACKET ds accesses DEFINES + do, + ds nr, + forget all but not, + set modul start ic, + read ds, + write ds, +: +INT CONST stdds := 4 + index(myself) * 256; +INT PROC read ds (INT CONST drid, add hi, add lo): + EXTERNAL 154 +END PROC read ds; +INT PROC read ds (DATASPACE CONST drid, INT CONST add hi, add lo): + EXTERNAL 154 +END PROC read ds; +PROC write ds (INT CONST drid, add hi, add lo, data): + EXTERNAL 155 +END PROC write ds; +PROC write ds (DATASPACE CONST drid, INT CONST add hi, add lo, data): + EXTERNAL 155 +END PROC write ds; +PROC forget (INT CONST ds): + EXTERNAL 71 +END PROC forget; +OP := (INT VAR left, DATASPACE CONST right): + EXTERNAL 260 +END OP :=; +PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, + INT VAR modul nr, BOOL CONST ins, lst, rt check, ser): + EXTERNAL 256 +END PROC elan; +PROC do (INT CONST modul nr): + INT VAR modul no:= modul nr; + DATASPACE VAR source; + elan (4, source, "", modul no, FALSE, FALSE, FALSE, FALSE); +END PROC do; +INT PROC ds nr (TEXT CONST name): + INT VAR nr := old (name); nr +END PROC ds nr; +PROC forget all but not (INT CONST ds): + INT VAR i, a; + FOR i FROM 5 UPTO 255 REP + a := i + 256 * index (myself); + IF i <> ds MOD 256 THEN + cout (i); forget (a); + FI; + PER +END PROC forget all but not; +PROC set modul start ic (INT CONST modul nr, ic hi, ic lo): + IF ic hi < 2 OR ic hi > 3 THEN error stop ("Falscher Instruction Counter") FI; + IF (modul nr >= 1280 AND ic hi = 3) OR (modul nr <= 1280 AND ic hi = 2) THEN + write ds (stdds, 0, modul nr + 512, ic lo); + ELSE + error stop ("Falsche Modulnummer: " + text (modul nr)); + FI; +END PROC set modul start ic; +END PACKET ds accesses; +PACKET lader DEFINES + lade, +: +INT CONST stdds := 4 + index (myself) * 256; +PROC get ic (FILE VAR f, INT VAR ic hi, ic lo): + find text (f,"start:"); + get int (f,ic hi); get int (f,ic lo); + IF ic hi <> 3 THEN error stop ("Falscher Start IC") FI; +END PROC get ic; +PROC get pbase (FILE VAR f, INT VAR ps): + find text (f, "pbase:"); + get int (f, ps); + IF ps MOD 256 <> 0 THEN error stop ("Falsche Packet Basis") FI; +END PROC get pbase; +PROC get modul (FILE VAR f, INT VAR modul nr): + find text (f, "modul:"); + get int (f, modul nr); +END PROC get modul; +PROC load code (FILE VAR f): + INT VAR add hi, add lo, code wert; + TEXT VAR code ende; + check end code (f); + get code add (f, add hi, add lo); + REP + get code (f, code wert, code ende); + IF code ende = "end" THEN LEAVE load code FI; + write ds (stdds, add hi, add lo, code wert); + add lo INCR 1; + PER +END PROC load code; +PROC load pbase (FILE VAR f): + INT VAR pbase add, pbase wert; + TEXT VAR pbase ende; + check end pbase (f); + get pbase (f, pbase add); + REP + get pbase (f, pbase wert, pbase ende); + IF pbase ende = "end" THEN LEAVE load pbase FI; + write ds (stdds, 0, pbase add, pbase wert); + pbase add INCR 1; + PER +END PROC load pbase; +INT PROC read pbase var (FILE VAR f, INT CONST index): + INT VAR pbase add; + get pbase (f, pbase add); + read ds (stdds, 0, pbase add+index) +END PROC read pbase var; +PROC write pbase var (FILE VAR f, INT CONST index, var): + INT VAR pbase add; + get pbase (f, pbase add); + write ds (stdds, 0, pbase add+index, var); +END PROC write pbase var; +PROC get code add (FILE VAR f, INT VAR add hi, add lo): + find text (f, "code:"); + get int (f, add hi); get int (f, add lo); + IF add hi <> 3 THEN error stop ("Falsche Code-Adresse") FI; +END PROC get code add; +PROC get int (FILE VAR f, INT VAR value): + IF eof (f) THEN error stop ("Daten fehlen") FI; + TEXT VAR daten; + get (f, daten); + IF daten = "-32768" THEN + value := -maxint-1; + ELSE + value := int (daten); + ENDIF; +END PROC get int; +PROC get code (FILE VAR f, INT VAR value, TEXT VAR ende ): + IF eof(f) THEN error stop ("'End Code'-Kennung fehlt") FI; + TEXT VAR daten ; + get (f, daten); + IF daten = "endc" THEN + ende := "end" + ELSE + IF daten = "-32768" THEN + value := -maxint-1; + ELSE + value := int (daten); + ENDIF; + ende := "no end" + FI; +END PROC get code; +PROC check end code (FILE VAR f): + find text (f, "endc"); +END PROC check end code; +PROC get pbase (FILE VAR f,INT VAR value, TEXT VAR ende): + IF eof (f) THEN error stop ("'End Pbase'-Kennung fehlt") FI; + TEXT VAR daten ; + get (f, daten); + IF daten = "endp" THEN + ende := "end" + ELSE + IF daten = "-32768" THEN + value := -maxint-1; + ELSE + value := int (daten); + ENDIF; + ende := "no end" + FI; +END PROC get pbase; +PROC check end pbase (FILE VAR f): + find text (f, "endp"); +END PROC check end pbase; +PROC find text (FILE VAR f, TEXT CONST suchtext): + TEXT VAR t; + go start (f); + WHILE NOT eof (f) REP + get (f, t); + IF t = suchtext THEN LEAVE find text FI; + PER; + error stop (suchtext + " fehlt") +END PROC find text; +PROC go start (FILE VAR f): + TEXT VAR t; + reset (f); + WHILE NOT eof (f) REP + get (f, t); + IF t = "EUMEL0:" THEN LEAVE go start FI + PER; + error stop ("EUMEL0-Code nicht gefunden"); +END PROC go start; +PROC run code (INT VAR ic hi, ic lo, modul nr): + set modul start ic (modul nr, ic hi, ic lo); + do (modul nr); +END PROC run code; +PROC lade (TEXT CONST datei name): + INT VAR ic hi, ic lo, modul nr; + line; + IF NOT yes ("Wollen sie den Standarddatenraum kopieren") THEN LEAVE lade FI; + FILE VAR f := sequentialfile (input, dateiname); + get ic (f, ic hi, ic lo); + get modul (f, modul nr); + load code (f); + load pbase (f); + load pbase var (f); + run code (ic hi, ic lo, modul nr); +END PROC lade; +PROC load pbase var (FILE VAR f): + INT VAR dss, dst; TEXT VAR name := "STD DS4"; + line; + put ("Wohin soll der Standarddatenraum kopiert werden:"); + editget (name); + line; + IF NOT exists (name) THEN create (name); FI; + dss := 4 + 256 * index (myself); + dst := ds nr (name); + write pbase var (f, 1, dss); + write pbase var (f, 2, dst); +END PROC load pbase var; +PROC lade: + lade ("RUN save ds4"); +END PROC lade; +END PACKET lader; +lade; + diff --git a/devel/debug/1/source-disk b/devel/debug/1/source-disk new file mode 100644 index 0000000..e42b22b --- /dev/null +++ b/devel/debug/1/source-disk @@ -0,0 +1 @@ +debug/debug-1_1987-04-24.img diff --git a/devel/debug/1/src/RUN dez <-> hex b/devel/debug/1/src/RUN dez <-> hex new file mode 100644 index 0000000..041fcf1 --- /dev/null +++ b/devel/debug/1/src/RUN dez <-> hex @@ -0,0 +1,49 @@ +LET hexziffern = "123456789ABCDEF"; +ROW 4 INT CONST faktoren :: ROW 4 INT : (1, 16, 256, 4096); + +INT PROC dez (TEXT CONST hex): + INT VAR stellen := LENGTH hex; + IF stellen > 4 + OR stellen > 3 AND (hex SUB 1) > "7" + THEN errorstop ("Zahl zu groß") + FI; + INT VAR i :: 0, stelle, ziffpos; + TEXT VAR ziffer; + FOR stelle FROM 1 UPTO stellen REP + ziffer := hex SUB (stellen - stelle + 1); + ziffpos := pos (hexziffern, ziffer); + IF ziffpos <> 0 + THEN i INCR ziffpos * faktoren [stelle] + ELIF ziffer <> "0" + THEN errorstop ("Hexadezimalzahl fehlerhaft") + FI + PER; + i +END PROC dez; +{194 + 76 ; kann nicht durch `replace' zu Beginn verkleinert werden } +TEXT PROC hex (TEXT CONST t dez): + IF t dez = "" THEN LEAVE hex WITH "" FI; + INT VAR stelle, hex ziffer, dez := int (t dez); + TEXT VAR hexzahl := ""; + FOR stelle FROM 4 DOWNTO 1 REP + hexziffer := dez DIV faktoren [stelle]; + IF hexziffer <> 0 + THEN hexzahl CAT (hexziffern SUB hexziffer); + dez DECR hexziffer * faktoren [stelle] + ELSE hexzahl CAT "0" + FI + PER; + hexzahl +END PROC hex; + +putline (""1""4"Dezimalzahlen schlicht, Hexadezimalzahlen mit schließendem ""h"" eingeben"); +line; +TEXT VAR z; +REP put ("Zahl:"); + get (z); + IF (z SUB LENGTH z) = "h" + THEN put (dez (subtext (z, 1, LENGTH z - 1))) + ELSE put (hex (z)) + FI +UNTIL z = "" PER + diff --git a/devel/debug/1/src/all tracer b/devel/debug/1/src/all tracer new file mode 100644 index 0000000..1e84b59 --- /dev/null +++ b/devel/debug/1/src/all tracer @@ -0,0 +1,10 @@ +gen.trace +extended instr +convert +info +disa +trace +gen.procheads +gen.bulletin +trace.dok + diff --git a/devel/debug/1/src/convert b/devel/debug/1/src/convert new file mode 100644 index 0000000..426a5e5 --- /dev/null +++ b/devel/debug/1/src/convert @@ -0,0 +1,154 @@ +PACKET convert DEFINES dec, hex, dsget2b, exhilo, (* Stand: 87-01-13 *) + addc, subc, addl, subl, incl, (* Autor: G. Szalay *) + txt, CT, gethex, integ: + +LET dectab = "0123456789", hextab="0123456789abcdef", mask16=15; +INT VAR number, digit, i; +TEXT VAR buffer, char; +INT CONST min 1 := dec ("ffff"), + min 2 := dec ("fffe"), + minint := dec ("8000"), + maxint := dec ("7fff"), + maxint min 1 := dec ("7ffe"); + +INT PROC integ (TEXT CONST text): (*only digits allowed*) + number := 0; + FOR i FROM 1 UPTO LENGTH text REP + digit := pos (dectab, text SUB i); + IF digit > 0 + THEN number := number * 10 + digit - 1 + FI + UNTIL digit = 0 PER; + number +END PROC integ; + +TEXT PROC hex (INT CONST n): + buffer := ""; number := n; + FOR i FROM 1 UPTO 4 REP + rotate (number,4); + digit := number AND mask16; + buffer CAT (hextab SUB (digit + 1)) + PER; + buffer +END PROC hex; + +INT PROC dec (TEXT CONST t): + IF LENGTH t > 4 THEN leave with message FI; + number := 0; + FOR i FROM 1 UPTO LENGTH t + REP char := t SUB i; + digit := pos (hextab, char) - 1; + IF digit<0 THEN leave with message FI; + rotate (number, 4); + number INCR digit + PER; + number. + + leave with message: + error stop ("wrong param for dec"); + LEAVE dec WITH 0. + +END PROC dec; + +INT PROC exhilo (INT CONST val): + INT VAR ex := val; rotate (ex, 8); + ex +END PROC exhilo; + +INT PROC dsget2b (INT CONST drid, off hi, off lo): + INT VAR val := dsgetw (drid, off hi, off lo); + IF drid <> 1 THEN rotate (val, 8) FI; + val +END PROC dsget2b; + +PROC addc (INT CONST a, b, INT VAR sum, BOOL VAR carry): + INT VAR s; + disable stop; + s := a + b; + IF a >= 0 AND b >= 0 THEN carry := FALSE + ELIF a < 0 AND b < 0 THEN carry := TRUE + ELSE carry := s >= 0 + FI; + sum := s; + clear error +END PROC addc; + +PROC subc (INT CONST a, b, INT VAR diff, BOOL VAR carry): + INT VAR d; + disable stop; + d := a - b; + IF a >= 0 AND b < 0 THEN carry := TRUE + ELIF a < 0 AND b >= 0 THEN carry := FALSE + ELSE carry := d < 0 + FI; + diff := d; + clear error +END PROC subc; + +PROC incl (INT VAR ah, al, INT CONST ainc): + BOOL VAR ov; + IF ainc = 1 + THEN IF al = min1 THEN al := 0; ah INCR 1 + ELIF al = maxint THEN al := minint + ELSE al INCR 1 + FI + ELIF ainc = 2 + THEN IF al = min2 THEN al := 0; ah INCR 1 + ELIF al = maxint min1 THEN al := minint + ELSE al INCR 2 + FI + ELSE addc (al, ainc, al, ov); + IF ov THEN addc (ah, 1, ah, ov) FI + FI +END PROC incl; + +PROC addl (INT CONST ah, al, bh, bl, INT VAR sumh, suml, BOOL VAR carry): + BOOL VAR low carry, high carry; + addc (al, bl, suml, low carry); + addc (ah, bh, sumh, high carry); + IF low carry THEN addc (sumh, 1, sumh, low carry) FI; + carry := low carry OR high carry +END PROC addl; + +PROC subl (INT CONST ah, al, bh, bl, INT VAR diffh, diffl, BOOL VAR carry): + BOOL VAR low carry, high carry; + subc (al, bl, diffl, low carry); + subc (ah, bh, diffh, high carry); + IF low carry THEN subc (diffh, 1, diffh, low carry) FI; + carry := low carry OR high carry +END PROC subl; + +TEXT PROC txt (INT CONST num): + IF num = minint THEN "-32768" + ELIF num < 0 THEN "-" CT txt (-num) + ELIF num <= 9 THEN code (num + 48) + ELSE txt (num DIV 10) CT code (num MOD 10 + 48) + FI +END PROC txt; + +TEXT OP CT (TEXT CONST left, right): + buffer := left; buffer CAT right; buffer +END OP CT; + +PROC gethex (TEXT VAR hexline): + buffer := ""; + REP inchar (char); + SELECT pos (""13""12"0123456789abcdef", char) OF + CASE 0: out(""7"") + CASE 1: hexline := buffer; out (""13""10""); LEAVE gethex + CASE 2: delete last char + OTHERWISE buffer CAT char; out (char) + ENDSELECT + PER. + +delete last char: + IF buffer = "" + THEN out (""7"") + ELSE buffer := subtext (buffer, 1, LENGTH buffer - 1); + out (""8" "8"") + FI. + +ENDPROC gethex; + +END PACKET convert; + diff --git a/devel/debug/1/src/disa b/devel/debug/1/src/disa new file mode 100644 index 0000000..8819e21 --- /dev/null +++ b/devel/debug/1/src/disa @@ -0,0 +1,454 @@ +PACKET dis DEFINES disasm, disa, proc head, (* Autor: G.Szalay *) + set proc heads: (* Stand: 87-04-23 *) + +LET INSTR = STRUCT (TEXT mnem, INT length, class), + clear to eop = ""4"", stdds = 0, no of lines = 4, beep = ""7""; +INT VAR first word, opcode, cur x, cur y; +INT CONST right 2 := -2; + +ROW 31 INSTR CONST primary list :: ROW 31 INSTR: + ( INSTR: ("LN - ",1,10), + INSTR: ("LN1 - ",1,10), + INSTR: ("MOV i- ",2,0), + INSTR: ("INC1 I ",1,0), + INSTR: ("DEC1 I ",1,0), + INSTR: ("INC Ii ",2,0), + INSTR: ("DEC Ii ",2,0), + INSTR: ("ADD iiI ",3,0), + INSTR: ("SUB iiI ",3,0), + INSTR: ("CLEAR I ",1,0), + INSTR: ("TEST i ",1,1), + INSTR: ("EQU ii ",2,1), + INSTR: ("LSEQ ii ",2,1), + INSTR: ("FMOV r- ",2,0), + INSTR: ("FADD rrR ",3,0), + INSTR: ("FSUB rrR ",3,0), + INSTR: ("FMUL rrR ",3,0), + INSTR: ("FDIV rrR ",3,0), + INSTR: ("FLSEQ rr ",2,1), + INSTR: ("TMOV t- ",2,0), + INSTR: ("TEQU tt ",2,1), + INSTR: ("ULSEQ ii ",2,1), + INSTR: ("DSACC dE ",2,0), + INSTR: ("REF a- ",2,0), + INSTR: ("SUBS vviaE",5,0), + INSTR: ("SEL avE ",3,0), + INSTR: ("PPV -i ",2,9), + INSTR: ("PP a ",1,9), + INSTR: ("B - ",1,2), + INSTR: ("B1 - ",1,2), + INSTR: ("CALL - ",1,4) ); + +ROW 6 INSTR CONST special list :: ROW 6 INSTR: + ( INSTR: ("EQUIM vi ",2,1), + INSTR: ("MOVX vh- ",3,0), + INSTR: ("GETW ihI ",3,0), + INSTR: ("MOVI vI ",2,0), + INSTR: ("PUTW vhi ",3,0), + INSTR: ("PENTER v ",1,8) ); + +ROW 157 INSTR CONST secondary list :: ROW 157 INSTR: + ( INSTR: ("RTN ",1,7), + INSTR: ("RTNT ",1,7), + INSTR: ("RTNF ",1,7), + INSTR: ("RESTART ",1,0), + INSTR: ("STOP ",1,11), + (* INSTR: ("*057F* ",0,0), *) + INSTR: ("LBAS H ",2,0), + INSTR: ("KE ",1,12), + (* INSTR: ("*077F* ",0,0), *) + INSTR: ("DSGETW dhhH ",5,0), + INSTR: ("BCRD iI ",3,0), + INSTR: ("CRD II ",3,0), + INSTR: ("ECWR Iii ",4,0), + INSTR: ("CWR IIi ",4,0), + INSTR: ("CTT iE ",3,0), + INSTR: ("GETC tII ",4,1), + INSTR: ("FNONBL ItI ",4,1), + INSTR: ("DREM256 Ii ",3,0), + INSTR: ("AMUL256 Ii ",3,0), + (* INSTR: ("*117F* ",0,0), *) + INSTR: ("DSPUTW dhhh ",5,0), + INSTR: ("ISDIG i ",2,1), + INSTR: ("ISLD i ",2,1), + INSTR: ("ISLC i ",2,1), + INSTR: ("ISUC i ",2,1), + INSTR: ("GADDR -iI ",4,0), + INSTR: ("GCADDR iiI ",4,1), + INSTR: ("ISSHA a ",2,1), + INSTR: ("SYSG ",1,0), + INSTR: ("GETTAB ",1,0), + INSTR: ("PUTTAB ",1,0), + INSTR: ("ERTAB ",1,0), + INSTR: ("EXEC - ",2,5), + INSTR: ("PPROC - ",2,9), + INSTR: ("PCALL - ",2,6), + INSTR: ("BRCOMP iv ",3,3), + INSTR: ("MOVXX vh- ",4,0), + INSTR: ("ALIAS vdD ",4,0), + INSTR: ("MOVII vI ",3,0), + INSTR: ("FEQU rr ",3,1), + INSTR: ("TLSEQ tt ",3,1), + INSTR: ("FNEG rR ",3,0), + INSTR: ("NEG iI ",3,0), + INSTR: ("IMULT iiI ",4,0), + INSTR: ("MUL iiI ",4,0), + INSTR: ("DIV iiI ",4,0), + INSTR: ("MOD iiI ",4,0), + INSTR: ("ITSUB tiI ",4,0), + INSTR: ("ITRPL Tii ",4,0), + INSTR: ("DECOD tI ",3,0), + INSTR: ("ENCOD iT ",3,0), + INSTR: ("SUBT1 tiT ",4,0), + INSTR: ("SUBTFT tiiT ",5,0), + INSTR: ("SUBTF tiT ",4,0), + INSTR: ("REPLAC Tit ",4,0), + INSTR: ("CAT Tt ",3,0), + INSTR: ("TLEN tI ",3,0), + INSTR: ("POS ttI ",4,0), + INSTR: ("POSF ttiI ",5,0), + INSTR: ("POSFT ttiiI",6,0), + INSTR: ("STRAN -iitiiI",8,0), + INSTR: ("POSIF tiiiI",6,0), + INSTR: ("*3B7F* ",0,0), + INSTR: ("OUT t ",2,0), + INSTR: ("COUT i ",2,0), + INSTR: ("OUTF ti ",3,0), + INSTR: ("OUTFT tii ",4,0), + INSTR: ("INCHAR T ",2,0), + INSTR: ("INCETY T ",2,0), + INSTR: ("PAUSE i ",2,0), + INSTR: ("GCPOS II ",3,0), + INSTR: ("CATINP TT ",3,0), + INSTR: ("NILDS D ",2,0), + INSTR: ("DSCOPY Dd ",3,0), + INSTR: ("DSFORG d ",2,0), + INSTR: ("DSWTYP di ",3,0), + INSTR: ("DSRTYP dI ",3,0), + INSTR: ("DSHPSIZ dI ",3,0), + INSTR: ("ESTOP ",1,11), + INSTR: ("DSTOP ",1,11), + INSTR: ("SETERR i ",2,0), + INSTR: ("ISERR ",1,1), + INSTR: ("CLRERR ",1,13), + INSTR: ("RPCB iI ",3,0), + INSTR: ("INFOPW ttI ",4,0), + INSTR: ("TWCPU pr ",3,0), + INSTR: ("ROTATE Hi ",3,0), + INSTR: ("IOCNTL iiiI ",5,0), + INSTR: ("BLKOUT diiiI",6,0), + INSTR: ("BLKIN diiiI",6,0), + INSTR: ("BLKNXT diI ",4,0), + INSTR: ("DSSTOR dpI ",4,0), + INSTR: ("STORAGE II ",3,0), + INSTR: ("SYSOP i ",2,0), + INSTR: ("ARITS ",1,0), + INSTR: ("ARITU ",1,0), + INSTR: ("HPSIZE I ",2,0), + INSTR: ("GARB ",1,0), + INSTR: ("TCREATE ppia ",5,0), + INSTR: ("FSLD iRI ",4,0), + INSTR: ("GEXP rI ",3,0), + INSTR: ("SEXP iR ",3,0), + INSTR: ("FLOOR rR ",3,0), + INSTR: ("RTSUB tiR ",4,0), + INSTR: ("RTRPL Tir ",4,0), + INSTR: ("CLOCK iR ",3,0), + INSTR: ("SETNOW r ",2,0), + INSTR: ("TRPCB piI ",4,0), + INSTR: ("TWPCB pii ",4,0), + INSTR: ("TCPU pR ",3,0), + INSTR: ("TSTAT pI ",3,0), + INSTR: ("ACT p ",2,0), + INSTR: ("DEACT p ",2,0), + INSTR: ("THALT p ",2,0), + INSTR: ("TBEGIN pa ",3,0), + INSTR: ("TEND p ",2,0), + INSTR: ("SEND pidI ",5,0), + INSTR: ("WAIT DIP ",4,0), + INSTR: ("SWCALL piDI ",5,0), + INSTR: ("CDBINT hI ",3,0), + INSTR: ("CDBTXT hT ",3,0), + INSTR: ("PNACT P ",2,0), + INSTR: ("PW hhi ",4,0), + INSTR: ("GW hhI ",4,0), + INSTR: ("BITXOR hhH ",4,0), + INSTR: ("SNDWT piDI ",5,0), + INSTR: ("TEXIST p ",2,1), + INSTR: ("BITAND hhH ",4,0), + INSTR: ("BITOR hhH ",4,0), + INSTR: ("SESSION I ",2,0), + INSTR: ("SNDFROM ppiDI",6,0), + INSTR: ("DEFCOLL i ",2,0), + INSTR: ("IDENT iI ",3,0), + INSTR: ("*827F* ",0,0), + INSTR: ("*837F* ",0,0), + INSTR: ("*847F* ",0,0), + INSTR: ("*857F* ",0,0), + INSTR: ("*867F* ",0,0), + INSTR: ("*877F* ",0,0), + INSTR: ("*887F* ",0,0), + INSTR: ("*897F* ",0,0), + INSTR: ("*8a7F* ",0,0), + INSTR: ("*8b7F* ",0,0), + INSTR: ("*8c7F* ",0,0), + INSTR: ("*8d7F* ",0,0), + INSTR: ("*8e7F* ",0,0), + INSTR: ("*8f7F* ",0,0), + INSTR: ("*907F* ",0,0), + INSTR: ("*917F* ",0,0), + INSTR: ("*927F* ",0,0), + INSTR: ("*937F* ",0,0), + INSTR: ("*947F* ",0,0), + INSTR: ("*957F* ",0,0), + INSTR: ("*967F* ",0,0), + INSTR: ("*977F* ",0,0), + INSTR: ("*987F* ",0,0), + INSTR: ("*997F* ",0,0), + INSTR: ("DSGETW dhhH ",5,0), + INSTR: ("DSPUTW dhhh ",5,0), + INSTR: ("LBAS H ",2,0) ); + + +PROC disa (INT CONST icount h, icount l, + TEXT VAR mnemonic, oplist, + INT VAR instr length, instr class) : + fetch first instr word; + fetch opcode; + IF primary THEN process primary + ELIF secondary THEN process secondary + ELIF longprim THEN process longprim + ELSE process special + FI; + oplist := subtext (mnemonic, 9); + mnemonic := subtext (mnemonic, 1, 8). + +fetch first instr word: + first word := dsgetw (stdds, icount h, icount l). + +fetch opcode: + opcode := first word; + rotate (opcode,8); + opcode := opcode AND 255. + +primary: (opcode AND 124) <> 124. + +secondary: opcode = 127. + +longprim: opcode = 255. + +process primary: + opcode := opcode AND 124; + rotate (opcode, right 2); + mnemonic := primary list (opcode+1) . mnem; + instr length := primary list (opcode+1) . length; + instr class := primary list (opcode+1) . class. + +process secondary: + opcode := first word AND 255; + IF opcode <= 156 + THEN mnemonic := secondary list (opcode+1) . mnem; + instr length := secondary list (opcode+1) . length; + instr class := secondary list (opcode+1) . class + ELSE mnemonic := "wrongopc"; + instr length := 0; instr class := -1 + FI. + +process longprim: + opcode := first word AND 255; + IF (opcode AND 124) = opcode + THEN rotate (opcode, -2); + mnemonic := primary list (opcode+1) . mnem; + instr length := primary list (opcode+1) . length + 1; + instr class := primary list (opcode+1) . class + ELSE mnemonic := "wrongopc"; + instr length := 0; instr class := -1 + FI. + +process special: + IF opcode < 128 + THEN opcode := (opcode AND 3) + 1 + ELSE opcode := (opcode AND 3) + 4 + FI; + mnemonic := special list (opcode) .mnem; + instr length := special list (opcode) .length; + instr class := special list (opcode) . class. + +END PROC disa; + +(*********************************************************************) + +LET max modno = 3071; +INT VAR word1, modno; +TEXT VAR buf, mod decr; +BOOL VAR proc heads file exists := FALSE; +INITFLAG VAR initflag := FALSE; +BOUND ROW max modno TEXT VAR proc heads; + +PROC set proc heads (TEXT CONST proc heads filename): + proc heads file exists := FALSE; + IF proc heads filename <> "" AND exists (proc heads filename) + THEN proc heads := old (proc heads filename); + put (proc heads (max modno)); (*to test type*) + proc heads file exists := TRUE + FI +END PROC set proc heads; + +TEXT PROC proc head (INT CONST module no): + IF NOT initialized (initflag) + THEN provide proc heads file + FI; + INT VAR modno := module no; + IF modno >= 10000 THEN modno DECR 10000 FI; + IF proc heads file exists AND modno <= max modno + THEN IF modno = 0 + THEN "(* mod no 0 *)" + ELSE buf := proc heads (modno); + IF subtext (buf, 1, 2) = "+>" + THEN mod decr := subtext (buf, 3); + buf := "(* " CT mod decr CT " +> " + CT proc head (modno - integ (mod decr)) CT " *)" + FI; + buf + FI + ELSE "" + FI. + +provide proc heads file: + IF NOT exists ("procheads") + THEN disable stop; + command dialogue (FALSE); + fetch ("procheads"); + IF is error + THEN putline ("(*** proc heads file missing ***)"); + out (beep); clear error + ELSE set proc heads ("procheads") + FI; + command dialogue (TRUE) + FI +ENDPROC proc head; + +(***********************************************************************) + +INT VAR ic h:=2, ic l:=0, ilen, iclass, i, cmd, maxlines:=12, lines; +INT CONST mask 8000 := dec ("8000"), + mask 7fff := dec ("7fff"), + mask 0400 := dec ("0400"), + bf mask1 := dec ("0040"), + opcode mask0 := dec ("83ff"); +BOOL VAR step mode := TRUE, quit; +TEXT VAR iname, ioplist, char, input; + +PROC disasm : + out (""13""); + disasm (ic h, ic l) + +ENDPROC disasm; + +PROC disasm (INT CONST startaddr hi, startaddr lo): + ic h := startaddr hi; + ic l := startaddr lo; + lines := 0; + quit := FALSE; + REP + IF NOT (ic h = 3 OR ic h = 2) + THEN out ("*** icount out of code area ***"); line; out (beep); + step mode := TRUE + ELSE disa (ic h, ic l, iname, ioplist, ilen, iclass); + put icount mnemonic and instr words; + put proc head for call; + line; lines INCR 1; + IF iclass = 1 THEN put cond branch instr FI; + FI; + process command if necessary + UNTIL quit PER. + +put icount mnemonic and instr words: + put icount; + out (iname); + out (" "); + IF ilen > 0 + THEN IF iclass = 4 THEN word1 := dsgetw (stdds, ic h, ic l) FI; + FOR i FROM 1 UPTO ilen REP + out (hex (dsget2b (stdds, ic h, ic l))); out (" "); + incl (ic h, ic l, 1) + PER + ELSE out (hex (dsget2b (stdds, ic h, ic l))); out (""7""); + incl (ic h, ic l, 1); + step mode := TRUE + FI. + +put cond branch instr: + put icount; + word1 := dsget2b (stdds, ic h, ic l); + IF (word1 AND bf mask1) <> 0 + THEN out ("BF ") + ELSE out ("BT ") + FI; + putline (hex (word1)); + lines INCR 1; + incl (ic h, ic l, 1). + +put icount: + out (txt (ic h)); + out (hex (ic l)); + out (": "). + +put proc head for call: + IF iclass = 4 + THEN eval module no; + out (" "); + out (proc head (mod no)) + FI. + +eval module no: + mod no := word1 AND opcode mask0; + IF (mod no AND mask 8000) <> 0 + THEN mod no := mod no AND mask 7fff OR mask 0400 + FI. + +process command if necessary: + IF step mode OR incharety <> "" OR lines >= maxlines + THEN process command; + lines := 0 + FI. + +process command : + REP putline (""15"DISASM: step, more, address, lines, info, or quit"14""); + inchar (char); + cmd := pos ("smaliq",char); + IF cmd > 0 + THEN SELECT cmd OF + CASE 1: step mode := TRUE; point to previous line + CASE 2: step mode := FALSE; point to previous line + CASE 3: set new ic + CASE 4: set new linecount + CASE 5: info (stdds, ic h, ic l, no of lines) + CASE 6: quit := TRUE + ENDSELECT + FI + UNTIL char <> "i" PER. + +point to previous line: + get cursor (cur x, cur y); cursor (1, cur y - 1); out (clear to eop). + +set new line count: + out ("lines="); gethex (buf); maxlines := dec (buf). + +set new ic : + REP + put ("type new ic (20000...3ffff)"); + gethex (input); + input := "0000" CT input; + ic l := dec (subtext (input, LENGTH input-3)); + ic h := dec (subtext (input, LENGTH input-7, LENGTH input-4)); + IF ic h = 2 OR ic h = 3 THEN LEAVE set new ic FI; + out (beep); putline ("*** icount out of code area ***") + PER. + +ENDPROC disasm; + +(* disasm *) (*for test only*). + +END PACKET dis; + diff --git a/devel/debug/1/src/extended instr b/devel/debug/1/src/extended instr new file mode 100644 index 0000000..93b3b9e --- /dev/null +++ b/devel/debug/1/src/extended instr @@ -0,0 +1,25 @@ +(**************************************************************) +(* Extended EUMEL0-instructions for TRACE G.Szalay *) +(************************************************* 87-04-03 ***) + +PACKET extended instr DEFINES dsgetw, dsputw, local base, + signed arith, unsigned arith: + +INT PROC dsgetw (INT CONST drid, adr hi, adr lo): + EXTERNAL 154 +ENDPROC dsgetw; + +PROC dsputw (INT CONST drid, adr hi, adr lo, word): + EXTERNAL 155 +ENDPROC dsputw; + +INT PROC local base: + EXTERNAL 156 +ENDPROC local base; + +PROC signed arith: EXTERNAL 91 ENDPROC signed arith; + +PROC unsigned arith: EXTERNAL 92 ENDPROC unsigned arith; + +ENDPACKET extended instr; + diff --git a/devel/debug/1/src/gen.bulletin b/devel/debug/1/src/gen.bulletin new file mode 100644 index 0000000..8c5b15b --- /dev/null +++ b/devel/debug/1/src/gen.bulletin @@ -0,0 +1,536 @@ +PACKET eumel coder part 1 m DEFINES bulletin m : (* Author: U.Bartling *) + (* modif'd by G.Szalay*) + (* 87-03-31 *) + +(**************************************************************************) +(* *) +(* This program generates a file "bulletin" containing procedure heads *) +(* and the module numbers, to be used by the debugging packet 'trace'. *) +(* *) +(**************************************************************************) + + + (***** Globale Variable *****) + +TEXT VAR object name; + +FILE VAR bulletin file; + +INT VAR hash table pointer, nt link, permanent pointer, param link, + index, mode, word, packet link; + +BOOL VAR found, end of params; + +#page# +(**************************************************************************) +(* *) +(* 1. Interface zum ELAN-Compiler 04.08.1986 *) +(* 1.8.0 *) +(* *) +(* Beschreibung der Tabellen (-groessen), *) +(* internen Vercodung von Typen *) +(* und Kennungen . *) +(* Initialisieren und Beenden des Compilers, *) +(* Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle *) +(* *) +(**************************************************************************) + + +LET begin of hash table = 0 , + end of hash table = 1023 , + + begin of permanent table = 22784 , + before first pt entry = 22784 , + first permanent entry = 22785 , + end of permanent table = 32767 , + + wordlength = 1 , (* compile u n d run time *) + two word length = 2 , + three word length = 3 , + + permanent param const = 10000 , + permanent param var = 20000 , + permanent proc op = 30000 , + permanent type = 30000 , + permanent row = 10 , + permanent struct = 11 , + permanent param proc = 12 , +(* permanent param proc end marker = 0 , *) + permanent type field = 0 , + + ptt limit = 10000 , + begin of pt minus ptt limit = 12784 , + + void = 0 , + int = 1 , + real = 2 , + string = 3 , + bool = 5 , + bool result = 6 , + dataspace = 7 , + row = 10 , + struct = 11 , + + const = 1 , + var = 2 , +(* proc = 3 , *) +(* denoter = 5 , *) + bold = 2 ; + + +INT CONST permanent packet := -2 , + permanent end := -3 ; + + + + + (***** Hash/Namenstabelle *****) +. +next hash entry : + hash table pointer INCR wordlength . + +end of hash table reached : + hash table pointer > end of hash table . + +yet another nt entry : + nt link := cdb int (nt link) ; + nt link <> 0 . ; + +PROC to object (TEXT CONST searched object) : + hash ; + search nt entry . + +hash : + hash code := 0 ; + FOR index FROM 1 UPTO LENGTH searched object REP + addmult cyclic + ENDREP . + +addmult cyclic : + hash code INCR hash code ; + IF hash code > end of hash table THEN wrap around FI ; + hash code := (hash code + code (searched object SUB index)) MOD 1024 . + +wrap around : + hash code DECR end of hash table . + +hash code : nt link . + +search nt entry : + found := FALSE ; + WHILE yet another nt entry REP + read current entry ; + IF object name = searched object + THEN found := TRUE ; + LEAVE to object + FI + PER . + +read current entry : + permanent pointer := cdb int (nt link + wordlength) ; + object name := cdb text (nt link + two word length) +ENDPROC to object ; + + + (***** Permanent Tabelle *****) +. +next procedure : + permanent pointer := cdb int (permanent pointer) . ; + +PROC next pt param : + mode := cdb int (param link) MOD ptt limit ; + param link INCR wordlength ; + IF mode = permanent row THEN skip over permanent row + ELIF mode = permanent struct THEN skip over permanent struct + FI ; + set end marker if end of list . + +skip over permanent row : + param link INCR wordlength ; + next pt param . + +skip over permanent struct : + REP + next pt param ; + mode := cdb int (param link) + UNTIL mode = permanent type field PER ; + param link INCR wordlength +ENDPROC next pt param ; + +PROC set end marker if end of list : + mode := cdb int (param link) ; + end of params := mode >= permanent proc op OR mode <= 0 +ENDPROC set end marker if end of list ; + +PROC get type and mode (INT VAR type) : + mode := cdb int (param link) ; + IF mode = permanent param proc THEN type of param proc + ELSE type of object + FI . + +type of param proc : + param link INCR wordlength ; + get type and mode (type) ; + mode := permanent param proc . + +type of object : + IF mode < 0 THEN type := 2769 + (32767 + mode) ; + mode := 0 + ELSE type := mode MOD ptt limit ; + mode DECR type ; + translate type if necessary ; + translate mode if necessary + FI . + +translate type if necessary : + IF permanent row or struct THEN translate type FI . + +translate type : + type := param link - begin of pt minus ptt limit . + +translate mode if necessary : + IF mode = permanent param const THEN mode := const + ELIF mode = permanent param var THEN mode := var + FI . + +permanent row or struct : + type = permanent row OR type = permanent struct +ENDPROC get type and mode ; + + + (***** Allgemeine Zugriffsprozeduren *****) + +INT PROC cdb int (INT CONST index) : + EXTERNAL 116 +ENDPROC cdb int ; + +TEXT PROC cdb text (INT CONST index) : + EXTERNAL 117 +ENDPROC cdb text ; + +#page# +(**************************************************************************) +(* *) +(* 10. Inspector 01.08.1986 *) +(* *) +(**************************************************************************) + + + +INT VAR line number, begin of packet, + last packet entry, indentation; + +TEXT VAR type and mode, pattern, buffer; + +PROC name of type (INT CONST type) : + SELECT type OF + CASE void : + CASE int : type and mode CAT "INT" + CASE real : type and mode CAT "REAL" + CASE string : type and mode CAT "TEXT" + CASE bool, bool result : type and mode CAT "BOOL" + CASE dataspace : type and mode CAT "DS" + CASE row : type and mode CAT "ROW " + CASE struct : type and mode CAT "STRUCT" + OTHERWISE : complex type + ENDSELECT . + +complex type : + IF type > ptt limit THEN perhaps permanent struct or row + ELSE get complex type + FI . + +perhaps permanent struct or row : + index := type + begin of pt minus ptt limit ; + mode := cdb int (index) MOD ptt limit ; + IF mode = permanent row THEN get permanent row + ELIF mode = permanent struct THEN get permanent struct + ELSE type and mode CAT "-" + FI . + +get complex type : + index := type + begin of permanent table ; + IF is complex type THEN get name + ELSE type and mode CAT "-" + FI . + +is complex type : + permanent type definition mode = permanent type . + +get name : + type and mode CAT cdb text (link to type name + two word length) . + +link to type name : + cdb int (index + three word length) . + +permanent type definition mode : + cdb int (index + wordlength) . + +get permanent row : + INT VAR t; + type and mode CAT "ROW " ; + type and mode CAT text (cdb int (index + wordlength)) ; + type and mode CAT " " ; + param link := index + two wordlength ; + get type and mode (t) ; + name of type (t) . + +get permanent struct : + type and mode CAT "STRUCT ( ... )" +ENDPROC name of type ; + + +BOOL PROC not end of chain : + permanent pointer <> 0 +ENDPROC not end of chain ; + +PROC put specifications (TEXT CONST proc name) : + put obj name (proc name) ; + to first param ; + IF NOT end of params THEN put param list FI ; + put result ; + write bulletin line (text(cdb int(param link+wordlength),5)) ; + writeline . + +to first param : + param link := permanent pointer + word length ; + set end marker if end of list . + +put result : + INT VAR type; + get type and mode (type) ; + IF type <> void THEN type and mode := " --> " ; + name of type (type) ; + write bulletin line (type and mode) + FI +ENDPROC put specifications ; + +PROC put param list : + write bulletin line (" (") ; + REP + INT VAR type, param mode; + get type and mode (type) ; + param mode := mode ; + put type and mode ; + maybe param proc ; + next pt param ; + IF end of params THEN write bulletin line (")") ; + LEAVE put param list + FI ; + write bulletin line (", ") ; + PER . + +put type and mode : + type and mode := "" ; + name of type (type) ; + type and mode CAT name of mode ; + write bulletin line (type and mode) . + +name of mode : + IF param mode = const THEN " C" + ELIF param mode = var THEN " V" + ELSE " PROC" + FI . + +maybe param proc : + IF mode = permanent param proc THEN put virtual params FI . + +put virtual params : + skip over result type if complex type ; + IF NOT end of virtual params THEN put param list FI. + +skip over result type if complex type : + next pt param . + +end of virtual params : + end of params +ENDPROC put param list ; + +PROC to packet (TEXT CONST packet name) : + to object ( packet name) ; + IF found THEN find start of packet objects FI . + +find start of packet objects : + last packet entry := 0 ; + packet link := before first pt entry ; + REP + packet link INCR wordlength ; + word := cdb int (packet link) ; + IF word < 0 THEN IF word = permanent packet THEN packet found + ELIF word = permanent end THEN return + FI + FI + ENDREP . + +packet found : + IF cdb int (packet link + wordlength) = nt link + THEN last packet entry := packet link FI . + +return : + IF last packet entry <> 0 THEN found := TRUE ; + packet link := last packet entry + ELSE found := FALSE + FI ; + LEAVE to packet +ENDPROC to packet ; + +PROC next packet : + REP + packet link INCR wordlength ; + word := cdb int (packet link) ; + IF word = permanent packet THEN true return + ELIF end of permanents THEN false return + FI ; + ENDREP . + +true return : + found := TRUE ; + LEAVE next packet . + +false return : + found := FALSE ; + LEAVE next packet . + +end of permanents : + word = permanent end OR packet link > end of permanent table +ENDPROC next packet ; + +PROC prep bulletin : + IF exists ("bulletin") + THEN IF yes("overwrite old file ""bulletin""") + THEN command dialogue (FALSE); + forget ("bulletin"); + command dialogue (TRUE); + bulletin file := sequential file (output, new ("bulletin")) + ELSE bulletin file := sequential file (output, old ("bulletin")) + FI + ELSE bulletin file := sequential file (output, new ("bulletin")) + FI; + putline ("GENERATING ""bulletin"" ..."); + line number := 0 ; + buffer := "" +ENDPROC prep bulletin ; + +PROC write bulletin line (TEXT CONST line) : + (* IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ; *) + buffer CAT line +ENDPROC write bulletin line ; + +PROC writeline : + write (bulletin file, buffer) ; + line (bulletin file) ; + line number INCR 1 ; + cout (line number) ; + buffer := "" +ENDPROC writeline ; + +PROC writeline (INT CONST times) : + IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ; + writeline + ELSE index := times + FI ; + line (bulletin file, index) ; + line number INCR index; + indentation := 0 ; + cout (line number) +ENDPROC writeline ; + +PROC bulletin m (TEXT CONST packet name) : + prep bulletin ; + scan (packet name) ; + next symbol (pattern) ; + to packet (pattern) ; + IF found THEN list packet + ELSE error stop (packet name + " ist kein Paketname") + FI . + +ENDPROC bulletin m; + +PROC list packet : + begin of packet := packet link + word length ; + find end of packet ; + run through nametab and list all packet objects . + +find end of packet : + last packet entry := begin of packet ; + REP + last packet entry INCR wordlength ; + word := cdb int (last packet entry) ; + UNTIL end of packet entries PER . + +end of packet entries : + word = permanent packet OR word = permanent end . + +run through nametab and list all packet objects : + hashtable pointer := begin of hashtable ; + REP + nt link := hashtable pointer ; + list objects of current packet in this chain ; + next hash entry + UNTIL end of hashtable reached ENDREP . + +list objects of current packet in this chain : + WHILE yet another nt entry REP + permanent pointer := cdb int (nt link + wordlength) ; + put objects of this name + PER . + +put objects of this name : + IF there is at least one object of this name in the current packet + THEN into bulletin FI . + +there is at least one object of this name in the current packet : + REP + IF permanent pointer >= begin of packet AND + permanent pointer < last packet entry + THEN LEAVE there is at least one object of this name + in the current packet WITH TRUE FI ; + next procedure + UNTIL permanent pointer = 0 PER ; + FALSE . + +into bulletin : + object name := cdb text (nt link + two word length) ; + object names into bulletin (BOOL PROC within packet) +ENDPROC list packet ; + +BOOL PROC within packet : + permanent pointer >= begin of packet AND + permanent pointer < last packet entry +ENDPROC within packet ; + +PROC object names into bulletin (BOOL PROC link ok) : + scan (object name) ; + next symbol (object name, mode) ; + IF NOT type definition THEN put object definitions FI . + +type definition : + mode = bold AND no params . + +no params : + cdb int (permanent pointer + word length) >= permanent type . + +put object definitions : + WHILE link ok REP + put specifications (object name) ; + next procedure + ENDREP +ENDPROC object names into bulletin ; + +PROC bulletin m: + prep bulletin ; + packet link := first permanent entry ; + REP + list packet ; + next packet + UNTIL NOT found PER +ENDPROC bulletin m; + +PROC put obj name (TEXT CONST name) : + buffer := name. +ENDPROC put obj name ; + +bulletin m; + +ENDPACKET eumel coder part 1 m; + diff --git a/devel/debug/1/src/gen.procheads b/devel/debug/1/src/gen.procheads new file mode 100644 index 0000000..e2ab0ea --- /dev/null +++ b/devel/debug/1/src/gen.procheads @@ -0,0 +1,89 @@ +(**********************************************************************) +(* *) +(* This program generates/updates a dataspace "procheads" from the *) +(* file "bulletin", including the module numbers. "procheads" will *) +(* be used by 'trace" and 'disasm" to show the name and the formal *) +(* param list of a called procedure. *) +(* *) +(* GMD-Z2.P/G.Szalay/86-04-06 *) +(* *) +(**********************************************************************) + +LET digits = "1234567890", outname = "procheads", + maxno of procs = 3071, first compiled module no = 256; +FILE VAR infile := sequential file (input, old ("bulletin")); +TEXT VAR buf, linebuf, entry, answer; +INT VAR i, j, module no, posit, max module no := 0; +BOUND ROW maxno of procs TEXT VAR proc heads; + +putline ("generating """ + outname + """ ..."); +BOOL VAR oldfile := exists (outname); +IF oldfile +THEN ask for action to be taken; + IF answer = "r" + THEN forget (outname); oldfile := FALSE; + proc heads := new (outname) + ELSE proc heads := old (outname) + FI +ELSE proc heads := new (outname) +FI; + +IF NOT oldfile THEN init heads FI; +getline (infile, linebuf); +FOR i FROM 1 UPTO 1000 REP + process line; + cout (i); + getline (infile, linebuf) +UNTIL eof (infile) PER; +process missing heads. + +ask for action to be taken: + out ("replace or append to old file """+outname+""" (r/a) ? "); + REP inchar (answer); + IF answer <> "r" AND answer <> "a" THEN out(""7"") FI + UNTIL answer = "r" OR answer = "a" PER; + putline (answer). + +init heads: + proc heads (1) := "+>1"; + FOR i FROM 2 UPTO maxno of procs REP proc heads (i) := "" PER. + +process line: + fetch module no and entry; + IF module no >= first compiled module no + THEN IF module no < 10000 + THEN proc heads (module no) := entry + ELSE proc heads (module no - 10000) := entry + FI + FI. + +fetch module no and entry: + posit := LENGTH linebuf - 1; + WHILE pos (digits, linebuf SUB posit) <> 0 + REP posit DECR 1 PER; + module no := int (subtext (linebuf, posit+1)); + IF module no < 10000 AND module no > max module no + THEN max module no := module no + FI; + WHILE (linebuf SUB posit) = " " REP posit DECR 1 PER; + entry := subtext (linebuf, 1, posit). + +process missing heads: + putline ("max module no=" + text(max module no)); + FOR i FROM 1 UPTO max module no REP + cout(i); + IF proc heads (i) = "" THEN put in offset to last head FI + PER. + +put in offset to last head: + FOR j FROM i-1 DOWNTO 1 REP + IF proc heads (j) <> "" + THEN IF subtext (proc heads (j), 1, 2) = "+>" + THEN proc heads (i) := "+>" + text (i - j + + int (subtext (proc heads (j), 3))) + ELSE proc heads (i) := "+>" + text (i - j) + FI; + LEAVE put in offset to last head + FI + PER. + diff --git a/devel/debug/1/src/gen.trace b/devel/debug/1/src/gen.trace new file mode 100644 index 0000000..4dc8c53 --- /dev/null +++ b/devel/debug/1/src/gen.trace @@ -0,0 +1,23 @@ +checkoff; +putline("inserting ""extended instr"" ..."); +insert("extended instr"); +putline("inserting ""convert"" ..."); +insert("convert"); +putline("inserting ""info"" ..."); +insert("info"); +putline("inserting ""disa"" ..."); +insert("disa"); +putline("inserting ""trace"" ..."); +insert("trace"); +putline("inserting ""gen.bulletin"" ..."); +insert("gen.bulletin"); +putline("compiling ""gen.procheads"" ..."); +run("gen.procheads"); +do("set procheads(""procheads"")"); +forget("bulletin",quiet); +putline("task """+name(myself)+""" is now global manager"); +putline("press any key ..."); +pause; global manager + + + diff --git a/devel/debug/1/src/info b/devel/debug/1/src/info new file mode 100644 index 0000000..31099c6 --- /dev/null +++ b/devel/debug/1/src/info @@ -0,0 +1,371 @@ +PACKET info DEFINES info: + +(**********************************************************************) +(** **) +(** M i n i - I N F O Autor: G. Szalay Stand: 87-04-03 **) +(** **) +(**********************************************************************) + +LET charset = "1234567890ß'qwertzuiopü+asdfghjklöä#YXCVBNM;:_ ", + hextab = "0123456789abcdef", stdds = 0, + cr = ""13"", cr rubout = ""13""12"", + up down left right = ""3""10""8""2""; +TEXT VAR buf, linebuf, bytes, hexbytes, char, + search param := ""255"", search buffer, + first byte, hex search param := "ff", search mode := "h"; +INT VAR drid := stdds, adr hi := 2, adr lo := 0, lines := 4, + begin hi := adr hi, begin lo := adr lo, first word, + saddr hi, saddr lo, + no of found bytes, cur xx, cur x, cur y, ymin, ymax, + xmin := 9, xmidlo := xmin + 21, + xmidhi := xmidlo + 5, xmax := xmidhi + 21, + word, byte, i, l; +INT CONST mask 00ff := dec ("00ff"), + mask ff00 := dec ("ff00"), + offs mask := dec ("0007"), + addr mask := dec ("fff8"); +BOOL VAR found, low byte flag := TRUE, interrupted, + area 2 nonchangeable := id (1) <> 4 (*i.e. other than 68000*); + +PROC wait for (TEXT CONST chars): + inchar (char); + WHILE pos (chars, char) = 0 + REP out (""7""); inchar (char) PER +END PROC wait for; + +PROC info: + info (drid, begin hi, begin lo, lines) +END PROC info; + +PROC info (INT CONST start drid, start addr hi, start addr lo, start len): + drid := start drid; + begin hi := start addr hi; + begin lo := start addr lo; + lines := start len; + line; line; show dump; + command loop. + +command loop: + REP + zeige kommandoliste; + kommando lesen und ausfuehren + PER. + +zeige kommandoliste: + putline (""15"INFO: more, address, dsid, lines, find, or quit"14""). + +kommando lesen und ausfuehren: + inchar (char); + SELECT pos ("damlfq"3"", char) OF + CASE 1: drid command + CASE 2: addr command + CASE 3: more command + CASE 4: len command + CASE 5: find command + CASE 6: quit command + CASE 7: up command + OTHERWISE more command + END SELECT. + +quit command: LEAVE command loop. + +drid command: + out ("dsid="); gethex (buf); drid := dec (buf); + IF drid > 0 AND drid < 4 OR drid > 255 + THEN beep; drid := stdds + ELIF drid = 4 + THEN drid := stdds + FI; + found := FALSE; + show dump. + +len command: + out ("lines="); gethex (buf); lines := dec (buf); show dump. + +addr command: + out ("address="); + gethex (buf); + IF LENGTH buf < 5 + THEN begin hi := 0; begin lo := dec (buf) + ELSE begin hi := dec (subtext (buf, 1, LENGTH buf - 4)); + begin lo := dec (subtext (buf, LENGTH buf - 3)) + FI; + low byte flag := TRUE; found := FALSE; + show dump. + +more command: + begin hi := adr hi; begin lo := adr lo; + low byte flag := TRUE; found := FALSE; + line; show dump. + +show dump: + interrupted := FALSE; + get cursor (cur x, cur y); + cursor (1, cur y - 2); + out ("---------------------------- dsid="); + IF drid = stdds THEN out ("04") ELSE outsubtext (hex (drid), 3) FI; + putline (" --------------------"); + adr hi := begin hi; + adr lo := begin lo AND addr mask; + FOR l FROM 1 UPTO lines REP + buf := " "; linebuf := " "; bytes := ""; + out (txt (adr hi)); out (hex (adr lo) CT ": "); + IF adr hi = 8 + THEN out ("_________e_n_d___o_f___d_a_t_a_s_p_a_c_e_________"); + line; beep; LEAVE show dump + FI; + FOR i FROM 1 UPTO 8 REP + word := dsgetw (drid, adr hi, adr lo); + replace (buf, 1, word); rotate (word, 8); hexbytes := hex (word); + IF adr lo <> begin lo + THEN outsubtext (hexbytes, 1, 2); out (" "); + outsubtext (hexbytes, 3) ; out (" ") + ELIF low byte flag + THEN out (""8"-"); outsubtext (hexbytes, 1, 2); out ("-"); + outsubtext (hexbytes, 3); out (" ") + ELSE outsubtext (hexbytes, 1, 2); out ("-"); + outsubtext (hexbytes, 3); out ("-") + FI; + IF i = 4 THEN out (" ") FI; + bytes CAT buf; + incl (adr hi, adr lo, 1) + PER; + FOR i FROM 1 UPTO 16 REP + IF pos (charset, bytes SUB i) = 0 THEN replace (bytes, i, ".") FI + PER; + out (" "); outsubtext (bytes, 1, 8); + out (" "); outsubtext (bytes, 9); line; + IF incharety <> "" THEN interrupted := TRUE; LEAVE show dump FI + PER. + +up command: + IF change not allowed THEN beep; reposit cursor; LEAVE up command FI; + get cursor (cur x, cur y); + ymax := cur y - 2; ymin := ymax - lines + 1; + cur x := xmin + (begin lo AND offs mask) * 6; + IF cur x > xmidlo THEN cur x INCR 2 FI; + IF NOT low byte flag THEN cur x INCR 3 FI; + cur y := ymin; + cursor (cur x, cur y); + REP inchar (char); + IF pos (up down left right, char) > 0 THEN move cursor + ELIF pos (hextab, char) > 0 THEN read byte and move cursor + ELIF char <> cr THEN beep + FI + UNTIL char = cr PER; + cursor (1, ymax + 2); line; show dump. + +change not allowed: + interrupted OR area 2 nonchangeable AND area 2 of stdds in window. + +area 2 of stdds in window: + drid = stdds AND + (begin hi = 2 OR + begin hi = 1 AND begin lo < 0 AND lines * 8 + begin lo > 0). + +read byte and move cursor: + out (char); byte := pos (hextab, char) - 1; + wait for (hextab); + out (char); byte := pos (hextab, char) - 1 + 16 * byte; + out (""8""8""); + eval cursor address and modify word; + char := ""2""; move cursor. + +eval cursor address and modify word: + adr hi := begin hi; adr lo := begin lo AND addr mask; + incl (adr hi, adr lo, ((cur y - ymin)*8 + (cur x - xmin) DIV 6)); + word := dsgetw (drid, adr hi, adr lo); + IF high byte read + THEN rotate (byte, 8); word := (word AND mask 00ff) OR byte + ELSE word := (word AND mask ff00) OR byte + FI; + dsputw (drid, adr hi, adr lo, word). + +high byte read: + cur xx := cur x; IF cur xx > xmidlo THEN cur xx DECR 2 FI; + cur xx MOD 6 < 3. + +move cursor: + SELECT pos (up down left right, char) OF + CASE 1: IF cur y = ymin THEN beep ELSE cur y DECR 1 FI + CASE 2: IF cur y = ymax THEN beep ELSE cur y INCR 1 FI + CASE 3: IF cur x = xmin THEN IF cur y = ymin THEN beep + ELSE cur y DECR 1; cur x := xmax + FI + ELIF cur x = xmidhi THEN cur x DECR 5 + ELSE cur x DECR 3 FI + CASE 4: IF cur x = xmax THEN IF cur y = ymax THEN beep + ELSE cur y INCR 1; cur x := xmin + FI + ELIF cur x = xmidlo THEN cur x INCR 5 + ELSE cur x INCR 3 FI + ENDSELECT; + cursor (cur x, cur y). + +beep: out (""7""). + +reposit cursor: out (""3""). + +find command: + out ("find: hex, char, or last param? (h/H/c/C/)"); + wait for ("hHcC"13""); + saddr hi := begin hi; saddr lo := begin lo; + IF char = "c" OR char = "C" + THEN out (char); get char string; low byte flag := NOT low byte flag + ELIF char = "h" OR char = "H" + THEN out (char); get hex string; low byte flag := NOT low byte flag + ELSE out (search mode); + IF pos ("cC", search mode) > 0 + THEN out (search param) + ELSE out (hex search param) + FI; + IF NOT found THEN low byte flag := NOT low byte flag + ELIF NOT low byte flag OR pos ("CH", search mode) > 0 + THEN incl (saddr hi, saddr lo, 1) + FI + FI; + out (cr); (*acknowledge CR*) + search string; + line; show dump. + +get char string: + search mode := char; + search param := ""; + REP inchar (char); + SELECT pos (cr rubout, char) OF + CASE 1: IF search param = "" THEN beep ELSE LEAVE get char string FI + CASE 2: delete last char + OTHERWISE search param CAT char; out (char) + ENDSELECT + PER. + +delete last char: + IF search param = "" + THEN beep + ELSE search param := subtext (search param, 1, LENGTH search param - 1); + out (""8" "8"") + FI. + +get hex string: + search mode := char; + search param := ""; + REP wait for (hextab CT cr rubout); + SELECT pos (cr rubout, char) OF + CASE 1: IF NOT regular hex string THEN beep; char :="" FI + CASE 2: delete last char + OTHERWISE search param CAT char; out (char) + ENDSELECT + UNTIL char = cr PER; + hex search param := search param; + search param := ""; + FOR i FROM 1 UPTO LENGTH hex search param DIV 2 REP + char := hex search param SUB i; + word := pos (hextab, hex search param SUB (2*i-1)) - 1; + word := word * 16 + pos (hextab, hex search param SUB (2*i)) - 1; + search param CAT code (word) + PER. + +regular hex string: + LENGTH search param > 0 AND (LENGTH search param AND 1) = 0. + +search string: + first byte := search param SUB 1; buf := " "; + IF LENGTH search param > 1 THEN first word := search param ISUB 1 FI; + REP IF pos ("ch", search mode) > 0 + THEN search first byte or word + ELSE search first word + FI; + search rest if any; + IF found THEN begin hi := saddr hi; begin lo := saddr lo; + LEAVE search string + FI; + IF NOT low byte flag THEN incl (saddr hi, saddr lo, 1) FI + PER. + +search first byte or word: + REP + IF saddr hi = 8 THEN LEAVE search first byte or word FI; + word := dsgetw (drid, saddr hi, saddr lo); + replace (buf, 1, word); + IF NOT low byte flag AND (buf SUB 1) = first byte + THEN IF LENGTH search param = 1 + THEN low byte flag := TRUE; no of found bytes := 1; + LEAVE search first byte or word + ELIF (buf SUB 2) = (search param SUB 2) + THEN low byte flag := TRUE; no of found bytes := 2; + LEAVE search first byte or word + ELSE look in high byte + FI + ELSE look in high byte + FI; + low byte flag := FALSE; + incr search address and provide for interaction + PER. + +search first word: + REP + IF saddr hi = 8 THEN LEAVE search first word FI; + word := dsgetw (drid, saddr hi, saddr lo); + IF LENGTH search param = 1 + THEN replace (buf, 1, word); + IF (buf SUB 1) = first byte + THEN low byte flag := TRUE; no of found bytes := 1; + LEAVE search first word + FI + ELSE IF word = first word + THEN low byte flag := TRUE; no of found bytes := 2; + LEAVE search first word + FI + FI; + incr search address and provide for interaction + PER. + +look in high byte: + IF (buf SUB 2) = first byte + THEN low byte flag := FALSE; no of found bytes := 1; + LEAVE search first byte or word + FI. + +incr search address and provide for interaction: + incl (saddr hi, saddr lo, 1); + IF incharety <> "" + THEN cursor (64, 24); out ("--- interrupted"); line; line; + begin hi := saddr hi; begin lo := saddr lo; + LEAVE search string + FI. + +search rest if any: + found := TRUE; + IF LENGTH search param = no of found bytes OR saddr hi = 8 + THEN LEAVE search rest if any + FI; + IF low byte flag + THEN search buffer := subtext (search param, 3) + ELSE search buffer := subtext (search param, 2) + FI; + adr hi := saddr hi; adr lo := saddr lo; + FOR i FROM 1 UPTO (LENGTH search param - no of found bytes) DIV 2 REP + incl (adr hi, adr lo, 1); + word := dsgetw (drid, adr hi, adr lo); + IF (search buffer ISUB i) = word + THEN no of found bytes INCR 2 + ELSE found := FALSE + FI + UNTIL NOT found PER; + IF found AND LENGTH search param > no of found bytes + THEN search last byte + FI. + +search last byte: + incl (adr hi, adr lo, 1); + word := dsgetw (drid, adr hi, adr lo); + replace (buf, 1, word); + found := (buf SUB 1) = (search param SUB length (search param)). + +END PROC info; + +(* info *) (****) + +END PACKET info; + diff --git a/devel/debug/1/src/trace b/devel/debug/1/src/trace new file mode 100644 index 0000000..773b5f2 --- /dev/null +++ b/devel/debug/1/src/trace @@ -0,0 +1,1020 @@ +PACKET trace DEFINES trace: + +(**************************************************************) +(* Autor: G. Szalay *) +(* E U M E L 0 - T R A C E *) +(* Stand: 87-04-23 *) +(**************************************************************) + +LET packet area = 0, stack area = 1, text opd maxlen = 14, + stdds = 0, info lines = 4, crlf = ""13""10"", + beep = ""7"", carriage return = ""13"", cursor up = ""3"", + std charset = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ123456 + 7890<>.,:;-_+*!""�$%&/()=?'äÄöÖüÜ#^", + blanks = " ", + startindent = 10, indentincr = 2; +BOOL VAR trap set := FALSE, trapped, initial call := TRUE, quit, + single step := FALSE, protocol := FALSE, cond br follows, + prot just started := FALSE, prot stopped := TRUE, + users error := FALSE, users stpdis, prot operands := TRUE, + nontraceable found, errorstop processing := FALSE, + std procs traceable := id (1) = 4 (* processor = 68000 *), + longcall to trace flag; +INT VAR aret hi := 0, aret lo := 0, ic hi, ic lo, ic h, ic l, i, + atrap hi, atrap lo, nail1 hi, nail1 lo, nail2 hi, nail2 lo, + no of nails := 1, saved instr, saved instr w2, + saved1, saved1 w2, saved2, saved2 w2, + call to trace, call2 to trace, length of call to trace, + cmd, ilen, iclass, ilen1, iclass1, indentpos, + code addr modif, pbase, lbase, users lbase, + users errcode, users errline, old flags, flags, + module no, word, word1, word2, case, xpos, ypos, + cond br hi, cond br lo, maxlines:=12, lines, + opad hiword, opad hi, opad lo, opdds, br param, brcomp index, + ic off, opd ptr, int opd, text opd len, text opd tr len, + heap link, root word 2, no of results:=0, + no of nontraceables := 0, no of long nontraceables := 0, + pproc modno, pproc call, pproc ic lo := 0; +ROW 3 INT VAR res ds, res opadh, res opadl; +INT CONST lo byte mask := dec ("00ff"), + hi byte mask := dec ("ff00"), + branch param mask := dec ("87ff"), + opcode mask0 := dec ("83ff"), + opcode mask1 := dec ("7c00"), + bf mask1 := dec ("0040"), + ln br mask1 := dec ("7800"), + stpdis mask0 := dec ("ffbf"), + stpdis mask1 := dec ("0040"), + aritu mask1 := dec ("0010"), + error mask1 := dec ("0080"), + flags mask1 := dec ("00fc"), + mask 8000 := dec ("8000"), + mask 7fff := dec ("7fff"), + mask 7ffe := dec ("7ffe"), + mask 7f00 := dec ("7f00"), + mask 0400 := dec ("0400"), + mask fbff := dec ("fbff"), + mask 0007 := dec ("0007"), + mask fff8 := dec ("fff8"), + m l t start := dec ("0200"), + ln opcode := dec ("0000"), + br opcode := dec ("7000"), + rtn opcode := dec ("7f00"), + call opcode := dec ("7800"), + longcall opcode := dec ("ff78"), + pproc opcode := dec ("7f1e"), + estop opcode := dec ("7f4b"), + dstop opcode := dec ("7f4c"); +TEXT VAR buf, char, command, iname, iname1, ioplist, ioplist1, opd type, + opd buf, text opd, res types, users errmsg; + + +(********* following OPs and PROCs may be used by TRACE only ***********) + +PROC put (TEXT CONST a): + out (a); out (" ") +ENDPROC put; + +PROC putline (TEXT CONST a): + out (a); out (crlf) +ENDPROC putline; + + +(***********************************************************************) + +PROC eval br addr (INT CONST br para hi, br para lo, + INT VAR br addr hi, br addr lo): + br param := dsgetw (stdds, br para hi, br para lo) + AND branch param mask; + br addr hi := br para hi; + br addr lo := (br para lo AND hi byte mask) + OR (br param AND lo byte mask); + IF NOT br within page + THEN rotate (br param, 8); + br param := br param AND lo byte mask; + rotate (br param, 1); + IF br param > 255 + THEN br param INCR 1; + br param := br param AND 255 + FI; + rotate (br param, 8); + br addr lo INCR br param; + word := br addr lo AND hi byte mask; rotate (word, 8); + IF word >= code addr modif + THEN br addr lo DECR dec("1000") + FI + FI. + + br within page: + br param = (br param AND lo byte mask). + +ENDPROC eval br addr; + + +PROC eval opd addr (INT CONST ic offset): + word := dsgetw (stdds, ic hi, ic lo PLUS ic offset); + IF ic offset = 0 + THEN word := word AND opcode mask0 + FI; + IF global + THEN eval global addr + ELIF local + THEN eval local addr + ELSE eval ref addr + FI. + + global: (word AND mask 8000) = 0. + + local: (word AND 1) = 0. + + eval global addr: + opdds := stdds; + opad hi := packet area; + opad hiword := opad hi; + opad lo := pbase PLUS word; + perhaps put opad. + + eval local addr: + opdds := stdds; + opad hi := stack area; + opad hiword := opad hi; + word := word AND mask 7ffe; rotate (word, -1); + opad lo := users lbase PLUS word; + perhaps put opad. + + eval ref addr: + eval local addr; + opad hiword := dsgetw (stdds, stack area, opad lo PLUS 1); + opad lo := dsgetw (stdds, stack area, opad lo); + opdds := opad hiword AND hi byte mask; rotate (opdds, 8); + opad hi := opad hiword AND lo byte mask; + perhaps put opad. + +perhaps put opad: + (* put("opad=" CT hex(opad hiword) CT hex(opad lo)) *) . (*for tests*) + +ENDPROC eval opd addr; + + +PROC out int opd: + out (txt (int opd)); + IF int opd < 0 OR int opd > 9 + THEN out ("("); out (hex (int opd)); out (")") + FI +ENDPROC out int opd; + + +PROC fetch text opd: + root word 2 := dsgetw (opdds, opad hi, opad lo PLUS 1); + opd buf := subtext (blanks, 1, text opd maxlen + 2); + IF text on heap + THEN eval text from heap + ELSE eval text from root + FI; + convert nonstd chars; + text opd := """"; + text opd CAT subtext (opd buf, 1, text opd tr len); + text opd CAT """"; + IF text opd len > text opd tr len + THEN text opd CAT "(..."; + text opd CAT txt (text opd len); + text opd CAT "B)" + FI. + +text on heap: + (root word 2 AND lo byte mask) = 255. + +eval text from root: + text opd len := root word 2 AND lo byte mask; + text opd tr len := min (text opd len, text opd maxlen); + FOR i FROM 1 UPTO text opd tr len DIV 2 + 1 REP + replace (opd buf, i, dsgetw (opdds, opad hi, opad lo PLUS i)) + PER; + opd buf := subtext (opd buf, 2, text opd tr len + 1). + +eval text from heap: + rotate (root word 2, 8); + text opd len := root word 2 AND lo byte mask + OR (dsget2b (opdds, opad hi, opad lo PLUS 2) AND hi byte mask); + text opd tr len := min (text opd len, text opd maxlen); + heap link := dsgetw (opdds, opad hi, opad lo); + rotate (heap link, 15); + opad hi := heap link AND mask 0007; + opad lo := heap link AND mask fff8; + IF opdds = stdds THEN opad lo INCR 2 FI; + FOR i FROM 1 UPTO text opd tr len DIV 2 REP + replace (opd buf, i, dsgetw (opdds, opad hi, opad lo PLUS i)) + PER; + opd buf := subtext (opd buf, 1, text opd tr len). + +convert nonstd chars: + i := 1; + WHILE i <= LENGTH opd buf REP + char := opd buf SUB i; + IF pos (std charset, char) = 0 + THEN buf := txt (code (char)); + opd buf := subtext (opd buf, 1, i-1) CT + """" CT buf CT """" CT + subtext (opd buf, i+1); + i INCR 2 + length (buf); + ELIF char = """" + THEN opd buf := subtext (opd buf, 1, i-1) CT """""" CT + subtext (opd buf, i+1); + i INCR 2 + ELSE i INCR 1 + FI + PER; + text opd tr len := LENGTH opd buf. + +END PROC fetch text opd; + + +INT OP PLUS (INT CONST a, b): + unsigned arith; + a + b +ENDOP PLUS; + +PROC trace: + ROW 40 INT VAR dummy space for 20 pps; + get return address; + IF initial call + THEN save call to trace + ELSE process regular call + FI. + +get return address: + lbase:=local base; + users lbase := dsgetw (stdds, stack area, lbase); + aret lo := dsgetw (stdds, stack area, lbase+1); + word := dsgetw (stdds, stack area, lbase+2); + aret hi := word AND 3; + flags := word AND flags mask1; + ic hi := aret hi; ic lo := aret lo. + +save call to trace: + call to trace := dsgetw (stdds, aret hi, aret lo - 1); + IF (call to trace AND opcode mask1) = call opcode + THEN length of call to trace := 1; + longcall to trace flag := FALSE + ELSE call2 to trace := call to trace; + call to trace := dsgetw (stdds, aret hi, aret lo - 2); + length of call to trace := 2; + longcall to trace flag := TRUE; + putline ("WARNING: call to trace needs 2 words!!!") + FI; + initial call := FALSE. + +process regular call: + IF protocol + THEN pull old nails + ELSE indentpos := startindent; cond br follows := FALSE + FI; + get users error state and set modes for trace; + IF NOT errorstop processing + THEN normal processing of instructions + ELSE errorstop processing := FALSE + FI; + handle possible trace errors; + IF NOT protocol THEN restore users error state FI. + +normal processing of instructions: + trapped := trap set AND atrap lo = ic lo - length of call to trace + AND atrap hi = ic hi; + IF protocol THEN postprocess protocol FI; + IF trapped THEN handle trap FI; + IF protocol OR trapped + THEN ic lo DECR length of call to trace; + update icount on stack + FI; + IF trapped OR NOT protocol OR single step OR incharety <> "" + OR lines >= maxlines + THEN quit := FALSE; protocol := FALSE; single step := FALSE; lines := 0; + REP ask for next action; + execute command + UNTIL quit PER + FI; + IF protocol THEN protocol instruction and set nails FI. + +get users error state and set modes for trace: + signed arith; + IF NOT protocol + THEN users error := (flags AND error mask1) <> 0; + users stpdis := (flags AND stpdis mask1) <> 0; + IF users error + THEN save users error state; clear error; + line; putline ("trace called with user error " CT + txt (users errcode) CT ": " CT users errmsg) + ELSE disable stop + FI + ELIF is error + THEN IF first occurrence + THEN users error := TRUE; + save users error state; + line; + putline ("trace detected user error " CT + txt (users errcode) CT ": " CT users errmsg); + IF users stpdis + THEN out ("(stop disabled)") + ELSE errorstop processing := TRUE; stop op; + IF protocol THEN set nail1 FI + FI + ELSE line; + putline ("trace detected user error " CT + txt (error code) CT ": " CT error message); + out ("(ignored because of previous error(s)) "); + FI; + clear error + ELSE IF (flags AND stpdis mask1) = 0 + THEN set stpdis flag on stack; disable stop + FI + FI. + +first occurrence: NOT users error. + +save users error state: + users errmsg := error message; + users errline := error line; + users errcode := error code. + +handle possible trace errors: + IF is error + THEN line; + putline ("TRACE error " CT txt (error code) + CT " at line " CT txt (error line) + CT ": " CT error message); + clear error + FI. + +restore users error state: + IF users error + THEN error stop (users errcode, users errmsg); + users error := FALSE + FI; + restore users stpdis flag on stack. + +handle trap: + put trap message; + restore instruction; + trap set := FALSE. + +put trap message: + putline ("trap at address " CT txt (atrap hi) CT hex (atrap lo)). + +restore instruction: + dsputw (stdds, atrap hi, atrap lo, saved instr); + IF longcall to trace flag + THEN dsputw (stdds, atrap hi, atrap lo PLUS 1, saved instr w2) + FI. + +postprocess protocol: + IF prot operands THEN protocol result operands FI; + line; lines INCR 1; + IF cond br follows THEN protocol cond br op; cond br follows := FALSE FI. + +protocol cond br op: + outsubtext (blanks, 1, indentpos); + out (txt (cond br hi)); out (hex (cond br lo)); out (": "); + word := dsget2b (stdds, cond br hi, cond br lo); + IF (word AND bf mask1) <> 0 + THEN out ("BF ") + ELSE out ("BT ") + FI; + putline (hex (word)); lines INCR 1. + +pull old nails: + dsputw (stdds, nail1 hi, nail1 lo, saved1); + IF longcall to trace flag + THEN dsputw (stdds, nail1 hi, nail1 lo PLUS 1, saved1 w2) + FI; + IF no of nails = 2 + THEN dsputw (stdds, nail2 hi, nail2 lo, saved2); + IF longcall to trace flag + THEN dsputw (stdds, nail2 hi, nail2 lo PLUS 1, saved2 w2) + FI; + no of nails := 1 + FI. + +update icount on stack: + dsputw (stdds, 1, lbase + 1, ic lo). + +ask for next action: + putline (""15"" CT + "TRACE: step, more, trap, regs, lines, info, disasm, or quit"14""); + inchar (command). + +execute command: + cmd := pos ("tidqmsrl", command); + SELECT cmd OF + CASE 1: set address trap; prot stopped := TRUE + CASE 2: info (stdds, ic hi, ic lo, info lines); prot stopped := TRUE + CASE 3: disasm (ic hi, ic lo); prot stopped := TRUE + CASE 4: quit := TRUE; prot stopped := TRUE + CASE 5: initialize protocol; single step := FALSE; + quit := TRUE + CASE 6: initialize protocol; single step := TRUE; + quit := TRUE + CASE 7: show registers; prot stopped := TRUE + CASE 8: set new line count; prot stopped := TRUE + OTHERWISE out(beep CT carriage return CT cursor up) + ENDSELECT. + +set new line count: + out ("lines="); gethex (buf); maxlines := dec (buf). + +set address trap: + IF trap set + THEN putline ("current trap address: " CT txt (atrap hi) CT hex (atrap lo)); + out ("type to confirm, or ") + ELSE out ("type ") + FI; + out ("new trap addr ("); + IF std procs traceable THEN out ("2") ELSE out ("3") FI; + out ("0000...3ffff), or 0 for no trap:"); + gethex (buf); + IF buf <> "" + THEN IF trap set THEN restore instruction; trap set := FALSE FI; + buf:="0000" CT buf; + atrap hi := dec (subtext (buf, LENGTH buf-7, LENGTH buf-4)); + atrap lo := dec (subtext (buf, LENGTH buf-3)); + IF atrap hi=3 OR atrap hi=2 AND std procs traceable + THEN saved instr := dsgetw (stdds, atrap hi, atrap lo); + dsputw (stdds, atrap hi, atrap lo, call to trace); + IF longcall to trace flag + THEN saved instr w2 := dsgetw (stdds, atrap hi, atrap lo PLUS 1); + dsputw (stdds, atrap hi, atrap lo PLUS 1, call2 to trace); + FI; + trap set := TRUE + ELIF NOT (atrap hi=0 AND atrap lo=0) + THEN out (beep); putline ("address not in above range") + FI + ELSE IF NOT trap set THEN out (beep); putline ("no trap specified") FI + FI. + +initialize protocol: + pbase := dsgetw (stdds, stack area, lbase + 2) AND hi byte mask; + code addr modif := dsgetw (stdds, stack area, lbase + 3) + AND lo byte mask; + set stpdis flag on stack; + prot just started := TRUE; + protocol := TRUE. + +set stpdis flag on stack: + word := dsgetw (stdds, stack area, lbase + 2); + dsputw (stdds, stack area, lbase + 2, word OR stpdis mask1). + +restore users stpdis flag on stack: + word := dsgetw (stdds, stack area, lbase + 2) AND stpdis mask0; + IF users stpdis THEN word := word OR stpdis mask1 FI; + dsputw (stdds, stack area, lbase + 2, word). + +protocol instruction and set nails: + protocol instr; + SELECT iclass OF + CASE 0: standard ops + CASE 1: cond branch ops + CASE 2: branch ops + CASE 3: comp branch op + CASE 4: call op + CASE 5: exec op + CASE 6: pcall op + CASE 7: return ops + CASE 8: penter op + CASE 9: pp ops + CASE 10: line ops + CASE 11: stop ops + CASE 12: ke op + CASE 13: clrerr op + OTHERWISE: wrong ops + ENDSELECT; + IF protocol THEN set nail1 FI. + +protocol instr: + word1 := dsgetw (stdds, ic hi, ic lo); + disa (ic hi, ic lo, iname, ioplist, ilen, iclass); + protocol this instr. + +protocol this instr: + possibly delete command line; + outsubtext (blanks, 1, indentpos); + ic h := ic hi; ic l := ic lo; + out (txt (ic h)); out (hex (ic l)); out (": "); + out (iname); out (" "); + IF ilen > 0 + THEN FOR i FROM 1 UPTO ilen + REP out (hex (dsget2b (stdds, ic h, ic l))); out (" "); + ic l INCR 1 PER + ELSE out (hex (dsget2b (stdds, ic h, ic l))); out (" ") + FI; + IF prot operands THEN protocol operands FI. + +possibly delete command line: + IF prot just started + THEN prot just started := FALSE; + IF prot stopped + THEN prot stopped := FALSE + ELSE delete command line + FI + FI. + +delete command line: + get cursor (xpos, ypos); cursor (1, ypos-1); out(""4""). + +protocol operands: + out (" "); + IF (word1 AND mask 7f00) = mask 7f00 + THEN ic off := 1 + ELSE ic off := 0 + FI; + res types := ""; + no of results := 0; + FOR opd ptr FROM 1 UPTO LENGTH ioplist REP + opd type := ioplist SUB opd ptr; + IF opd type <> " " + THEN case := pos ("irtdpahIRTDPEH", opd type); + IF case > 0 + THEN eval opd addr (ic off); + SELECT case OF + CASE 1: prot int rd opd + CASE 2: prot real rd opd + CASE 3: prot text rd opd + CASE 4: prot dataspace rd opd + CASE 5: prot task rd opd + CASE 6: prot virt addr + CASE 7: prot hex rd opd + OTHERWISE save res type + ENDSELECT + FI; + ic off INCR 1 + FI + UNTIL opd type = " " PER. + +save res type: + res types CAT opd type; + no of results INCR 1; + res ds (no of results) := opdds; + res opadh (no of results) := opad hi; + res opadl (no of results) := opad lo. + +protocol result operands: + FOR opd ptr FROM 1 UPTO no of results REP prot this result PER. + +prot this result: + opdds := res ds (opd ptr); + opad hi := res opadh (opd ptr); + opad lo := res opadl (opd ptr); + opd type := res types SUB opd ptr; + SELECT pos ("IRTDPEH", opd type) OF + CASE 1: prot int result + CASE 2: prot real result + CASE 3: prot text result + CASE 4: prot dataspace result + CASE 5: prot task result + CASE 6: prot eva result + CASE 7: prot hex result + OTHERWISE out (opd type CT "(???) ") + ENDSELECT. + +prot int rd opd: + int opd := dsgetw (opdds, opad hi, opad lo); + out (">"); out int opd; out (" "). + +prot int result: + int opd := dsgetw (opdds, opad hi, opad lo); + out int opd; out ("> "). + +prot hex rd opd: + int opd := dsgetw (opdds, opad hi, opad lo); + out (">"); out (hex (int opd)); out (" "). + +prot hex result: + int opd := dsgetw (opdds, opad hi, opad lo); + out (hex (int opd)); out ("> "). + +prot real rd opd: + out (">"); + out (hex (dsget2b (opdds, opad hi, opad lo))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 1))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 2))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 3))); out (" "). + +prot real result: + out (hex (dsget2b (opdds, opad hi, opad lo))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 1))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 2))); + out (hex (dsget2b (opdds, opad hi, opad lo PLUS 3))); + out ("> "). + +prot text rd opd: + fetch text opd; + out (">"); out (text opd); out (" "). + +prot text result: + fetch text opd; + out (text opd); out ("> "). + +prot dataspace rd opd: + int opd := dsgetw (opdds, opad hi, opad lo); + out (">"); out (hex (int opd)); out (" "). + +prot dataspace result: + int opd := dsgetw (opdds, opad hi, opad lo); + out (hex (int opd)); out ("> "). + +prot task rd opd: + out (">"); out (hex (dsgetw (opdds, opad hi, opad lo))); + out ("/"); out (hex (dsgetw (opdds, opad hi, opad lo PLUS 1))); out (" "). + +prot task result: + out (hex (dsgetw (opdds, opad hi, opad lo))); out ("/"); + out (hex (dsgetw (opdds, opad hi, opad lo PLUS 1))); out ("> "). + +prot virt addr: + out (">"); out (hex (opad hiword)); out (hex (opad lo)); out (" "). + +prot eva result: + out (hex (dsgetw (opdds, opad hi, opad lo PLUS 1))); + out (hex (dsgetw (opdds, opad hi, opad lo))); + out (">"). + +standard ops: + nail1 hi := ic hi; nail1 lo := ic lo PLUS ilen. + +set nail1: + saved1 := dsgetw (stdds, nail1 hi, nail1 lo); + dsputw (stdds, nail1 hi, nail1 lo, call to trace); + IF longcall to trace flag + THEN saved1 w2 := dsgetw (stdds, nail1 hi, nail1 lo PLUS 1); + dsputw (stdds, nail1 hi, nail1 lo PLUS 1, call2 to trace) + FI. + +set nail2: + saved2 := dsgetw (stdds, nail2 hi, nail2 lo); + dsputw (stdds, nail2 hi, nail2 lo, call to trace); + IF longcall to trace flag + THEN saved2 w2 := dsgetw (stdds, nail2 hi, nail2 lo PLUS 1); + dsputw (stdds, nail2 hi, nail2 lo PLUS 1, call2 to trace) + FI. + +cond branch ops: + cond br follows := TRUE; + cond br hi := ic hi; cond br lo := ic lo PLUS ilen; + nail1 hi := cond br hi; nail1 lo := cond br lo PLUS 1; + eval br addr (cond br hi, cond br lo, nail2 hi, nail2 lo); + no of nails := 2; set nail2. + +branch ops: + eval br addr (ic hi, ic lo, nail1 hi, nail1 lo). + +comp branch op: + eval opd addr (1); + brcomp index := dsgetw (stdds, opad hi, opad lo); + IF brcomp index < 0 OR brcomp index >= dsgetw (stdds, ic hi, ic lo PLUS 2) + THEN brcomp index := -1 + FI; + nail1 hi := ic hi; + nail1 lo := ic lo PLUS ilen PLUS brcomp index PLUS 1. + +call op: + eval module no; + call or exec. + +call or exec: + IF module no < 1280 AND NOT std procs traceable + THEN possibly append proc head; + out (" (*n.t.*)"); + nontraceable found := TRUE + ELSE check for nontraceable + FI; + IF NOT nontraceable found + THEN restore users stpdis flag on stack; + get proc address via module link table; + possibly append proc head; + indentpos INCR indentincr; + nail1 hi := ic hi; nail1 lo := ic lo PLUS 1 (*nail behind head*) + ELIF call to trace found + THEN skip instruction + ELIF possibly call to bool proc + THEN cond branch ops + ELSE standard ops + FI. + +eval module no: + IF word1 = longcall opcode + THEN module no := dsgetw (stdds, ic hi, ic lo PLUS 1) + ELSE module no := word1 AND opcode mask0; + IF (module no AND mask 8000) <> 0 + THEN module no := module no AND mask 7fff OR mask 0400 + FI + FI. + +check for nontraceable: + nontraceable found := FALSE; + IF word1 = longcall opcode + THEN word2 := dsgetw (stdds, ic hi, ic lo PLUS 1); + FOR j FROM 1 UPTO no of long nontraceables REP + IF word 2 = call2 to nontraceables (j) + THEN out (names of long nontraceables (j)); + nontraceable found := TRUE + FI + UNTIL nontraceable found PER + ELSE FOR j FROM 1 UPTO no of nontraceables REP + IF word1 = calls to nontraceables (j) + THEN out (names of short nontraceables (j)); + nontraceable found := TRUE + FI + UNTIL nontraceable found PER + FI. + +get proc address via module link table: + IF module no < 1280 THEN ic hi := 2 ELSE ic hi := 3 FI; + ic lo := dsgetw (stdds, packet area, m l t start + module no). + +possibly append proc head: + out (proc head (module no)). + +skip instruction: + ic lo INCR ilen; update icount on stack; + nail1 hi := ic hi; nail1 lo := ic lo. + +possibly call to bool proc: + word := dsgetw (stdds, ic hi, ic lo PLUS ilen) AND ln br mask1; + word = ln opcode OR word = br opcode. + +exec op: + eval opd addr (1); + module no := dsgetw (stdds, opad hi, opad lo); + call or exec. + +pcall op: + eval opd addr (1); + IF opad lo = 2 AND NOT std procs traceable + THEN out (" (*n.t.*)"); + nontraceable found := TRUE + ELSE check for nontraceable pproc + FI; + IF NOT nontraceable found + THEN restore users stpdis flag on stack; + possibly append proc head for pproc; + indentpos INCR indentincr; + nail1 hi := opad hi; nail1 lo := opad lo PLUS 1 (*nail behind head*) +(*ELIF word1 = call to trace + THEN skip instruction *) + ELIF possibly call to bool proc + THEN cond branch ops + ELSE standard ops + FI. + +check for nontraceable pproc: + nontraceable found := FALSE; + IF opad lo = pproc ic lo + THEN FOR j FROM 1 UPTO no of nontraceables REP + IF pproc call = calls to nontraceables (j) + THEN out (names of nontraceables (j)); + nontraceable found := TRUE + FI + UNTIL nontraceable found PER + ELSE nontraceable found := TRUE (*to be on the secure side*) + FI. + +possibly append proc head for pproc: + IF opad lo = pproc ic lo + THEN out (proc head (pproc modno)) + FI. + +return ops: + fetch eumel0 regs of caller from users stack; + out ("--> "); + put users flags; + IF (old flags AND aritu mask1) <> 0 + THEN put ("ARITU") + ELSE put ("ARITS") + FI; + IF nontraceable caller + THEN line; putline ("trace ended by returning to nontraceable caller"); + protocol := FALSE; prot stopped := TRUE + ELIF users error AND NOT users stpdis + THEN stop op + ELSE set nail for return ops + FI. + +set nail for return ops: + IF word1 = rtn opcode + THEN nail1 hi := ic hi; nail1 lo := ic lo + ELSE nail1 hi := ic hi; nail1 lo := ic lo PLUS 1; + eval br addr (ic hi, ic lo, nail2 hi, nail2 lo); + no of nails := 2; set nail2 + FI. + +penter op: + pbase := word1 AND lo byte mask; rotate (pbase, 8); + standard ops. + +line ops: + standard ops. + +stop ops: + IF word1 = estop opcode + THEN users stpdis := FALSE; + IF users error THEN stop op ELSE standard ops FI + ELIF word1 = dstop opcode + THEN users stpdis := TRUE; standard ops + ELSE stop op + FI. + +clrerr op: + users error := FALSE; standard ops. + +ke op: + skip instruction; + line; putline ("INFO: ke"); + info (stdds, ic hi, ic lo, info lines); + single step := TRUE. + +pp ops: + save modno and ic lo if pproc; + look at next instr; + WHILE iclass1 = 9 REP + ic lo INCR ilen; iname := iname1; ioplist := ioplist1; + ilen := ilen1; iclass := iclass1; + line; lines INCR 1; + protocol this instr; + save modno and ic lo if pproc; (*only the first one will be saved!!!*) + look at next instr + PER; + standard ops. + +save modno and ic lo if pproc: + IF word1 = pproc opcode + THEN pproc modno := dsgetw (stdds, ic hi, ic lo PLUS 1); + IF pproc modno < 256 + THEN putline ("*** this looks like a compiler error ***"); + protocol := FALSE; prot stopped := TRUE; users error := TRUE; + users errcode := 0; users errmsg := ("maybe a compiler error"); + LEAVE normal processing of instructions + ELIF (pproc modno AND mask 0400) <> 0 + THEN word := (pproc modno AND mask fbff) OR mask 8000 + ELSE word := pproc modno + FI; + pproc call := word OR opcode mask1; + pproc ic lo := dsgetw (stdds, packet area, m l t start + pproc modno) + FI. + +look at next instr: + word1 := dsgetw (stdds, ic hi, ic lo PLUS ilen); + disa (ic hi, ic lo PLUS ilen, iname1, ioplist1, ilen1, iclass1). + +wrong ops: + putline ("**** das kann ich (noch) nicht!!! ***"); + info (stdds, ic hi, ic lo, info lines); + protocol := FALSE. + +show registers: + pbase := dsgetw (stdds, stack area, lbase + 2) AND hi byte mask; + code addr modif := dsgetw (stdds, stack area, lbase + 3) + AND lo byte mask; + putline ("----------------- EUMEL0-registers: ------------------"); + put ("icount=" CT txt (ic hi) CT hex (ic lo) CT + " lbase=1" CT hex (users lbase) CT " pbase=" CT hex (pbase)); + put users flags; + IF (flags AND aritu mask1) <> 0 + THEN putline ("ARITU") + ELSE putline ("ARITS") + FI. + +put users flags: + IF users stpdis + THEN put ("STPDIS") + ELSE put ("STOPEN") + FI; + IF users error + THEN put ("ERROR") + ELSE put ("NOERR") + FI. + +ENDPROC trace; + + +PROC stop op: + line; + suppress result protocolling; + REP outsubtext (blanks, 1, indentpos); + fetch eumel0 regs of caller from users stack; + out ("stop/error induced return to addr "); + out (txt (ic hi)); out (hex (ic lo)); + IF users stpdis + THEN putline (" (STPDIS)") + ELSE putline (" (STOPEN)") + FI; + lines INCR 1; + IF nontraceable caller + THEN putline ("trace ended by returning to nontraceable caller"); + protocol := FALSE; prot stopped := TRUE + ELIF users stpdis + THEN copy stack of disabled caller to tracers stack + ELSE users lbase := dsgetw (stdds, stack area, users lbase) + FI + UNTIL users stpdis OR NOT protocol PER; + nail1 hi := ic hi; nail1 lo := ic lo. + +suppress result protocolling: + no of results := 0. + +copy stack of disabled caller to tracers stack: + FOR i FROM 1 UPTO 4 REP + word := dsgetw (stdds, stack area, users lbase + i - 1); + dsputw (stdds, stack area, lbase + i - 1, word) + PER. + +ENDPROC stop op; + + +i n i t i a l i z e t r a c e. + +nontraceable caller: + ic hi = 2 AND NOT std procs traceable + OR (old flags AND aritu mask1) <> 0 AND (flags AND aritu mask1) = 0. + +fetch eumel0 regs of caller from users stack: + indentpos DECR indentincr; + ic lo := dsgetw (stdds, stack area, users lbase + 1); + word := dsgetw (stdds, stack area, users lbase + 2); + ic hi := word AND 3; + old flags := word AND flags mask1; + users stpdis := (old flags AND stpdis mask1) <> 0; + pbase := word AND hi byte mask; + code addr modif := dsgetw (stdds, stack area, users lbase + 3) + AND lo byte mask. + +initialize trace: + LET maxno of nontraceables = 20; + INT VAR int, j; + TEXT VAR text; + ROW maxno of nontraceables TEXT VAR names of nontraceables; + ROW maxno of nontraceables TEXT VAR names of short nontraceables; + ROW maxno of nontraceables TEXT VAR names of long nontraceables; + ROW maxno of nontraceables INT VAR calls to nontraceables; + ROW maxno of nontraceables INT VAR call2 to nontraceables; + + putline("initializing ""trace"" ..."); + names of nontraceables (1) := "disa (I,I,T,T,I,I) (*n.t.*)"; + names of nontraceables (2) := "disasm (I,I) (*n.t.*)"; + names of nontraceables (3) := "info (I,I,I,I) (*n.t.*)"; + names of nontraceables (4) := "dec (T) (*n.t.*)"; + names of nontraceables (5) := "hex (I) (*n.t.*)"; + names of nontraceables (6) := "dsget2b (I,I,I) (*n.t.*)"; + names of nontraceables (7) := "trace (*ignored*)"; + trace; (* initialize 'call to trace', 'ic hi' and 'ic lo' *) + IF FALSE THEN + disa (int, int, text, text, int, int); + disasm (int, int); + info (int, int, int, int); + int := dec (text); + text := hex (int); + int := dsget2b (int, int, int); + trace (****** must be the last one !!! *****) + FI; + FOR j FROM 1 UPTO maxno of nontraceables REP + REP ic lo INCR 1; + word1 := dsgetw (stdds, ic hi, ic lo) + UNTIL call opcode found PER; + IF word1 <> longcall opcode + THEN no of nontraceables INCR 1; + calls to nontraceables (no of nontraceables) := word1; + names of short nontraceables (no of nontraceables) := + names of nontraceables (j) + ELSE no of long nontraceables INCR 1; + word2 := dsgetw (stdds, ic hi, ic lo PLUS 1); ic lo INCR 1; + call2 to nontraceables (no of long nontraceables) := word2; + names of long nontraceables (no of long nontraceables) := + names of nontraceables (j) + FI + UNTIL call to trace found + OR no of nontraceables = maxno of nontraceables + OR no of long nontraceables = maxno of nontraceables PER; + putline ("""trace"" initialized:"); + putline (" " CT txt (no of nontraceables) + CT " nontraceable shortcalls"); + putline (" " CT txt (no of long nontraceables) + CT " nontraceable longcalls"); + IF no of nontraceables = maxno of nontraceables + OR no of long nontraceables = maxno of nontraceables + THEN errorstop ("too many nontraceables") + ELSE test trace + FI. + +call opcode found: + (word1 AND opcode mask1) = call opcode OR word1 = longcall opcode. + +call to trace found: + IF word1 = call to trace + THEN IF longcall to trace flag + THEN word2 = call2 to trace + ELSE TRUE + FI + ELSE FALSE + FI. + +test trace:. + +END PACKET trace; + diff --git a/devel/debug/1/src/trace.dok b/devel/debug/1/src/trace.dok new file mode 100644 index 0000000..7de46f8 --- /dev/null +++ b/devel/debug/1/src/trace.dok @@ -0,0 +1,387 @@ +#type ("trium8")##limit (13.0)# +#start(3.0,1.5)# +#pagelength(18.5)# +#block# +#type("trium36.b")# +#free(3.5)# +#center#EUMEL +#center#DEBUG +#type("trium18.b")# +#free(1.4)# +#center#Version 1 +#center#87-04-24 + +#center#G. Szalay +#page(1)# +#type ("trium8")##limit (13.0)# +#head# +#center#- % - + + +#end# +#type ("trium14.b")# +#center#E U M E L - D E B U G + +#type ("trium12.b")# +#center#Task-local Debugging Tools for EUMEL: +#center##type("trium12.bc")#info, disasm, #type("trium12.b")#and #type("trium12.bc")#trace + + +#b("1. Features")# + +#it("info:")# display and modification of a dataspace on the users terminal in the conventional dump + format; search for a bytestring; + +#it("disasm:")# disassembly of EUMEL-0-code out of the standard dataspace using symbolic opcodes + and procedure heads; + +#it("trace:")# tracing of user programs, protocolling of executed instructions and their actual operands, + trap at a given code address, single-step-mode, multiple-step-mode (interruptable at + any time) + +The procedures have no effect outside the task. Especially no other task will be halted by using the +single-step mode. + + +#b("2. Installation")# + +The debugging tools need a suitable system kernel ("Urlader"). They can be used with kernels for +processors Z80, 8086 and 80286 with versions 190 \#14, 181 \#347 \#1347, 180 \#347 \#1347 and higher, +and with 68000-kernel version \#3600 and higher. + +The archive diskette "trace" contains all necessary files. The commands +#inb# + archive ("trace"); + fetchall (archive); + run ("gen.trace") +#ine# +insert all source files and generate a dataspace "procheads" containing procedure heads of all +inserted procedures (including the standard ones). Then the current task becomes a local mana­ +ger. Now a son task may be created, in which the debugging tools are available. + +The first time when (in a son task) #it("disasm")# or #it("trace")# protocols a CALL-instruction the dataspace +'procheads' will be fetched from the father task for subsequent usage. If for any reason (e.g. after +inserting new packets, see below) the user will change or re-install 'procheads' he has to inform +the debugging procedures by issuing the command +#inb# set procheads ("procheads") #ine# + +Access to the dataspace "procheads" may be suppressed by +#inb# set procheads ("") #ine# + +Procedures inserted at a later time by the user should be added to the dataspace "procheads" (in the +current task!) by typing the commands +#inb# + bulletin m (""); + run ("gen.procheads") +#ine# + + + +#b("3. Description of the debugging procedures")# + +#b1("3.1 PROC info ")# + +The standard output is a hexadecimal dump of a dataspace in the following format: + +#outb# +---------------------------- dsid=xx -------------------- +xxxxx: -xx-xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx yyyyyyy......... +xxxxx: xx xx xx ... ..... +xxxxx: xx xx ... ... +xxxxx: xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx .........yyyyyyy +#re("INFO: more, address, dsid, lines, find, or quit")# +#oute# + + +The first line displays the dataspace identifier (4 <= dsid <= ff, dsid=4 identifies the standard +dataspace). +The dump lines begin with the hexadecimal word (!) address of the first word on this line. The order +of bytes is the same as on EUMEL-'Hintergrund': low byte, high byte. Following the hexadecimal +display of 16 bytes they will be shown as ascii-characters, too. Non-ascii characters will be +displayed as '.'. + +The last line shows (as with #it("disasm")# and #it("trace")#, too) possible commands which will be recognized by +their first letter. If a parameter is needed, it has to be typed as a hexadecimal number followed by a +. The key may be used to delete the last input character(s). +Possible commands and their effect: + +m (more): continues displaying at the next higher address + +a (address): specifies a new address + +d (dsid): specifies a new dataspace identifier + +l (lines): specifies a new line count (=window height); this value may be larger than the + number of lines of the terminal screen. + +f (find): (tries to) find a hexadecimal or character bytestring. The prompting message +#outb# + find: hex, char, or last param? (h/H/c/C/) +#oute# + may be answered in several ways. Examples: + + #inb#h41#ine# looks for a byte 41h, beginning at the actual position, marked by -xx-. + + #inb#Hcafe#ine# searches the bytestring 0cafeh, beginning at the actual word address. + Only strings at word addresses will be concerned for a comparison. + + #inb#challo#ine# searches the character string "hallo", beginning at the actual position. + + #inb#Ca#ine# searches the letter "a", which has to be located at a word address. + #inb#H41 #ine#has the same effect. + + #inb##ine# searches the last bytestring explicitly specified in a search command, + beginning #bo("behind")# the marked position. The last parameter will be shown + during the search. + + The search can be interrupted at any time by pressing a key. It may then be conti­ + nued by a new 'find' command and . + +q (quit): leaves #it("info")# . + +Instead of a command the dataspace can be modified within the displayed area by the key- +sequence + positions the cursor to the first displayed byte; + ... moves the cursor within the hexadecimal display; + <2 hexadecimal digits>... overwrite the byte under the cursor; + leaves the window. + +Note: in the standard dataspace changes within the address range 20000...2ffff are only allowed in + conjunction with a 68000-kernel (see also 3.3, note a.). + + + +#b1("3.2 PROC disasm ")# + +EUMEL-0-code in the address range 20000...3ffff of the standard dataspace will be disassem­ +bled. The code will be listed one instruction per line, using symbolic opcodes and (in case of a CALL +instruction) procedure heads as found in the dataspace "procheads". + +The following example shows the disassembled code of the standard procedure + +REAL OP MOD (REAL CONST left, right): + REAL VAR result := left - floor (left/right) * right; + IF result < 0.0 + THEN result + abs (right) + ELSE result + FI +ENDOP MOD; + +#outb# +23edd: LN 2000 +23ede: PENTER 15fe +23edf: FDIV 09c4 0d80 2880 +23ee2: FLOOR 637f 2880 2880 +23ee5: FMUL 28c0 0d80 2880 +23ee8: FSUB 09bc 2880 1880 +23eeb: FLSEQ 6049 1880 +23eed: BT f700 +23eee: PP 0dec +23eef: PP 28ec +23ef0: CALL 5d79 abs (REAL C) --> REAL +23ef1: FADD 18b8 2880 2880 +23ef4: REF 28dc 2080 +23ef6: B f970 +23ef7: REF 18dc 2080 +23ef9: FMOV 21b4 1180 +23efb: RTN 007f +#re("DISASM: step, more, address, lines, info, or quit")# +#oute# + +Possible commands: + +s (step): shows the next instruction on the terminal. The command line will be rewritten. + +m (more): shows the next instructions. The output will stop after 'lines' (standard=12) lines. It + can be interrupted at any time by pressing any key. The output list terminates, when + an invalid opcode has been detected or when the instruction count exceeds 3ffff. + +a (address): specifies a new code address. Disassembly continues at this address. + +l (lines): specifies a new line count; this value may be larger than the number of lines of the + terminal screen. + +i (info): calls #it("info")#. The first line of dump contains the first word of the next instruction not yet + disassembled. This word will be marked. (After leaving #it("info")# disassembly would + continue with this instruction.) + +q (quit): leaves #it("disasm")#. + + +#b1("3.3 PROC trace ")# + +#it("trace")# allowes controlled execution of subsequent EUMEL-0-code. The effect of the trace-mode +can be demonstrated by showing the protocol produced by + + #inb#trace; putline ("hallo") + + #ine##outb##re("TRACE: step, more, trap, regs, lines, info, disasm, or quit")# +#oute##inb# + p + +#ine##outb# + 34afb: PP 006d >00009000 + 34afc: CALL f37a putline (TEXT C) + 28d63: PENTER 38fe + 28d64: TEST c828 >0 + 28d65: BF 6b70 + 28d66: OUT 3c7f 0980 >"hallo" hallo + 28d68: OUT 3c7f 6c01 >""13""10"" + + 28d6a: B 6e70 + 28d6e: RTN 007f --> STOPEN NOERR ARITS + 34afd: RTN 007f --> STOPEN NOERR ARITS + 20944: RTN 007f --> STPDIS NOERR ARITU + trace ended by returning to nontraceable caller +#oute# + +Comments on this output: +- the indentation of the protocol lines shows the call depth. +- in order to get 1 line per instruction as often as possible, some abbreviations are used in the + procedure heads: 'C' for 'CONST', 'V' for 'VAR', 'DS' for 'DATASPACE'. +- the first occurrence of the string 'hallo' is part of the protocol. The second one is a result of the + execution of the (first) OUT-instruction. The blank line is produced by the second OUT-instruc­ + tion! +- the flags given with a RTN-instruction reflect the flag settings #bo("after")# execution of the RTN: + STOPEN = stop enabled STPDIS = stop disabled + NOERR = no error ERROR = error occurred + ARITS = signed arith mode ARITU = unsigned arith mode + + +Possible commands: + +s (step): executes and protocols one instruction (=single-step-mode). For reasons of the + implementation, consecutive PP-instructions will be executed as one single step. The + same holds for instructions followed by a conditional branch (e.g. EQU+BT). + + The protocol contains also actual operand values. Example: +#inb# + + trace;INT VAR a:= 2 + 11 +#ine##outb# + + 34afb: ADD 001d 0101 5400 >2 >11(000b) 13(000d)> +#oute# + + '>' in front of a value indicates input-operand; + '>' behind a value indicates output-operand. (For the instructions MOV, FMOV and + TMOV only 1 (output-)operand will be shown.) + INT-objects are shown decimal and (in parentheses) hexadecimal (4 digits). The + numbers 0 to 9 will be shown only decimal. + REAL-objects will be shown in the internal representation (e.g. 11.5 as + 0115000000000082) + TEXT-objects will be shown as text denoters. Non-ascii characters will be converted + (see example). For long texts only the first 14 characters will be shown, followed by + the (correct) number of characters. + All other objects (TASKs, DATASPACEs and effective virtual addresses) will be shown + hexadecimal (4 or 8 digits). + +m (more): executes and protocols up to 'line count' (standard=12) instructions. Execution can be + interrupted at any time by any key, and resumed by commands 's' or 'm'. + +t (trap): sets a trap on a code address. As soon as the instruction count reaches the specified + value, the message +#outb# + trap at address ..... +#oute# + will be displayed and the execution stopped. (The instruction at the trap address is the + next one to be executed!) At the same time the trap is deleted. + +r (regs): shows the relevant EUMEL-0-registers 'icount' (address of the instruction to be + executed next), 'pbase' (=packet base, base address for packet data), 'lbase' (=local + base, base address for local data on stack) as well as flag registers + (STOPEN/STPDIS, NOERR/ERROR, ARITS/ARITU). + +l (lines): specifies a new line count; this value may be larger than the number of lines of the + terminal screen. + +i (info): calls #it("info")#, s. 3.1. The instruction word pointed to by the instruction count is the actual + position, marked on the first line. + +d (disasm): calls #it("disasm")#, s. 3.2. Disassembly begins at the next instruction not yet executed. + +q (quit): leaves the trace-mode. However, a trap (see above) may still be in effect! Tracing + will be #bo("implicitly")# finished as soon as a RTN-instruction returns to a procedure + running in the 'unsigned arithmetic'-mode. (Regularly this is the ELAN-Compiler.) + + +#bo("Important Notes ")# + +Erroneous use of #it("info")# and #it("trace")# may destruct your task. Therefore read carefully and observe follow­ +ing notes: + +a. In order to gain control at proper points of the code area, #it("trace")# temporarily modifies the user code + by inserting instructions (CALLs to itself) into it. On EUMEL-hardware based on Z80, 8086, or + 80286, #it("trace")# does not allow modification of address range 20000...2ffff for reasons of storage + management strategy. Therefore calls to procedures occupying this address range will be marked + in the protocol by "(*n.t.*)" (for 'nontraceable') and executed normally, i.e. not protocolled. + + WARNING: execution of a nontraceable procedure cannot be interrupted by and 'halt'. So + be careful! + +b. Traps may only be set on the first word of an instruction. In a sequence of consecutive PP- + instructions only the first one may be trapped. In the same manner, a conditional branch (BT / BF) + following another instruction (e.g. EQU) may not be trapped. + +c. On inserting #it("trace")# it may get a module number > 2047. In that case the CALL to #it("trace")# occupies + 2 words. The user will be informed of this fact at the time just after inserting #it("trace")#: + #outb# + WARNING: call to trace needs 2 words! + #oute# + In this situation special care has to be taken to set a trap, e.g.: + +#outb# + LSEQ xxxx xxxx + BT xxxx (*branch on true to address a*) + ... + ... + a-1: B xxxx + a: ... +#oute# + + In this example the branch instruction at address 'a-1' may not be trapped because the following + instruction (at 'a') would be destroyed by a 2-word-CALL to #it("trace")#. A jump to 'a' would have an + undefined effect. So be careful! First inspect the code environment by using #it("disasm")# and then set + a trap at a suitable address! + +d. In the current version of #it("trace")# a trap will be implicitly deleted as soon as it has become active. If + the user wants (e.g. in a loop) to trap a given address again and again, he has to choose a + second suitable address, too, and alternately set a trap at these addresses. (A trap may be + #bo("explicitly")# deleted by specifying 0 as trap address.) + +e. One may be tempted to trace the ELAN-compiler by writing + #inb# + trace; do ("..........") + #ine# + which seems to work indeed for dozens of lines but at some point it begins to deliver wrong + results even with such trivial instructions as an integer ADD. This trouble arises from a storage + assignment policy during compilation of the ELAN compiler: temporary storage (e.g. for calculating + the value of an expression) will be assigned above the stack top of a procedure if it does not call + any other one. An #bo("implicit")# CALL to #it("trace")# causes a further stack frame to be established thus + possibly overwriting some temporary values of a compiler procedure. (Of course, the compiler + cannot know anything about CALLs inserted by #it("trace")# into the code area!) + +f. Errors (e.g. overflow) in user programs will be detected by #it("trace")# at the point of their occurrence + and reported in the protocol. However, #it("trace")# has no influence on the error handling, i.e. it does + not turn off the error flag by itself, nor causes it an error stop on the users level. (#it("trace")# may be + seen as an extension of the virtual EUMEL-0-machine offering some additional features but still + fully controlled by the users program.) + +g. Each time when the user has control within #it("trace")#, the users code area contains no other patches + than a possible CALL at the trap address if specified. + +h. The procedures #it("trace, disasm, info")#, and some others used by them are nontraceable. The body of + these procedures will not be protocolled. CALLs to them will be marked as nontraceable. Explicit + CALLs to #it("trace")# (i.e. in addition to the first call to switch on the trace mode) will be ignored. + +i. In trace-mode the EUMEL-0-instruction KE has the same effect as an explicit call to #it("info")#. + +j. Protocolling the execution produces output in addition to output programmed by the user. This + may lead to unexpected results when the user program specifies cursor positioning. The cursor + will always be moved to the position (10,13) instead of the position specified by the user. This is + due to the fact that cursor positioning takes place in two steps. One OUT instruction sends the + escape character for 'cursor positioning' (=""6""), and a second one sends two bytes containing + the coordinate values. The protocol line containing the first OUT will be followed by a lf-cr- + sequence (""10""13"") before the next protocol line can be written. + + diff --git a/doc/porting-8086/8/doc/Port.8086 b/doc/porting-8086/8/doc/Port.8086 new file mode 100644 index 0000000..a709a2a --- /dev/null +++ b/doc/porting-8086/8/doc/Port.8086 @@ -0,0 +1,2483 @@ +#type ("trium6")##limit (12.)# +#limit (30.0)# +#type ("trium8")##limit (12.0)# +#start(1.5,1.5)# +#type("triumb36")# +#free(4.0)# + EUMEL + Portierungshand­ + buch + 8086 / 8088 +#type("triumb18")# +#free(1.5)# + Version 8 +#page(1)# +#type ("trium8")##limit (12.0)# +#block# +#pagelength(19.5)# +#head# +#center#- % - + + +#end# +#type("triumb12")#Inhalt + +#a# +Teil 1: Einführung #topage("ein")# +#free(0.3)# + Zweck dieses Handbuchs #topage("zweck")# + Referenzliteratur #topage("reflit")# + Minimale Hardwarevoraussetzungen #topage("hardw")# + Systemdurchsatz #topage("durchsatz")# + Softwarekomponenten des EUMEL-Systems #topage("kompo")# + Anlieferung des 8086/8088-EUMEL-Systems #topage("anlief")# + +Teil 2: Allgemeine Strukturen #topage("allgem")# +#free(0.3)# + Hintergrund #topage("hg")# + Archiv #topage("arch")# + Hauptspeicher #topage("speicher")# + +Teil 3: SHard-Interface Spezifikation #topage("shardifc")# +#free(0.3)# + 0. Vorbemerkungen #topage("vor")# + Zur Notation #topage("not")# + Link-Leisten #topage("leist")# + Allgemeine Link-Bedingungen #topage("link")# + Interrupts #topage("intr")# + 1. System laden #topage("laden")# + 2. Systemstart und -ende #topage("start")# + 3. Speicherverwaltung #topage("spver")# + Hauptspeicher #topage("haupt")# + Speicherfehler #topage("memerr")# + 4. Zeitgeber #topage("zeit")# + 5. Kanäle #topage("channel")# + 5.1 Stream-IO #topage("stream")# + Terminals #topage("term")# + Drucker, Plotter #topage("druck")# + Exoten #topage("exot")# + 5.2 Block-IO #topage("block")# + Block-IO bei Hintergrund und Archiv #topage("bhgarch")# + Block-IO zur MS-DOS-Partition #topage("bmsdosp")# + 5.3 IO-Steuerung #topage("iocontrol")# + Einstellung serieller Schnittstellen #topage("v24")# + Flußkontrolle #topage("fluss")# + Kalender #topage("kalender")# + 6. SHard-Interface Version #topage("shdver")# + 7. ID-Konstanten #topage("ID")# + 8. Zusätzliche Leistungen #topage("shdelan")# + 9. Spezialroutinen #topage("ke")# + +Teil 4: Tips zur Portierung #topage("tips")# + 0-Version des SHards #topage("0ver")# + Effizienzprobleme #topage("eff")# + Typische Fehler #topage("fehler")# + +Anhang A: EUMEL-Debugger "Info" #topage("info")# +#free(0.3)# + Aufruf des Infos #topage("aufrinf")# + Info-Format #topage("forminf")# + Info-Kommandos #topage("cmdinf")# + Einige Systemadressen #topage("sysaddr")# + Leitblock #topage("pcb")# +#page# +#cc("Teil 1: ","Einführung")# +#goalpage("ein")# + + +#b("Zweck dieses Handbuchs")# +#goalpage("zweck")# + +Dieses Portierungshandbuch wendet sich an diejenigen, die das EUMEL-System auf einem +neuen Rechnertyp implementieren wollen. Es ist Teil einer Serie von Portierungshandbüchern +für verschiedene Prozessortypen. Dieses bezieht sich auf Rechner mit 8086/ 8088-Prozes­ +soren. + +Zum Betrieb eines EUMEL-Systems wird dieses Handbuch nicht benötigt! + + + +#b("Referenzliteratur")# +#goalpage("reflit")# + + + "EUMEL Benutzerhandbuch" + + "EUMEL Systemhandbuch" + + "EUMEL Quellcode der insertieren ELAN-Pakete" + + "iAPX 86,88-Users Manual" + intel, 1981 + + + +#b("Minimale Hardwarevoraussetzungen")# +#goalpage("hardw")# + +Um das EUMEL-System effizient einsetzen zu können, sollte die Hardware mindestens +folgenden Kriterien genügen: + + #ib#CPU#ie# Die 8086-CPU sollte mit mindestens 2.5 MHz (8088: 4.0 MHz) + arbeiten. Falls die Buszugriffe durch einen CRTC o.ä. ver­ + langsamt werden, sollte die echte 8086/ 8088-Leistung + durchschnittlich mindestens einem ungebremsten 2.5 MHz (4.0 + MHz) System entsprechen. + Seltene Verlangsamungen (z.B. nur bei I/O-Operationen) + spielen bei diesen Überlegungen keine Rolle. + + RAM Das System sollte über mindestens 80 K Byte #ib#Hauptspeicher#ie# + verfügen, besser sind 128 K als Anfangsausrüstung. + + #ib#Hintergrund#ie# Als Hintergrundmedium sind #ib#Floppy#ie#, #ib#Harddisk#ie# und RAM bzw. + ROM denkbar. + + Kapazität: > 300 K, besser > 400 K (Single-User) + > 750 K, besser > 1000 K (Multi-User) + + Zugriff: < 500 ms (Single-User) + < 200 ms (Multi-User) *) +#foot# +#f# +*) Hier ist die durchschnittliche Zugriffszeit auf einen 512 Byte großen Block gemeint. Für Platten und Floppies kann man +sie als Summe der Positionierzeit über die halbe Platte und der Zeit einer halben Umdrehung berechnen.#a##end# + + #ib#Archiv#ie# Als Archivgerät wird meistens eine Floppy eingesetzt. Aber + auch Band oder Kassettenrecorder sind denkbar. Die Anfor­ + derungen an Kapazität und Geschwindigkeit sind anwen­ + dungsspezifisch. + + #ib#Bildschirm#ie# Angestrebt werden sollte ein Bildschirm mit 24 Zeilen mit je 80 + Zeichen (oder größer). Kleinere Bildschirme sind anschließbar, + aber mit 40 Zeichen pro Zeile läßt sich nicht mehr komfortabel + arbeiten. + Rollup und freie Cursorpositionierung sind notwendige Vor­ + aussetzungen, invers-video ist erwünscht, aber nicht not­ + wendig. Weiterhin werden 'Löschen bis Zeilenende' und 'Lö­ + schen bis Schirmende' benötigt. Lokale Editierfunktionen sind + überflüssig. + + #ib#Tastatur#ie# An Steuertasten sollten mindestens ESC und die vier Cur­ + sortasten vorhanden sein. Dabei ist es günstig, wenn die + Cursortasten ergonomisch als Block bzw. Kreuz angeordnet + sind. EUMEL benötigt weitere Steuertasten für HOP, RUBIN, + RUBOUT und MARK. Dafür können beliebige Tasten der + Tastatur gewählt werden. + + + +#b("Systemdurchsatz")# +#goalpage("durchsatz")# + +Da das EUMEL-System auf dem Prinzip des Demand Paging aufbaut, hängt der System­ +durchsatz von + + - CPU Leistung + - Speichergröße (RAM) + - Geschwindigkeit beim Hintergrundzugriff (Floppy, Harddisk) + +ab. Mit zunehmender Benutzerzahl steigen in der Regel die Anforderungen an das Paging +(Hintergrund-Zugriff) schneller als an die CPU. In diesem Bereich kann man die System­ +leistung dann durch mehr Speicher und/oder eine schnellere Platte in größerem Umfang +steigern. Dabei läßt sich eine langsame Platte teilweise durch mehr RAM und umgekehrt +wenig RAM durch eine schnelle Platte ausgleichen. + + + +#b("Softwarekomponenten des EUMEL-Systems")# +#goalpage("kompo")# + +Das EUMEL-System besteht aus mehreren Schichten: + + + + EUMEL  2: Standardpakete, Editor, ... + + EUMEL  1: ELAN Compiler + + EUMEL  0: Basismaschine + + EUMEL -1: SHard + + H a r d w a r e + + +Dieses #ib#Schichtenmodell#ie# ist nach oben offen und kann deshalb um beliebig viele (höhere) +Schichten erweitert werden. + +EUMEL > 0 Die Standardsoftware der Schichten > 0 ist in der Sprache ELAN geschrie­ + ben (siehe "EUMEL Quellcode"). Dementsprechend sind alle Schichten ober­ + halb der EUMEL-0-Maschine prozessor- und rechnerunabhängig, d.h. + Anpassungen an einen neuen Rechnertyp sind nicht erforderlich. + +#ib#EUMEL 0#ie# Die sogenannte "EUMEL-0-Maschine" enthält alle Basisoperationen und + hängt davon ab, welchen Prozessortyp der Rechner als CPU verwendet. Sie + existiert für verschiedene Prozessortypen. Hier wird nur auf den Typ 8086/ + 8088 Bezug genommen. Bei der Portierung auf einen 8086/8088-Rechner + wird die 8086/8088-EUMEL-0-Maschine ohne Anpassungen (!) übernom­ + men. + +EUMEL -1 Diese Schicht stellt das Interface zwischen der EUMEL-0-Maschine und der + eigentlichen Hardware (vom Prozessor abgesehen) dar. Insbesondere umfaßt + sie alle Routinen zur Ansteuerung peripherer Geräte (Gerätetreiber). + Diese Schicht wird "SHard" genannt ("S"oftware-"Hard"ware Interface). + +Der SHard ist der einzige Teil des Systems, der bei der Portierung auf einen 8086/8088- +Rechner angepaßt bzw. neu geschrieben werden muß. Deshalb besteht der größte Teil dieses +Handbuchs aus der Spezifikation des 8086/8088-SHards. + + + +#b("Anlieferung des 8086/8088-EUMEL-Systems")# +#goalpage("anlief")# + +Der Implementierer erhält die EUMEL-Software auf Disketten. Dabei stehen folgende +Standardformate zur Wahl: + + 8", 1D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte + + 5", 2D, 40 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte *) +#foot# +#f# +*) 48 tpi#a##end# + + +Die Diskettenlieferung enthält + + - Single-User Hintergrund + - Multi-User Hintergrund + - Standardarchive + - Archive mit weiterer Anwendersoftware + +Dabei enthält der Hintergrund auch die EUMEL-0-Software (oft auch als "Urlader" be­ +zeichnet). + +#on("i")#Bitte gehen Sie vorsichtig mit diesen Mutterdisketten um. Verwenden Sie sie nur als Quelle +beim Kopieren. Sie sollten nur auf Kopien davon arbeiten!#off("i")# +#page# +#cc("Teil 2: ","Allgemeine Strukturen")# +#goalpage("allgem")# + + +#b("Hintergrund")# +#goalpage("hg")# + +Der Hintergrund ist in 512 Bytes große Blöcke unterteilt. Sie werden durch Blocknummern (0, +1, 2, ...) adressiert. Die physische Ablage der Blöcke auf dem Hintergrundmedium bleibt dem +SHard überlassen. Er kann sie z.B. linear oder versetzt anordnen. Man sollte darauf achten, +daß Positionierungen auf logisch "nahe" Blöcke möglichst schnell gehen sollten. Deshalb ist +in der Regel zylinderorientierte Anordnung der oberflächenorientierten vorzuziehen. + +Falls auf dem Hintergrundgerät spezielle Blöcke z.B. für Boot und SHard freigehalten werden +sollen, muß das bei der Abbildung der Hintergrundblocknummern auf die Sektoren der Floppy +bzw. der Harddisk berücksichtigt werden. + +Aufbau des Hintergrundes: + + Block 0 Systemetikett + + Block 10...10+k-1 EUMEL-0-Software (Urlader) + + Block 1...9, 10+k ... Paging-Bereich + + +Aufbau des #ib#Systemetikett#ie#s (#ib#Block 0#ie#): + + Byte Wert/Aufgabe + + 0...5 "EUMEL-"; Kennzeichen für EUMEL-Hintergrund. + 6...11 Versionsnummer in druckbaren Zeichen. Sie stellt sicher, daß Urlader und + Hintergrund kompatibel sind. + 12 FFh ; zur Zeit ohne Bedeutung + 13 enthält Wert 0 , wenn System im Shutupzustand ist. + 14..15 Systemlaufzähler (14=low, 15=high). Wird bei jedem Systemstart um 1 + erhöht. + 16..35 Reserviert; zur Zeit ohne Bedeutung + 36..37 Aus historischen Gründen für interne Zwecke belegt. + 38 .. 69 Hier kann eine Installationsnummer geführt werden. + 70 .. 79 Info-Paßwort + 80...255 Reserviert. + 256..511 Kann von SHard beliebig verwendet werden. + + + +#b("Archiv")# +#goalpage("arch")# + +Wie der Hintergrund sind die Archive in 512 Bytes große Blöcke unterteilt. Bisher gibt es +folgende #dx("Standardformate")#: + + + 8", 1D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte + 8", 2D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte + + Block Seite Spur Sektor + + 0 0 0 0 + 16 0 1 0 + 77*16 1 0 0 + + n n DIV (77*16) n MOD (77*16) DIV 16 n MOD 16 + + + 5", 2D, 40 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte + + Block Seite Spur Sektor + + 0 0 0 1 + 9 0 1 1 + 40*9 1 0 1 + + n n DIV (40*9) n MOD (40*9) DIV 9 n MOD 9 + 1 + + + 5", 2D, 80 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte + + Block Seite Spur Sektor + + 0 0 0 1 + 9 0 1 1 + 80*9 1 0 1 + + n n DIV (80*9) n MOD (80*9) DIV 9 n MOD 9 + 1 + + + 5", HD, 80 Spuren, 15 Sektoren (\#1...\#15) � 512 Byte + + Block Seite Spur Sektor + + 0 0 0 1 + 15 0 1 1 + 80*15 1 0 1 + + n n DIV (80*15) n MOD (80*15) DIV 15 n MOD 15 + 1 + + +Selbstverständlich können auch andere #ib#Archivformate#ie# implementiert werden, falls das aus +Hardwaregründen notwendig ist oder sich dadurch wesentliche Verbesserungen (z.B. in der +Kapazität) ergeben. + +Wenn irgend möglich sollte aber mindestens eines der oben aufgeführten Standardformate +unterstützt werden - evtl. als zusätzliches Format -, um den Austausch zwischen verschie­ +denen Rechnertypen zu vereinfachen. + +#on("i")#Hinweis: Um den Datenaustausch zwischen verschiedenen Rechnertypen zu vereinfa­ + chen, sollten möglichst alle der hardwaremäßig möglichen Standardformate (min­ + destens lesend) unterstützt werden. Dabei sollte SHard sich automatisch auf das + Format der jeweils eingelegten Floppy einstellen:#off("i")# + + + Laufwerkstyp Diskettentyp(en) + + 8" 1D 8" 1D + 8" 2D 8" 2D, 1D + + 5" 2D-40 5" 2D-40 + 5" 2D-80 5" 2D-80, 2D-40 *), + 5" HD-80 5" HD-80, 2D-80, 2D-40 *) +#foot# +#f# +*) Bei der Behandlung von 40-Spur-Disketten auf 80-Spur-Laufwerken gelten meistens folgende Regeln: + a) Lesen funktioniert sicher. + b) Schreiben ist unsicher, funktioniert aber häufig. + c) Formatieren funktioniert fast nie. +#a# +#end# + + + +#b("Hauptspeicher")# +#goalpage("speicher")# + +Der #ib#Speicher#ie# wird EUMEL-0 vom SHard in maximal vier Speicherbereichen (M0...M3) +zugewiesen. M0 muß immer vorhanden sein, M1, M2 und M3 nur in speziellen Betriebsarten: + + #dx("M0")# #on("b")#allgemeines #ib#RAM#ie(1,", allgemeines")##off("b")# + Dieser Bereich muß immer vorhanden sein. Bei den meisten Rechnern liegt der + Urlader nicht in einem ROM, sondern wird von SHard in das RAM geladen. Das + geschieht dann an den Anfang von M0. Der Rest wird für Tabellen und als Pa­ + gingbereich benutzt. M0 umfaßt deshalb meistens allen verfügbaren Speicher, bis + auf den Platz für SHard, Boot-ROM und Bildwiederholspeicher. + + #dx("M1")# #on("b")#Urlader-#ib#ROM#ie(1,", Urlader")##off("b")# + Gibt es nur bei Rechnern, die den Urlader in einem ROM haben. (M0 wird dann + nur für Tabellen und als Pagingspeicher eingesetzt.) + + #dx("M2")# #on("b")#Hintergrund-#ib#ROM#ie(1,", Hintergrund")##off("b")# + Gibt es nur bei Rechnern, die nicht Floppy oder Festplatte sondern ROM und + RAM als Hintergrundspeicher verwenden. + + #dx("M3")# #on("b")#Hintergrund-#ib#RAM#ie(1,", Hintergrund")##off("b")# + Gibt es nur bei Rechnern, die nicht Floppy oder Festplatte sondern ROM und + RAM oder RAM allein als Hintergrundspeicherverwenden. + +Damit sind drei verschiedene Betriebsarten des EUMEL-Systems möglich: + + #dx("Normalbetrieb")#: M0 (> 80 K) + Hintergrundgerät (Festplatte oder Floppy) + Archivgerät (Floppy) + + Im Normalbetrieb befindet sich der Hintergrund auf einer Festplatte oder Floppy. + RAM wird für den Urlader und zum Paging eingesetzt. Alle mittleren und grö­ + ßeren Systeme verwenden den Normalbetrieb. + + + #dx("Minibetrieb")#: M0 (> 80 K) + M3 (mindestens 300 K) + Archivgerät (Floppy) + + Im Minibetrieb wird RAM als Hintergrundspeicher eingesetzt. Dieser wird beim + Einschalten über das Archivgerät geladen und beim Abschalten ('shutup') wieder + zurückgeschrieben. + + + #dx("ROM-Betrieb")#: M0 (> 24 K) + M1 (> 45 K) + M2 (> 170 K) + M3 (> 60 K) + Archivgerät (Kassettenrecorder oder Floppy) + + Im ROM-Betrieb stehen Urlader und Standardteil des Hintergrundes im ROM. + Der übrige Hintergrund befindet sich im RAM. + +#page# +#cc("Teil 3: SHard ","Interface Spezifikation")# +#goalpage("shardifc")# + + +#bb("0. ","Vorbemerkungen")# +#goalpage("vor")# + + +#b("Zur Notation")# +#goalpage("not")# + +Im folgenden wird zwischen #dx("0-Routinen")#, die dem SHard vom EUMEL-0-System zur +Verfügung gestellt werden, und #dx("SHard-Routinen")# unterschieden, die der SHard implemen­ +tieren muß. Damit dieser Unterschied bei der Spezifikation deutlich wird, werden 0-Routinen +folgendermaßen aufgeführt: + + name (0-Routine) + +Zusätzlich werden 0-Routinen grundsätzlich klein und SHard-Routinen groß geschrieben. + +8086/8088-Befehle werden wie in "iAPX 86,88 Users Manual" (intel, 1981) notiert: + + mov al,27 + add ab,bl + +Hexadezimale Zahlen werden durch ein nachgestelltes 'h' gekennzeichnet: + + 12h = 18 + 1Fh = 31 + FFFFh = 65535 + + +#b("Link-Leisten")# +#goalpage("leist")# + +Die Verbindung zwischen SHard und Urlader (EUMEL-0) erfolgt über zwei Tabellen. In der +"0-Leiste" stellt EUMEL-0 dem SHard verschiedene 0-Routinen zur Verfügung. Diese +Leiste beginnt an der Adresse M0:0 (im Normal- oder Minimodus) bzw. M1:0 (im ROM- +Modus): + + Adresse + + 00h eumel0id db 'EUMEL ' + db 10 dup (?) + 10h eumel0blocks dw + 12h hgver dw + 14h cputype dw 3 ; für 8086 oder kompatible CPU + 16h urver dw + 18h dw + 1Ah shdvermin dw + 1Ch shdvermax dw + 1E dw + 20h systemstart dd + 24h inputinterrupt dd + 28h timerinterrupt dd + 2Ch warte dd + 30h grab dd + 34h free dd + 38h shutup dd + 3Ch info dd + +Hinweis: Die Segmentteile der 'dd'-Addressen in dieser Link-Leiste sind natürlich unde­ + finiert. Deshalb muß SHard diese auf M0 bzw. M1 setzen. Dazu ist es mindestens + beim ROM-Urlader erforderlich, die 0-Leiste in einen von SHard verwalteten + RAM-Bereich zu kopieren. + + +Für die Gegenrichtung muß SHard der 0-Maschine die "SHard-Leiste" zur Verfügung stel­ +len: + + Adresse + + 00h SHDID db 'SHARD ' + db 10 dup (?) + 10h SHDVER dw 8 + 12h MODE dw + 14h ID4 dw + 16h ID5 dw + 18h ID6 dw + 1Ah ID7 dw + db 4 dup (?) + 20h OUTPUT dd + 24h BLOCKIN dd + 28h BLOCKOUT dd + 2Ch IOCONTROL dd + 30h SYSEND dd + db 12 dup (?) + 40h M0START dw + 42h M0SIZE dw + 44h M1START dw + 46h M1SIZE dw + 48h M2START dw + 4Ah M2SIZE dw + 4Ch M3START dw + 4Eh M3SIZE dw + + +Dabei ist als 'MxSTART' eine Paragraphenadresse (d.h. Adresse DIV 16) und entsprechend +als 'MxSIZE' die Länge des Bereichs als Bytelänge DIV 16 anzugeben. + + + + +#b("Allgemeine Link-Bedingungen")# +#goalpage("link")# + +In der Regel sind sowohl 0-Routinen als auch SHard-Routinen durch 'call' aufzurufen: + + call dword ptr + +Ausnahmen von dieser Regel sind im folgenden stets besonders vermerkt. + +Generelle Link-Bedingung (für SHard- und 0-Routinen) ist: + + Alle Register - bis auf die jeweils spezifizierten Ausgangsparameter und das F-Re­ + gister *) - bleiben unverändert. +#foot# +#f# +*) Flags sind i.a. nach dem Aufruf einer Routine undefiniert. Ausnahmen sind natürlich die Flags, die als Ausgangspara­ +meter in manchen Fällen definiert sind.#a##end# + +Jede SHard-Routine muß also alle Register (bis auf F), die sie verändert und die keine +Ausgangsparameter sind, retten und wiederherstellen. Im Gegenzug braucht SHard beim +Aufruf von 0-Routinen selbst keine Register zu retten. +Das schließt auch die Segmentregister mit ein. Um SHard-eigene Daten über DS zu adres­ +sieren, muß SHard also DS sichern, neu laden und zum Schluß wiederherstellen. Entspre­ +chendes gilt für ES. SS darf nicht verändert werden. + + +#b("Interrupts")# +#goalpage("intr")# + +Zwei externe Ereignisse (Zeitgeber und Eingabe, siehe S.#topage("zeit")# und S.#topage("inp")#) werden von +EUMEL-0 behandelt. Die entsprechenden Interrupts muß SHard per 'call' an 0-Routinen +weiterleiten. +Die Register (bis auf AX und F) werden von den aufzurufenden 0-Routinen selbst gesi­ +chert. Auch die Segmentregister DS und ES werden von EUMEL-0 geladen. (CS wird +automatisch durch den "far call" gesetzt, SS darf sowieso nicht verändert werden.) Die +normale Interrupt-Sequenz im SHard sieht dann folgendermaßen aus: + + intadr: push ax + mov al, + call dword ptr + ; interrupt level freigeben + pop ax + iret + + + +#bb("1. System ","laden")# +#goalpage("laden")# + +SHard muß die EUMEL-0-Software vor dem eigentlichen Start an den Anfang der Spei­ +cherregion M0 laden. EUMEL-0 befindet sich normalerweise auf dem Hintergrund von Block +10 ab. Der erste Block (10) enthält am Anfang die 0-Leiste. Dort steht an der Stelle 10h die +Größe 'eumel0blocks'. Sie gibt an, wieviel Blöcke konsekutiv geladen werden müssen. Hat +sie beispielsweise den Wert 80, müssen die Blöcke 10 bis 89 geladen werden. + + Achtung: Zu diesem Zeitpunkt kann SHard die oben aufgeführten 0-Routinen na­ + türlich noch nicht benutzen. Insbesondere dürfen die Laderoutinen nicht + 'warte' aufrufen. Das wird hier besonders betont, weil der Hintergrundzugriff + beim eigentlichen Systemlauf in der Regel 'warte' verwenden wird. + + Hinweis: Der erste Block der EUMEL-0-Software (Block 10) enthält in den ersten + fünf Bytes den Text "EUMEL", um eine Identifikation durch den SHard- + Lader zu ermöglichen. + +Es wird empfohlen, nach folgendem Verfahren zu laden: + + IF archivgeraet enthaelt diskette AND eumel 0 auf archiv + THEN lade eumel 0 vom archiv + ELIF eumel 0 auf hintergrund + THEN lade eumel 0 vom hintergrund + ELSE laden unmoeglich + FI . + +So kann man auch bei einem frisch formatierten Hintergrundmedium einen neuen Hinter­ +grund (mit EUMEL-0-Urlader) einspielen, indem man ein Hintergrundarchiv vor dem +Systemstart in das Archivgerät legt. Dann wird EUMEL-0 von dort geladen, so daß man den +Hintergrund dann wie im Systemhandbuch beschrieben vom Archiv auf das Hintergrundme­ +dium kopieren kann.*) +#foot# +#f# +*) Kopiervorgänge (Archiv -> Hintergrund) werden vom EUMEL-0-Urlader erledigt, so daß SHard keine derartigen +Routinen enthalten muß.#a##end# + + + +#bb("2. System","start und -ende")# +#goalpage("start")# + +SHard muß alle für den Rechner notwendigen (Hardware-) Initialisierungen durchführen und +erst danach die EUMEL-0-Maschine starten ('systemstart'). + + #dx("systemstart")# (0-Routine) + + Eingang: DS:BX Adresse der SHard-Leiste + Interrupts disabled + + Aufruf: jmp dword ptr systemstart + + Zweck: Die EUMEL-0-Maschine wird gestartet. Alle notwendigen + Hardwareinitialisierungen (z.B. der Peripheriebausteine) + müssen vorher schon geschehen sein. + + Hinweis: Der Stackpointer und die Segmentregister brauchen nicht + definiert zu sein, da beim Ansprung alle Interrupts maskiert + sein sollten und somit keine Interrupts auftreten können. + EUMEL-0 lädt beim Start CS, SS, SP, DS, ES und läßt In­ + terrupts zu (STI). Falls jedoch in dieser Zeit ein "Non Maskable + Interrupt" auftreten kann, muß SHard SS und SP "vorläufig" + laden. + + MODE: Über das MODE-Wort in der SHard-Leiste können Optionen + gesetzt werden: + + Bit 0 = 0 EUMEL-0 ist auf dem Hintergrund abge­ + speichert. Der entsprechende Bereich bleibt + geschützt. (Standard) + + Bit 0 = 1 EUMEL-0 befindet sich nicht auf dem Hin­ + tergrund. Der entsprechende Bereich steht zur + freien Verfügung für andere EUMEL-Daten. + (Da die EUMEL-0-Software nur beim + Systemstart geladen wird (read only!), kann es + bei Geräten mit kleinem Hintergrund inter­ + essant sein, diese Blöcke auf dem Hinter­ + grund anderweitig zu nutzen. Das Systemla­ + den kann dann z.B. mit Hilfe einer speziellen + Urladediskette vom Archivgerät aus erfolgen.) + + Bit 8 = 0 Beim Systemstart wird der Speicher überprüft. + (Standard) + + Bit 8 = 1 Der Speichertest beim Systemstart unterbleibt. + Man sollte nur bei Rechnern, die beim Ein­ + schalten schon eigene Speichertests durch­ + führen, auf den Speichertest des EUMEL + verzichten. + + Bit 9 = 0 Beim Systemstart wird die Vortest-Tapete + ausgegeben und man kann durch Eingabe + eines Zeichens die Vortestmenüs aktivieren (s. + Systemhandbuch). (Standard) + + Bit 9 = 1 Die Vortest-tapete wird unterdrückt. Es gibt + auch keine Möglichkeit, die Vortestfunktionen + aufzurufen. Der Speichertest unterbleibt + ebenfalls. + + + + #d("SYSEND")# + + Parameter: - + + Zweck: Hiermit wird SHard das Ende eines Systemlaufs mitgeteilt. + Somit können evtl. notwendige Abschlußbehandlungen durch­ + geführt werden. SHard kann mit 'ret' zu EUMEL-0 zurück­ + kehren, muß aber nicht. Diese Routine kann z.B. dazu benutzt + werden, die Hardware auszuschalten oder in ein umgebendes + System zurückzukehren (EUMEL als Subsystem). In den mei­ + sten Fällen wird die Routine leer implementiert werden, d.h. + nur aus 'ret' bestehen. + + +#bb("3. ","Speicherverwaltung")# +#goalpage("spver")# + + +#b("Hauptspeicher")# +#goalpage("haupt")# + +Der Hauptspeicher umfaßt die Teile des 8086/8088-Speichers, die EUMEL-0 verwalten +darf, nämlich die Bereiche M0, M1, M2 und M3 (siehe S.#topage("speicher")#). M1, M2 und M3 sind dabei nur +bei speziellen Betriebsarten nötig. Jeder der vier Bereiche wird in der SHard-Leiste durch +die Anfagsadresse MxSTART und seine Länge MxSIZE beschrieben: + + MxSTART Anfang des Bereichs als Paragraphenadresse (Byteadresse DIV + 16) + MxSIZE Größe des Bereichs in Paragraphen (Bytegröße DIV 16) + +Nicht vorhandenen Bereiche werden durch MxSIZE = MxSTART = 0 gekennzeichnet. + + + + + +#b("Speicherfehler")# +#goalpage("memerr")# + +Falls die Hardware Speicherfehler aufgrund von Paritybits, ECC oder ähnlichem feststellen +und an SHard melden kann, sollte das zur Erhöhung der Systemsicherheit genutzt werden. + +Wenn SHard (z.B. über Interrupt) einen Speicherfehler mitgeteilt bekommt, sollte er wenn +möglich eine entsprechende Meldung ausgeben und das System brutal anhalten: + + rien ne vas plus: jmp rien ne vas plus + + +Wenn Speicherfehler mit Sicherheit bemerkt werden, verhindert diese Reaktion, daß die +Fehler auf dem Hintergrund festgeschrieben werden und evtl. später zu Systemfehlern füh­ +ren. + +Der Anwender kann dann durch Hardware-Reset auf den letzten Fixpunkt des EUMEL- +Systems zurücksetzen. So verliert er zwar evtl. die letzten Minuten seiner Arbeit, behält aber +auf alle Fälle ein konsistentes System. + + + + +#bb("4. ","Zeitgeber")# +#goalpage("zeit")# + +SHard muß einen Zeitgeberinterrupt erzeugen, der ca. 10 bis 100 mal pro Sekunde auftritt. +Dabei ist die 0-Routine 'timerinterrupt' aufzurufen. Ohne diesen Interrupt wird die Uhr nicht +geführt, und die Zeitscheibenlogik für das Timesharing fällt aus. + + #dx("timerinterrupt")# (0-Routine) + + Eingang: AL seit letztem Zeitgeberinterrupt vergangene Zeit (in ms) + + Zweck: Wird von EUMEL-0 für interne Uhren und für das Schedu­ + ling (Zeitscheibenlogik) verwendet. Es werden keine hohen + Genauigkeitsanforderungen an die Zeitangaben bei #on("i")#einzel­ + nen#off("i")# Interrupts gestellt. Um EUMEL-0 eine genaue Real­ + zeituhr zu ermöglichen, sollte die so erzeugte Zeitangabe #on("i")#im + Mittel#off("i")# aber möglichst genau sein, d.h. die Summe der in­ + nerhalb einer Minute so übergebenen Werte sollte zwischen + 59995 und 60005 liegen. + + + +#bb("5. ","Kanäle")# +#goalpage("channel")# + +Einiges zum Kanalkonzept: + +Das System kennt die Kanäle 0..32. + + Kanal 0 ist der Systemhintergrund. + Die Kanäle 1..15 sind für Stream-IO (Terminals, Drucker, ...) vorgesehen. + Kanal 31 ist der Standard-Archivkanal. + Kanal 32 ist der Parameterkanal. + +Die Kanäle 2.. 30 können installationsabhängig verfügbar sein oder auch nicht. Deren Funk­ +tion ist dann Absprachesache zwischen Installation und SHard. + +Kanäle können über Block-IO (BLOCKOUT, BLOCKIN) oder Stream-IO (OUTPUT,..) +angesprochen werden. Das System erfährt über IOCONTROL, welche Betriebsart des Kanals +sinnvoll ist. + +#on("i")##on("b")#Achtung: Alle Kanaloperationen müssen grundsätzlich für alle Kanäle (0...32) aufgerufen + werden können. Dabei können Operationen auf nicht vorhandenen Kanälen und + unsinnige Operationen (z.B. Stream-IO auf Kanal 0) leer implementiert wer­ + den.#off("b")# (Dafür werden im folgenden bei jeder SHard-Routine Vorschläge gemacht.)#off("i")# + + + +#bb("5.1 ","Stream-IO")# +#goalpage("stream")# + +Über Stream-IO wickelt das System die übliche zeichenorientierte Ein-/Ausgabe auf Ter­ +minals, Druckern, Plottern usw. ab. Stream-IO wird nur für die Kanäle 1...15 gemacht. + + #dx("inputinterrupt")# (0-Routine)#goalpage("inp")# + + Eingang: AL Kanalnummer (1...15) + CH eingegebenes Zeichen + CL Fehlerbits: + Bit 0 = 1 Mindestens ein Zeichen konnte auf + diesem Kanal nicht empfangen + werden (z.B. weil Interrupts gesperrt + waren). + Bit 1 = 1 Es wurde ein BREAK erkannt (bei + V24). Dieses Ereignis kann nicht + durch ein Sonderzeichen gemeldet + werden, da bei einer 8-bit-Über­ + tragung schon alle Zeichen vergeben + sind. Daher wird BREAK hier aufge­ + nommen, obwohl es im eigentlichen + Sinne kein Fehler sein muß. + Bit 2 = 1 Das übergebene Zeichen ist verfälscht + (z.B. Parität falsch). + + Ausgang: AL Zahl der noch freien Bytes im Eingabepuffer von + EUMEL-0. Die Angabe gilt für den Puffer dieses + Kanals nach Eintrag des übergebenen Zeichens. + + Zweck: SHard muß EUMEL-0 durch Aufruf dieser Routine mitteilen, + daß eine Eingabe vorliegt. + + Hinweise: EUMEL-0 puffert die Zeichen. Falls 0 geliefert wird, ist der + Puffer voll und EUMEL-0 ignoriert weitere Eingaben, bis + wieder Platz im Puffer vorhanden ist. (siehe IOCONTROL + "weiter", S.#topage("weiter")#) + + Bei Kanalnummern <1 oder >15 wird der Aufruf von + EUMEL-0 ignoriert. + + Falls die Hardware keine Inputinterrupts zur Verfügung stellt, + sollte ein Timer benutzt werden, um alle möglichen Input­ + quellen regelmäßig abzufragen. Dabei muß man allerdings den + goldenen Mittelweg zwischen zu häufiger (Systemdurchsatz + sinkt) und zu seltener Abfrage (Zeichen gehen verloren) such­ + en. Man sollte dabei nicht nur an die menschliche Tippge­ + schwindigkeit sondern auch an die höchste Baudrate denken, + die man für Rechnerkopplungen noch unterstützen will. *) + + Falls SHard Flußkontrolle für den Kanal + ausüben soll, muß er die Rückmeldung in AL + auswerten. Dabei ist mit einem geeigneten + Schwellwert zu arbeiten, da in der Regel die + sendende Gegenstelle einer Sendeunterbrechung + nicht sofort Folge leistet. + +#foot# +#f# +*) Eine weitere Möglichkeit, auf manchen Kanälen ohne Interrupts auszukommen, wird bei der IOCONTROL-Funktion +"weiter" beschrieben (siehe S.#topage("weiter")#).#a##end# + + Achtung: #on("i")#Keinesfalls darf 'inputinterrupt' rekursiv aufgerufen werden. + Normalerweise wird das automatisch verhindert, wenn man den + zugehörigen Hardwareinterrupt erst nach der 0-Routine + wieder freigibt. Falls das nicht möglich ist und unter bestimm­ + ten Umständen das nächste Zeichen abgeholt werden muß, + bevor die 0-Routine beendet ist, muß SHard einen eigenen + Puffer implementieren:#off("i")# + + hardwareinterrupt: + IF input interrupt aktiv + THEN trage zeichen in shard puffer ein ; + gib hardware interrupt frei + ELSE input interrupt aktiv := true ; + gib hardware interrupt frei ; + input interrupt ; + disable interrupt ; + WHILE shard puffer enthält noch + zeichen REP + nimm zeichen aus shard puffer ; + enable interrupt ; + input interrupt ; + disable interrupt + PER ; + input interrupt := false ; + enable interrupt + FI . + + + + #d("OUTPUT")# + + Eingang: AL Kanalnummer (1...15) + CX Anzahl auszugebender Zeichen + DS:BX Adresse der Zeichenkette + Ausgang: CX Anzahl der übernommenen Zeichen + C-Flag gesetzt <=> alle Zeichen übernommen + + Zweck: Ausgabe einer Zeichenkette. Diese ist (möglichst ganz) zwi­ + schenzupuffern, denn die Ausführung von OUTPUT sollte kein + Warten auf IO enthalten. Der Ausgabepuffer muß mindestens + 50, besser 100 Zeichen fassen können. Durch eine Interrupt­ + logik oder etwas Äquivalentes ist sicherzustellen, daß dieser + Puffer parallel zur normalen Verarbeitung ausgegeben wird. + Wenn die auszugebende Zeichenkette nicht vollständig in den + Puffer paßt, sollten trotzdem so viele Zeichen wie möglich + übernommen werden. Im weiteren Verlauf ruft EUMEL-0 dann + wieder OUTPUT mit dem Rest der Zeichenkette auf. + + Hinweis: OUTPUT kann mit CX=0 aufgerufen werden. Auch diese leere + Operation muß mit gesetztem C-Flag quittiert werden. + + Achtung: #on("i")#Keinesfalls darf innerhalb von OUTPUT die 0-Routine 'warte' + aufgerufen werden.#off("i")# + + Vorschlag: Falls der Kanal nicht existiert bzw. OUTPUT darauf unsinnig + ist, sollte vorgegaukelt werden, alle Zeichen seien ausgege­ + ben (CX unverändert und C-Flag gesetzt). + + + +#b("Terminals")# +#goalpage("term")# + +"Normale" #ib#Terminal#ie(1,", normales")#s können ohne weitere Unterstützung des SHards angeschlossen wer­ +den. Die zur Anpassung an den EUMEL-Zeichensatz *) notwendigen #ib#Umcodierungen#ie# +werden von den höheren Ebenen aus eingestellt. Da diese Umsetztabellen vom SHard +unabhängig sind, stehen automatisch alle so angepaßten Terminaltypen allen EUMEL- +Anwendern zur Verfügung! +#foot# +#f# +*) Siehe "EUMEL Benutzerhandbuch, Teil 3: Editor, 5. Zeichencode"#a##end# + +Für den Anschluß eines #on("b")##on("i")#integrierten #ib#Terminal#ie(1,", integriertes")#s#off("i")##off("b")#, in dessen Bildwiederholspeicher direkt gear­ +beitet wird, kann man häufig den Terminaltyp 'psi' verwenden (siehe auch "Exoten"). + +Näheres zu Terminaltypen und -anschlüssen findet man im "EUMEL Systemhandbuch" unter +den Stichwörtern #on("i")#Konfiguration#off("i")# und #on("i")#Konfigurierung#off("i")#. + + + +#bb("Drucker, ","Plotter")# +#goalpage("druck")# + +#ib#Drucker#ie# und Plotter werden vom EUMEL-System wie Terminals angesehen. Da in der Regel +der Rechner aber schneller Zeichen senden als der Drucker drucken kann, müssen solche +Geräte in der Regel mit Flußkontrolle angeschlossen werden (siehe S.#topage("fluss")#). + +Wenn Drucker oder Plotter über eine Parallelschnittstelle angeschlossen werden, kann man +auf diesem Kanal möglicherweise auf einen Ausgabepuffer verzichten. Voraussetzung ist +dabei, daß + + a) der Drucker einen eigenen Puffer hat und + b) der Puffer "schnell" gefüllt werden kann (< 0.1 ms/Zeichen). + +Dann kann man auf den bei der SHard-Routine OUTPUT geforderten Puffer verzichten und +die Zeichenkette direkt über die Parallelschnittstelle an den Drucker übergeben. Wenn der +Drucker 'Puffer voll' signalisiert, sollte die Zeichenübernahme bei OUTPUT abgebrochen +werden. *) #on("i")#Auf keinen Fall darf CPU-intensiv auf Freiwerden des Puffers gewartet werden!#off("i")# +#foot# +#f# +*) siehe auch IOCONTROL "frout", S.#topage("frout")##a##end# + + + +#b("Exoten")# +#goalpage("exot")# + +Exotische #ib#Terminal#ie(1," exotisches")#s (im Sinne dieser Beschreibung) sind solche, für die eine Umsetztabelle +im System (siehe Konfiguratorbeschreibung) nicht ausreicht bzw. nicht nötig ist (Beispiele: +Terminals, in deren Bildwiederholspeicher direkt gearbeitet wird; Terminals, die soweit pro­ +grammierbar sind, daß sie den EUMEL-Zeichencode können). + +Für solche Terminals muß in der Konfiguration der Terminaltyp '#ib#psi#ie#' eingestellt werden. +Dieser wirkt ohne Umcodierungen, d.h. die EUMEL-Codes (siehe Benutzerhandbuch 1.7 +Seite 106) werden direkt dem SHard zugestellt (wie bei 'transparent'), jedoch mit folgenden +Besonderheiten: + +Eingabeseitig werden zusätzlich folgende Codezuordnungen getroffen: + + Code Funktion + + 7 SV (Aktivierung: 'gib supervisor kommando:') + 17 STOP (Ausgabe auf diesen Kanal wird gestoppt) + 23 WEITER (Ausgabe läuft wieder weiter) + 4 INFO (System geht in Debugger, falls Debugoption) + + + +#bb("5.2 ","Block-IO")# +#goalpage("block")# + +Über Block-IO wickelt das System die Zugriffe zum Pagingmedium und zum Archiv ab. +Ferner ist daran gedacht, auch auf V.24-Schnittstellen Block-IO z.B. für Rechnerkopp­ +lung zuzulassen. Die Kanalnummer in Reg. AL unterscheidet diese Fälle. Außer beim Paging +(AL=0) wird ein Block-IO durch die ELAN-Prozeduren 'blockin' und blockout' induziert. + +Bei Block-IO wird immer ein 512 Byte großer Hauptspeicherbereich mit übergeben. Dieser +kann (im Gegensatz zu OUTPUT) direkt benutzt werden, d.h. es muß keine Umpufferung +erfolgen. + +Dieser Hauptspeicherbereich darf nur bei BLOCKIN verändert werden. + +SHard darf (anders als bei OUTPUT) erst dann zur Aufrufstelle zurückgeben, wenn die ver­ +langte Operation abgeschlossen ist. Treten während der Operation Wartezeiten auf, so muß +SHard die 0-Routine 'warte' aufrufen, damit das System andere Prozesse weiterlaufen +lassen kann. + +EUMEL-0 definiert bestimmte Funktionen für Hintergrund (Kanal 0) und Archiv (Kanal 31). +Operationen auf anderen Kanälen kann SHard nach Belieben implementieren und deren +Leistung seinen Installationen über ELAN-Pakete zur Verfügung stellen. Das System vergibt +auch in Zukunft für den Parameter in Register CX nur positive Werte (Bit 7 von CH = 0). +Der SHard kann selbst negative Codes einführen. + + + #d("BLOCKIN")# + + Eingang: AL Kanalnummer (0...32) + CX Parameter 1 + DX Parameter 2 + DS:BX Adresse des Hauptspeicherbereichs + Ausgang: AL undefiniert (darf also verändert werden) + CX Rückmeldecode + DS:BX darf verändert werden + + Der Inhalt des Hauptspeicherbereichs (... +511) darf verändert sein. + + Zweck: "Einlesen" von Blöcken. Die genaue Wirkung hängt vom + Parameter und dem Kanal ab. + + Vorschlag: Falls der Kanal nicht existiert bzw. BLOCKIN darauf unsinnig + ist, sollte die Rückmeldung -1 in CX geliefert werden. + + + #d("BLOCKOUT")# + + Eingang: AL Kanalnummer (0...32) + CX Parameter 1 + DX Parameter 2 + DS:BX Adresse des Hauptspeicherbereichs + Ausgang: AL undefiniert (darf also verändert werden) + CX Rückmeldecode + DS:BX darf verändert werden + + Der Inhalt des Hauptspeicherbereichs darf #on("i")#nicht#off("i")# verändert + werden! + + Zweck: "Ausgeben" von Blöcken. Die genaue Wirkung hängt vom + Parameter und dem Kanal ab. + + Vorschlag: Falls der Kanal nicht existiert bzw. BLOCKOUT darauf un­ + sinnig ist, sollte die Rückmeldung -1 in CX geliefert wer­ + den. + + + #dx("warte")# (0-Routine) + + Ausgang: Alle Register undefiniert! + + Zweck: Diese Routine ist bei 'blockin' oder 'blockout' dann aufzu­ + rufen, wenn SHard im Augenblick nichts zu tun hat. Durch den + Aufruf von 'warte' erhalten andere Systemteile die Möglichkeit, + weiter zu arbeiten. Ein 'warte' kann bis zu ca. 1/4 Sekunde + Zeit aufnehmen. 'warte' darf nicht in Interruptroutinen und + Stream-IO verwendet werden! 'warte' zerstört alle Register, + bis auf die Segmentregister CS und SS! SHard muß davon + ausgehen, daß 'warte' seinerseits andere SHard-Kompo­ + nenten aufruft. + + +Die Verwendung der 0-Routine 'warte' soll hier an einigen Beispielen verdeutlicht wer­ +den: + + + blockout auf platte : + WHILE platte noch nicht frei REP + warte + ENDREP ; + uebertrage schreibbefehl an controller ; + uebertrage daten an controller . + + blockin von platte : + WHILE platte noch nicht frei REP + warte + ENDREP ; + uebertrage lesebefehl an controller ; + WHILE daten noch nicht gelesen REP + warte + ENDREP ; + hole daten vom controller . + + + blockout auf floppy : + seekbefehl an controller ; + WHILE seek noch nicht fertig REP + warte + ENDREP ; + setze dma auf schreiben block zur floppy ; + schreibbefehl an controller ; + WHILE schreiben noch nicht fertig REP + warte + ENDREP . + + blockin von floppy : + seekbefehl an controller ; + WHILE seek noch nicht fertig REP + warte + ENDREP ; + setze dma auf lesen block von floppy ; + lesebefehl an controller ; + WHILE lesen noch nicht fertig REP + warte + ENDREP . + + + +#b("Block-IO bei Hintergrund und Archiv")# +#goalpage("bhgarch")# + +#ib#Hintergrund#ie# (Kanal 0) und #ib#Archiv#ie# (Kanal 31) unterscheiden sich in den Link-Bedingungen +nur in der Kanalnummer. Die Aufrufe von BLOCKIN und BLOCKOUT werden mit folgenden +Eingangsparametern versorgt: + + #on("b")#BLOCKIN#off("b")# AL 0 bzw. 31 + CH 0 + CL Blocknummer DIV 65536 + DX Blocknummer MOD 65536 + DS:BX Hauptspeicheradresse + + Der angegebene 512-Byte-Block ist in den Hauptspeicher + ab einzulesen. + + #on("b")#BLOCKOUT#off("b")# AL 0 bzw. 31 + CH 0 + CL Blocknummer DIV 65536 + DX Blocknummer MOD 65536 + DS:BX Hauptspeicheradresse + + Der Hauptspeicherbereich (... +511) ist + auf den angegebenen Block zu schreiben. + +Als Rückmeldungen sind zu liefern:#goalpage("errcod")# + + 0 Operation korrekt ausgeführt. + 1 Manuell behebbarer Fehler (z.B. Laufwerktür offen) + 2 Permanenter Fehler (z.B. Daten nicht lesbar) + 3 Versorgungsfehler (zu hohe Blocknummer) + +Zusätzlich zu der Rückmeldung muß bei CX <> 0 in DS:BX die Adresse eines Fehlerstrings +(Längenbyte + Fehlertext) geliefert werden. *) +#foot# +#f# +*) Diese Zusatzrückmeldung ist nur für die BLOCKIN/OUT Aufrufe auf Kanal 0/31 von Bedeutung. Sie wird nur von +EUMEL-0 beim Paging und im Hardwaretest ausgewertet.#a##end# + +#dx("Fehlerwiederholungen")#: Das EUMEL-System führt von sich aus Fehlerwiederholungen + beim Hintergrund- und beim Archivzugriff durch. SHard sollte + deshalb im Fehlerfall die Operation nicht selbst wiederholen, + sondern einen Lese/ Schreibfehler zurückmelden. So werden + dem EUMEL-System auch Soft-Errors gemeldet. In manchen + Fällen soll vor einem erneuten Lese- oder Schreibversuch der + Arm auf Spur 0 positioniert werden o.ä. Um das zu erreichen, + sollte SHard diese "Reparaturaktion" direkt im Anschluß an den + fehlerhaften Versuch durchführen. + +#dx("Kontrollesen")#: Falls Kontrollesen (nach jedem Schreibzugriff) notwendig ist, muß + das allerdings vom SHard durchgeführt werden. In der Regel + reicht es dazu, den geschriebenen Block "ohne Datentrans­ + port" zu lesen, so daß nur CRC überprüft wird. + +Will SHard weitere Archivlaufwerke zur Verfügung stellen, so kann er dafür Kanalnummern +(30,29..) vergeben. Auf ELAN-Ebene kann die archivierende Task durch 'continue (x)' das +Laufwerk 'x' ansteuern. + +Hinweis: Das System versucht Hintergrund und Archiv parallel zu betreiben, d.h. wenn + SHard bei der Hintergrundbehandlung das UP 'warte' aufruft, kann 'warte' sei­ + nerseits die Archivbehandlung des SHards aufrufen. Wenn beides z.B. denselben + Floppykontroller benutzt, muß SHard sicherstellen, daß das gut geht (z.B. durch + Semaphoren). + + +Sollen auch #on("b")#Disketten nach #ib#DIN 66 239#ie##off("b")# auf dem Archivkanal gelesen und geschrieben +werden können, müssen auf Kanal 31 zusätzlich Blöcke mit 'deleted data mark' gelesen und +geschrieben werden können. Dafür kann BLOCKIN (beim Lesen einer Diskette) als weitere +Rückmeldung liefern: + + 4 'Deleted data mark' gelesen. + +Ausgabeseitig wird ein entsprechendes BLOCKOUT benötigt: + + #on("b")#BLOCKOUT#off("b")# AL 31 + CH 40h + CL Blocknummer DIV 65536 + DX Blocknummer MOD 65536 + DS:BX Hauptspeicheradresse + + Der Hauptspeicherbereich (... +511) ist + mit der Kennung 'deleted data mark' auf den angegebenen + Block zu schreiben. + +Anmerkung: Diese Funktion muß nur implementiert werden, wenn Disketten nach DIN 66 239 + beschrieben können werden sollen. + + + +#b("Block-IO zur MS-DOS-Partition")# +#goalpage("bmsdosp")# + +Auf EUMEL-Rechnern, die mit einer Festplatte ausgerüstet sind, kann man einen Teil der +Platte als MS-DOS-Partition und einen anderen als EUMEL-Partition reservieren. Für den +Datenaustausch auf Dateiebene existiert EUMEL-Software, die über den Kanal 29 auf die +MS-DOS-Partition zugreift. Falls SHard dieses unterstützen will, muß er entsprechende +BLOCKIN/OUT-Operationen zur Verfügung stellen. Diese entsprechen den Operationen auf +Kanal 0: + + #on("b")#BLOCKIN#off("b")# AL 29 + CH 0 + CL Blocknummer DIV 65536 + DX Blocknummer MOD 65536 + DS:BX Hauptspeicheradresse + + Der angegebene 512-Byte-Block ist in den Hauptspeicher + ab einzulesen. Hier bezieht sich die Blocknummer + auf die MS-DOS-Partition. Dabei muß Block 0 derjenige + sein, der den Urladesektor der MS-DOS-Partition enthält. + (Hier steht der Bios-Parameterblock.) Die weiteren Blöcke + werden genauso wie in der von MS-DOS verwendeten + Numerierung relativ zu diesem Urladesektor adressiert. + + #on("b")#BLOCKOUT#off("b")# AL 29 + CH 0 + CL Blocknummer DIV 65536 + DX Blocknummer MOD 65536 + DS:BX Hauptspeicheradresse + + Der Hauptspeicherbereich (... +511) ist + auf den angegebenen Block zu schreiben. Für die Blocknu­ + merierung gilt das oben beschreibenen. + +Als Rückmeldungen sind zu liefern: + + 0 Operation korrekt ausgeführt. + 1 Manuell behebbarer Fehler (z.B. Laufwerktür offen) + 2 Permanenter Fehler (z.B. Daten nicht lesbar) + 3 Versorgungsfehler (zu hohe Blocknummer) + + Wichtig: Wird ein Block angesprochen, der nicht zur MS-DOS-Parti­ + tion gehört, so muß 'Versorgungsfehler' (3) gemeldet werden. + + +Anmerkung: Diese Funktionen müssen nur implementiert werden, wenn Datenaustausch + mit MS-DOS-Partitionen auf Plattenmaschinen unterstützt werden soll. + + +#bb("5.3 ","IO-Steuerung")# +#goalpage("iocontrol")# + +Die IO-Steuerung erlaubt Steuerung und Zustandsabfragen der Kanäle. IO-Steuerung wird +(außer bei Kanal 0) auch durch 'control' in ELAN induziert. + +Der Funktionscode in CX unterliegt denselben Konventionen wie bei Block-IO, d.h. das +System verwendet nur positive Codes. Der SHard-Schreiber kann auch negative Codes für +Sonderzwecke vorsehen. + + + #d("IOCONTROL")# + + Eingang: AL Kanalnummer (0...32) + CX Funktionscode 1 + DX Funktionscode 2 + BX Funktionscode 3 + Ausgang: CX Rückmeldung + AL darf verändert werden, in einigen Fällen zusätzliche + Rückmeldung + C-Flag (in einigen Fällen zusätzliche Meldung) + + Zweck: abhängig von 'Funktionscode 1' (s.u.) + +Das System verlangt folgende Informations- und Steuerleistungen über IOCONTROL: + + #d("IOCONTROL ""typ""")# + + Eingang: AL Kanalnummer (0...31) + CX 1 + Ausgang: CX Kanaltyp + + Zweck: Informiert EUMEL-0, welche IO für den angegebenen Kanal + sinnvoll ist. Die Rückmeldung in CX wird bitweise interpre­ + tiert: + + Bit 0 gesetzt <=> 'inputinterrupt' kann kommen. + Bit 1 gesetzt <=> OUTPUT ist sinnvoll. + Bit 2 gesetzt <=> BLOCKIN ist sinnvoll. + Bit 3 gesetzt <=> BLOCKOUT ist sinnvol. + Bit 4 gesetzt <=> IOCONTROL "format" ist sinn­ + voll. + + Hinweis: #on("i")#Trotz dieser Informationsmöglichkeit wird nicht garantiert, daß + nur sinnvolle Operationen für den Kanal aufgerufen werden.#off("i")# + + + #d("IOCONTROL ""frout""")# + #goalpage("frout")# + + Eingang: AL Kanalnummer (1...15) + CX 2 + Ausgang: CX Anzahl Zeichen, die nächster OUTPUT übernimmt + C-Flag gesetzt <=> Puffer leer + + Zweck: Liefert Information über die Belegung des Puffers. Diese + Information wird von EUMEL-0 zum Scheduling benutzt. + + Achtung: #on("i")#Wenn EUMEL-0 längere Zeit kein OUTPUT gemacht hat, + muß irgendwann CX > 49 gemeldet werden.#off("i")# + + Hinweis: Unter Berücksichtigung des oben Gesagten darf "gelogen" + werden. Man kann z.B. immer 50 in CX zurückmelden, muß + dann aber schlechtere Nutzung der CPU bei Multi-User- + Systemen in Kauf nehmen. + + Falls auf dem angegebenen Kanal ein Drucker mit eigenem + Puffer über Parallelschnittstelle angeschlossen ist (siehe S.#topage("druck")# + ) und man auf einen SHard-internen Puffer verzichtet hat, + sollte bei 'Druckerpuffer voll' 0 in CX und 'NC' zurückge­ + meldet werden. Wenn aber Zeichen übernommen werden + können, sollte 50 in CX und 'C-Flag gesetzt' gemeldet wer­ + den. + + Vorschlag: Falls der Kanal nicht existiert oder nicht für Stream-IO zur + Verfügung steht, sollten 200 in CX und C-Flag gesetzt zu­ + rückgemeldet werden. + + + #d("IOCONTROL ""weiter""")# + #goalpage("weiter")# + + Eingang: AL Kanalnummer (1...15) + CX 4 + Ausgang: - + + Zweck: Das System ruft "weiter" für den in AL angegebenen Kanal + auf, wenn es wieder Eingabezeichen puffern kann. (siehe + auch: Flußkontrolle S.#topage("fluss")#) + + Hinweis: "weiter" wird von EUMEL-0 auch immer dann aufgerufen, + wenn ein Prozeß auf dem angegebenen Kanal auf Eingabe + wartet und keine Zeichen mehr gepuffert sind. Wenn der be­ + troffene Kanal von sich aus keine Interrupts erzeugt, kann + SHard dies benutzen, um durch Aufruf von 'inputinterrupt' ein + Eingabezeichen zuzustellen. + #on("i")#Diese Betriebsart sollte nicht für normale Terminalkanäle + eingesetzt werden. Denn dann wird die SV-Taste nur an + EUMEL-0 zugestellt, wenn ein Prozeß auf diesem Kanal auf + Eingabe wartet. Somit sind in dieser Betriebsart CPU-inten­ + sive Endlosschleifen nicht normal abbrechbar!#off("i")# + + + #d("IOCONTROL ""size""")# + + Eingang: AL Kanalnummer (0...31) + CX 5 + DX Schlüssel + Ausgang: CX Anzahl Blöcke MOD 65536 + AL Anzahl Blöcke DIV 65536 + + Zweck: EUMEL-0 ruft 'size' auf, um die Anzahl Blöcke zu erfahren, + die ein Block-IO-Kanal verkraften kann (Größe von Hin­ + tergrund und Archiven). Bei Archivlaufwerken, die mehrere + Formate bearbeiten können, dient dieser Aufruf auch zum + Einstellen des Formats für die folgenden blockin/blockout- + Operationen anhand des Schlüssels. + + Schlüssel: 0 Wenn möglich 'erkennend', sonst 'standard'. Im ersten + Fall erkennt SHard das Format der eingelegten Diskette + und stellt dieses ein. + + Die weiteren Schlüssel sind stets definierend. Dabei gibt es die + EUMEL-Standardformate: + + 1 5" 2D-40, Sektor 1..9, 512 Bytes + 2 5" 2D-80, Sektor 1..9, 512 Bytes + 3 5" HD-80, Sektor 1..15, 512 Bytes + 10 8" 1D-77, Sektor 0..15, 512 Bytes + 11 8" 2D-77, Sektor 0..15, 512 Bytes + + Zusätzlich kann man sämtliche Spezialformate angeben: + + 8192 * laufwerkstyp 1: 8" + 2: 5" + 3: 3" + + + 4096 * seiten 0: einseitig + 1: doppelseitig + + + 1024 * dichte 0: single + 1: double + 2: high + + + 256 * spuren 0: 35 + 1: 40 + 2: 77 + 3: 80 + + + 64 * sektorbytes 0: 128 + 1: 256 + 2: 512 + + + 32 * erster sektor 0: \#0 + 1: \#1 + + + sektoren pro spur 0 ... 31 + + So bezeichnet '8762' das Format 8" 1S-77 Sektor 1..26 a + 128 Bytes. + + Anmerkung: SHard sollte alle physisch möglichen EUMEL-Standard­ + formate unterstützen. Von den Spezialformaten sollten die für + den Datenaustausch wichtigen Formate berücksichtigt werden. + Die EUMEL-Standardformate (1,2,3,10,11) sollten auch über + die entsprechenden analytischen Codes erreicht werden. (Z.B. + bezeichnen 1 und 21929 dasselbe Format.) Die Numerierung + der Blöcke ist in jedem Fall seitenorientiert, d.h. entsprechend + den Standardformaten (siehe S.#topage("arch")#). + + Hinweis: Bei Archiven wird 'size' aufgerufen, nachdem der Archivträ­ + ger eingelegt wurde. D.h. SHard hat die Gelegenheit, die + Größe anhand des eingelegten Archivträgers zu bestimmen + (z.B. ob single- oder doublesided). + + Vorschlag: Diese Funktion sollte auf nicht vorhandenen und den + Stream-IO-Kanälen 0 liefern. Sie muß aber mindestens auf + Kanal 0 (Hintergrund) und Kanal 31 (Archiv) "echte" Werte + liefern. + + Achtung: #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die + 0-Routine 'warte' aufgerufen werden.#off("i")# + + + #d("IOCONTROL ""format""")# + + Eingang: AL Kanalnummer (0...31) + CX 7 + DX Schlüssel + Ausgang: CX Fehlercode wie bei Archiv-BLOCKOUT (siehe S.#topage("errcod")#) + + Zweck: Dient zum Formatieren einen Mediums. Diese Funktion kann + für jeden Kanal leer implementiert sein ('ret'). Sie sollte aber + "formatierend" (z.B. auf Kanal 31) arbeiten, falls auf diesem + Kanal die "typ"-Abfrage "Formatieren sinnvoll" liefert. Falls + (bei Diskettenlaufwerken) mehrere Formate möglich sind, + bestimmt der Schlüssel das gewünschte Format. + + Schlüssel: wie bei IOCONTROL "size" + + Achtung: #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die + 0-Routine 'warte' aufgerufen werden.#off("i")# + + + +#b("Konfigurierung serieller Schnittstellen")# +#goalpage("v24")# + +Bei Kanälen, die hardwaremäßig auf #ib#serielle Schnittstellen#ie# (#ib#V.24#ie#) zurückgeführt werden, sind +in der Regel die Größen + + - #ib#Baudrate#ie# (..., 2400, 4800, 9600, ...) + - #ib#Zeichenlänge#ie# (7 Bits, 8 Bits) + - #ib#Parität#ie# (keine, gerade, ungerade) + +einstellbar. Dafür muß SHard die IOCONTROL-Funktionen "baud" und "bits" zur Verfü­ +gung stellen. Diese werden in zwei Modi benutzt: + + a) #on("b")#einstellend#off("b")# + Läuft der aufrufende EUMEL-Prozeß auf dem privilegierten Steuerkanal (AL = 32), + wird der als Parameter mit übergebene #on("i")#adressierte Kanal#off("i")# auf die geforderten Werte + eingestellt, sofern das möglich ist. + + b) #on("b")#abfragend#off("b")# + Läuft der aufrufende EUMEL-Prozeß nicht auf Kanal 32 (AL <> 32), wird le­ + diglich abgefragt, ob der #on("i")#adressierte Kanal#off("i")# auf die übergebenen Werte eingestellt + werden könnte. + +Aufgrund des zweiten Modus können die höheren EUMEL-Ebenen dem Anwender bei der +Konfigurierung mitteilen, welche Werte sich auf dem jeweiligen Kanal einstellen lassen. Das +nutzt z.B. das Standard-Konfigurationsprogramm aus. + +Hinweis: Bei einigen Kanälen (z.B. bei einem integrierten Terminal oder einer Parallel­ + schnittstelle) sind Baudrateneinstellungen sinnlos. Bei anderen können sie nur + hardwaremäßig vorgenommen werden (Jumper, Dip Switches). In allen diesen + Fällen muß SHard bei allen Einstellungen 'unmöglich' melden. (Standardmäßig + wird der Anwender bei der Einstellung seiner Konfiguration dann auch nicht + danach gefragt.) + + + #d("IOCONTROL ""baud""")# + + Eingang: AL eigener Kanal (1...15 / 32) + CX 8 + DX adressierter Kanal + BX Schlüssel + Ausgang: CX Rückmeldung (0 = ok, 1 = nicht möglich) + + Zweck: Wird diese Routine auf dem Steuerkanal (AL=32) aufgeru­ + fen, wird die angegebene Baudrate für den durch Register DX + adressierten Kanal eingestellt, falls das möglich ist. + Wird diese Routine auf einem anderen Kanal als 32 aufge­ + rufen, informiert sie den Aufrufer lediglich, ob eine derartige + Einstellung des adressierten Kanals möglich wäre. + + Schlüssel: 1 50 Baud + 2 75 Baud + 3 110 Baud + 4 134.5 Baud + 5 150 Baud + 6 300 Baud + 7 600 Baud + 8 1200 Baud + 9 1800 Baud + 10 2400 Baud + 11 3600 Baud + 12 4800 Baud + 13 7200 Baud + 14 9600 Baud + 15 19200 Baud + 16 38400 Baud + + Anmerkung: In der Regel werden nicht alle Baudraten vom SHard unter­ + stützt werden. Bei V.24 Schnittstellen sollten aber minde­ + stens 2400, 4800 und 9600 Baud zur Verfügung stehen, + besser auch 300, 600, 1200 und 19200 Baud. + + Hinweis: Falls SHard-spezifisch weitere Baudraten implementiert + werden sollen, darf SHard hierfür negative Schlüsselwerte + (Register BX) vergeben. + + + #d("IOCONTROL ""bits""")# + + Eingang: AL eigener Kanal (1...15 / 32) + CX 9 + DX adressierter Kanal + BX Schlüssel + Ausgang: CX Rückmeldung (0 = ok, 1 = nicht möglich) + + Zweck: Wird diese Routine auf dem Steuerkanal (AL=32) aufgeru­ + fen, wird die angegebene Zeichenlänge (Bits pro Zeichen) und + Parität für den durch Register DX adressierten Kanal einge­ + stellt, falls das möglich ist. + Wird diese Routine auf einem anderen Kanal als 32 aufge­ + rufen, informiert sie den Aufrufer lediglich, ob eine derartige + Einstellung des adressierten Kanals möglich wäre. + + + Schlüssel: stop * 32 + par * 8 + (bit - 1) + + stop: 0 1 Stopbit + 1 1.5 Stopbits + 2 2 Stopbits + + par: 0 keine Parität + 1 ungerade Parität + 2 gerade Parität + + bit: 1...8 Bits pro Zeichen + + + Anmerkung: In der Regel werden nicht alle Kombinationen vom SHard + unterstützt werden. Bei V.24 Schnittstellen sollten aber mög­ + lichst 1 Stopbit, 7 und 8 Bits pro Zeichen und alle drei Pari­ + tätseinstellungen zur Verfügung stehen. + + Hinweis: Falls SHard-spezifisch weitere Einstellungen implementiert + werden sollen, darf SHard hierfür negative Schlüsselwerte + (Register BX) vergeben. + + + + +#b("Flußkontrolle")# +#goalpage("fluss")# + +Die stromorientierten Kanäle (1...15) werden nicht nur zum Anschluß schneller Geräte (wie +Terminals) verwendet, sondern auch, um langsame Geräte (wie Drucker) anzuschließen, die +die Daten u.U. nicht so schnell übernehmen können, wie sie der Rechner schickt. Dabei ist +auf eine geeignete Flußkontrolle zu achten (nicht schneller senden, als der Andere emp­ +fangen kann). Dieses Problem stellt sich auch bei einer Rechner-Rechner-Kopplung. Hier +ist in der Regel sogar zweiseitige Flußkontrolle notwendig. + +Als Flußkontrolle ist die #ib#REQUEST TO SEND/CLEAR TO SEND#ie# Logik der V.24-Schnitt­ +stelle oder das #ib#XON/XOFF#ie#-Protokoll zu verwenden. Das letztere kann auch bei Parallel­ +schnittstellen eingesetzt werden. + +Zur eingabeseitigen Flußkontrollsteuerung kann SHard die Rückmeldung der 0-Routine +'inputinterrupt' (siehe S.#topage("inp")#), die "stop" signalisieren kann, und die IOCONTROL-Funktion +"weiter" (siehe S.#topage("weiter")#)verwenden: + +Allerspätestens bei der 'inputinterrupt'-Rückmeldung AL=0 muß SHard +auf der V.24-Schnittstelle das Signal 'REQUEST TO SEND' wegnehmen bzw. XON senden +(oder +weiter einlaufenden Input selbst zwischenpuffern). Dadurch wird bei den meisten Fremd­ +rechnern ein weiteres Senden unterbrochen, sofern (im ersten Fall) das Signal 'REQUEST +TO SEND' dort mit dem V.24-Eingang 'CLEAR TO SEND' verbunden ist. Wird von +EUMEL-0 "weiter" aufgerufen, so kann auf dem ensprechenden Kanal wieder empfangen +werden (RTS setzen bzw. XON senden). In der Regel wird SHard schon reagieren müssen, +bevor der EUMEL-Puffer gänzlich gefüllt ist, da die Sendehardware nicht schnell genug +reagieren kann bzw. da noch sich noch Zeichen in Hardwarepuffern befinden können. + +Für die ausgabeseitige Flußkontrolle muß rechnerseitig ebenfalls das Signal 'CLEAR TO +SEND' bzw. der Empfang von XOFF/XON berücksichtigt werden. Wenn an der Schnittstelle +das 'CLEAR TO SEND' weggenommen wird, darf SHard keinen weiteren Output auf dieser +Schnittstelle machen, bis 'CLEAR TO SEND' wieder anliegt. Entsprechend muß der Empfang +von XOFF die Ausagbe anhalten und XON sie wieder starten. + +Bemerkung: Die meisten Systeme enthalten die CTS-Funktion schon in ihrer Hardware, so + daß im SHard dafür keine Vorkehrungen getroffen werden müssen. + + +Zur Einstellung der gewünschten Flußkontrolle eines Kanals dient die IOCONTROL-Funk­ +tion "flow". Ähnlich wie "baud" und "bits" wirkt auch "flow" nur auf Kanal 32 #on("i")#einstellend#off("i")# und +auf allen anderen Kanälen lediglich #on("i")#abfragend#off("i")#. + + + #d("IOCONTROL ""flow""")# + + Eingang: AL eigener Kanal (1...15 / 32) + CX 6 + DX adressierter Kanal + BX Modus + Ausgang: CX Rückmeldung (0 = ok, 1 = nicht möglich) + + Zweck: Wird diese Routine auf dem Steuerkanal (AL=32) aufgeru­ + fen, muß sie den gewünschten Flußkontrollmodus für den + adressierten Kanal einstellen. + Dabei sind folgende Modi festgelegt: + + BX= 0 Keine Flußkontrolle + BX= 1 XON/XOFF (in beide Richtungen) + BX= 2 RTS/CTS (in beide Richtungen) + BX= 5 XON/XOFF (nur ausgabeseitig) + BX= 6 RTS/CTS (nur ausgabeseitig) + BX= 9 XON/XOFF (nur eingabesetig) + BX=10 RTS/CTS (nur eingabeseitig) + + SHard wird hierdurch informiert, wie er auf "Puffer voll" und + "weiter" reagieren soll. Wenn keine Flußkontrolle gewünscht + wird (BX=0), muß SHard "stop" und "weiter" ignorieren; bei + BX=1 oder BX=9 muß bei "stop" XOFF und bei "weiter" XON + geschickt werden; bei BX=2 oder BX=10 muß bei "stop" das + Signal RTS auf low und bei "weiter" wieder auf high gesetzt + werden. Mit + "stop" ist hierbei das Unterschreiten des + Schwellwertes bei der Rückmeldung von + "inputinterrupt" gemeint. + + Bei BX=1 oder BX=5 müssen empfangene XON/XOFF-Zei­ + chen, bei BX=2 oder BX=6 das Signal CTS beachtet wer­ + den. + + Wird diese Routine auf einem anderen Kanal als 32 aufge­ + rufen, informiert sie den Aufrufer lediglich, ob der geforderte + Flußkontrollmodus auf dem adressierten Kanal einstellbar + wäre. + + Hinweis: Falls SHard-spezifisch weitere Flußkontrollmodi implemen­ + tiert werden sollen, darf SHard hierfür negative Moduswerte + (Register BX) vergeben. + + "weiter" wird von EUMEL-0 sehr oft aufgerufen. Es + ist daher nicht sinnvoll, jedesmal XON zu senden, da dies die Gegenstelle + damit überfluten würde. SHard muß sich + merken, ob der Kanal im XOFF-Zustand ist und + nur dann bei "weiter" ein XON senden. + + +#b("Kalender")# +#goalpage("kalender")# + +Die Datums- und Uhrzeitabfrage ist bei Rechnern mit eingebauter Uhr unnötig. EUMEL holt +sich Datum und Uhrzeit dann von SHard. + + #d("IOCONTROL ""calendar""")# + + Eingang: CX 10 + DX (1=Minute, 2=Stunde, 3=Tag, 4=Monat, 5=Jahr) + gewünscht + Ausgang: CX Rückmeldung + + Zweck: Erfragen von Datum und Uhrzeit. Falls keine Uhr vorhanden + ist, muß bei jedem Aufruf -1 zurückgemeldet werden, bei + eingebauter Uhr jeweils das Gewünschte (Minute: 0..59, + Stunde: 0..23, Tag: 1..7, Monat: 1..12, Jahr: 0..99). Die + Rückmeldung muß als BCD-Zahl erfolgen. + + Hinweis: Die Uhr darf zwischen zwei Aufrufen umspringen. Die daraus + resultierende Probleme werden auf höheren Ebenen abge­ + handelt. + + + + +#bb("6. SHard-","Interface Version")# +#goalpage("shdver")# + +Die #ib#Versionsnummer#ie# der Interface-Spezifikation, auf der SHard aufbaut, muß als 2-By­ +te-Konstante #ib#SHDVER#ie# in der SHard-Leiste stehen. Für das hier beschriebene Interface +muß sie den Wert 8 haben. + +So sind spätere Erweiterungen des SHard-Interfaces möglich, ohne daß alle SHard-Mo­ +duln geändert werden müssen. + + + +#bb("7. ","ID-Konstanten")# +#goalpage("ID")# + +SHard muß direkt hinter SHDVER vier 2-Byte-Konstanten ablegen. Diese können von den +höheren Ebenen durch die ELAN-Prozedur + + INT PROC #ib#id#ie# (INT CONST no) + +abgefragt werden. Dabei werden id(0) bis id(3) von EUMEL-0 geliefert, während SHard in +der Leiste die Werte für id(4) bis id(7) zur Verfügung stellen muß: + + ID4 #ib#Lizenznummer#ie# des SHards *) +#foot# +#f# +*) Dieser Wert muß mit der Nummer des Lizenzvertrags zwischen Implementierer und GMD übereinstimmen!#a##end# + + ID5 #ib#Installationsnummer#ie# des EUMEL-Anwenders **) +#foot# +#f# +**) Diese Nummer vergibt der Lizenznehmer an die von ihm belieferten Anwender.#a##end# + + ID6 zur freien Verfügung + + ID7 zur freien Verfügung + + + + +#bb("8. ","Zusätzliche Leistungen")# +#goalpage("shdelan")# + +Will der SHard-Implementierer zusätzliche Leistungen anbieten, die mit den Standardope­ +rationen nicht möglich sind, kann er weitere Codes für BLOCKIN, BLOCKOUT und +IOCONTROL zur Verfügung stellen. Um Überdeckungen mit Codes zu vermeiden, die von +EUMEL-0 intern verwendet oder erst später eingeführt werden, darf SHard für zusätzli­ +che Leistungen nur negative Werte als 'Funktionscode 1' verwenden. + + +Zum Ansprechen der neuen Leistungen stehen die ELAN-Prozeduren #on("i")#'#ib# blockout#ie#', '#ib#blockin#ie#'#off("i")# +und #on("i")#'#ib#control#ie#'#off("i")# zur Verfügung. + +Ferner steht dem SHard ein Parameterkanal (32) zur Verfügung. Funktionen, die (im Mul­ +ti-User) nicht jeder Task zur Verfügung stehen dürfen, müssen über diesen Kanal 32 abge­ +wickelt werden und dürfen nur dort wirken. + + + PROC blockout (ROW 256 INT CONST para, (* --> DS:BX *) + INT CONST funktion1, (* --> CX *) + funktion2, (* --> DX *) + INT VAR antwort) (* <-- CX *) + + PROC blockin (ROW 256 INT VAR para, (* --> DS:BX *) + INT CONST funktion1, (* --> CX *) + funktion2, (* --> DX *) + INT VAR antwort) (* <-- CX *) + + PROC control (INT CONST funktion1, (* --> CX *) + funktion2, (* --> DX *) + funktion3, (* --> BX *) + INT VAR antwort) (* <-- CX *) + +Hinweis: Der SHard darf für 'funktion 1' (CX) zusätzlich zu den hier beschriebenen Stan­ + dardcodes nur negative Codes vereinbaren. + + +Beispiel: + + Gibt eine Task, die durch 'continue (x)' an Kanal 'x' hängt, den Befehl + + control (-7,1200,13,antwort), + + so wird IOCONTROL mit (AL='x', CX=-7, BX=13, DX=1200) aufgerufen. Verläßt + SHard 'control' mit CX = 1, so enthält 'antwort' anschließend eine 1. + + +Hinweis: Um die zusätzlichen Leistungen dem Anwender einfach (und abgesichert) zur + Verfügung zu stellen, sollte man sie in ein ELAN-Paket einbetten und dieses + ebenfalls an die Anwender ausliefern. + + Beispiel: PACKET zusatz DEFINES fanfare, ... : + + PROC fanfare (INT CONST tonhoehe, dauer) : + + IF dauer < 0 + THEN errorstop ("negative dauer") + ELIF tonhoehe < 16 + THEN errorstop ("infraschall") + ELIF tonhoehe > 20000 + THEN errorstop ("ultraschall") + ELSE control (-37, 20000 DIV tonhoehe, dauer) + FI + + ENDPROC fanfare ; + + . . . + + + + +#bb("9. ","Spezialroutinen")# +#goalpage("ke")# + +Als Testhilfe und zur Fehlerdiagnose kann SHard in seine Routinen Kontrollereignisse ein­ +bauen. Das geschieht durch Aufruf der 0-Routine 'info'. Dieser EUMEL-Debugger wird im +Anhang A (siehe S.#topage("info")#) beschreiben. + + #dx("info")# (0-Routine) + + Aufruf: call dword ptr info + jr weiter + db ' text' + weiter: + + Zweck: Info wird aufgerufen. Dabei wird 'text' zur Identifikation des + Kontrollereignisses ausgegeben. Der übergebene Text darf + nicht mit 0h beginnen. + + Hinweis: Bei Systemen "ohne Info" (nur solche dürfen an Anwender + ausgeliefert werden) wird nur der Info-Text ausgegeben und + EUMEL-0 angehalten. + + Achtung: Da der Info selbst die hier beschriebenen Stream-IO-Routi­ + nen benutzt, darf man ihn von diesen Routinen aus (inputin­ + terrupt, OUTPUT, IOCONTROL "frout", IOCONTROL "weiter") + nicht aufrufen. Wenn die Ein-/Ausgabe auf Terminal 1 inter­ + ruptgetrieben läuft, dürfen die Interrupts beim Info-Aufruf + natürlich nicht gesperrt sein. + + +Falls SHard für bestimmte Aktionen, die selten durchgeführt werden (z.B. Formatieren), viel +Speicher benötigt, kann er diesen dynamisch anfordern und später wieder freigeben. + + #dx("grab")# (0-Routine) + + Eingang: BX Anfangsadresse des zu reservierenden Bereichs im + Datensegment von EUMEL-0, muß auf 512 Byte + ausgerichtet sein. + CX Länge des zu reservierenden Bereichs in 512-Byte- + Kacheln + Ausgang: CX Rückmeldecode + + Zweck: Wenn möglich wird der zu verlangte Bereich von EUMEL-0 + "leergekämpft" und SHard zur Verfügung gestellt. + Rückmeldecode: 0 ok, Speicher steht zur Verfügung + 1 grundsätzlich nicht möglich + 2 augenblicklich nicht möglich + + Achtung: Der Aufruf von 'grab' wird in der Regel 'warte' und Block-IO + auf Kanal 0 induzieren. + + Hinweis: Es wird empfohlen, Speicher ab 3800h anzufordern, da diese + Adresse stets im frei einplanbaren Paging-Bereich liegt. + + + #dx("free")# (0-Routine) + + Eingang: BX Anfangsadresse des freizugebenden Bereichs im Da­ + tensegment von EUMEL-0, muß auf 512 Byte ausge­ + richtet sein. + CX Länge des zu freizugebenden Bereichs als 'Bytes DIV + 512' + + Zweck: Der entsprechende Bereich muß vorher mit 'grab' beschafft + worden sein. Hiermit wird er wieder EUMEL-0 zur freien + Verfügung gestellt. + + +Für spezielle Fehlersituationen steht die 0-Routine 'shutup' zur Verfügung. Damit kann +SHard z.B. bei Netzausfall ein kontrolliertes Systemende erzwingen. Das ist allerdings nur +sinnvoll, wenn durch Batteriepufferung oder Ähnliches sichergestellt ist, daß noch genügend +Zeit bleibt, um alle Seiten auf den Hintergrund zurückzuschreiben. + + #dx("shutup")# (0-Routine) + + Zweck: Erzwingt Rückschreiben aller Seiten und Systemende, d.h. + entspricht der ELAN-Prozedur 'shutup'. + + Achtung: Der Aufruf von 'shutup' wird in der Regel 'warte' und + Block-IO auf Kanal 0 induzieren, abschließend wird 'sysend' + aufgerufen. +#page# +#cc("Teil 4: ","Tips zur Portierung")# +#goalpage("tips")# + + +#b("0-Version des SHards")# +#goalpage("0ver")# + + +Es wird empfohlen, zuerst eine "0-Version" des SHard zu entwickeln, die möglichst einfach +aufgebaut und nicht auf Effizienz und vollständige Ausnutzung der Betriebsmittel ausge­ +richtet sein sollte. Damit kann man rasch praktische Erfahrung gewinnen, die dann den +Entwurf und die Implementation des eigentlichen SHard erleichtert. Die 0-Version soll­ +te + + - nur die Kanäle 0 (Hintergrund), 1 (Terminal) und 31 (Archiv) behandeln, + + - keine Baudraten-, Zeichenlängen-, Paritäts- und Flußkontrolleinstellungen un­ + terstützen (immer 'nicht möglich' melden), + + - vorhandene (ROM-) Routinen möglichst nutzen, ohne sich um Unschönes wie "busy + wait" beim Floppy- bzw. Plattenzugriff zu grämen. + +Mit dieser 0-Version sollte man dann versuchen, EUMEL zu starten. Da der Hintergrund +beim ersten Mal noch leer ist, muß man das Hintergrund-Archiv (Archivfloppy mit +EUMEL-0 und höheren Ebenen) in das Archivlaufwerk einlegen und von dort laden. Der +Vortest sollte sich direkt nach dem Start folgendermaßen auf Terminal 1 melden: + + E U M E L - Vortest + + Terminals: 1, + RAM-Groesse (gesamt): ? kB + Pufferbereich: ? kB + Hintergrund-Speicher: ? kB + + Speichertest: ************ + +Man sollte während der ****-Ausgabe des Speichertests irgendein Zeichen eingeben. Das +EUMEL-System muß dann in das ausführliche Start-Menü überwechseln. (Andernfalls +funktioniert die Eingabe nicht richtig!) + +Als nächstes sollte man versuchen, den Hintergrund vom Archiv aus zu laden. (Diese Mög­ +lichkeit wird im Start-Menü angeboten.) Nach dem Ende dieser Operation wird der +EUMEL-Lauf automatisch beendet. Jetzt kann man das HG-Archiv aus dem Archivlauf­ +werk entfernen und das System neu starten. Dann sollte EUMEL-0 vom Hintergrund gela­ +den werden. + +Bei Problemen kann der "Info" (siehe S.#topage("info")#) hilfreich sein. Voraussetzung für seine Ver­ +wendung ist aber, daß die Terminal Ein-/Ausgabe schon funktioniert. + +Beim Start des EUMEL-Systems kann (wie im Systemhandbuch beschrieben) durch den +Konfigurationsdialog der Terminaltyp von Kanal 1 eingestellt werden. Falls das verwendete +Terminal in dieser Liste nicht aufgeführt wird und auch keinem der aufgeführten (in Bezug +auf die Steuercodes) gleicht, kann man z.B. + + - den neuen Terminaltyp an einem anderen EUMEL-Rechner verfügbar machen + (Umsetztabellen definieren) und per Archiv zum neuen Rechner tragen, + + - die notwendigen Umcodierungen per SHard durchführen. + +Diese Problematik entsteht bei Rechnern mit integriertem Terminal in der Regel nicht, weil +Steuerzeichen dort sowieso algorithmisch interpretiert werden müssen. In diesem Fall wird +man direkt die EUMEL-Codes als Grundlage wählen, so daß keine Umsetzungen erfor­ +derlich sind. + +Bei einer provisorischen Anpassung kann man auf Invers-Video ohne weiteres verzichten. + + +Im Gegensatz zu der 0-Version sollte man bei der eigentlichen SHard-Implementierung +darauf achten, die Möglichkeiten der Hardware effizient zu nutzen. Der Testverlauf entspricht +dann wieder im wesentlichen dem oben beschriebenen Vorgang. + + + +#b("Typische Fehler")# +#goalpage("fehler")# + + + a) SHard-Routinen zerstören Registerinhalte bzw. sichern sie beim Interrupt nicht + vollständig. Hierbei sollte man auch an die Segmentregister denken. + + b) 'call' bzw. 'ret' verändern den Stackpointer. + + c) Fehler bei der Interruptbehandlung führen zu Blockaden ("hängende Interrupts"). + + d) Cursorpositionierung außerhalb des Bildschirms bei einem internen Terminal + (Bildwiederholspeicher im Rechner) wird nicht abgefangen. Das führt dann zu + wildem Schreiben in den Hauptspeicher. + + e) 'warte' wird unerlaubt aufgerufen. ('warte' darf nur von BLOCKIN, BLOCKOUT, + IOCONTROL "size" und IOCONTROL "format" aus aufgerufen werden. Ferner + kann man 'warte' noch nicht beim Systemladen aufrufen!) + + f) OUTPUT-Verhaspler oder -Blockaden entstehen durch Fehlsynchronisation + zwischen dem Füllen des Ausgabepuffers durch die Routine OUTPUT und der + Interruptroutine, die den Puffer leert und ausgibt. + + g) IOCONTROL "frout" meldet in gewissen Situationen nie "mindestens 50 Zeichen + im Puffer frei" und "Puffer leer". Das kann schon im Vortest zu Output-Blok­ + kaden führen. + + h) Obwohl "frout" einen Wert größer als x meldet, nimmt "output" nicht alle x Zei­ + chen an. + + i) IOCONTROL "size" meldet falsche Werte. + + j) IOCONTROL verkraftet keine beliebigen (auch unsinnige) Werte. + + k) BLOCKIN bzw. BLOCKOUT geben die Kontrolle an das System zurück, bevor alle + Daten übertragen sind. (Sofort nach der Rückgabe geht EUMEL-0 davon aus, + daß der Puffer frei ist und anderweitig benutzt werden kann!) + + l) Fälschlicherweise wird davon ausgegangen, daß DS oder ES konstant bleiben. + + m) Die Stepping-Rate eines Festplattencontrollers wird falsch eingestellt, bezie­ + hungsweise die Platte wird nicht im 'buffered step mode' betrieben, obwohl + beschleunigend positionieren kann. Dadurch werden die Zugriffszeiten auf dem + Hintergrund unnötig verlangsamt. Man bedenke, daß man so einen Fehler leicht + übersieht, weil sich das System nicht fehlerhaft, sondern nur langsamer verhält. + Außerdem macht sich die Verlangsamung erst bemerkbar, wenn größere Teile des + Hintergrundes benutzt werden. + + n) Bei schnellem Zeichenempfang treten "Dreher" auf. Das deutet meistens auf + einen rekursiven Aufruf der 0-Routine 'inputinterrupt' hin. Dabei überholt dann + das zweite Zeichen das erste. + + o) Bei schnellem Zeichenempfang, speziell bei gleichzeitiger Ausgabe, gehen Ein­ + gabezeichen verloren oder werden verfälscht. In der Regel ist das auf Timing­ + probleme bei der Interruptbehandlung zurückzuführen. Interrupts gehen verloren + bzw. die Zeichen werden nicht schnell genug abgeholt. + + + +#b("Effizienzprobleme")# +#goalpage("eff")# + + a) Bei #on("i")##on("b")#V.24- und Parallelschnittstellen#off("i")##off("b")# ist schlechter Durchsatz in der Regel auf + Fehlverhalten von "frout" zurückzuführen. Auch kostet es in Multi-User- + Systemen sehr viel, wenn OUTPUT immer nur ein Zeichen übernimmt. (Dann läuft + der ganze Apparat der EUMEL-0-Maschine für jedes Zeichen wieder an.) + + Besonders bei der Parallelschnittstelle achte man darauf, daß nicht durch ung­ + lückliches Timing häufig Blockaden auftreten. So kann zu kurzes 'busy wait' auf + Freiwerden der Parallelschnittstelle dazu führen, daß jedes zweite Zeichen abge­ + lehnt wird, so daß OUTPUT faktisch zeichenweise arbeitet. Andererseits darf + natürlich 'busy wait' auch nicht auf Millisekunden ausgedehnt werden. + + + b) Wenn #on("i")##on("b")#Floppies ohne DMA#off("i")##off("b")# angeschlossen werden, kann man bei Single-User- + Systemen ohne weiteres 'busy wait' einsetzen, um nach dem Seek-Vorgang auf + den Block zu warten. Im Multi-User sollte das aber wenn irgend möglich um­ + gangen werden, da eine halbe Umdrehung immerhin ca. 100 ms kostet. + Falls nur ein Endeinterrupt nach jeder Floppyoperation zur Verfügung steht, kann + folgendes Verfahren günstig sein: + + seek befehl an controller ; + warten auf endeinterrupt ; + lesebefehl ohne datentransport auf sektor davor ; + warten auf endeinterrupt ; + lese oder schreib befehl auf adressierten sektor ; + cpu intensives warten und datentransport . + + Die Dummyoperation auf den Sektor vor dem adressierten dient dabei nur dazu, + ohne CPU-Belastung einen Zeitpunkt zu finden, wo man dem eigentlichen + Sektor möglichst nahe ist. Die Zeit, in der die CPU benötigt wird, sinkt damit auf + ca. 25 ms. Die Implementation dieses Algorithmus' ist aber nicht ganz einfach, da + die 0-Routine 'warte' wegen der verlangten kurzen Reaktionszeiten nicht ver­ + wendet werden kann. Alle 'warte auf ...' müssen also durch Interrupts realisiert + werden: + + setze interrupt auf lesen davor ; + stosse seek an ; + REP + warte + UNTIL komplette operation beendet ENDREP . + + lesen davor : + setze interrupt auf eigentliche operation ; + stosse lesen davor an . + + eigentliche operation : + ignoriere fehler beim datentransport ; + stosse lesen oder schreiben an ; + REP + REP UNTIL bereit ENDREP ; + uebertrage ein byte + UNTIL alles uebertragen ENDREP ; + melde komplette operation beendet . + + Hinweis: Solche Systeme sind über V.24 nicht netzfähig, da sie Eingabezeichen + verlieren werden. + + + c) Bei der Ansteuerung von #on("i")##on("b")#Harddisks#off("b")##off("i")# sollte man darauf achten, daß die 0-Rou­ + tine 'warte' nicht öfter als notwendig aufgerufen wird. Sonst wird das Paging + zugunsten der CPU-intensiven Prozesse zu stark verlangsamt. Z.B. kann man + bei vielen Plattencontrollern auf eine eigene Seek-Phase verzichten: + + beginne seek ; beginne seek und lesen ; + REP REP + warte warte + UNTIL fertig PER ; UNTIL fertig PER + beginne lesen ; + REP + warte + UNTIL fertig PER + + Hier braucht die linke Fassung immer mindestens ein 'warte' mehr als die rechte. + Bei starker CPU Belastung wird sie deshalb bis zu 100 ms länger für das Einlesen + eines Blocks benötigen. + + Eine ähnliche Situation kann auftreten, wenn die Platte in 256-Byte-Sektoren + unterteilt ist, so daß zu jedem EUMEL-Block zwei Sektoren gehören. Wenn + möglich sollte dann zwischen diesen beiden Sektoren kein 'warte' aufgerufen + werden. Andererseits darf natürlich auch nicht längere Zeit CPU-intensiv gewar­ + tet werden. Evtl. lohnt es sich in solchem Fall, mit der Sektorverschränkung zu + experimentieren. + +#page# +#cc("Anhang A: EUMEL-","Debugger ""Info""")# +#goalpage("info")# + + +Für interne Testzwecke gibt es den "Info". Systeme "mit Info" und "ohne Info" unterschei­ +den sich nur im EUMEL-0-Teil (Urlader). Der SHard-Implementierer erhält zum Test +Hintergründe "mit Info" und zur Auslieferung solche "ohne Info". Infofähige Systeme dürfen +nur von den SHard-Implementierern verwendet werden. + + #on("i")##on("b")#Achtung: Infofähige Systeme dürfen auf keinen Fall an Anwender ausgeliefert werden, + da vermittels Info alle Systemsicherungs- und Datenschutzmaßnahmen un­ + terlaufen werden können.#off("i")##off("b")# *) +#foot# +#f# +*) Ausnahmen von dieser Regel bedürfen der expliziten Zustimmung der EUMEL-Systemgruppe (GMD bzw. HRZ Bie­ +lefeld) und des jeweiligen Anwenders. Solche System müssen immer durch spezielle Schlüsselworte abgesichert werden.#a##end# + + +#b("Aufruf des Info")# +#goalpage("aufrinf")# + +Zum Aufruf des Infos gibt es drei Möglichkeiten: + + a) Beim Start des EUMEL-Systems geht man durch Eingabe eines beliebigen Zei­ + chens während des Vortests in den ausführlichen Start-Dialog. Durch Eingabe von + 'I' gelangt man dann in den Info-Modus. #on("i")#(Diese Möglichkeit wird in dem Startmenü + nicht aufgeführt.)#off("i")# + + b) Man kann den Info durch die ELAN-Prozedur 'ke' aufrufen. D.h. wenn das System + gestartet wurde und sich eine Task am Terminal mit "gib kommando" gemeldet hat, + kann man durch 'ke *return*' in den Info-Modus gelangen. + + c) Wenn sich am Terminal keine Task befindet, die auf Eingabe wartet, gelangt man + durch die Tastenfolge 'i *info*' (*info* meist = CTL d, zur Tastendefinition siehe + "Systemhandbuch, Konfigurierung") in den Info-Modus. + +Alle diese Möglichkeiten funktionieren nur bei infofähigen Systemen. + +Bei schweren Systemfehlern, die eine Weitermeldung an die höheren Ebenen des +EUMEL-Systems unmöglich machen, wird soweit möglich ebenfalls der Info aufgerufen. Bei +Systemen "ohne Info" wird lediglich eine Meldung auf Kanal 1 ausgegeben und das System +angehalten. + +Bevor das System Infokommandos annimmt, muß mit dem Kommando 'P' ein Paßwort +eingegeben werden. Lediglich dieses Kommando und das Kommando 'g' werden immer +angenommen. Das Paßwort kann mit dem Kommando 'yP' eingestellt werden. + +#b("Info-Format")# +#goalpage("forminf")# + +Der Info ist bildschirmorientiert. Beim Aufruf des Infos und nach den meisten Info-Kom­ +mandos werden die drei obersten Zeilen wie folgt aufgebaut: *) +#foot# +#f# +*) Bildschirmgetreues Verhalten kann der Info allerdings erst nach der Konfigurierung des Kanals zeigen. Vorher (d.h. +insbesondere beim Aufruf aus dem Vortest heraus) werden Cursorpositionierungen in der Regel nicht korrekt durchgeführt. #a##end# + +#limit(14.0)# +XYY TEXT +F AL AH CL CH DL DH BL BH SI DI SP BP PC DS ES +xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx + +#limit(12.0)# + +wobei + + X den Miniprozeß bezeichnet, der den Übergang in den Info veranlaßt hat (A=Archiv, + E=Elan, L=Lader, M=Müllabfuhr), + + YY den Maxiprozeß (Task) bezeichnet, der gerade durch den Elan-Prozessor bear­ + beitet wird (YY ist die hexadezimale Tasknummer), + + TEXT den Grund für den Info-Modus anzeigt, + +Die zweite und dritte Zeile zeigen die Inhalte der 8086/8088-Register an. In der untersten +Zeile erscheint die Eingabeaufforderung 'info:'. + + +#b("Info-Kommandos")# +#goalpage("cmdinf")# + +Info-Kommandos können in der 'info:'-Zeile mit dem Format + + [] + +gegeben werden oder, wenn der Cursor sich im Dump befindet, mit dem Format + + + +wobei dann für die der Cursorposition entsprechende Dumpadresse (modulo 2**16) +gesetzt wird (siehe '*cup*'). + + ist immer in Hexaform einzugeben. + +'g' Der Info-Modus wird wieder verlassen. Dies ist allerdings bei harten Fehlern ge­ + sperrt. + +'z' Der Leitblock des angezeigten Maxiprozesses wird dargestellt, falls = 0 ist, + sonst der Leitblock der Task mit der Nummer . (Nur im ELAN-Miniprozeß). + +'q' Die Task mit der Nummer wird nach dem nächsten 'g'-Kommando in den + Info überführt. Dies ist nötig, wenn man sich die Datenräume dieser Task anschauen + will ('s'). + +'s' Dumps werden auf den Datenraum eingestellt. (s:=) + Auch der Realspeicher kann hiermit in verschiedenen Modi eingestellt werden: + FF absolute Adressierung + 0 CS-relativ + 1 DS-relativ + 2 ES-relativ + 3 SS-relativ + +'l' Dumps werden auf die Länge eingestellt. Desungeachtet kann man einen + versehentlich zu langen Dump durch eine beliebige Eingabe abbrechen. Dann wird + allerdings '*cup*' gesperrt (siehe unten). + +'p' Dumps werden auf die Byteadresse eingestellt (p:= ; wmodus:= + FALSE). + +'w' Dumps werden auf die Wortadresse eingestellt. Die vor jeder Dumpzeile + ausgegebene Adresse ist dann auch eine Wortadresse. Ein Wort = 2 Bytes. (p:=2* + ; wmodus: =TRUE) + +'k' Block laden und per Dump anzeigen. Es erfolgt dabei eine Umstellung auf + den Realdatenraum (s=1). + +'P' Paßworteingabe: P*return* + Erst nach diesem Kommando sind die übrigen Kommandos ausführbar. + +'x' Suchen nach Bytekette: + +--> xc text +--> xh xx xx ... +--> x + + Es wird nach 'text' bzw. Hexafolge 'xx xx ...' bzw. nach der durch das letzte 'x'- + Kommando eingestellten Bytekette gesucht. + Das Kommando ist durch *return* abzuschließen. + Die Suche beginnt ab Position 'p' und ist auf die Länge Seiten (512 + Byte-Einheiten) begrenzt (0=unendlich). + Eine beliebige Eingabe bricht die Suche vorzeitig ab. + +'*return*' + Es wird der eingestellte Dump ausgegeben (siehe 's','l','p','w'). Bei wmodus (siehe + 'p', 'w') werden Wortadressen ausgegeben. + +'o' Wie '*return*', jedoch wird zuvor p := p+l gesetzt (zum Weiterblättern). + +'r' Freigabe der anderen Miniprozesse. + + Zunächst werden bei Übergang in den Info alle Miniprozesse gesperrt, um eine Ver­ + fälschung der Fehlersituation zu vermeiden. Bei manchen Kommandos an den Info + müssen aber andere Miniprozesse u.U. aktiv werden (z.B. beim 'k' der Lader). Wenn + dies erforderlich ist, meldet der Info: + 'paging erforderlich'. Man kann dann 'r' geben und das letzte Infokommando wie­ + derholen, oder mit anderen Kommandos fortfahren, falls man den Fehlerzustand noch + so beibehalten will. + +'y' Zweitfunktion ausführen. + +--> 'yP*return*' + Neues Paßwort einstellen (max. 9 Zeichen). Dieses wird bei 'shutup' (erst + dann!) in Block 0 eingetragen. + +--> 'yt' Block von Archiv lesen. Dient zum Test des Archivs. + Es wird eine Kachel freigemacht und der Block mit der Nummer + eingelesen. Der Inhalt wird sofort angezeigt (wie Kommando 'k'). + +--> 'yb' Breakpoint an die Adresse setzen. Es wird ein INT3 (für Aufruf von + Info) abgesetzt. Info verwaltet gleichzeitig bis zu 10 gesetzte Breakpoints. Die + Breakpointnummer kann man aus der nach jedem Setzen (und Löschen) + angezeigten Breakpoint-Tabelle entnehmen. Breakpoints sind nur im Real­ + speicher sinnvoll. Ein Aufruf meldet sich mit TEXT= 'break z--xxxx:yyyy' (z + = Breakpointnummer, xxxx = CS, yyyy = PC beim Aufruf des Breakpoints). + Wird Info mit 'g' verlassen, so stellt er zuvor die alten 8086/8088-Befehle + wieder her und führt sie an ihrem originalen Ort aus. Direkt danach wird der + Breakpoint wieder hergestellt. + +--> 'yc' Löscht den Breakpoint an der Adresse und stellt die ursprüngli­ + chen Befehle wieder her. In der Breakpoint-Tabelle muß ein Breakpoint an + dieser Adresse vermerkt sein. + +--> 'yw' Zu anderen Miniprozeß wechseln. Nur sinnvoll, wenn ein anderer Mini unter + 'vor info' aufgeführt ist. + +--> 'yl' Lernmodus ein (wie beim Editor). + +--> 'ye' Ende Lernmodus. + +--> 'ya' Ausführen. Die zwischen 'yl' und 'ye' eingegebenen Zeichen werden dem Info + so vorgesetzt, als kämen sie von der Tastatur. + + Achtung: Rekursion ('ya' im Lernmodus) wird nicht abgefangen. Das Ge­ + lernte wird nach jedem Kommando, das die ersten drei Zeilen + wiederaufbaut (z.B. *return*), in der Zeile vier angezeigt, wobei + für Steuerzeichen eine Ersatzdarstellung erscheint (%x mit + x=code (code (zeichen) +code ("A")), also z.B. %M für *re­ + turn*). + +--> 'y *return*' + Wie *return*, jedoch wird der Dump auch beim Ausführen (ya) ausgegeben. + (Ein gelerntes *return* führt im Ausführmodus nicht zum Dump). + +'*cup*' *) (Cursor up). Umschaltung in den Modus zum Ändern in Dumps. +#foot# +#f# +*) Falls der Kanal noch nicht konfiguriert ist, muß man natürlich eine Taste betätigen, die den EUMEL-Code für Cursor +Up erzeugt. In der Regel ist das CTL c. Falls das Terminal ohne Konfigurierung keine Cursorpositionierungen durchführt, ist +dieser Modus nicht sehr gut benutzbar.#a##end# + Der Cursor fährt in den Dump und kann mit den Cursortasten dort bewegt + werden. Wird eine Hexazahl jetzt eingegeben, so wird diese als Inhalt des + Bytes eingetragen, auf dem der Cursor gerade steht. Dies funktioniert auch + auf beliebigen Datenräumen. Info beantragt dann bei der Speicherverwal­ + tung einen Schreibzugriff für die entsprechende Datenraumseite, so daß + Änderungen mit der Copy-on-Write-Logik erfolgen, also nur taskspezi­ + fisch sind (durch 'q' eingestellt). Für diese Task sind die Änderungen aller­ + dings dann permanent, da sie auch auf den Hintergrund wirken. + + Hinweis: Dumpt man mit 'k' einen Block und ändert dann darin, so sind + diese Änderungen u.U. nur temporär, da der Info kein Rückschrei­ + ben des Blockes veranlaßt. + + Achtung: Jede Eingabe, die kein Positionierzeichen und kein gültiges Zahl­ + zeichen ist, beendet diesen Modus. Das neue Zeichen wird als + Info-Kommando aufgefaßt, wobei auf die aktuelle + Adresse gesetzt wird. + (Für 'yc' / 'yb' sinnvoll: Man setzt den Cursor auf die Stelle, an der + ein Break ausgelöst werden soll und gibt 'yc'/'yb'). + Somit wird dieser Änderungsmodus üblicherweise durch *return* + beendet. + +#b("Einige Systemadressen")# +#goalpage("sysaddr")# + +Der Info nützt nur wenig, wenn man nicht weiß, was man sich anschauen soll. Wesentliche +Angaben über die Systemstruktur enthält das 'Brikett' (interne Systemdokumentation für +Projekt Mikros der GMD). Da diese etwas allgemeiner gehalten ist, geht sie nicht auf imple­ +mentationsabhängige Konstanten ein. Diese sind hier aufgeführt. + +Ab 1s100h liegt die 'ktab'. Sie enthält Informationen, welche Blöcke an welcher Stelle des +Arbeitsspeicher liegen: In der Kachel mit der Adresse 512*i befindet sich der Inhalt des +Blockes, dessen Nummer in ktab+i, ktab+100h+i steht. Ferner enthält die Tabelle, zu +welchem Datenraum (drid) und welcher Seite des Datenraums der Inhalt gehört. (Nur rele­ +vant, wenn die Prozeßnummer <> 255 ist). + +Steuerbits: 2**0 : Inhalt wird gerade transportiert (zum HG oder Archiv). + 2**1 : Inhalt ist identisch mit Inhalt auf HG. Wird beim Schreiben auf die + Kachel (per Software) zurückgesetzt. + 2**2 : Schreiberlaubnis (siehe Brikett). + 2**3 : Inhalt wurde kürzlich benutzt. Solche Kacheln werden 'weniger stark' + verdrängt. + + + ktab frei niederwertige Blocknummer + + +80h frei frei Steuerbits + + +100h frei höherwertige Blocknummer + + +180h frei frei Prozeßnummer + + +200h frei frei drid (prozeßspezifisch) + + +280h frei frei Seitennummer (höherw.) + + +300h frei frei Seitennummer (niederw.) + + ^ ^ + -- unbenutzt -- -- Beginn echter Kacheln + -- Beginn der Anforderungen + + +Der 'Beginn echter Kacheln' hängt von der Größe der 8086/8088-Teile ('urlader') ab (i.A. +30h < i < 40h). + +'Beginn der Anforderungen' liegt bei i=2. Es handelt sich um Blocknummern von zu laden­ +den Blöcken. Ist der höherwertige Teil der Blocknummer gleich FDh, so ist dies keine Anfor­ +derung. + +Blocknummern > FF00h stehen für Blöcke mit dem Inhalt 512 FFh's und werden nie auf +dem Hintergrundmedium gespeichert. + + + +1sA00h enthält den DR-Eintrag des drdr (siehe Brikett). + + +'musta': Das System fordert Checkpoints und Müllabfuhren über die Zelle 'musta' an. Diese + findet man mit dem Info durch + + xc musta + + (hierfür ist der Text 'musta:' vor der Zelle abgesetzt). + + Die Zelle selbst enthält + + FFh : Keine Müllabfuhr oder Checkpoint + 01h : Müllabfuhr + 02h : Checkpoint + 03h : beides + 04h : Systemendecheckpoint + 0Bh : System auf Archiv schreiben ('save system') + F0h : Müllabfuhr und Checkpoint sind geperrt (nur durch Setzen im Info + möglich) + + Durch Einsetzen der Werte mit dem Info kann die entsprechende Operation ver­ + anlaßt werden. Beim Einsetzen darf der Info nicht im 'r'-Zustand (siehe Eingabe + 'r') stehen; zum Ausführen der Operation muß 'r' (man bleibt im Info) oder 'g' (Info + verlassen) gegeben werden. + + +1s480h-4FFh: + enthält die Aktivierungstabelle. Ist (480h+i)=01h, so ist die Task i aktiv. Hin­ + weis: 4FFh enthält immer 01h, ohne daß dieser Zelle eine Task zugeordnet ist. + + +#b("Leitblock")# +#goalpage("pcb")# + +Mit dem 'z'-Kommando wird der Leitblock einer Task dargestellt. Es werden Hexapaare, +gefolgt von einer Bezeichnung, ausgegeben. In der folgenden Beschreibung werden die +Hexapaare durch a,b,c dargestellt. + + a b c icount Der virtuelle Befehlszähler der Task steht auf (cMOD4)* + 10000h+b*100h+a = im Datenraum 4 dieser Task. + Durch die Eingabefolge: + 4sw*return* + kann man sich den Code, der ausgeführt werden soll, ansehen. + + Bit 2**7 von c zeigt den Fehlerzustand an. + Bit 2**6 von c zeigt 'disable stop' (siehe Benutzerhandbuch) + an. + Bit 2**4 zeigt vorzeichenlose Arithmetik an (Compilierung). + + a b lbas Die lokale Basis steht auf 10000h+b* 100h+c = im + Datenraum 4 (Wortadresse). + + a b hptop Der Arbeitsheap geht von 30000h (Byteadr.) bis (aMOD16)* + 10000h+b* 100h+(aDIV16)*10h (Byteadr!). + + a b channel Die Task hängt an Kanal 100h*b+a (Terminalnummer). 0 = + kein Terminal angekoppelt. + + a b taskid Die Tasknummer der betrachteten Task ist a. (b ist die Ver­ + sionsnummer zum Abdichten von 'send'/ 'wait'). + +Um den Code, auf den der 'icount' zeigt, zu interpretieren, ziehe man das Brikett zu Rate. + + +Hinweis: Wenn der Info einen internen Fehler anzeigt, und auch bei 'ke', ist der durch 'z' + angezeigte Leitblock u.U. nicht aktualisiert. Man kann dies durch die Eingaben 'r', + 'g' erzwingen. (Der Info stellt wegen 'r' dem Interpreter einen Restart zu, der dann + beim 'g' den Leitblock aktualisiert und den Befehl erneut aufsetzt). Tritt dabei der + Fehler nicht wieder auf, handelte es sich um einen transienten Fehler (z.B. der + Codeblock war noch im Einlesen und ist jetzt voll da). So etwas kann z.B. passie­ + ren, wenn der SHard den Abschluß einer Leseoperation zu früh meldet. + + + + + + + + + + + + diff --git a/doc/porting-8086/8/source-disk b/doc/porting-8086/8/source-disk new file mode 100644 index 0000000..8aeb5a2 --- /dev/null +++ b/doc/porting-8086/8/source-disk @@ -0,0 +1 @@ +porting/portdoc-x86-8.img diff --git a/doc/porting-mc68k/1985.11.26/doc/Port.68000 b/doc/porting-mc68k/1985.11.26/doc/Port.68000 new file mode 100644 index 0000000..0ca6840 --- /dev/null +++ b/doc/porting-mc68k/1985.11.26/doc/Port.68000 @@ -0,0 +1,2173 @@ +#type ("trium8")##limit (12.0)# +#start(2.0,1.5)# +#type("triumb36")# +#free(4.0)# + EUMEL + Portierungs­ + handbuch + MC68000 +#type("triumb18")# +#free(1.5)# + Stand 26.11.85 +#page(1)# +#type ("trium8")##limit (12.0)# +#block# +#pagelength(18.4)# +#head# +#center#- % - + + +#end# +#type("triumb12")#Inhalt#a# + + + +Teil 1: Einführung #topage("ein")# +#free(0.3)# + Zweck dieses Handbuchs #topage("zweck")# + Referenzliteratur #topage("reflit")# + Minimale Hardwarevoraussetzungen #topage("hardw")# + Systemdurchsatz #topage("durchsatz")# + Softwarekomponenten des EUMEL-Systems #topage("kompo")# + Anlieferung des MC68000-EUMEL-Systems #topage("anlief")# + +Teil 2: Allgemeine Strukturen #topage("allgem")# +#free(0.3)# + Hintergrund #topage("hg")# + Archiv #topage("arch")# + Hauptspeicher #topage("speicher")# + +Teil 3: SHard-Interface Spezifikation #topage("shardifc")# +#free(0.3)# + 0. Vorbemerkungen #topage("vor")# + Zur Notation #topage("not")# + Link-Leisten #topage("leist")# + Allgemeine Link-Bedingungen #topage("link")# + Interrupts #topage("intr")# + 1. System laden #topage("laden")# + 2. Systemstart und -ende #topage("start")# + 3. Speicherverwaltung #topage("spver")# + Hauptspeicher #topage("haupt")# + Speicherfehler #topage("memerr")# + 4. Zeitgeber #topage("zeit")# + 5. Kanäle #topage("channel")# + 5.1 Stream-IO #topage("stream")# + Terminals #topage("term")# + Drucker, Plotter #topage("druck")# + Exoten #topage("exot")# + 5.2 Block-IO #topage("block")# + Block-IO bei Hintergrund und Archiv #topage("bhgarch")# + 5.3 I/O-Steuerung #topage("iocontrol")# + Konfigurierung serieller Schnittstellen #topage("v24")# + Flußkontrolle #topage("fluss")# + Kalender #topage("kalender")# + 6. SHard-Interface Version #topage("shdver")# + 7. ID-Konstanten #topage("ID")# + 8. Zusätzliche Leistungen #topage("shdelan")# + 9. Spezialroutinen #topage("ke")# + +Teil 4: Tips zur Portierung #topage("tips")# +#free(0.3)# + Nullversion des SHards #topage("0ver")# + Typische Fehler #topage("fehler")# + Effizienzprobleme #topage("eff")# + +Anhang A: EUMEL-Debugger "Info" #topage("info")# +#free(0.3)# + Aufruf des Infos #topage("aufrinf")# + Info-Format #topage("forminf")# + Info-Kommandos #topage("cmdinf")# + Einige Systemadressen #topage("sysaddr")# + Leitblock #topage("pcb")# + +Anhang B: Einige EUMEL-Begriffe #topage("glossar")# +#page# +#cc("Teil 1: ","Einführung")##goalpage("ein")# + + +#b("Zweck dieses Handbuchs")##goalpage("zweck")# + +Dieses Portierungshandbuch wendet sich an diejenigen, die das EUMEL-System auf +einem neuen Rechnertyp implementieren wollen. Es ist Teil einer Serie von Portierungs­ +handbüchern für verschiedene Prozessortypen. Dieses bezieht sich auf Rechner mit +MC68000-Prozessoren. + +Zum Betrieb eines EUMEL-Systems wird dieses Handbuch nicht benötigt! + + + +#b("Referenzliteratur")##goalpage("reflit")# + + + "EUMEL Benutzerhandbuch" + + "EUMEL Systemhandbuch" + + "EUMEL Quellcode der insertierten ELAN-Pakete" + + "MC68000 16-bit microprocessor - Users Manual" + Motorola, 1982 + + "68000 Assembler Reference" + XENIX Group, Microsoft Corp., 1982 + + "Anhang zu '68000 Assembler Reference'" + TA Nürnberg, 1984 + + +Siehe auch die Vorbemerkungen zur Notation in Teil 3 (S. #topage("not")#), sowie die Begriffserklä­ +rungen im Anhang B (S. #topage("glossar")#). + + +#b("Minimale Hardwarevoraussetzungen")##goalpage("hardw")# + +Um das EUMEL-System effizient einsetzen zu können, sollte die Hardware mindestens +folgenden Kriterien genügen: + + #ib#CPU#ie# Die MC68000-CPU sollte mit mindestens 8.0 MHz arbeiten. Falls die + Buszugriffe durch einen CRTC o.ä. verlangsamt werden, sollte die + echte MC68000-Leistung durchschnittlich mindestens einem unge­ + bremsten 8.0 MHz System entsprechen. + Seltene Verlangsamungen (z.B. nur bei I/O-Operationen) spielen bei + diesen Überlegungen keine Rolle. + + RAM Das System sollte über mindestens 256 KByte #ib#Hauptspeicher#ie# verfü­ + gen. + + #ib#Hintergrund#ie# Als Hintergrundmedium sind #ib#Diskette#ie#, #ib#Platte#ie# und RAM bzw. ROM + denkbar. + + Kapazität: + > 300 K, besser > 400 K (Single-User) + > 750 K, besser > 1000 K (Multi-User) + + Zugriff: *) +#foot# +#f#*) Hier ist die durchschnittliche Zugriffszeit auf einen 512 Byte großen Block gemeint. Für Platten und Disketten kann +man sie als Summe der Positionierzeit über die halbe Anzahl der Spuren und der Zeit einer halben Umdrehung be­ +rechnen. +#a# +#end# + < 500 ms (Single-User) + < 200 ms (Multi-User) + + #ib#Archiv#ie# Als Archiv wird meistens eine Diskette eingesetzt. Aber auch Band + oder Kassette sind denkbar. Die Anforderungen an Kapazität und + Geschwindigkeit sind anwendungsspezifisch. + + #ib#Bildschirm#ie# Angestrebt werden sollte ein Bildschirm mit 24 Zeilen zu je 80 Zeichen + (oder größer). Kleinere Bildschirme sind anschließbar, aber mit 40 Zei­ + chen pro Zeile läßt sich nicht mehr komfortabel arbeiten. + Rollup und freie Cursorpositionierung sind notwendige Voraussetzun­ + gen, invers-video ist erwünscht, aber nicht notwendig. Weiterhin + werden die Funktionen 'Löschen bis Zeilenende' und 'Löschen bis + Schirmende' benötigt. + + #ib#Tastatur#ie# An Steuertasten sollten mindestens ESC und die vier Cursortasten + vorhanden sein. Dabei ist es günstig, wenn die Cursortasten ergono­ + misch als Block bzw. Kreuz angeordnet sind. EUMEL benötigt weitere + Steuertasten für HOP, RUBIN, RUBOUT und MARK. Dafür können + beliebige, anderweitig nicht benötigte Tasten der Tastatur gewählt + werden. + + + +#b("Systemdurchsatz")##goalpage("durchsatz")# + +Da das EUMEL-System auf dem Prinzip des Demand Paging aufbaut, hängt der System­ +durchsatz von + + - CPU Leistung + - Speichergröße (RAM) + - Geschwindigkeit beim Hintergrundzugriff (Diskette, Platte) + +ab. Mit zunehmender Benutzerzahl steigen in der Regel die Anforderungen an das Paging +(Hintergrund-Zugriff) schneller als an die CPU. In diesem Bereich kann man die System­ +leistung dann durch mehr Speicher und/oder eine schnellere Platte in größerem Umfang +steigern. Dabei läßt sich eine langsame Platte teilweise durch mehr RAM und umgekehrt +wenig RAM durch eine schnelle Platte ausgleichen. + + + +#b("Softwarekomponenten des EUMEL-Systems")##goalpage("kompo")# + +Das EUMEL-System besteht aus mehreren Schichten: + + + EUMEL  2: Standardpakete, Editor, ... + + EUMEL  1: ELAN Compiler + + EUMEL  0: Systemkern (EUMEL-0-Maschine, EUMEL-0) + + EUMEL -1: SHard + + H a r d w a r e + + +Dieses #ib#Schichtenmodell#ie# ist nach oben offen und kann deshalb um beliebig viele (höhere) +Schichten erweitert werden. + +EUMEL > 0 Die Standardsoftware der Schichten > 0 ist in der Sprache ELAN ge­ + schrieben (siehe "EUMEL Quellcode"). Dementsprechend sind alle Schich­ + ten oberhalb der EUMEL-0-Maschine prozessor- und rechnerunabhän­ + gig, d.h. Anpassungen an einen neuen Rechnertyp sind nicht erforderlich. + +EUMEL   0 Die sogenannte "EUMEL-0-Maschine" enthält alle Basisoperationen und + hängt davon ab, welchen Prozessortyp der Rechner als CPU verwendet. Sie + existiert für verschiedene Prozessortypen. Hier wird nur auf den Typ + MC68000 Bezug genommen. Bei der Portierung auf einen MC68000- + Rechner wird die MC68000-EUMEL-0-Maschine ohne Anpassungen (!) + übernommen. + +EUMEL  -1 Diese Schicht stellt das Interface zwischen der EUMEL-0-Maschine und + der eigentlichen Hardware (vom Prozessor abgesehen) dar. Insbesondere + umfaßt sie alle Routinen zur Ansteuerung peripherer Geräte (Gerätetreiber). + Diese Schicht wird "SHard" genannt ("S"oftware-"Hard"ware Interface). + +Der SHard ist der einzige Teil des Systems, der bei der Portierung auf einen MC68000- +Rechner angepaßt bzw. neu geschrieben werden muß. Deshalb besteht der größte Teil +dieses Handbuchs aus der Spezifikation des MC68000-SHards. + + + +#b("Anlieferung des MC68000-EUMEL-Systems")##goalpage("anlief")# + +Der Implementierer erhält die EUMEL-Software auf Disketten. Dabei stehen folgende +Standardformate zur Wahl: + + Diskette 200 (8"), 1D, 77 Spuren, 16 Sektoren (\#0...\#15) zu 512 Byte + + Diskette 130 (5.25"), 2D, 40 Spuren, 9 Sektoren (\#1...\#9) zu 512 Byte *) +#foot# +#f#*) 48 tpi +#a# +#end# + + +Die Diskettenlieferung **) enthält +#foot# +#f#**) Zu Inhalt und Zweck der angelieferten Disketten siehe EUMEL Systemhandbuch, Teil 1: System einrichten. +#a# +#end# + + - Single-User Hintergrund + - Multi-User Hintergrund + - Standardarchive + - ggfs. Archive mit weiterer Anwendersoftware (installationsspezifisch) + +Dabei enthält der Hintergrund auch die EUMEL-0-Maschine (oft auch als "Urlader" +bezeichnet). + +#on("i")#Bitte gehen Sie vorsichtig mit diesen Mutterdisketten um. Verwenden Sie sie nur als +Quelle beim Kopieren. Sie sollten nur auf Kopien davon arbeiten!#off("i")# +#page# +#cc("Teil 2: ","Allgemeine Strukturen")##goalpage("allgem")# + + +#b("Hintergrund")##goalpage("hg")# + +Der Hintergrund ist in 512 Bytes große Blöcke unterteilt. Sie werden durch Blocknummern +(0, 1, 2, ...) adressiert. Die physische Ablage der Blöcke auf dem Hintergrundmedium +bleibt dem SHard überlassen. Er kann sie z.B. linear oder versetzt anordnen. Man sollte +darauf achten, daß Positionierungen auf logisch "nahe" Blöcke möglichst schnell gehen +sollten. Deshalb ist in der Regel zylinderorientierte Anordnung der oberflächenorientierten +vorzuziehen. + +Falls auf dem Hintergrundmedium spezielle Blöcke z.B. für Bootstrap und SHard freige­ +halten werden sollen, muß das bei der Abbildung der Hintergrundblocknummern auf die +Sektoren der Diskette bzw. der Platte berücksichtigt werden. + +Aufbau des Hintergrundes: + + Block 0 Systemetikett + + Block 10...10+k-1 EUMEL-0-Maschine (z.Zt. ist k=200; dieser Wert ist nur + für EUMEL-0 von Bedeutung) + + Block 1...9, 10+k ... Paging-Bereich + + +Aufbau des #ib#Systemetikett#ie#s (#ib#Block 0#ie#): + + Byte Wert/Aufgabe + + 0...5 "EUMEL-"; Kennzeichen für EUMEL-Hintergrund. + 6...11 Versionsnummer in druckbaren Zeichen. Sie stellt sicher, daß System- + kern und Hintergrund kompatibel sind. + 12 zur Zeit ohne Bedeutung + 13 enthält Wert 0 , wenn System im Shutupzustand ist. + 14..15 Systemlaufzähler (14=low, 15=high). Wird bei jedem Systemstart um 1 + erhöht. + 16..35 Reserviert; zur Zeit ohne Bedeutung + 36..37 Aus historischen Gründen für interne Zwecke belegt. + 38..69 Hier kann eine Installationsnummer geführt werden. + 70..79 Info-Paßwort + 80 =0 Normalzustand + =1 Kompresslauf erforderlich (System frisch von Archiv geladen) + 81...255 Reserviert. + 256..511 Kann von SHard beliebig verwendet werden. + + + +#b("Archiv")##goalpage("arch")# + +Wie der Hintergrund, sind die Archive in 512 Bytes große Blöcke unterteilt *). Bisher gibt +es folgende #d("Standardformate")#: +#foot# +#f#*) Der genaue Aufbau der Archivblöcke ist weder für den SHard-Implementierer, noch für den Benutzer von Be­ +deutung. SHard hantiert nur mit Blöcken aufgrund von Blocknummern, unabhängig vom Inhalt der Blöcke. Der Benut­ +zer "sieht" nur Datenräume bzw. Dateien, unabhängig von ihrem Format auf dem Archiv. +#a# +#end# + + + Diskette 200 (8"), 1D, 77 Spuren, 16 Sektoren (\#0...\#15) zu 512 Byte + Diskette 200 (8"), 2D, 77 Spuren, 16 Sektoren (\#0...\#15) zu 512 Byte + + Block Seite Spur Sektor + + 0 0 0 0 + 16 0 1 0 + 77*16 1 0 0 + + n n DIV (77*16) n MOD (77*16) DIV 16 n MOD 16 + + + Diskette 130 (5.25"), 2D, 40 Spuren, 9 Sektoren (\#1...\#9) zu 512 Byte + + Block Seite Spur Sektor + + 0 0 0 1 + 9 0 1 1 + 40*9 1 0 1 + + n n DIV (40*9) n MOD (40*9) DIV 9 n MOD 9 + 1 + + + Diskette 130 (5.25"), 2D, 80 Spuren, 9 Sektoren (\#1...\#9) zu 512 Byte + + Block Seite Spur Sektor + + 0 0 0 1 + 9 0 1 1 + 80*9 1 0 1 + + n n DIV (80*9) n MOD (80*9) DIV 9 n MOD 9 + 1 + + + Diskette 130 (5.25"), HD, 80 Spuren, 15 Sektoren (\#1...\#15) zu 512 Byte + + Block Seite Spur Sektor + + 0 0 0 1 + 15 0 1 1 + 80*15 1 0 1 + + n n DIV (80*15) n MOD (80*15) DIV 15 n MOD 15 + 1 + + +Selbstverständlich können auch andere #ib#Archivformate#ie# implementiert werden, falls das aus +Hardwaregründen notwendig ist oder sich dadurch wesentliche Verbesserungen (z.B. in +der Kapazität) ergeben. + +Wenn irgend möglich sollte aber mindestens eines der oben aufgeführten Standardformate +unterstützt werden - evtl. als zusätzliches Format -, um den Austausch zwischen ver­ +schiedenen Rechnertypen zu vereinfachen. + +#on("i")#Hinweis: Um den Datenaustausch zwischen verschiedenen Rechnertypen zu vereinfa­ + chen, sollten möglichst alle hardwaremäßig möglichen Standardformate (min­ + destens lesend) unterstützt werden. Dabei sollte SHard sich automatisch auf + das Format der jeweils eingelegten Diskette einstellen:#off("i")# + + + Laufwerkstyp Diskettentyp(en) + + 8" 1D 8" 1D + 8" 2D 8" 2D, 1D + + 5" 2D-40 5" 2D-40 + 5" 2D-80 5" 2D-80, 2D-40 *) + 5" HD-80 5" HD-80, 2D-80, 2D-40 *) + +#foot# +#f#*) Bei der Behandlung von 40-Spur-Disketten auf 80-Spur-Laufwerken gelten meistens folgende Regeln: + a) Lesen funktioniert sicher. + b) Schreiben ist unsicher, funktioniert aber häufig. + c) Formatieren funktioniert fast nie. +#a# +#end# + + + +#b("Hauptspeicher")##goalpage("speicher")# + +Der #ib#Speicher#ie# wird EUMEL-0 vom SHard in maximal vier Speicherbereichen (M0...M3) +zugewiesen. Die Anfangsadresse eines solchen Bereiches muß ein Vielfaches von 512B +sein. M0 muß immer vorhanden sein, M1, M2 und M3 nur in speziellen Betriebsarten: + + #d("M0")# #on("b")#allgemeines #ib#RAM#ie(1,", allgemeines")##off("b")# + Dieser Bereich muß immer vorhanden sein. Bei den meisten Rechnern liegt der + Systemkern nicht in einem ROM, sondern wird von SHard in das RAM geladen. + Das geschieht dann an den Anfang von M0. Der Rest wird für Tabellen und als + Pagingbereich benutzt. M0 umfaßt deshalb meistens allen verfügbaren Spei­ + cher, bis auf den Platz für SHard, Boot-ROM und Bildwiederholspeicher. **) +#foot# +#f#**) Der im Tabellenspeicher liegende 'ktab' ist für die Verwaltung von max. 2048 Kacheln (=1MB) ausgelegt. Der +Speicherbedarf des Systemkerns liegt bei 80KB, für Tabellen werden 40KB benötigt. Dies sollte man bei der Angabe +von M0SIZE berücksichtigen. +#a# +#end# + + #d("M1")# #on("b")#Systemkern-#ib#ROM#ie(1,", Systemkern")##off("b")# + Gibt es nur bei Rechnern, die den Systemkern in einem ROM haben. (M0 wird + dann nur für Tabellen und als Pagingspeicher eingesetzt.) + + #d("M2")# #on("b")#Hintergrund-#ib#ROM#ie(1,",Hintergrund")##off("b")# + Gibt es nur bei Rechnern, die nicht Diskette oder Platte sondern ROM und + RAM als Hintergrundspeicher verwenden. + + #d("M3")# #on("b")#Hintergrund-#ib#RAM#ie(1,",Hintergrund")##off("b")# + Gibt es nur bei Rechnern, die nicht Diskette oder Platte sondern ROM und + RAM oder RAM allein als Hintergrundspeicher verwenden. + +Damit sind drei verschiedene Betriebsarten des EUMEL-Systems möglich: + + #d("Normalbetrieb")#: M0 (> 256 KB) + Hintergrundgerät (Platte oder Diskette) + Archivgerät (Diskette) + + Im Normalbetrieb befindet sich der Hintergrund auf einer Platte oder Diskette + RAM wird für den Systemkern und zum Paging eingesetzt. Alle mittleren und + größeren Systeme verwenden den Normalbetrieb. + + + #d("Minibetrieb")#: M0 (> 256 KB) + M3 (mindestens 300 KB) + Archivgerät (Diskette) + + Im Minibetrieb wird RAM als Hintergrundspeicher eingesetzt. Dieser wird beim + Einschalten über das Archivgerät geladen und beim Abschalten ('shutup') + wieder zurückgeschrieben. + + + #d("ROM-Betrieb")#: M0 (>40 KB) + M1 (>60 KB) + M2 (>170 KB) + M3 (>60 KB) + Archivgerät (Kassettenrecorder oder Diskettenlaufwerk) + + Im ROM-Betrieb stehen Systemkern und Standardteil des Hintergrundes im + ROM. Der übrige Hintergrund befindet sich im RAM. *) +#foot# +#f#*) Für ROM-Betrieb benötigt man eine Spezialversion des Systemkerns. +#a# +#end# + +#page# +#cc("Teil 3: SHard ","Interface Spezifikation")##goalpage("shardifc")# + + +#bb("0. ","Vorbemerkungen")##goalpage("vor")# + + +#b("Zur Notation")##goalpage("not")# + +Im folgenden wird zwischen #d("0-Routinen")#, die dem SHard vom EUMEL-0-System zur +Verfügung gestellt werden, und +#d("SHard-Routinen")# unterschieden, die der SHard implementieren muß. Damit dieser Unter­ +schied bei der Spezifikation deutlich wird, werden 0-Routinen folgendermaßen aufgeführt: + + name (0-Routine) + +Zusätzlich werden 0-Routinen grundsätzlich klein und SHard-Routinen groß geschrie­ +ben. + +MC68000-Befehle werden wie im "Anhang zu '68000 Assembler Reference'", (TA, 1984) +notiert: + + moveq \#27,d0 + addw d3,d1 + + +Hexadezimale Zahlen werden durch ein vorangestelltes '/' gekennzeichnet: + + /12 = 18 + /1f = 31 + /ffff = 65535 + + +Achtung: Die Übergabe von Integer-Parametern zwischen SHard und EUMEL-0 erfolgt + grundsätzlich in den niederwertigen 16 Bits des jeweils angegebenen Daten­ + registers. + +#b("Link-Leisten")##goalpage("leist")# + +Die Verbindung zwischen SHard und EUMEL-0 erfolgt über zwei Tabellen. In der +"0-Leiste" stellt EUMEL-0 dem SHard verschiedene 0-Routinen zur Verfügung. Diese +Leiste beginnt an der Adresse M0 (im Normal- oder Minimodus) bzw. M1 (im ROM- +Modus): + + Adresse Assemblerbefehl + + M0 + 0 eumel0id: .ascii "EUMEL jj-mm-tt  " !Kennung mit Datum + +16 eumel0blocks: .word ... !Anzahl EUMEL0-Bloecke auf HG + +18 hgver: .word 173 !HG-Versionsnummer + +20 cputype: .word 4 !MC68000 oder kompat. CPU + +22 eumel0ver: .word mmmtt !EUMEL0-Version (mmm=1 --> Jan.84) + +24 shdvermin: .word 8 !Minimum bzw. Maximum fuer die + +26 shdvermax: .word 8 ! SHard-Versionsnummer + +28 systemstart: jmp ... !Ab hier stehen Sprungbefehle zu + +34 inputinterrupt: jmp ... ! den entsprechenden 0-Routinen + +40 timerinterrupt: jmp ... + +46 warte: jmp ... + +52 shutup: jmp ... + +58 info: jmp ... + + +Für die Gegenrichtung muß SHard der 0-Maschine die "SHard-Leiste" zur Verfügung +stellen: + + Adresse Assemblerbefehl + +SHDID+ 0 SHDID: .ascii "SHARD jj-mm-tt  " !Kennung mit Datum + +16 SHDVER: .word 8 !Versionsnummer d. SHard-Schnittstelle + +18 MODE: .word !Modusbits: + BITEUDEL = 0 ! EUMEL-0-Bloecke auf HG freigeben + BITNORMAL = 1 ! Normalbetrieb + BITMINI = 2 ! Minibetrieb + BITROM = 3 ! ROM-Betrieb + +20 ID4: .word !ID-Konstanten (s.S. #topage("ID")#) + +22 ID5: .word ! dito + +24 ID6: .word ! dito + +26 ID7: .word ! dito + +28 OUTCHAR: jmp !Ab hier stehen Sprungbefehle in die + +34 OUTPUT: jmp ! entsprechenden SHard-Routinen + +40 BLOCKIN: jmp + +46 BLOCKOUT: jmp + +52 IOCONTROL: jmp + +58 SYSEND: jmp + +64 SYSABORT: jmp + +70 M0START: .long !Startadr bzw. + +74 M0SIZE: .long ! Länge (in Bytes) des Bereiches M0 + +78 M1START: .long ! dito f. M1 + +82 M1SIZE: .long + +86 M2START: .long ! dito f. M2 + +90 M2SIZE: .long + +94 M3START: .long ! dito f. M3 + +98 M3SIZE: .long + + + +#b("Allgemeine Link-Bedingungen")##goalpage("link")# + +In der Regel sind sowohl 0-Routinen als auch SHard-Routinen durch 'jbsr' aufzurufen: + + jbsr + +Ausnahmen von dieser Regel sind im folgenden stets besonders vermerkt. + +Generelle Link-Bedingung (für SHard- und 0-Routinen) ist: + + Alle Register - bis auf die jeweils spezifizierten Ausgangsparameter und die 'condi­ + tion code'-Flags im Status Register *) - bleiben unverändert. +#foot# +#f#*) Condition-Code-Flags sind i.a. nach dem Aufruf einer Routine undefiniert. Ausnahmen sind natürlich die Flags, +die als Ausgangsparameter in manchen Fällen definiert sind. +#a# +#end# + +Jede SHard-Routine muß also alle Register, die sie verändert und die keine Ausgangs­ +parameter sind, retten und wiederherstellen. Im Gegenzug braucht SHard beim Aufruf von +0-Routinen selbst keine Register zu retten. + + + +#b("Interrupts")##goalpage("intr")# + +Zwei externe Ereignisse (Zeitgeber und Eingabe, siehe S.#topage("zeit")# und S.#topage("inp")#) werden von +EUMEL-0 behandelt. Die entsprechenden Interrupts muß SHard per 'jbsr' an 0-Routinen +weiterleiten. +Die Register (bis auf die Parameterregister) werden von den aufzurufenden 0-Routinen +selbst gesichert. Die normale Interrupt-Sequenz im SHard sieht dann folgendermaßen +aus: + + intadr:  movl d0,(sp)- + movw ,d0 + jbsr + andw \#/fcff,sr ! interrupt level freigeben + movl (sp)+,d0 + rti + +Achtung: SHard muß die Interrupt-Routinen im 'disable-int'-Modus anspringen, d.h. im + Status Register muß der korrekte Interrupt-Level gesetzt sein. (MC68000 setzt + beim Interrupt schon automatisch die Interrupt-Level-Flags.) + + + + + +#bb("1. System ","laden")##goalpage("laden")# + +SHard muß die EUMEL-0-Software vor dem eigentlichen Start an den Anfang des Spei­ +cherbereiches M0 laden. EUMEL-0 befindet sich auf dem Hintergrund von Block 10 ab. +Der erste Block von EUMEL-0 enthält am Anfang die 0-Leiste. Dort steht an der +Byteadresse 16 die Größe 'eumel0blocks'. Sie gibt an, wieviel Blöcke konsekutiv geladen +werden müssen. Hat sie beispielsweise den Wert 80, müssen die Blöcke 10 bis 89 gela­ +den werden. + + Achtung: Zu diesem Zeitpunkt kann SHard die oben aufgeführten 0-Routinen natür­ + lich noch nicht benutzen. Insbesondere dürfen die Laderoutinen nicht + 'warte' aufrufen. Das wird hier besonders betont, weil der Hintergrundzugriff + beim eigentlichen Systemlauf in der Regel 'warte' verwenden wird. + + Hinweis: Der erste Block von EUMEL-0 enthält in den ersten fünf Bytes den Text + "EUMEL", um eine Identifikation durch den SHard-Lader zu ermöglichen. + +Es wird empfohlen, nach folgendem Verfahren zu laden: + + IF archivgeraet enthaelt diskette AND eumel 0 auf archiv + THEN lade eumel 0 vom archiv + ELIF eumel 0 auf hintergrund + THEN lade eumel 0 vom hintergrund + ELSE laden unmoeglich + FI . + +So kann man auch bei einem frisch formatierten Hintergrundmedium einen neuen Hinter­ +grund (mit EUMEL-0) einspielen, indem man ein Hintergrundarchiv vor dem Systemstart +in das Archivgerät legt. Dann wird EUMEL-0 von dort geladen, so daß man den Hinter­ +grund dann wie im Systemhandbuch beschrieben vom Archiv auf das Hintergrundmedium +kopieren kann.*) +#foot# +#f#*) Kopiervorgänge (Archiv -> Hintergrund) werden von EUMEL-0 erledigt, so daß SHard keine derartigen Routinen +enthalten muß. +#a# +#end# + + + + +#bb("2. System","start und -ende")##goalpage("start")# + +SHard muß alle für den Rechner notwendigen (Hardware-) Initialisierungen durchführen +und erst danach die EUMEL-0-Maschine starten ('systemstart'). + + #d("systemstart")# (0-Routine) + + Eingang: a0 = Adresse der SHard-Leiste + + Aufruf: jmp systemstart + + Zweck: Die EUMEL-0-Maschine wird gestartet. Alle notwendigen Hard­ + wareinitialisierungen (z.B. der Peripheriebausteine) müssen vorher + schon geschehen sein. + + Hinweis: SHard muß den Stackpointer (a7) "vorläufig" definieren (etwa 100 + Langworte reichen dafür aus), da beim Sprung in EUMEL-0 Inter­ + rupts auftreten können. + + + + #d("SYSEND")# + + Parameter: - + + Zweck: Hiermit wird SHard das Ende eines Systemlaufs mitgeteilt. Somit + können evtl. notwendige Abschlußbehandlungen durchgeführt + werden. SHard kann mit 'rts' zu EUMEL-0 zurückkehren, muß + aber nicht. Diese Routine kann z.B. dazu benutzt werden, die + Hardware auszuschalten oder in ein umgebendes System zurück­ + zukehren (EUMEL als Subsystem). In den meisten Fällen wird die + Routine leer implementiert werden, d.h. nur aus 'rts' bestehen. + + + + +#bb("3. ","Speicherverwaltung")##goalpage("spver")# + + +#b("Hauptspeicher")##goalpage("haupt")# + +Der Hauptspeicher umfaßt die Teile des MC68000-Speichers, die EUMEL-0 verwalten +darf. + + + +#b("Speicherfehler")##goalpage("memerr")# + +Falls die Hardware Speicherfehler aufgrund von Paritybits, ECC oder ähnlichem feststellen +und an SHard melden kann, sollte das zur Erhöhung der Systemsicherheit genutzt wer­ +den. + +Wenn SHard (z.B. über Interrupt) einen Speicherfehler mitgeteilt bekommt, sollte er, wenn +möglich, eine entsprechende Meldung ausgeben und das System anhalten: + + basta: jra basta + + +Wenn Speicherfehler mit Sicherheit bemerkt werden, verhindert diese Reaktion, daß die +Fehler auf dem Hintergrund festgeschrieben werden und evtl. später zu Systemfehlern +führen. + +Der Anwender kann dann durch Hardware-Reset auf den letzten Fixpunkt des EUMEL- +Systems zurücksetzen. So verliert er zwar evtl. die letzten Minuten seiner Arbeit, behält +aber auf alle Fälle ein konsistentes System. + + + + +#bb("4. ","Zeitgeber")##goalpage("zeit")# + +SHard muß einen Zeitgeberinterrupt erzeugen, der ca. 10 bis 100 mal pro Sekunde auftritt. +Dabei ist die 0-Routine 'timerinterrupt' aufzurufen. Ohne diesen Interrupt wird die Uhr +nicht geführt, und die Zeitscheibenlogik für das Timesharing fällt aus. + + #d("timerinterrupt")# (0-Routine) + + Eingang: d0 = seit letztem Zeitgeberinterrupt vergangene Zeit (in ms) + + Zweck: Wird von EUMEL-0 für interne Uhren und für das Scheduling + (Zeitscheibenlogik) verwendet. Es werden keine hohen Genauig­ + keitsanforderungen an die Zeitangaben bei #on("i")#einzelnen#off("i")# Interrupts + gestellt. Um EUMEL-0 eine genaue Realzeituhr zu ermöglichen, + sollte die so erzeugte Zeitangabe #on("i")#im Mittel#off("i")# aber möglichst genau + sein, d.h. die Summe der innerhalb einer Minute so übergebenen + Werte sollte zwischen 59995 und 60005 liegen. + + + + +#bb("5. ","Kanäle")##goalpage("channel")# + +Einiges zum Kanalkonzept: + +Das System kennt die Kanäle 0..32. + + Kanal 0 ist der Systemhintergrund. + Kanäle 1..15 sind für Stream-IO (Terminals, Drucker, ...) vorgesehen. + Kanal 31 ist der Standard-Archivkanal. + Kanal 32 ist der Parameterkanal. + +Die Kanäle 2..30 können installationsabhängig verfügbar sein oder auch nicht. Deren +Funktion ist dann Absprachesache zwischen Installation und SHard. + +Kanäle können über Block-IO (BLOCKOUT, BLOCKIN) oder Stream-IO (OUTPUT,..) +angesprochen werden. Das System erfährt über IOCONTROL, welche Betriebsart des +Kanals sinnvoll ist. + +#on("i")##on("b")#Achtung: Alle Kanaloperationen müssen grundsätzlich für alle Kanäle (0...32) aufgerufen + werden können. Dabei können Operationen auf nicht vorhandenen Kanälen und + unsinnige Operationen (z.B. Stream-IO auf Kanal 0) leer implementiert werden.#off("b")# + (Dafür werden im folgenden bei jeder SHard-Routine Vorschläge gemacht.)#off("i")# + + + +#bb("5.1 ","Stream-IO")##goalpage("stream")# + +Über Stream-IO wickelt das System die übliche zeichenorientierte Ein-/Ausgabe auf Ter­ +minals, Druckern, Plottern usw. ab. Stream-IO wird nur für die Kanäle 1...15 gemacht. + + #d("inputinterrupt")# (0-Routine)#goalpage("inp")# + + Aufruf: movl kanalnummer,(sp)- !1...15 + movl zeichen,(sp)- !rechtsbündig + jbsr inputinterrupt + lea 8(sp),sp !restore stackpointer + + Zweck: SHard muß EUMEL-0 durch Aufruf dieser Routine mitteilen, daß + eine Eingabe vorliegt. + + Hinweise: EUMEL-0 puffert die Zeichen. EUMEL-0 signalisiert den Zustand + "Puffer voll" durch IOCONTROL "stop" und ignoriert weitere + Eingaben, bis wieder Platz im Puffer vorhanden ist. (siehe + IOCONTROL "stop" und "weiter", S.#topage("weiter")#) + + Bei Kanalnummern <1 oder >15 wird der Aufruf von EUMEL-0 + ignoriert. + + Falls die Hardware keine Inputinterrupts zur Verfügung stellt, sollte + ein Timer benutzt werden, um alle möglichen Inputquellen regel­ + mäßig abzufragen. Dabei muß man allerdings den goldenen Mittel­ + weg zwischen zu häufiger (Systemdurchsatz sinkt) und zu seltener + Abfrage (Zeichen gehen verloren) suchen. Man sollte dabei nicht + nur an die menschliche Tippgeschwindigkeit sondern auch an die + höchste Baudrate denken, die man für Rechnerkopplungen noch + unterstützen will. *) + +#foot# +#f#*) Eine weitere Möglichkeit, auf manchen Kanälen ohne Interrupts auszukommen, wird bei der IOCONTROL-Funk­ +tion "weiter" beschrieben (siehe S.#topage("weiter")#). +#a# +#end# + +Achtung: #on("i")#Keinesfalls darf 'inputinterrupt' rekursiv aufgerufen werden. Nor­ + malerweise wird das automatisch verhindert, wenn man den + zugehörigen Hardwareinterrupt erst nach der 0-Routine wieder + freigibt. Falls das nicht möglich ist und unter bestimmten Umstän­ + den das nächste Zeichen abgeholt werden muß, bevor die + 0-Routine beendet ist, muß SHard einen eigenen Puffer imple­ + mentieren:#off("i")# + + hardwareinterrupt: + IF input interrupt aktiv + THEN trage zeichen in shard puffer ein; + gib hardware interrupt frei + ELSE input interrupt aktiv := true; + gib hardware interrupt frei; + input interrupt; + disable interrupt; + WHILE shard puffer enthaelt noch zeichen + REP nimm zeichen aus shard puffer; + enable interrupt; + input interrupt; + disable interrupt + PER; + input interrupt := false; + enable interrupt + FI. + + + #d("OUTPUT")# + + Eingang: d0 = Kanalnummer (1...15) + d2 = Anzahl auszugebender Zeichen + a0 = Adresse der Zeichenkette + Ausgang: d2 = Anzahl der übernommenen Zeichen + + Zweck: Ausgabe einer Zeichenkette. Diese ist (möglichst ganz) zwischen­ + zupuffern, denn die Ausführung von OUTPUT sollte kein Warten + auf IO enthalten. Der Ausgabepuffer muß mindestens 50 Zeichen + fassen können. Durch eine Interruptlogik oder etwas Äquivalentes + ist sicherzustellen, daß dieser Puffer parallel zur normalen Verar­ + beitung ausgegeben wird. Wenn die auszugebende Zeichenkette + nicht vollständig in den Puffer paßt, sollten trotzdem so viele + Zeichen wie möglich übernommen werden. Im weiteren Verlauf ruft + EUMEL-0 dann wieder OUTPUT mit dem Rest der Zeichenkette + auf. + + + Achtung: #on("i")#Keinesfalls darf innerhalb von OUTPUT die 0-Routine 'warte' auf­ + gerufen werden.#off("i")# + + Vorschlag: Falls der Kanal nicht existiert bzw. OUTPUT darauf unsinnig ist, + sollte vorgegaukelt werden, alle Zeichen seien ausgegeben (d2 + unverändert). + + + + #d("OUTCHAR")# + + Eingang: d0 = Kanalnummer (1...15) + d1 = auszugebendes Zeichen + + Zweck: Ausgabe eines Zeichens. + + Hinweis: Ob das Zeichen übernommen wird, kann vorher durch einen Aufruf + IOCONTROL "frout" erfragt werden, s. S. #topage("frout")#. + + + +#b("Terminals")##goalpage("term")# + +"Normale" #ib#Terminal#ie(1,", normales")#s können ohne weitere Unterstützung des SHards angeschlossen +werden. Die zur Anpassung an den EUMEL-Zeichensatz *) notwendigen #ib#Umcodierungen#ie# +werden von den höheren Ebenen aus eingestellt. Da diese Umsetztabellen vom SHard +unabhängig sind, stehen automatisch alle so angepaßten Terminaltypen allen EUMEL- +Anwendern zur Verfügung! +#foot# +#f#*) Siehe "EUMEL Benutzerhandbuch, Teil 3: Editor, 5. Zeichencode" +#a# +#end# + +Für den Anschluß eines #on("b")##on("i")#integrierten #ib#Terminal#ie(1,", integriertes")#s#off("i")##off("b")#, in dessen Bildwiederholspeicher direkt +gearbeitet wird, kann man häufig den Terminaltyp 'psi' verwenden (siehe auch "Exoten"). + +Näheres zu Terminaltypen und -anschlüssen findet man im "EUMEL Systemhandbuch" +unter den Stichwörtern #on("i")#Konfiguration#off("i")# und #on("i")#Konfigurierung#off("i")#. + + + +#bb("Drucker, ","Plotter")##goalpage("druck")# + +#ib#Drucker#ie# und Plotter werden vom EUMEL-System wie Terminals angesehen. Da in der +Regel der Rechner aber schneller Zeichen senden als der Drucker drucken kann, müssen +solche Geräte in der Regel mit Flußkontrolle angeschlossen werden (siehe S.#topage("fluss")#). + +Wenn Drucker oder Plotter über eine Parallelschnittstelle angeschlossen werden, kann man +auf diesem Kanal möglicherweise auf einen Ausgabepuffer verzichten. Voraussetzung ist +dabei, daß + + a) der Drucker einen eigenen Puffer hat und + b) der Puffer "schnell" gefüllt werden kann (<0.1 ms je Zeichen). + +Dann kann man auf den bei der SHard-Routine OUTPUT geforderten Puffer verzichten +und die Zeichenkette direkt über die Parallelschnittstelle an den Drucker übergeben. Wenn +der Drucker 'Puffer voll' signalisiert, sollte die Zeichenübernahme bei OUTPUT abgebro­ +chen werden. **) #on("i")#Auf keinen Fall darf CPU-intensiv auf Freiwerden des Puffers gewartet +werden!#off("i")# +#foot# +#f#**) siehe auch IOCONTROL "frout", S.#topage("frout")# +#a# +#end# + + + +#b("Exoten")##goalpage("exot")# + +Exotische #ib#Terminal#ie(1," exotisches")#s (im Sinne dieser Beschreibung) sind solche, für die eine Umsetz­ +tabelle im System (siehe Konfiguratorbeschreibung) nicht ausreicht bzw. nicht nötig ist +(Beispiele: Terminals, in deren Bildwiederholspeicher direkt gearbeitet wird; Terminals, die +soweit programmierbar sind, daß sie den EUMEL-Zeichencode können). + +Für solche Terminals muß in der Konfiguration der Terminaltyp '#ib#psi#ie#' eingestellt werden. +Dieser wirkt ohne Umcodierungen, d.h. die EUMEL-Codes (siehe Benutzerhandbuch 1.7 +Seite 106) werden direkt dem SHard zugestellt (wie bei 'transparent'), jedoch mit folgenden +Besonderheiten: + +Eingabeseitig werden zusätzlich folgende Codezuordnungen getroffen: + + Code Funktion + + 7 SV (Aktivierung: 'gib supervisor kommando:') + 17 STOP (Ausgabe auf diesen Kanal wird gestoppt) + 23 WEITER (Ausgabe läuft wieder weiter) + 4 INFO (System geht in Debugger, falls Debugoption) + + + +#bb("5.2 ","Block-IO")##goalpage("block")# + +Über Block-IO wickelt das System die Zugriffe zum Hintergrund und zum Archiv ab. +Ferner ist daran gedacht, auch auf V.24-Schnittstellen Block-IO z.B. für Rechnerkopp­ +lung zuzulassen. Die Kanalnummer in Reg. d0 unterscheidet diese Fälle. Außer beim +Paging (d0=0) wird ein Block-IO durch die ELAN-Prozeduren 'blockin' und blockout' +induziert. + +Bei Block-IO wird immer ein 512 Byte großer Hauptspeicherbereich mit übergeben. +Dieser kann (im Gegensatz zu OUTPUT) direkt benutzt werden, d.h. es muß keine Um­ +pufferung erfolgen. + +Dieser Hauptspeicherbereich darf nur bei BLOCKIN verändert werden. + +SHard darf (anders als bei OUTPUT) erst dann zur Aufrufstelle zurückgeben, wenn die +verlangte Operation abgeschlossen ist. Treten während der Operation Wartezeiten auf, so +muß SHard die 0-Routine 'warte' aufrufen, damit das System andere Prozesse weiter­ +laufen lassen kann. + +EUMEL-0 definiert bestimmte Funktionen für Hintergrund (Kanal 0) und Archiv (Kanal 31). +Operationen auf anderen Kanälen kann SHard nach Belieben implementieren und deren +Leistung seinen Installationen über ELAN-Pakete zur Verfügung stellen. Das System +vergibt auch in Zukunft für den #ib##on("i")#Funktionscode#ie##off("i")# in Register d1 nur positive Werte (Bit 15 +von d1 = 0). Der SHard kann selbst negative Codes einführen. + + + #d("BLOCKIN")# + + Eingang: d0 = Kanalnummer (0...32) + d1 = Funktionscode 1 + d2 = Funktionscode 2 + a0 = Adresse des Hauptspeicherbereichs + Ausgang: d0 = undefiniert (darf also verändert werden) + d1 = Rückmeldecode + a0 = darf verändert werden + + Der Inhalt des Hauptspeicherbereichs (... +511) darf + verändert sein. + + Zweck: "Einlesen" von Blöcken. Die genaue Wirkung hängt vom Funk­ + tionscode und dem Kanal ab. + + Vorschlag: Falls der Kanal nicht existiert bzw. BLOCKIN darauf unsinnig ist, + sollte die Rückmeldung -1 in d1 geliefert werden. + + + #d("BLOCKOUT")# + + Eingang: d0 = Kanalnummer (0...32) + d1 = Funktionscode 1 + d2 = Funktionscode 2 + a0 = Adresse des Hauptspeicherbereichs + Ausgang: d0 = undefiniert (darf also verändert werden) + d1 = Rückmeldecode + a0 = darf verändert werden + + Der Inhalt des Hauptspeicherbereichs darf #on("i")#nicht#off("i")# verändert werden! + + Zweck: "Ausgeben" von Blöcken. Die genaue Wirkung hängt vom Funk­ + tionscode und dem Kanal ab. + + Vorschlag: Falls der Kanal nicht existiert bzw. BLOCKOUT darauf unsinnig ist, + sollte die Rückmeldung -1 in d1 geliefert werden. + + + #d("warte")# (0-Routine) + + Ausgang: Alle Register undefiniert! + + Zweck: Diese Routine ist bei 'blockin' oder 'blockout' dann aufzurufen, + wenn SHard im Augenblick nichts zu tun hat. Durch den Aufruf von + 'warte' erhalten andere Systemteile die Möglichkeit, weiter zu ar­ + beiten. Ein 'warte' kann bis zu ca. 1/4 Sekunde Zeit aufnehmen. + 'warte' darf nicht in Interruptroutinen und Stream-IO verwendet + werden! 'warte' zerstört alle Register! SHard muß davon ausgehen, + daß 'warte' seinerseits andere SHard-Komponenten aufruft. + + +Die Verwendung der 0-Routine 'warte' soll hier an einigen Beispielen verdeutlicht wer­ +den: + + + blockout auf platte : + WHILE platte noch nicht frei REP + warte + ENDREP ; + uebertrage schreibbefehl an controller ; + uebertrage daten an controller . + + blockin von platte : + WHILE platte noch nicht frei REP + warte + ENDREP ; + uebertrage lesebefehl an controller ; + WHILE daten noch nicht gelesen REP + warte + ENDREP ; + hole daten vom controller . + + + blockout auf floppy : + seekbefehl an controller ; + WHILE seek noch nicht fertig REP + warte + ENDREP ; + setze dma auf schreiben block zur floppy ; + schreibbefehl an controller ; + WHILE schreiben noch nicht fertig REP + warte + ENDREP . + + blockin von floppy : + seekbefehl an controller ; + WHILE seek noch nicht fertig REP + warte + ENDREP ; + setze dma auf lesen block von floppy ; + lesebefehl an controller ; + WHILE lesen noch nicht fertig REP + warte + ENDREP . + + + +#b("Block-IO bei Hintergrund und Archiv")##goalpage("bhgarch")# + +#ib#Hintergrund#ie# (Kanal 0) und #ib#Archiv#ie# (Kanal 31) unterscheiden sich in den Link-Bedingungen +nur in der Kanalnummer. Die Aufrufe von BLOCKIN und BLOCKOUT werden mit folgenden +Eingangsparametern versorgt: + + #on("b")#BLOCKIN#off("b")# d0 = 0 bzw. 31 + d1 = 0 + d2 = Blocknummer + a0 = Hauptspeicheradresse + + Der angegebene 512-Byte-Block ist in den Hauptspeicher ab + einzulesen. + + #on("b")#BLOCKOUT#off("b")# d0 = 0 bzw. 31 + d1 = 0 + d2 = Blocknummer + a0 = Hauptspeicheradresse + + Der Hauptspeicherbereich (... +511) ist auf den + angegebenen Block zu schreiben. + +Als Rückmeldungen sind zu liefern:#goalpage("errcod")# + + 0 Operation korrekt ausgeführt. + 1 Manuell behebbarer Fehler (z.B. Laufwerktür offen) + 2 Permanenter Fehler (z.B. Daten nicht lesbar) + 3 Versorgungsfehler (zu hohe Blocknummer) + + +#d("Fehlerwiederholung")#: Das EUMEL-System führt von sich aus Fehlerwiederholungen beim + Hintergrund- und beim Archivzugriff durch. SHard sollte deshalb + im Fehlerfall die Operation nicht selbst wiederholen, sondern einen + Lese/ Schreibfehler zurückmelden. So werden dem EUMEL-Sy­ + stem auch Soft-Errors gemeldet. In manchen Fällen soll vor + einem erneuten Lese- oder Schreibversuch der Arm auf Spur 0 + positioniert werden o.ä. Um das zu erreichen, sollte SHard diese + "Reparaturaktion" direkt im Anschluß an den fehlerhaften Versuch + durchführen. + +#d("Kontrollesen")#: Falls Kontrollesen (nach jedem Schreibzugriff) notwendig ist, muß das + allerdings vom SHard durchgeführt werden. In der Regel reicht es + dazu, den geschriebenen Block "ohne Datentransport" zu lesen, + + + + + + + + + + + + + + + + + + + + + +System verwendet nur positive Codes. Der SHard-Schreiber kann auch negative Codes +für Sonderzwecke vorsehen. + + + #d("IOCONTROL")# + + Eingang: d0 = Kanalnummer (0...32) + d1 = Funktionscode 1 + d2 = Funktionscode 2 + d3 = Funktionscode 3 + Ausgang: d1 = Rückmeldung + + Zweck: abhängig von 'Funktionscode 1' (s.u.) + +Das System verlangt folgende Informations- und Steuerleistungen über IOCONTROL: + + + #d("IOCONTROL ""typ""")# + + Eingang: d0 = Kanalnummer (0...31) + d1 = 1 + Ausgang: d1 = Kanaltyp + + Zweck: Informiert EUMEL-0, welche IO für den angegebenen Kanal + sinnvoll ist. Die Rückmeldung in d1 wird bitweise interpretiert: + + Bit 0 gesetzt  <=> 'inputinterrupt' kann kommen. + Bit 1 gesetzt  <=> OUTPUT ist sinnvoll. + Bit 2 gesetzt  <=> BLOCKIN ist sinnvoll. + Bit 3 gesetzt  <=> BLOCKOUT ist sinnvoll. + Bit 4 gesetzt  <=> IOCONTROL "format" ist sinnvoll. + + Hinweis: #on("i")#Trotz dieser Informationsmöglichkeit wird nicht garantiert, daß nur + sinnvolle Operationen für den Kanal aufgerufen werden.#off("i")# + + + #d("IOCONTROL ""frout""")##goalpage("frout")# + + Eingang: d0 = Kanalnummer (1...15) + d1 = 2 + Ausgang: d1 = Anzahl Zeichen, die nächster OUTPUT übernimmt, bzw. + Anzahl der OUTCHAR-Aufrufe, deren Zeichen übernommen + wird. + + Zweck: Liefert Information über die Belegung des Puffers. Diese Informa­ + tion wird von EUMEL-0 zum Scheduling benutzt. + + Achtung: #on("i")#Wenn EUMEL-0 längere Zeit kein OUTPUT gemacht hat, muß + irgendwann d1 > 49 gemeldet werden.#off("i")# + + Hinweis: Unter Berücksichtigung des oben Gesagten darf "gelogen" werden. + Man kann z.B. immer 50 in d1 zurückmelden, muß dann aber + schlechtere Nutzung der CPU bei Multi-User-Systemen in Kauf + nehmen. + + Falls auf dem angegebenen Kanal ein Drucker mit eigenem Puffer + über Parallelschnittstelle angeschlossen ist (siehe S.#topage("druck")# ) und man + auf einen SHard-internen Puffer verzichtet hat, sollte bei 'Druk­ + kerpuffer voll' 0 in d1 zurückgemeldet werden. Wenn aber Zeichen + übernommen werden können, sollte 50 in d1 gemeldet werden + + Vorschlag: Falls der Kanal nicht existiert oder nicht für Stream-IO zur Verfü­ + gung steht, sollten 200 in d1 zurückgemeldet werden. + + + #d("IOCONTROL ""weiter""")##goalpage("weiter")# + + Eingang: d0 = Kanalnummer (1...15) + d1 = 4 + Ausgang: - + + Zweck: Das System ruft "weiter" für den in d0 angegebenen Kanal auf, + wenn es wieder Eingabezeichen puffern kann. (siehe auch: Fluß­ + kontrolle S.#topage("fluss")#) + + Hinweis: "weiter" wird von EUMEL-0 auch immer dann aufgerufen, wenn + ein Prozeß auf dem angegebenen Kanal auf Eingabe wartet und + keine Zeichen mehr gepuffert sind. Wenn der betroffene Kanal von + sich aus keine Interrupts erzeugt, kann SHard diesen Aufruf dazu + benutzen, den Kanal auf mögliche Eingabe abzufragen und ggfs. + das Eingabezeichen durch Aufruf von 'inputinterrupt' EUMEL-0 + zuzustellen. + #on("i")#Diese Betriebsart sollte nicht für normale Terminalkanäle eingesetzt + werden, weil sie die SV-Taste nur dann an EUMEL-0 zustellt, + wenn ein Prozeß auf diesem Kanal auf Eingabe wartet. Dadurch + wären aber CPU-intensive Endlosschleifen nicht normal abbrech­ + bar! #off("i")# + + + #d("IOCONTROL ""size""")# + + Eingang: d0 = Kanalnummer (0...31) + d1 = 5 + d2 = Schlüssel + Ausgang: d1 = Anzahl Blöcke + + Zweck: EUMEL-0 ruft 'size' auf, um die Anzahl Blöcke zu erfahren, die + ein Block-IO-Kanal verkraften kann (Größe von Hintergrund und + Archiven). Bei Archivlaufwerken, die meherere Formate bearbeiten + können, dient dieser Aufruf auch zum Einstellen des Formats für + die folgenden blockin/blockout-Operationen anhand des Schlüs­ + sels. + + Schlüssel: 0 Wenn möglich 'erkennend', sonst 'standard'. Im ersten Fall + erkennt SHard das Format der eingelegten Diskette und stellt + dieses ein. + + Die weiteren Schlüssel sind stets definierend: + + 1 5.25" 2D-40, Sektor 1..9, 512 Bytes + 2 5.25" 2D-80, Sektor 1..9, 512 Bytes + 3 5.25" HD-80, Sektor 1..15, 512 Bytes + 4 5.25" 1D-80, Sektor 1..9, 512 Bytes + 10 8" 1D-77, Sektor 0..15, 512 Bytes + 11 8" 2D-77, Sektor 0..15, 512 Bytes + 12 8" 1S-77, Sektor 1..26, 128 Bytes + 13 8" 1D-77, Sektor 1..26, 256 Bytes + 14 8" 2D-77, Sektor 1..16, 256 Bytes + + Hinweis: Bei Archiven wird 'size' aufgerufen, nachdem der Archivträger ein­ + gelegt wurde. D.h. SHard hat die Gelegenheit, die Größe anhand + des eingelegten Archivträgers zu bestimmen (z.B. ob single- oder + doublesided). + + Vorschlag: Diese Funktion sollte auf nicht vorhandenen und den Stream-IO- + Kanälen 0 liefern. Sie muß aber mindestens auf Kanal 0 (Hinter­ + grund) und Kanal 31 (Archiv) "echte" Werte liefern. + + Achtung: #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die + 0-Routine 'warte' aufgerufen werden.#off("i")# + + + #d("IOCONTROL ""format""")# + + Eingang: d0 = Kanalnummer (0...31) + d1 = 7 + d2 = Schlüssel + Ausgang: d1 = Fehlercode wie bei Archiv-BLOCKOUT (siehe S.#topage("errcod")#) + + Zweck: Dient zum Formatieren eines Mediums. Diese Funktion kann für + jeden Kanal leer implementiert sein ('rts'). Sie sollte aber "forma­ + tierend" (z.B. auf Kanal 31) arbeiten, falls auf diesem Kanal die + "typ"-Abfrage "Formatieren sinnvoll" liefert. Falls (bei Disketten­ + laufwerken) mehrere Formate möglich sind, bestimmt der Schlüssel + das gewünschte Format. + + Schlüssel: 0 Standardformat dieses Rechners + 1 5.25" 2D-40, Sektor 1..9, 512 Bytes + 2 5.25" 2D-80, Sektor 1..9, 512 Bytes + 3 5.25" HD-80, Sektor 1..15, 512 Bytes + 4 5.25" 1D-80, Sektor 1..9, 512 Bytes + 10 8" 1D-77, Sektor 0..15, 512 Bytes + 11 8" 2D-77, Sektor 0..15, 512 Bytes + 12 8" 1S-77, Sektor 1..26, 128 Bytes + 13 8" 1D-77, Sektor 1..26, 256 Bytes + 14 8" 2D-77, Sektor 1..16, 256 Bytes + + Hinweis: Falls für das Formatieren ein großer Speicherbereich benötigt wird, + sollte das Formatieren von Disketten besser in einem Boot-Dialog + vor dem Start von EUMEL-0 angeboten werden. Denn sonst + müßte der Pagingbereich unnötig eingeschränkt werden. + Man kann das Formatieren #on("i")#einer Spur#off("i")# CPU-intensiv implementie­ + ren (d.h. ohne DMA im Interrupts-Disabled-Modus), wenn man in + Kauf nimmt, daß alle anderen Tasks des EUMEL-Systems in + dieser Zeit "stehen". Dann sollte man aber nach jeder Spur + mehrmals die 0-Routine 'warte' aufrufen. + + Achtung: #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die + 0-Routine 'warte' aufgerufen werden.#off("i")# + + + +#b("Konfigurierung serieller Schnittstellen")##goalpage("v24")# + +Bei Kanälen, die hardwaremäßig auf #ib#serielle Schnittstellen#ie# (#ib# V.24#ie#) zurückgeführt werden, +sind in der Regel die Größen + + - #ib#Baudrate#ie# (..., 2400, 4800, 9600, ...) + - #ib#Zeichenlänge#ie# (7 Bits, 8 Bits) + - #ib#Parität#ie# (keine, gerade, ungerade) + +einstellbar. Dafür muß SHard die IOCONTROL-Funktionen "baud" und "bits" zur Verfü­ +gung stellen. Diese werden in zwei Modi benutzt: + + a) #on("b")#einstellend#off("b")# + Läuft der aufrufende EUMEL-Prozeß auf dem privilegierten Steuerkanal (d0 = 32), + wird der als Parameter mit übergebene #on("i")#adressierte Kanal#off("i")# auf die geforderten Werte + eingestellt, sofern das möglich ist. + + b) #on("b")#abfragend#off("b")# + Läuft der aufrufende EUMEL-Prozeß nicht auf Kanal 32 (d0 <> 32), wird lediglich + abgefragt, ob der #on("i")#adressierte Kanal#off("i")# auf die übergebenen Werte eingestellt werden + könnte. + +Aufgrund des zweiten Modus können die höheren EUMEL-Ebenen dem Anwender bei der +Konfigurierung mitteilen, welche Werte sich auf dem jeweiligen Kanal einstellen lassen. Das +nutzt z.B. das Standard-Konfigurationsprogramm aus. + +Hinweis: Bei einigen Kanälen (z.B. bei einem integrierten Terminal oder einer Parallel­ + schnittstelle) sind Baudrateneinstellungen sinnlos. Bei anderen können sie nur + hardwaremäßig vorgenommen werden (Jumper, Dip Switches). In allen diesen + Fällen muß SHard bei allen Einstellungen 'unmöglich' melden. (Standardmäßig + wird der Anwender bei der Einstellung seiner Konfiguration dann auch nicht + danach gefragt.) + + + #d("IOCONTROL ""baud""")# + + Eingang: d0 = eigener Kanal (1...15 / 32) + d1 = 8 + d2 = 0 + d3 = Schlüssel * 256 + adressierter Kanal + Ausgang: d1 = Rückmeldung (0 = ok, 1 = nicht möglich) + + Zweck: Wird diese Routine auf dem Steuerkanal (d0=32) aufgerufen, wird + die angegebene Baudrate für den durch Register d3(0..7) adres­ + sierten Kanal eingestellt, falls das möglich ist. Wird diese Routine + auf einem anderen Kanal als 32 aufgerufen, informiert sie den + Aufrufer lediglich, ob eine derartige Einstellung des adressierten + Kanals möglich wäre. + + Schlüssel: 1 50 Baud + 2 75 Baud + 3 110 Baud + 4 134.5 Baud + 5 150 Baud + 6 300 Baud + 7 600 Baud + 8 1200 Baud + 9 1800 Baud + 10 2400 Baud + 11 3600 Baud + 12 4800 Baud + 13 7200 Baud + 14 9600 Baud + 15 19200 Baud + 16 38400 Baud + + Anmerkung: In der Regel werden nicht alle Baudraten vom SHard unterstützt + werden. Bei V.24 Schnittstellen sollten aber mindestens 2400, + 4800 und 9600 Baud zur Verfügung stehen, besser auch 300, 600, + 1200 und 19200 Baud. + + Hinweis: Falls SHard-spezifisch weitere Baudraten implementiert werden + sollen, darf SHard hierfür negative Schlüsselwerte in d3(8..15) ver­ + geben. + + + #d("IOCONTROL ""bits""")# + + Eingang: d0 = eigener Kanal (1...15 / 32) + d1 = 9 + d2 = 0 + d3 = Schlüssel * 256 + adressierter Kanal + Ausgang: d1 = Rückmeldung (0 = ok, 1 = nicht möglich) + + Zweck: Wird diese Routine auf dem Steuerkanal (d0=32) aufgerufen, wird + die angegebene Zeichenlänge (Bits pro Zeichen) und Parität für + den durch Register d3(0..7) adressierten Kanal eingestellt, falls das + möglich ist. + Wird diese Routine auf einem anderen Kanal als 32 aufgerufen, + informiert sie den Aufrufer lediglich, ob eine derartige Einstellung + des adressierten Kanals möglich wäre. + + + Schlüssel: stop * 32 + par * 8 + (bit - 1) + + stop: 0 1 Stopbit + 1 1.5 Stopbits + 2 2 Stopbits + + par: 0 keine Parität + 1 ungerade Parität + 2 gerade Parität + + bit: 1...8 Bits pro Zeichen + + + Anmerkung: In der Regel werden nicht alle Kombinationen vom SHard unter­ + stützt werden. Bei V.24 Schnittstellen sollten aber möglichst 1 + Stopbit, 7 und 8 Bits pro Zeichen und alle drei Paritätseinstellun­ + gen zur Verfügung stehen. + + Hinweis: Falls SHard-spezifisch weitere Einstellungen implementiert werden + sollen, darf SHard hierfür negative Schlüsselwerte in d3(8..15) ver­ + geben. + + + +#b("Flußkontrolle")##goalpage("fluss")# + +Die stromorientierten Kanäle (1...15) werden nicht nur zum Anschluß schneller Geräte (wie +Terminals) verwendet, sondern auch, um langsame Geräte (wie Drucker) anzuschließen, die +die Daten u.U. nicht so schnell übernehmen können, wie sie der Rechner schickt. Dabei +ist auf eine geeignete Flußkontrolle zu achten (nicht schneller senden, als der Andere +empfangen kann). Dieses Problem stellt sich auch bei einer Rechner-Rechner-Kopplung. +Hier ist in der Regel sogar zweiseitige Flußkontrolle notwendig. + +Als Flußkontrolle ist die #ib#REQUEST TO SEND/CLEAR TO SEND#ie# Logik der V.24-Schnitt­ +stelle oder das #ib#XON/XOFF#ie#-Protokoll zu verwenden. Das Letztere kann auch bei Parallel­ +schnittstellen eingesetzt werden. + +Zur eingabeseitigen Flußkontrollsteuerung kann SHard die IOCONTROL-Funktionen +"stop" und "weiter" (siehe S.#topage("weiter")#) verwenden: + +Nach "stop" muß SHard weiter einlaufenden Input selbst zwischenpuffern oder auf der +V.24-Schnittstelle das Signal 'REQUEST TO SEND' wegnehmen bzw. XON senden. +Dadurch wird bei den meisten Fremdrechnern ein weiteres Senden unterbrochen, sofern +(im ersten Fall) das Signal 'REQUEST TO SEND' dort mit dem V.24-Eingang 'CLEAR TO +SEND' verbunden ist. Wird von EUMEL-0 "weiter" aufgerufen, so kann auf dem ent­ +sprechenden Kanal wieder empfangen werden (RTS setzen bzw. XON senden). + +Für die ausgabeseitige Flußkontrolle muß rechnerseitig ebenfalls das Signal 'CLEAR TO +SEND' bzw. der Empfang von XOFF berücksichtigt werden. Wenn an der Schnittstelle das +'CLEAR TO SEND' weggenommen wird, darf SHard keinen weiteren Output auf dieser +Schnittstelle machen, bis 'CLEAR TO SEND' wieder anliegt. Entsprechend muß der +Empfang von XOFF die Ausgabe anhalten und XON sie wieder starten. + +Bemerkung: Die meisten Systeme enthalten diese CTS-Funktion schon in ihrer Hard­ + ware, so daß im SHard dafür keine Vorkehrungen getroffen werden müs­ + sen. + + +Zur Einstellung der gewünschten Flußkontrolle eines Kanals dient die IOCONTROL- +Funktion "flow". Ähnlich wie "baud" und "bits" wirkt auch "flow" nur auf Kanal 32 #on("i")#ein­ +stellend#off("i")# und auf allen anderen Kanälen lediglich #on("i")#abfragend#off("i")#. + + + #d("IOCONTROL ""flow""")# + + Eingang: d0 = eigener Kanal (1...15 / 32) + d1 = 6 + d2 = 0 + d3 = Modus * 256 + adressierter Kanal + Ausgang: d1 = Rückmeldung (0 = ok, 1 = nicht möglich) + + Zweck: Wird diese Routine auf dem Steuerkanal (d0=32) aufgerufen, muß + sie den gewünschten Flußkontrollmodus für den adressierten Kanal + einstellen. + Dabei sind folgende Modi festgelegt: + + Modus = 0 Keine Flußkontrolle + Modus = 1 XON/XOFF (in beiden Richtungen) + Modus = 2 RTS/CTS (in beiden Richtungen) + Modus = 5 XON/XOFF (nur ausgabeseitig) + Modus = 6 RTS/CTS (nur ausgabeseitig) + Modus = 9 XON/XOFF (nur eingabeseitig) + Modus = 10 RTS/CTS (nur eingabeseitig) + + SHard wird hierdurch informiert, wie er auf "stop" und "weiter" + reagieren soll. Wenn keine Flußkontrolle gewünscht wird + (Modus=0), muß SHard "stop" und "weiter" ignorieren; bei + Modus=1 oder Modus=9 muß bei "stop" XOFF und bei "weiter" + XON geschickt werden; bei Modus=2 oder Modus=10 muß bei + "stop" das Signal RTS auf low und bei "weiter" wieder auf high + gesetzt werden. Mit "stop" ist hierbei das Unterschreiten des + Schwellwertes bei der Rückmeldung von + "inputinterrupt" gemeint. + + Bei Modus=1 oder Modus=5 müssen empfangene XON/XOFF­ + -Zeichen, bei Modus=2 oder Modus=6 das Signal CTS beachtet + werden. + + Wird diese Routine auf einem anderen Kanal als 32 aufgerufen, + informiert sie den Aufrufer lediglich, ob der geforderte Flußkontroll­ + modus auf dem adressierten Kanal einstellbar wäre. + + Hinweis: Falls SHard-spezifisch weitere Flußkontrollmodi implementiert + werden sollen, darf SHard hierfür negative Moduswerte in d3(8..15) + vergeben. + + "weiter" wird von EUMEL-0 sehr oft aufgerufen. Es + ist daher nicht sinnvoll, jedesmal XON zu senden, da dies die Gegenstelle + damit überfluten würde. SHard muß sich + merken, ob der Kanal im XOFF-Zustand ist und + nur dann bei "weiter" ein XON senden. + +#b("Kalender")##goalpage("kalender")# + +Die Datums- und Uhrzeitabfrage ist bei Rechnern mit eingebauter Uhr unnötig. EUMEL +holt sich Datum und Uhrzeit dann von SHard. + + #d("IOCONTROL ""calendar""")# + + Eingang: d1 = 10 + d2 = gewünschte Einheit (1=Minute, 2=Stunde, 3=Tag, + 4=Monat, 5=Jahr) + Ausgang: d1 = Rückmeldung + + Zweck: Erfragen von Datum und Uhrzeit. Falls keine Uhr vorhanden ist, + muß bei jedem Aufruf -1 zurückgemeldet werden, bei eingebauter + Uhr jeweils das Gewünschte (Minute: 0..59, Stunde: 0..23, Tag: + 1..31, Monat: 1..12, Jahr: 0..99). + + Hinweis: Die Uhr darf zwischen zwei Aufrufen umspringen. Die daraus re­ + sultierenden Probleme werden auf höheren Ebenen abgehandelt. + + + +#bb("6. SHard-","Interface Version")##goalpage("shdver")# + +Die #ib#Versionsnummer#ie# der Interface-Spezifikation, auf der SHard aufbaut, muß als +2-Byte-Konstante #ib#SHDVER#ie# in der SHard-Leiste stehen. Für das hier beschriebene +Interface muß sie den Wert 8 haben. + +So sind spätere Erweiterungen des SHard-Interfaces möglich, ohne daß alle SHard- +Moduln geändert werden müssen. + + + + +#bb("7. ","ID-Konstanten")##goalpage("ID")# + +SHard muß in der Leiste vier 2-Byte-Konstanten ablegen. Diese können von den höhe­ +ren Ebenen durch die ELAN-Prozedur + + INT PROC #ib#id#ie# (INT CONST no) + +abgefragt werden. Dabei werden id(0) bis id(3) von EUMEL-0 geliefert, während SHard in +der Leiste die Werte für id(4) bis id(7) zur Verfügung stellen muß: + + ID4 #ib#Lizenznummer#ie# des SHards *) +#foot# +#f#*) Dieser Wert muß mit der Nummer des Lizenzvertrags zwischen Implementierer und GMD übereinstimmen! +#a# +#end# + + ID5 #ib#Installationsnummer#ie# des EUMEL-Anwenders **) +#foot# +#f#**) Diese Nummer vergibt der Lizenznehmer an die von ihm belieferten Anwender. +#a# +#end# + + ID6 zur freien Verfügung + + ID7 zur freien Verfügung + + + + +#bb("8. ","Zusätzliche Leistungen")##goalpage("shdelan")# + +Will der SHard-Implementierer zusätzliche Leistungen anbieten, die mit den Standardope­ +rationen nicht möglich sind, kann er weitere Codes für BLOCKIN, BLOCKOUT und +IOCONTROL zur Verfügung stellen. Um Überdeckungen mit Codes zu vermeiden, die von +EUMEL-0 intern verwendet oder erst später eingeführt werden, darf SHard für zusätzliche +Leistungen nur negative Werte als 'Funktionscode 1' verwenden. + + +Zum Ansprechen der neuen Leistungen stehen die ELAN-Prozeduren #on("i")#'#ib#blockout#ie#', '#ib#blockin#ie#'#off("i")# +und #on("i")#'#ib#control#ie#'#off("i")# zur Verfügung. + +Ferner steht dem SHard ein Parameterkanal (32) zur Verfügung. Funktionen, die (im Multi­ +-User) nicht jeder Task zur Verfügung stehen dürfen, müssen über diesen Kanal 32 +abgewickelt werden und dürfen nur dort wirken. + + + PROC blockout (ROW 256 INT CONST para, (* --> a0 *) + INT CONST funktion1, (* --> d1 *) + funktion2, (* --> d2 *) + INT VAR antwort) (* <-- d1 *) + + PROC blockin (ROW 256 INT VAR para, (* --> a0 *) + INT CONST funktion1, (* --> d1 *) + funktion2, (* --> d2 *) + INT VAR antwort) (* <-- d1 *) + + PROC control (INT CONST funktion1, (* --> d1 *) + funktion2, (* --> d2 *) + funktion3, (* --> d3 *) + INT VAR antwort) (* <-- d1 *) + +Hinweis: Der SHard darf für 'funktion 1' (d1) zusätzlich zu den hier beschriebenen + Standardcodes nur negative Codes vereinbaren. + + +Beispiel: Gibt eine Task, die durch 'continue (x)' an Kanal 'x' hängt, den Befehl + + control (-7,1200,13,antwort), + + so wird IOCONTROL mit (d0='x', d1=-7, d2=1200, d3=13) aufgerufen. + Verläßt SHard 'control' mit d1 = 1, so enthält 'antwort' anschließend eine 1. + + +Hinweis: Um die zusätzlichen Leistungen dem Anwender einfach (und abgesichert) zur + Verfügung zu stellen, sollte man sie in ein ELAN-Paket einbetten und dieses + ebenfalls an die Anwender ausliefern. + + Beispiel: PACKET zusatz DEFINES fanfare, ... : + + PROC fanfare (INT CONST tonhoehe, dauer): + + IF dauer < 0 + THEN errorstop ("negative dauer") + ELIF tonhoehe < 16 + THEN errorstop ("infraschall") + ELIF tonhoehe > 20000 + THEN errorstop ("ultraschall") + ELSE control (-37, 20000 DIV tonhoehe, + dauer) + FI + + ENDPROC fanfare ; + + . . . + + + + +#bb("9. ","Spezialroutinen")##goalpage("ke")# + +Als Testhilfe und zur Fehlerdiagnose kann SHard in seine Routinen Kontrollereignisse ein­ +bauen. Das geschieht durch Aufruf der 0-Routine 'info'. Dieser EUMEL-Debugger wird +im Anhang A (siehe S.#topage("info")#) beschreiben. + + + #d("info")# (0-Routine) + + Aufruf: movl \#infomsg,(sp)- + jbsr info + lea 4(sp),sp ! restore stackpointer + . + . + infomsg: .asciz "text" + + Zweck: Info wird aufgerufen. Dabei wird 'text' zur Identifikation des Kon­ + trollereignisses ausgegeben. #on("i")#Hinter dem übergebenen Text muß + ein Byte /00 stehen (durch '.asciz' sichergestellt)!#off("i")# + + Hinweis: Bei Systemen "ohne Info" (nur solche dürfen an Anwender aus­ + geliefert werden) wird nur der Info-Text ausgegeben und + EUMEL-0 angehalten. + + Achtung: Da der Info selbst die hier beschriebenen Stream-IO-Routinen + benutzt, darf man ihn von diesen Routinen aus (inputinterrupt, + OUTPUT, OUTCHAR, IOCONTROL "frout", IOCONTROL "stop", + IOCONTROL "weiter") nicht aufrufen. Wenn die Ein-/Ausgabe auf + Terminal 1 interruptgetrieben läuft, dürfen die Interrupts beim Info­ + -Aufruf natürlich nicht gesperrt sein. + +#page# +#cc("Teil 4: ","Tips zur Portierung")##goalpage("tips")# + + +#b("Nullversion des SHards")##goalpage("0ver")# + + +Es wird empfohlen, zuerst eine "Nullversion" des SHard zu entwickeln, die möglichst +einfach aufgebaut und nicht auf Effizienz und vollständige Ausnutzung der Betriebsmittel +ausgerichtet sein sollte. Damit kann man rasch praktische Erfahrung gewinnen, die dann +den Entwurf und die Implementation des eigentlichen SHard erleichtert. Die Nullversion +sollte + + - nur die Kanäle 0 (Hintergrund), 1 (Terminal) und 31 (Archiv) behandeln, + + - keine Baudraten-, Zeichenlängen-, Paritäts- und Flußkontrolleinstellungen un­ + terstützen (immer 'nicht möglich' melden), + + - vorhandene (ROM-) Routinen möglichst nutzen, ohne sich um Unschönes wie + "busy wait" beim Disketten- bzw. Plattenzugriff zu grämen. + +Mit dieser Nullversion sollte man dann versuchen, EUMEL zu starten. Da der Hintergrund + keitsanforderungen an die Zeitangaben bei #on("i")#einzelnen#off("i")# Interrupts +höheren Ebenen) in das Archivlaufwerk einlegen und von dort laden. Der Vortest sollte +sich direkt nach dem Start folgendermaßen auf Terminal 1 melden: + + E U M E L - Vortest + + Terminals: 1, + RAM-Groesse (gesamt): ... KB + Pufferbereich: ... KB + Hintergrund-Speicher: ... KB + + Speichertest: ************ + +Man sollte während der ****-Ausgabe des Speichertests irgendein Zeichen eingeben. +Das EUMEL-System muß dann in das ausführliche Start-Menü überwechseln. (Andern­ +falls funktioniert die Eingabe nicht richtig!) + +Als nächstes sollte man versuchen, den Hintergrund vom Archiv aus zu laden. (Diese +Möglichkeit wird im Start-Menü angeboten.) Nach dem Ende dieser Operation wird der +EUMEL-Lauf automatisch beendet. Jetzt kann man das HG-Archiv aus dem Archivlauf­ +werk entfernen und das System neu starten. Dann sollte EUMEL-0 vom Hintergrund +geladen werden. + +Bei Problemen kann der "Info" (siehe S.#topage("info")#) hilfreich sein. Voraussetzung für seine +Verwendung ist aber, daß die Terminal-Ein-/Ausgabe schon funktioniert. + +Beim Start des EUMEL-Systems kann (wie im Systemhandbuch beschrieben) durch den +Konfigurationsdialog der Terminaltyp von Kanal 1 eingestellt werden. Falls das verwendete +Terminal in dieser Liste nicht aufgeführt wird und auch keinem der aufgeführten (in Bezug +auf die Steuercodes) gleicht, kann man z.B. + + - den neuen Terminaltyp an einem anderen EUMEL-Rechner verfügbar machen + (Umsetztabellen definieren) und per Archiv zum neuen Rechner tragen, + + - die notwendigen Umcodierungen per SHard durchführen. + +Diese Problematik entsteht bei Rechnern mit integriertem Terminal in der Regel nicht, weil +Steuerzeichen dort sowieso algorithmisch interpretiert werden müssen. In diesem Fall wird +man direkt die EUMEL-Codes als Grundlage wählen, so daß keine Umsetzungen erfor­ +derlich sind. + +Bei einer provisorischen Anpassung kann man auf Invers-Video ohne weiteres verzich­ +ten. + + +Im Gegensatz zu der Nullversion sollte man bei der eigentlichen SHard-Implementierung +darauf achten, die Möglichkeiten der Hardware effizient zu nutzen. Der Testverlauf ent­ +spricht dann wieder im wesentlichen dem oben beschriebenen Vorgang. + + + +#b("Typische Fehler")##goalpage("fehler")# + + + a) SHard-Routinen zerstören Registerinhalte bzw. sichern sie beim Interrupt nicht + vollständig. + + b) 'jbsr' bzw. 'rts' verändern den Stackpointer. + + c) Fehler bei der Interruptbehandlung führen zu Blockaden ("hängende Inter­ + rupts"). + + d) Cursorpositionierung außerhalb des Bildschirms bei einem internen Terminal + (Bildwiederholspeicher im Rechner) wird nicht abgefangen. Das führt dann zu + wildem Schreiben in den Hauptspeicher. + + e) 'warte' wird unerlaubt aufgerufen. ('warte' darf nur von BLOCKIN, BLOCKOUT, + IOCONTROL "size" und IOCONTROL "format" aus aufgerufen werden. Ferner + kann man 'warte' noch nicht beim Systemladen aufrufen!) + + f) OUTPUT-Verhaspler oder -Blockaden entstehen durch Fehlsynchronisation + zwischen dem Füllen des Ausgabepuffers durch die Routine OUTPUT und der + Interruptroutine, die den Puffer leert und ausgibt. + + g) IOCONTROL "frout" meldet in gewissen Situationen nie "mindestens 50 Zeichen + im Puffer frei" und "Puffer leer". Das kann schon im Vortest zu Output-Blok­ + kaden führen. + + h) Obwohl "frout" einen Wert größer als x meldet, nimmt "output" nicht alle x + Zeichen an. + + i) IOCONTROL "size" meldet falsche Werte. + + j) IOCONTROL verkraftet keine beliebigen (auch unsinnige) Werte. + + k) BLOCKIN bzw. BLOCKOUT geben die Kontrolle an das System zurück, bevor + alle Daten übertragen sind. (Sofort nach der Rückgabe geht EUMEL-0 davon + aus, daß der Puffer frei ist und anderweitig benutzt werden kann!) + + l) Die Stepping-Rate eines Plattencontrollers wird falsch eingestellt, beziehungs­ + weise die Platte wird nicht im 'buffered step mode' betrieben, obwohl sie be­ + schleunigend positionieren kann. Dadurch werden die Zugriffszeiten auf dem + Hintergrund unnötig verlangsamt. Man bedenke, daß man so einen Fehler leicht + übersieht, weil sich das System nicht fehlerhaft, sondern nur langsamer verhält. + Außerdem macht sich die Verlangsamung erst bemerkbar, wenn größere Teile + des Hintergrundes benutzt werden. + + m) Bei schnellem Zeichenempfang treten "Dreher" auf. Das deutet meistens auf + einen rekursiven Aufruf der 0-Routine 'inputinterrupt' hin. Dabei überholt dann + das zweite Zeichen das erste. + + n) Bei schnellem Zeichenempfang, speziell bei gleichzeitiger Ausgabe, gehen + Eingabezeichen verloren oder werden verfälscht. In der Regel ist das auf + Timingprobleme bei der Interruptbehandlung zurückzuführen. Interrupts gehen + verloren bzw. die Zeichen werden nicht schnell genug abgeholt. + + + + +#b("Effizienzprobleme")##goalpage("eff")# + + a) Bei #on("i")##on("b")#V.24- und Parallelschnittstellen#off("i")##off("b")# ist schlechter Durchsatz in der Regel auf + Fehlverhalten von "frout" zurückzuführen. Auch kostet es in Multi-User- + Systemen sehr viel, wenn OUTPUT immer nur ein Zeichen übernimmt. (Dann + läuft der ganze Apparat der EUMEL-0-Maschine für jedes Zeichen wieder an.) + + Besonders bei der Parallelschnittstelle achte man darauf, daß nicht durch un­ + glückliches Timing häufig Blockaden auftreten. So kann zu kurzes 'busy wait' auf + Freiwerden der Parallelschnittstelle dazu führen, daß jedes zweite Zeichen abge­ + lehnt wird, so daß OUTPUT faktisch zeichenweise arbeitet. Andererseits darf na­ + türlich 'busy wait' auch nicht auf Millisekunden ausgedehnt werden. + + + b) Wenn #on("i")##on("b")#Disketten ohne DMA#off("i")##off("b")# angeschlossen werden, kann man bei Single- + User-Systemen ohne weiteres 'busy wait' einsetzen, um nach dem Seek- + Vorgang auf den Block zu warten. Im Multi-User sollte das aber wenn irgend + möglich umgangen werden, da eine halbe Umdrehung immerhin ca. 100 ms + kostet. + Falls nur ein Endeinterrupt nach jeder Diskettenoperation zur Verfügung steht, + kann folgendes Verfahren günstig sein: + + seek befehl an controller ; + warten auf endeinterrupt ; + lesebefehl ohne datentransport auf sektor davor ; + warten auf endeinterrupt ; + lese oder schreib befehl auf adressierten sektor ; + cpu intensives warten und datentransport . + + Die Dummyoperation auf den Sektor vor dem adressierten dient dabei nur dazu, + ohne CPU-Belastung einen Zeitpunkt zu finden, wo man dem eigentlichen + Sektor möglichst nahe ist. Die Zeit, in der die CPU benötigt wird, sinkt damit auf + ca. 25 ms. Die Implementation dieses Algorithmus' ist aber nicht ganz einfach, + da die 0-Routine 'warte' wegen der verlangten kurzen Reaktionszeiten nicht + verwendet werden kann. Alle 'warte auf ...' müssen also durch Interrupts reali­ + siert werden: + + setze interrupt auf lesen davor ; + stosse seek an ; + REP + warte + UNTIL komplette operation beendet ENDREP . + + lesen davor : + setze interrupt auf eigentliche operation ; + stosse lesen davor an . + + eigentliche operation : + ignoriere fehler beim datentransport ; + stosse lesen oder schreiben an ; + REP + REP UNTIL bereit ENDREP ; + uebertrage ein byte + UNTIL alles uebertragen ENDREP ; + melde komplette operation beendet . + + + c) Bei der Ansteuerung von #on("i")##on("b")#Platten#off("b")##off("i")# sollte man darauf achten, daß die 0-Routi­ + ne 'warte' nicht öfter als notwendig aufgerufen wird. Sonst wird das Paging + zugunsten der CPU-intensiven Prozesse zu stark verlangsamt. Z.B. kann man + bei vielen Plattencontrollern auf eine eigene Seek-Phase verzichten: + + beginne seek ; beginne seek und lesen ; + REP REP + warte warte + UNTIL fertig PER ; UNTIL fertig PER + beginne lesen ; + REP + warte + UNTIL fertig PER + + Hier braucht die linke Fassung immer mindestens ein 'warte' mehr als die + rechte. Bei starker CPU Belastung wird sie deshalb bis zu 100 ms länger für das + Einlesen eines Blocks benötigen. + + Eine ähnliche Situation kann auftreten, wenn die Platte in 256-Byte-Sektoren + unterteilt ist, so daß zu jedem EUMEL-Block zwei Sektoren gehören. Wenn + möglich sollte dann zwischen diesen beiden Sektoren kein 'warte' aufgerufen + werden. Andererseits darf natürlich auch nicht längere Zeit CPU-intensiv ge­ + wartet werden. Evtl. lohnt es sich in solchem Fall, mit der Sektorverschränkung + zu experimentieren. + +#page# +#cc("Anhang A: EUMEL-","Debugger ""Info""")##goalpage("info")# + + +Für interne Testzwecke gibt es den "Info". Systeme "mit Info" und "ohne Info" unter­ +scheiden sich nur im EUMEL-0-Teil (Systemkern). Der SHard-Implementierer erhält +zum Test Hintergründe "mit Info" und zur Auslieferung solche "ohne Info". Infofähige +Systeme dürfen nur von den SHard-Implementierern verwendet werden. + + #on("i")##on("b")#Achtung: Infofähige Systeme dürfen auf keinen Fall an Anwender ausgeliefert werden, + da vermittels Info alle Systemsicherungs- und Datenschutzmaßnahmen un­ + terlaufen werden können.#off("i")##off("b")# *) +#foot# +#f#*) Ausnahmen von dieser Regel bedürfen der expliziten Zustimmung der EUMEL-Systemgruppe (GMD bzw. HRZ +Bielefeld) und des jeweiligen Anwenders. Solche System müssen immer durch spezielle Schlüsselworte abgesichert +werden. +#a# +#end# + + + +#b("Aufruf des Info")##goalpage("aufrinf")# + +Zum Aufruf des Infos gibt es drei Möglichkeiten: + + a) Beim Start des EUMEL-Systems geht man durch Eingabe eines beliebigen Zei­ + chens während des Vortests in den ausführlichen Start-Dialog. Durch Eingabe + von 'I' gelangt man dann in den Info-Modus. #on("i")#(Diese Möglichkeit wird in dem + Startmenü nicht aufgeführt.)#off("i")# + + b) Man kann den Info durch die ELAN-Prozedur 'ke' aufrufen. D.h. wenn das + System gestartet wurde und sich eine Task am Terminal mit "gib kommando" + gemeldet hat, kann man durch 'ke *return*' in den Info-Modus gelangen. + + c) Wenn sich am Terminal keine Task befindet, die auf Eingabe wartet, gelangt man + durch die Tastenfolge 'i *info*' (*info* meist = CTL d, zur Tastendefinition siehe + "Systemhandbuch, Konfigurierung") in den Info-Modus. + +Alle diese Möglichkeiten funktionieren nur bei infofähigen Systemen. + +Bei schweren Systemfehlern, die eine Weitermeldung an die höheren Ebenen des +EUMEL-Systems unmöglich machen, wird soweit möglich ebenfalls der Info aufgerufen. +Bei Systemen "ohne Info" wird lediglich eine Meldung auf Kanal 1 ausgegeben und das +System angehalten. + + + +#b("Info-Format")##goalpage("forminf")# + +Der Info ist bildschirmorientiert. Beim Aufruf des Infos und nach den meisten Info-Kom­ +mandos werden die zwei obersten Zeilen wie folgt aufgebaut: *) +#foot# +#f#*) Bildschirmgetreues Verhalten kann der Info allerdings erst nach der Konfigurierung des Kanals zeigen. Vorher (d.h. +insbesondere beim Aufruf aus dem Vortest heraus) werden Cursorpositionierungen in der Regel nicht korrekt durchge­ +führt. +#a# +#end# + +Mini: nnnn text eeee +Maxi: xxxx + + +wobei + + #on("b")#nnnn#off("b")# den Miniprozeß bezeichnet, der den Übergang in den Info veranlaßt hat: INTER + (Interpreter), LADER, MUELL (Müllabfuhr) oder ARCHIV, + + #on("b")#xxxx#off("b")# den Maxiprozeß (Task) bezeichnet, der gerade durch den Elan-Prozessor + bearbeitet wird (xxxx ist code (tasknummer + code ("0"))), + + #on("b")#text#off("b")# den Grund für den Info-Modus anzeigt und + + #on("b")#eeee#off("b")# eine interne, nur den EUMEL-0-Entwickler interessierende Fehlernummer + ist. + +In der untersten Zeile erscheint (hinter der Angabe des evtl. angezeigten Datenraumes, der +Adresse und der Länge) die Eingabeaufforderung 'info:'. + + + +#b("Info-Kommandos")##goalpage("cmdinf")# + +Info-Kommandos können in der 'info:'-Zeile mit dem Format + + [] + +gegeben werden oder, wenn der Cursor sich im Dump befindet, mit dem Format + + + +wobei dann für die der Cursorposition entsprechende Dumpadresse (modulo +2**16) gesetzt wird (siehe '*cup*'). + + ist immer in Hexaform einzugeben. + +'g' Der Info-Modus wird wieder verlassen. Dies ist allerdings bei harten Fehlern ge + sperrt. + +'z' Der Leitblock des angezeigten Maxiprozesses wird dargestellt. (Nur im Miniprozeß + INTER.) + +'s' Dumps werden auf den Datenraum eingestellt (s:=). Auch der + Realspeicher kann hiermit in verschiedenen Modi eingestellt werden: + + 1s Programmspeicher (absolute Adressen) + ffs Tabellenspeicher (relativ zum Tabellenanfang) + +'l' Dumps werden auf die Länge eingestellt. Desungeachtet kann man einen + versehentlich zu langen Dump durch eine beliebige Eingabe abbrechen. Dann wird + allerdings '*cup*' gesperrt (siehe unten). + +'p' Dumps werden auf die Byteadresse eingestellt (p:= ; wmodus:= + FALSE). + +'w' Dumps werden auf die Wortadresse eingestellt. Die vor jeder Dumpzeile + ausgegebene Adresse ist dann auch eine Wortadresse. Ein Wort = 2 Bytes + (p:=2*; wmodus:=TRUE). + +'k' Block laden und per Dump anzeigen. Es erfolgt dabei eine Umstellung auf + den Realdatenraum (s:=/ff). + +'x' Suchen nach Bytekette: + +--> xctext +--> xhxx xx ... +--> x + + Es wird nach 'text' bzw. Hexafolge 'xx xx ...' bzw. nach der durch das letzte + 'x'-Kommando eingestellten Bytekette gesucht. + Das Kommando ist durch *return* abzuschließen. + Die Suche beginnt ab Position 'p' und ist auf die Länge Seiten (512 + Byte-Einheiten) begrenzt (0=unendlich). + Eine beliebige Eingabe bricht die Suche vorzeitig ab. + +'*return*' + Es wird der eingestellte Dump ausgegeben (siehe 's', 'l', 'p', 'w'). Bei wmodus + (siehe 'p', 'w') werden Wortadressen ausgegeben. + +'o' Wie '*return*', jedoch wird zuvor p := p+l gesetzt (zum Weiterblättern). + + +'*cup*' *) (Cursor up). Umschaltung in den Modus zum Ändern in Dumps. +#foot# +#f#*) Falls der Kanal noch nicht konfiguriert ist, muß man natürlich eine Taste betätigen, die den EUMEL-Code für +Cursor Up erzeugt. In der Regel ist das CTL c. Falls das Terminal ohne Konfigurierung keine Cursorpositionierungen +durchführt, ist dieser Modus nicht sehr gut benutzbar. +#a# +#end# + Der Cursor fährt in den Dump und kann mit den Cursortasten dort bewegt werden. + Wird eine Hexazahl jetzt eingegeben, so wird diese als Inhalt des Bytes eingetra­ + gen, auf dem der Cursor gerade steht. Dies funktioniert auch auf beliebigen Da­ + tenräumen. Info beantragt dann bei der Speicherverwaltung einen Schreibzugriff für + die entsprechende Datenraumseite, so daß Änderungen mit der Copy-on- + Write-Logik erfolgen, also nur taskspezifisch sind. Für diese Task sind die Ände­ + rungen allerdings dann permanent, da sie auch auf den Hintergrund wirken. + + Hinweis: Dumpt man mit 'k' einen Block und ändert dann darin, so sind diese + Änderungen u.U. nur temporär, da der Info kein Rückschreiben des + Blockes veranlaßt. + + Achtung: Jede Eingabe, die kein Positionierzeichen und kein gültiges Zahlzeichen + ist, beendet diesen Modus. Das neue Zeichen wird als Info-Komman­ + do aufgefaßt, wobei auf die aktuelle Adresse gesetzt wird. + Somit wird dieser Änderungsmodus üblicherweise durch *return* been­ + det. + + + +#b("Einige Systemadressen")##goalpage("sysaddr")# + +Der Info nützt nur wenig, wenn man nicht weiß, was man sich anschauen soll. Wesentliche +Angaben über die Systemstruktur enthält das 'Brikett' (interne Systemdokumentation für +Projekt Mikros der GMD). Da diese etwas allgemeiner gehalten ist, geht sie nicht auf +implementationsabhängige Konstanten ein. Diese sind hier aufgeführt. + +Der Tabellenspeicher der EUMEL-0-Maschine wird relativ zu M0START angelegt. Im Info +kann der Tabellenspeicher durch die Datenraumangabe ffs adressiert werden, z.B. wird +durch das Kommando ffs1000p der Anfang der 'ktab' gezeigt. + +Ab /1000 liegt die 'ktab'. Sie enthält Informationen, welche Blöcke an welcher Stelle des +Arbeitsspeichers liegen: In der Kachel mit der Adresse /a000+/200*i befindet sich der +Inhalt des Blockes, dessen Nummer in steht. Ferner enthält die Tabelle, zu +welchem Datenraum (drid) und welcher Seite des Datenraums der Inhalt gehört. (Nur +relevant, wenn die Prozeßnummer <> /ff ist). + + ktab: + + /1000 Blocknummern (je 2 Bytes) + /2000 Prozeßnummern (je 1 Byte) + /2800 drid's (prozeßspezifisch, je 1 Byte) + /3000 Seitennummern (je 2 Bytes) + /4000 Steuerbits (je 1 Byte): + + 2**0: Inhalt wird gerade transportiert (zum HG oder Archiv). + 2**1: Inhalt ist identisch mit Inhalt auf HG. Wird beim Schreiben auf die + Kachel (per Software) zurückgesetzt. + 2**2: Schreiberlaubnis (siehe Brikett). + 2**3: Inhalt wurde kürzlich benutzt. Solche Kacheln werden 'weniger + stark' verdrängt. + + + +/5d50 enthält den 'Laderpool'. Es handelt sich um Blocknummern von zu ladenden + Blöcken. Ist der höherwertige Teil der Blocknummer gleich /fd, so ist dies keine + Anforderung. + + Blocknummern > /ff00 stehen für Blöcke mit dem Inhalt 512mal /ff und werden + nie auf dem Hintergrundmedium gespeichert. + + + +/0 enthält den DR-Eintrag des drdr (siehe Brikett). + + + + +/5c00.../5cff: + enthält die Aktivierungstabelle. Ist (/5c00+i)=/01, so ist die Task i aktiv. Hin­ + weis: /5cff enthält immer /01, ohne daß dieser Zelle eine Task zugeordnet ist. + + + +#b("Leitblock")##goalpage("pcb")# + +Mit dem 'z'-Kommando wird der Leitblock einer Task dargestellt. Die einzelnen Einträge, +die voneinander durch je 2 Blanks getrennt sind, haben die Form + Bezeichnung=Wert +wobei Wert in hexadezimaler Form angegeben ist. In der folgenden Beschreibung steht x, +y und z für irgendeine Hexadezimalziffer. + + ic=0xxxxx Der virtuelle Befehlszähler der Task zeigt auf /xxxxx im Datenraum 4 + dieser Task. Durch die Eingabefolge: + 4sw*return* + kann man sich den Code, der ausgeführt werden soll, ansehen. + + flags=xxyy Bit /80 von yy zeigt den Fehlerzustand an. + Bit /40 von yy zeigt 'disable stop' (siehe Benutzerhandbuch) an. + Bit /10 von yy zeigt vorzeichenlose Arithmetik an (Compilierung). + + lbas=xxxx Die lokale Basis steht auf /1xxxx im Datenraum 4 (Wortadresse). + + pbas=xx Die Paketbasis steht auf /xx00 im Datenraum 4 (Wortadresse). + + hptop=xyz3 Der Arbeitsheap geht von /30000 (Byteadresse!) bis /3xyz0 (Byte­ + adresse!). + + chan=xx Die Task hängt an Kanal /xx (Terminalnummer). + 0 <==> kein Terminal angekoppelt. + + task=xxyy,zzzz Die Tasknummer der betrachteten Task ist /yy. /xx ist die Stations­ + nummer im EUMEL-Netz, /zzzz ist die Versionsnummer zum + Abdichten von 'send'/ 'wait'. + +Um den Code, auf den der 'ic' zeigt, zu interpretieren, ziehe man das Brikett zu Rate. +#page# +#cc("Anhang B: Einige ","EUMEL-Begriffe")##goalpage("glossar")# + + +#on("bold")#Archiv:#off("bold")# + + Medium (z.B. Diskette, Band, Kassette) zur Speicherung von Datenräumen (Pro­ + grammen, Daten und Dateien) einer oder mehrerer Tasks außerhalb eines + EUMEL-Systems zum Zwecke der Aufbewahrung oder des Datenaustauschs. + + Auch ein ganzer EUMEL-Hintergrund kann (durch 'save system') auf Archiv (z.B. auf + eine oder mehrere Disketten) geschrieben werden. Ein solches "Hintergrundarchiv" + kann dann zur Erzeugung eines EUMEL-Hintergrundes (im Vortest) dienen. + + +#on("bold")#Archivsystem:#off("bold")# + + Programmsystem zur Übertragung von Datenräumen zwischen Archiv und Hinter­ + grund. + + +#on("bold")#EUMEL-0 (EUMEL-0-Maschine, Systemkern):#off("bold")# + + Softwareschicht, aufbauend auf die hardwareabhängige Schicht SHard. EUMEL-0 ist + nur vom Prozessor, nicht aber von der jeweiligen Rechnerkonfiguration abhängig. Die + durch EUMEL-0 definierte Schnittstelle zu höheren (in ELAN implementierten) + Schichten ist auf allen EUMEL-Systemen identisch. EUMEL-0 wird auf dem + EUMEL-Hintergrundarchiv angeliefert. + + +#on("bold")#Hintergrund (EUMEL-Hintergrund, HG):#off("bold")# + + 1. Medium (z.B. Platte, Diskette, RAM) zur Speicherung von Datenräumen (Pro­ + grammen, Daten und Dateien) aller Tasks eines EUMEL-Systems; + 2. Die Gesamtheit der auf diesem Medium gespeicherten Information. + + Die Bezeichnung "Hintergrund" ist im Zusammenhang mit dem Konzept des im + EUMEL realisierten Virtuellen Speichers zu sehen. Der Datentransfer zwischen Hin­ + tergrund und Arbeitsspeicher (RAM) erfolgt ohne Zutun oder Wissen des EUMEL- + Benutzers bzw. der Task, der die Daten gehören. + diff --git a/doc/porting-mc68k/1985.11.26/source-disk b/doc/porting-mc68k/1985.11.26/source-disk new file mode 100644 index 0000000..bf86ccf --- /dev/null +++ b/doc/porting-mc68k/1985.11.26/source-disk @@ -0,0 +1 @@ +porting/portdoc-m68k_eumel-netz-1985-11-26.img diff --git a/doc/porting-z80/8/doc/Port.Z80 b/doc/porting-z80/8/doc/Port.Z80 new file mode 100644 index 0000000..ed3c80a --- /dev/null +++ b/doc/porting-z80/8/doc/Port.Z80 @@ -0,0 +1,2484 @@ +#type ("trium8")##limit (12.0)# +#pagelength(19.5)# +#start(1.5,1.5)# +#type("triumb36")# +#free(4.0)# + EUMEL + Portierungshandbuch + Z 80 +#type("triumb18")# +#free(1.5)# + Version 8 #page(1)# +#type ("trium8")##limit (12.0)# +#block# +#pagelength(19.5)# +#head# +#center#- % - + + +#end# +#type("triumb14")#Inhalt#a# + +Teil 1: Einführung #topage("ein")# +#free(0.3)# + Zweck dieses Handbuchs #topage("zweck")# + Referenzliteratur #topage("reflit")# + Minimale Hardwarevoraussetzungen #topage("hardw")# + Systemdurchsatz #topage("durchsatz")# + Softwarekomponenten des EUMEL-Systems #topage("kompo")# + Anlieferung des Z80-EUMEL-Systems #topage("anlief")# + +Teil 2: Allgemeine Strukturen #topage("allgem")# +#free(0.3)# + Hintergrund #topage("hg")# + Archiv #topage("arch")# + Hauptspeicher #topage("speicher")# + +Teil 3: SHard-Interface Spezifikation #topage("shardifc")# +#free(0.3)# + 0. Vorbemerkungen #topage("vor")# + Zur Notation #topage("not")# + Link-Leisten #topage("leist")# + Allgemeine Link-Bedingungen #topage("link")# + Interrupts #topage("intr")# + 1. System laden #topage("laden")# + 2. Systemstart und -ende #topage("start")# + 3. Speicherverwaltung #topage("spver")# + Hauptspeicher #topage("haupt")# + Schattenspeicher #topage("schatt")# + Blocktransfer im Speicher #topage("ldir")# + Speicherfehler #topage("memerr")# + 4. Zeitgeber #topage("zeit")# + 5. Kanäle #topage("channel")# + 5.1 Stream-IO #topage("stream")# + Terminals #topage("term")# + Drucker, Plotter #topage("druck")# + Exoten #topage("exot")# + 5.2 Block-IO #topage("block")# + Block-IO bei Hintergrund und Archiv #topage("bhgarch")# + 5.3 IO-Steuerung #topage("iocontrol")# + Einstellung serieller Schnittstellen #topage("v24")# + Flußkontrolle #topage("fluss")# + Kalender #topage("kalender")# + 6. SHard-Interface Version #topage("shdver")# + 7. ID-Konstanten #topage("ID")# + 8. Zusätzliche Leistungen #topage("shdelan")# + 9. Spezialroutinen #topage("ke")# + +Teil 4: Tips zur Portierung #topage("tips")# + 0-Version des SHards #topage("0ver")# + Effizienzprobleme #topage("eff")# + Typische Fehler #topage("fehler")# + +Anhang A: EUMEL-Debugger "Info" #topage("info")# +#free(0.3)# + Aufruf des Infos #topage("aufrinf")# + Info-Format #topage("forminf")# + Info-Kommandos #topage("cmdinf")# + Einige Systemadressen #topage("sysaddr")# + Leitblock #topage("pcb")# +#page# +#cc("Teil 1: ","Einführung")# +#goalpage("ein")# + + +#b("Zweck dieses Handbuchs")# +#goalpage("zweck")# + +Dieses Portierungshandbuch wendet sich an diejenigen, die das EUMEL-System auf einem +neuen Rechnertyp implementieren wollen. Es ist Teil einer Serie von Portierungshandbüchern +für verschiedene Prozessortypen. Dieses bezieht sich auf Rechner mit Z80-Prozessoren. + +Zum Betrieb eines EUMEL-Systems wird dieses Handbuch nicht benötigt! + + + +#b("Referenzliteratur")# +#goalpage("reflit")# + + + "EUMEL Benutzerhandbuch" + + "EUMEL Systemhandbuch" + + "EUMEL Quellcode der insertieren ELAN-Pakete" + + "Z80-Assembly Language Programming Manual" + Zilog, 1977 + + + +#b("Minimale Hardwarevoraussetzungen")# +#goalpage("hardw")# + +Um das EUMEL-System effizient einsetzen zu können, sollte die Hardware mindestens +folgenden Kriterien genügen: + + #ib#CPU#ie# Die Z80-CPU sollte mit mindestens 2.5 MHz arbeiten. Falls + die Buszugriffe durch einen CRTC o.ä. verlangsamt werden, + sollte die echte Z80-Leistung durchschnittlich mindestens + einem ungebremsten 2.5 MHz System entsprechen. + Seltene Verlangsamungen (z.B. nur bei I/O-Operationen) + spielen bei diesen Überlegungen keine Rolle. + + RAM Das System sollte über mindestens 64 K Byte #ib#Hauptspeicher#ie# + verfügen, besser sind 128 K als Anfangsausrüstung. + + #ib#Hintergrund#ie# Als Hintergrundmedium sind #ib#Floppy#ie#, #ib#Harddisk#ie# und RAM bzw. + ROM denkbar. + + Kapazität: > 300 K, besser > 400 K (Single-User) + > 750 K, besser > 1000 K (Multi-User) + + Zugriff: < 500 ms (Single-User) + < 200 ms (Multi-User) *) +#foot# +#f#*) Hier ist die durchschnittliche Zugriffszeit auf einen 512 Byte großen Block gemeint. Für Platten und Floppies kann man +sie als Summe der Positionierzeit über die halbe Platte und der Zeit einer halben Umdrehung berechnen.#a# +#end# + + #ib#Archiv#ie# Als Archivgerät wird meistens eine Floppy eingesetzt. Aber + auch Band oder Kassettenrecorder sind denkbar. Die An­ + forderungen an Kapazität und Geschwindigkeit sind anwen­ + dungsspezifisch. + + #ib#Bildschirm#ie# Angestrebt werden sollte ein Bildschirm mit 24 Zeilen mit je + 80 Zeichen (oder größer). Kleinere Bildschirme sind anschließ­ + bar, aber mit 40 Zeichen pro Zeile läßt sich nicht mehr kom­ + fortabel arbeiten. + Rollup und freie Cursorpositionierung sind notwendige Vor­ + aussetzungen, invers-video ist erwünscht, aber nicht not­ + wendig. Weiterhin werden 'Löschen bis Zeilenende' und + 'Löschen bis Schirmende' benötigt. Lokale Editierfunktionen + sind überflüssig. + + #ib#Tastatur#ie# An Steuertasten sollten mindestens ESC und die vier Cursor­ + tasten vorhanden sein. Dabei ist es günstig, wenn die Cursor­ + tasten ergonomisch als Block bzw. Kreuz angeordnet sind. + EUMEL benötigt weitere Steuertasten für HOP, RUBIN, + RUBOUT und MARK. Dafür können beliebige Tasten der + Tastatur gewählt werden. + + + +#b("Systemdurchsatz")# +#goalpage("durchsatz")# + +Da das EUMEL-System auf dem Prinzip des Demand Paging aufbaut, hängt der System­ +durchsatz von + + - CPU Leistung + - Speichergröße (RAM) + - Geschwindigkeit beim Hintergrundzugriff (Floppy, Harddisk) + +ab. Mit zunehmender Benutzerzahl steigen in der Regel die Anforderungen an das Paging +(Hintergrund-Zugriff) schneller als an die CPU. In diesem Bereich kann man die System­ +leistung dann durch mehr Speicher und/oder eine schnellere Platte in größerem Umfang +steigern. Dabei läßt sich eine langsame Platte teilweise durch mehr RAM und umgekehrt +wenig RAM durch eine schnelle Platte ausgleichen. + + + +#b("Softwarekomponenten des EUMEL-Systems")# +#goalpage("kompo")# + +Das EUMEL-System besteht aus mehreren Schichten: + + + + EUMEL  2: Standardpakete, Editor, ... + + EUMEL  1: ELAN Compiler + + EUMEL  0: Basismaschine + + EUMEL -1: SHard + + H a r d w a r e + + +Dieses #ib#Schichtenmodell#ie# ist nach oben offen und kann deshalb um beliebig viele (höhere) +Schichten erweitert werden. + +EUMEL > 0 Die Standardsoftware der Schichten > 0 ist in der Sprache ELAN geschrie­ + ben (siehe "EUMEL Quellcode"). Dementsprechend sind alle Schichten ober­ + halb der EUMEL-0-Maschine prozessor- und rechnerunabhängig, d.h. + Anpassungen an einen neuen Rechnertyp sind nicht erforderlich. + +#ib#EUMEL 0#ie# Die sogenannte "EUMEL-0-Maschine" enthält alle Basisoperationen und + hängt davon ab, welchen Prozessortyp der Rechner als CPU verwendet. Sie + existiert für verschiedene Prozessortypen. Hier wird nur auf den Typ Z80 + Bezug genommen. Bei der Portierung auf einen Z80-Rechner wird die + Z80-EUMEL-0-Maschine ohne Anpassungen (!) übernommen. + +EUMEL -1 Diese Schicht stellt das Interface zwischen der EUMEL-0-Maschine und der + eigentlichen Hardware (vom Prozessor abgesehen) dar. Insbesondere umfaßt + sie alle Routinen zur Ansteuerung peripherer Geräte (Gerätetreiber). + Diese Schicht wird "SHard" genannt ("S"oftware-"Hard"ware Interface). + +Der SHard ist der einzige Teil des Systems, der bei der Portierung auf einen Z80-Rech­ +ner angepaßt bzw. neu geschrieben werden muß. Deshalb besteht der größte Teil dieses +Handbuchs aus der Spezifikation des Z80-SHards. + + + +#b("Anlieferung des Z80-EUMEL-Systems")# +#goalpage("anlief")# + +Der Implementierer erhält die EUMEL-Software auf Disketten. Dabei stehen folgende Stan­ +dardformate zur Wahl: + + 8", 1D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte + + 8", 2D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte + + 5", 2D, 40 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte *) +#foot# +#f#*) 48 tpi#a# +#end# + + +Die Diskettenlieferung enthält + + - Single-User Hintergrund + - Multi-User Hintergrund + - Standardarchive + - Archive mit weiterer Anwendersoftware + +Dabei enthält der Hintergrund auch die EUMEL-0-Software (oft auch als "Urlader" be­ +zeichnet). + +#on("i")#Bitte gehen Sie vorsichtig mit diesen Mutterdisketten um. Verwenden Sie sie nur als Quelle +beim Kopieren. Sie sollten nur auf Kopien davon arbeiten!#off("i")# +#page# +#cc("Teil 2: ","Allgemeine Strukturen")# +#goalpage("allgem")# + + +#b("Hintergrund")# +#goalpage("hg")# + +Der Hintergrund ist in 512 Bytes große Blöcke unterteilt. Sie werden durch Blocknummern (0, +1, 2, ...) adressiert. Die physische Ablage der Blöcke auf dem Hintergrundmedium bleibt dem +SHard überlassen. Er kann sie z.B. linear oder versetzt anordnen. Man sollte darauf achten, +daß Positionierungen auf logisch "nahe" Blöcke möglichst schnell gehen sollten. Deshalb ist +in der Regel zylinderorientierte Anordnung der oberflächenorientierten vorzuziehen. + +Falls auf dem Hintergrundgerät spezielle Blöcke z.B. für Boot und SHard freigehalten werden +sollen, muß das bei der Abbildung der Hintergrundblocknummern auf die Sektoren der Floppy +bzw. der Harddisk berücksichtigt werden. + +Aufbau des Hintergrundes: + + Block 0 Systemetikett + + Block 10...10+k-1 EUMEL-0-Software (Urlader) + + Block 1...9, 10+k ... Paging-Bereich + + +Aufbau des #ib#Systemetikett#ie#s (#ib#Block 0#ie#): + + Byte Wert/Aufgabe + + 0...5 "EUMEL-"; Kennzeichen für EUMEL-Hintergrund. + 6...11 Versionsnummer in druckbaren Zeichen. Sie stellt sicher, daß Urlader und + Hintergrund kompatibel sind. + 12 FFh ; zur Zeit ohne Bedeutung + 13 enthält Wert 0 , wenn System im Shutupzustand ist. + 14..15 Systemlaufzähler (14=low, 15=high). Wird bei jedem Systemstart um 1 + erhöht. + 16..35 Reserviert; zur Zeit ohne Bedeutung + 36..37 Aus historischen Gründen für interne Zwecke belegt. + 38 .. 69 Hier kann eine Installationsnummer geführt werden. + 70 .. 79 Info-Paßwort + 80 =0 Normalzustand + =1 Kompresslauf erforderlich (System frisch von Archiv geladen) + 81...255 Reserviert. + 256..511 Kann von SHard beliebig verwendet werden. + + + +#b("Archiv")# +#goalpage("arch")# + +Wie der Hintergrund sind die Archive in 512 Bytes große Blöcke unterteilt. Bisher gibt es +folgende #dx("Standardformate")#: + + + 8", 1D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte + 8", 2D, 77 Spuren, 16 Sektoren (\#0...\#15) � 512 Byte + + Block Seite Spur Sektor + + 0 0 0 0 + 16 0 1 0 + 77*16 1 0 0 + + n n DIV (77*16) n MOD (77*16) DIV 16 n MOD 16 + + + 5", 2D, 40 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte + + Block Seite Spur Sektor + + 0 0 0 1 + 9 0 1 1 + 40*9 1 0 1 + + n n DIV (40*9) n MOD (40*9) DIV 9 n MOD 9 + 1 + + + 5", 2D, 80 Spuren, 9 Sektoren (\#1...\#9) � 512 Byte + + Block Seite Spur Sektor + + 0 0 0 1 + 9 0 1 1 + 80*9 1 0 1 + + n n DIV (80*9) n MOD (80*9) DIV 9 n MOD 9 + 1 + + + 5", HD, 80 Spuren, 15 Sektoren (\#1...\#15) � 512 Byte + + Block Seite Spur Sektor + + 0 0 0 1 + 15 0 1 1 + 80*15 1 0 1 + + n n DIV (80*15) n MOD (80*15) DIV 15 n MOD 15 + 1 + + +Selbstverständlich können auch andere #ib#Archivformate#ie# implementiert werden, falls das aus +Hardwaregründen notwendig ist oder sich dadurch wesentliche Verbesserungen (z.B. in der +Kapazität) ergeben. + +Wenn irgend möglich sollte aber mindestens eines der oben aufgeführten Standardformate +unterstützt werden - evtl. als zusätzliches Format -, um den Austausch zwischen verschie­ +denen Rechnertypen zu vereinfachen. + +#on("i")#Hinweis: Um den Datenaustausch zwischen verschiedenen Rechnertypen zu vereinfachen, + sollten möglichst alle der hardwaremäßig möglichen Standardformate (mindestens + lesend) unterstützt werden. Dabei sollte SHard sich automatisch auf das Format + der jeweils eingelegten Floppy einstellen:#off("i")# + + + Laufwerkstyp Diskettentyp(en) + + 8" 1D 8" 1D + 8" 2D 8" 2D, 1D + + 5" 2D-40 5" 2D-40 + 5" 2D-80 5" 2D-80, 2D-40 *) + 5" HD-80 5" HD-80, 2D-80, 2D-40 *) +#foot# +#f#*) Bei der Behandlung von 40-Spur-Disketten auf 80-Spur-Laufwerken gelten meistens folgende Regeln: + a) Lesen funktioniert sicher. + b) Schreiben ist unsicher, funktioniert aber häufig. + c) Formatieren funktioniert fast nie. +#a# +#end# + + + +#b("Hauptspeicher")# +#goalpage("speicher")# + +Die 64 K des direkt vom Z80 adressierbaren #ib#Speicher#ie#s sind folgendermaßen aufgeteilt: + + FFFFh #corner1("-5.0")# + Platz für SHard + yyyyh #box3("T","3","75.0")# + #corner1("-5.0")# + Pagingbereich + + xxxxh #box3("T","3","75.0")# + #corner1("-5.0")# + EUMEL 0 + + 1400h #box3("T","3","75.0")# + #corner1("-5.0")# + Platz für SHard + 0000h #box3("T","3","75.0")# + +Möglichst große Teile des SHards (am besten alle) sollten im unteren Adreßbereich (bis +13FFh) liegen, damit dem Paging viel Speicher zur Verfügung steht. + +Der nicht direkt (aber durch Banking oder DMA) erreichbare Teil des #ib#RAM#ie#s wird Schatten­ +speicher (siehe S.#topage("schatt")#) genannt. + + +Hinweis: Falls ein Teil des Hauptspeicher-Adreßraums fest (d.h. auch nach dem Boot­ + loading nicht ausblendbar) durch ROM belegt ist, muß dieses in einem der beiden + SHard-Bereichen liegen. + +#page# +#cc("Teil 3: SHard ","Interface Spezifikation")# +#goalpage("shardifc")# + + +#bb("0. ","Vorbemerkungen")# +#goalpage("vor")# + + +#b("Zur Notation")# +#goalpage("not")# + +Im folgenden wird zwischen #dx("0-Routinen")#, die dem SHard vom EUMEL-0-System zur +Verfügung gestellt werden, und #dx("SHard-Routinen")# unterschieden, die der SHard implementie­ +ren muß. Damit dieser Unterschied bei der Spezifikation deutlich wird, werden 0-Routinen +folgendermaßen aufgeführt: + + name (0-Routine) + +Zusätzlich werden 0-Routinen grundsätzlich klein und SHard-Routinen groß geschrieben. + +Z80-Befehle werden wie in "Z80-Assembly Language Programming Manual" (Zilog, 1977) +notiert: + + ld a,27 + add a,l + +Hexadezimale Zahlen werden durch ein nachgestelltes 'h' gekennzeichnet: + + 12h = 18 + 1Fh = 31 + FFFFh = 65535 + + +#b("Link-Leisten")# +#goalpage("leist")# + +Die Verbindung zwischen SHard und Urlader (EUMEL-0) erfolgt über zwei Tabellen. In der +"0-Leiste" stellt EUMEL-0 dem SHard verschiedene 0-Routinen zur Verfügung. Diese +Leiste beginnt an der Adresse 1400h: + + 1400h defm 'EUMEL ' + 1410h defw eumel0blocks + 1412h defw hgversion + 1414h defw 1 ; Kennzeichen für Z80-Urlader + 1416h defw urladerversion + 1418h defw 0 ; reserviert + 141ah defw ; kleinste unterstützte SHardversion + 141ch defw ; größte ... + 141eh jp systemstart + jp inputinterrupt + jp timerinterrupt + jp warte + jp grab + jp free + jp shutup + jp info + +Diese Leiste wird vom Urlader nach dem Systemstart überschrieben. Der SHard muß daher, +bevor er nach systemstart springt, die für ihn relevanten Teile (mindestens die Sprungbefehle) +in einen eigenen Bereich kopieren: + + #ib#eusystemstart#ie#: jp 0 + #ib#euinputinterrupt#ie#: jp 0 + #ib#eutimerinterrupt#ie#: jp 0 + #ib#euwarte#ie#: jp 0 + #ib#eugrab#ie#: jp 0 + #ib#eufree#ie#: jp 0 + #ib#eushutup#ie#: jp 0 + #ib#euinfo#ie# jp 0 + +So kann SHard die entsprechenden 0-Routinen vermittels der obigen Vereinbarungen aufru­ +fen: + + jp eusystemstart + ... + call euwarte + +Für die Gegenrichtung muß SHard der 0-Maschine die "SHard-Leiste" zur Verfügung +stellen, deren Adresse beim Sprung nach 'systemstart' in HL stehen muß. Die 0-Maschine +kopiert diese Leiste. SHard darf daher anschliessend den Bereich anderweitig (z.B. +EA-Puffer) verwenden: + + + #ib#SHDID#ie#: defm 'SHARD ' ; 16 Byte + #ib#SHDVER#ie#: defw 8 + #ib#MODE#ie#: defw + #ib#ID4#ie#: defw + #ib#ID5#ie#: defw + #ib#ID6#ie#: defw + #ib#ID7#ie#: defw + defw + defw + #ib#OUTPUT#ie#: jp shout + #ib#BLOCKIN#ie#: jp shbin + #ib#BLOCKOUT#ie#: jp shbout + #ib#IOCONTROL#ie#: jp shiocnt + #ib#SYSEND#ie#: jp shend + #ib#SCHINF#ie#: jp shsinf + #ib#SCHACC#ie#: jp shsacc + defw + #ib#LIMIT#ie#: defw + + +#b("Allgemeine Link-Bedingungen")# +#goalpage("link")# + +In der Regel sind sowohl 0-Routinen als auch SHard-Routinen durch 'call' aufzurufen: + + call + +Ausnahmen von dieser Regel sind im folgenden stets besonders vermerkt. + +Generelle Link-Bedingung (für SHard- und 0-Routinen) ist: + + Alle Register - bis auf die jeweils spezifizierten Ausgangsparameter und das F-Regi­ + ster *) - bleiben unverändert. +#foot# +#f#*) Flags sind i.a. nach dem Aufruf einer Routine undefiniert. Ausnahmen sind natürlich die Flags, die als Ausgangs­ +parameter in manchen Fällen definiert sind.#a# +#end# + +Jede SHard-Routine muß also alle Register (bis auf F), die sie verändert und die keine +Ausgangsparameter sind, retten und wiederherstellen. Im Gegenzug braucht SHard beim +Aufruf von 0-Routinen selbst keine Register zu retten. + + +#b("Interrupts")# +#goalpage("intr")# + +Zwei externe Ereignisse (Zeitgeber und Eingabe, siehe S.#topage("zeit")# und S.#topage("inp")#) werden von +EUMEL-0 behandelt. Die entsprechenden Interrupts muß SHard per 'call' an 0-Routinen +weiterleiten. Außerhalb des Moduls SHard wird der 'reti'-Befehl nicht verwendet, damit der +SHard die Kontrolle über die Interruptlevel behält. Die Register (bis auf die Eingangsparame­ +ter) werden von den aufzurufenden 0-Routinen selbst gesichert. Die normale Interrupt- +Sequenz im SHard sieht dann folgendermaßen aus: + + intadr: push af + ld a, + call + pop af + reti + +Achtung: SHard muß die Interrupt-Routinen im 'disable-int'-Modus anspringen. Dies ist + normalerweise schon durch die Hardware gegeben. + +Die 0-Routinen geben von sich aus den 'ei'-Befehl. Dies erfolgt im allgemeinen sehr +frühzeitig (innerhalb der ersten 30 Befehle), um einen interruptgetriebenen Floppytreiber +zulassen zu können. + + + + +#bb("1. System ","laden")# +#goalpage("laden")# + +SHard muß die EUMEL-0-Software vor dem eigentlichen Start laden. EUMEL-0 befindet +sich normalerweise auf dem Hintergrund. Es müssen von Block 10 an eumel-0-blocks +(siehe 0-Leiste) Blöcke in den Speicher von der Adresse 1400h an aufsteigend geladen +werden. + + Achtung: Zu diesem Zeitpunkt kann SHard die oben aufgeführten 0-Routinen natür­ + lich noch nicht benutzen. Insbesondere dürfen die Laderoutinen nicht 'warte' + aufrufen. Das wird hier besonders betont, weil der Hintergrundzugriff beim + eigentlichen Systemlauf in der Regel 'warte' verwenden wird. + + Hinweis: Der erste Block der EUMEL-0-Software (Block 10) enthält in den ersten + fünf Bytes den Text "EUMEL", um eine Identifikation durch den SHard- + Lader zu ermöglichen. + +Es wird empfohlen, nach folgendem Verfahren zu laden: + + IF archivgeraet enthaelt diskette AND eumel 0 auf archiv + THEN lade eumel 0 vom archiv + ELIF eumel 0 auf hintergrund + THEN lade eumel 0 vom hintergrund + ELSE laden unmoeglich + FI . + +So kann man auch bei einem frisch formatierten Hintergrundmedium einen neuen Hinter­ +grund (mit EUMEL-0-Urlader) einspielen, indem man ein Hintergrundarchiv vor dem +Systemstart in das Archivgerät legt. Dann wird EUMEL-0 von dort geladen, so daß man den +Hintergrund dann wie im Systemhandbuch beschrieben vom Archiv auf das Hintergrund­ +medium kopieren kann.*) +#foot# +#f#*) Kopiervorgänge (Archiv -> Hintergrund) werden vom EUMEL-0-Urlader erledigt, so daß SHard keine derartigen +Routinen enthalten muß.#a# +#end# + + + +#bb("2. System","start und -ende")# +#goalpage("start")# + +SHard muß alle für den Rechner notwendigen (Hardware-) Initialisierungen durchführen und +erst danach die EUMEL-0-Maschine starten ('systemstart'). + + #dx("systemstart")# (0-Routine) + + Eingang: HL = Adresse der SHard-Leiste + Interrupts disabled + + Aufruf: jp systemstart + + Zweck: Die EUMEL-0-Maschine wird gestartet. Alle notwendigen + Hardwareinitialisierungen (Interrupt Modus des Z80 und Ini­ + tialisierungen der Peripheriebausteine) müssen vorher schon + geschehen sein. + + Hinweis: Der Stackpointer braucht nicht definiert zu sein, da beim + Ansprung DI-Zustand herrschen sollte und somit keine + Interrupts auftreten können. EUMEL-0 lädt beim Start das + SP-Register und läßt Interrupts zu (EI). Falls jedoch in dieser + Zeit ein "Non Maskable Interrupt" auftreten kann, muß SHard + SP "vorläufig" laden. + + MODE: Über das MODE-Wort in der SHard-Leiste können Op­ + tionen gesetzt werden: + + Bit 0 = 0 EUMEL-0 ist auf dem Hintergrund abge­ + speichert. Der entsprechende Bereich bleibt + geschützt. (Standard) + + Bit 0 = 1 EUMEL-0 befindet sich nicht auf dem Hin­ + tergrund. Der entsprechende Bereich steht + zur freien Verfügung für andere EUMEL- + Daten. + (Da die EUMEL-0-Software nur beim + Systemstart geladen wird (read only!), kann + es bei Geräten mit kleinem Hintergrund + interessant sein, diese Blöcke auf dem + Hintergrund anderweitig zu nutzen. Das + Systemladen kann dann z.B. mit Hilfe einer + speziellen Urladediskette vom Archivgerät + aus erfolgen.) + + Bit 8 = 0 Beim Systemstart wird der Speicher über­ + prüft. (Standard) + + Bit 8 = 1 Der Speichertest beim Systemstart unter­ + bleibt. Man sollte nur bei Rechnern, die + beim Einschalten schon eigene Speicher­ + tests durchführen, auf den Speichertest des + EUMEL verzichten. + + Bit 9 = 0 Beim Systemstart wird die Vortest-Tapete + ausgegeben und man kann durch Eingabe + eines Zeichens die Vortestmenüs aktivieren + (s. Systemhandbuch). (Standard) + + Bit 9 = 1 Die Vortest-tapete wird unterdrückt. Es gibt + auch keine Möglichkeit, die Vortestfunk­ + tionen aufzurufen. Der Speichertest unter­ + bleibt ebenfalls. + + + #dx("SYSEND")# + + Parameter: - + + Zweck: Hiermit wird SHard das Ende eines Systemlaufs mitgeteilt. + Somit können evtl. notwendige Abschlußbehandlungen durch­ + geführt werden. SHard kann mit 'ret' zu EUMEL-0 zurück­ + kehren, muß aber nicht. Diese Routine kann z.B. dazu benutzt + werden, die Hardware auszuschalten oder in ein umgebendes + System zurückzukehren (EUMEL als Subsystem). In den + meisten Fällen wird die Routine leer implementiert werden, + d.h. nur aus 'ret' bestehen. + + +#bb("3. ","Speicherverwaltung")# +#goalpage("spver")# + + +#b("Hauptspeicher")# +#goalpage("haupt")# + +Der Hauptspeicher (#ib#RAM#ie#) umfaßt die direkt adressierbaren 64 K des Z80. Da die Anfangs­ +adresse des für EUMEL-0 und Paging verfügbaren Bereichs fest ist (1400h), muß SHard nur +über die Obergrenze des verfügbaren Bereichs informieren. + + #dx("LIMIT")# + + Über das LIMIT-Wort in der SHard-Leiste kann sich SHard + noch Bereiche vor dem Speicherende (z.B. für CP/M BIOS) + freihalten. Auf jeden Fall muß CFFFh <= LIMIT gewährleistet + sein, d.h. der Bereich bis CFFFh gehört zum Pagingbereich. + Im Normalfall wird FFFFh geliefert werden. + + + +#b("Schattenspeicher")# +#goalpage("schatt")# + +Das EUMEL-System ist in der Lage, trotz der durch die 16-Bit Adressen gegebenen Ein­ +schränkung auf 64 kB, weiteren Speicher anzuschließen. Dieser wird Schattenspeicher +genannt. + +Der Schattenspeicher (#ib#RAM#ie#) sollte so angeschlossen sein, daß über ein nicht zu großes #ib##on("italic")# +Fenster#ie##off("italic")# des normalen Adressraumes ( < 4 kB) auf diesen zugegriffen werden kann. Welcher +Bereich des Schattenspeichers dabei gemeint ist, wird durch die SHard-Routine SCHACC +mitgeteilt (s.u.). Diese Art des Zugriffs wird Fenstermodus genannt. Das Restsystem nutzt das +Fenster echt (d.h. ohne den Inhalt in andere Bereiche des normalen Adressraumes zu trans­ +portieren). + +Ist ein so kleines Fenster in der Hardware nicht vorgesehen (z.B. 48 kB Bänke bzw. nur +DMA-Zugriff), so kann auch solcher Schattenspeicher benutzt werden (Transportmodus). +Wichtig ist dabei, daß EUMEL-0 die oben erwähnten echten Fensterzugriffe unterläßt. +(Simulation im Transportmodus wäre erheblich zu teuer.) Daher muß EUMEL-0 wissen, in +welchem Modus der Schattenspeicher ansprechbar ist (SCHINF). + +Hinweis: Wenn möglich sollte der Fenstermodus implementiert werden, da er im Multi- + User-Betrieb (ab ca. 3 Teilnehmern) deutliche Effizienzvorteile bietet. + + +Das Schattenspeicherinterface gibt es in 2 Modi: + + - Fenstermodus (Bit 2**15 von BC gesetzt bei SCHINF) + - Transportmodus (Bit 2**14 von BC gesetzt bei SCHINF) + + +#d("Fenstermodus")# + + #dx("SCHINF")# (im Fenstermodus) + + Ausgang: BC 2**15 + Schattenspeichergröße (in K) + + Zweck: EUMEL-0 kann so die Größe des Schattenspeichers und den + gewünschten Modus (hier: Fenstermodus) erfragen. Falls kein + Schattenspeicher vorhanden ist, muß 0 als Größe geliefert + werden. Das Resultat von SCHINF darf sich innerhalb eines + Systemlaufs nicht ändern. + + + #dx("SCHACC")# (im Fenstermodus) + + Eingang: HL Nummer der 1/2K-Seite, die in das Fenster zu schal­ + ten ist. + Ausgang: HL Anfangsadresse (im Normaladreßraum) des aktuellen + Fensters + + Zweck: Dient zum Zugriff auf den Schattenspeicher über das Fen­ + ster. Man beachte, daß mehrere Fenster möglich sind, aber + alle im Adreßbereich des SHards liegen müssen! Die Num­ + mern der 1/2K-Seiten des Schattenspeichers liegen immer + im Bereich von 0 bis 2n-1, wobei n die von SCHINF geliefer­ + te Größe des Schattenspeichers ist. Daraus folgt, daß + SCHACC nicht aufgerufen wird, falls kein Schattenspeicher + vorhanden ist. + +#d("Transportmodus")# + + #dx("SCHINF")# (im Transportmodus) + + Ausgang: BC 2**14 + Schattenspeichergröße (in K) + + Zweck: EUMEL-0 kann so die Größe des Schattenspeichers und den + gewünschten Modus (hier: Transportmodus) erfragen. Falls + kein Schattenspeicher vorhanden ist, muß 0 als Größe gelie­ + fert werden. Das Resultat von SCHINF darf sich innerhalb + eines Systemlaufs nicht ändern. + + + #dx("SCHACC")# (im Transportmodus) + + Eingang: A = 1 Transport in den Schattenspeicher + A = 2 Transport aus dem Schattenspeicher + DE Nummer der 1/2K Seite im Schattenspeicher + HL Adresse im normalen Hauptspeicherbereich + + Zweck: Es werden jeweils 512 Bytes aus dem Normal- in den + Schattenspeicher (A=1) bzw. aus dem Schattenspeicher in + den normalen Hauptspeicher (A=2) kopiert. + Die Nummern der 1/2K-Seiten des Schattenspeichers liegen + immer im Bereich von 0 bis 2n-1, wobei n die von SCHINF + gelieferte Größe des Schattenspeichers ist. Daraus folgt, daß + SCHACC nicht aufgerufen wird, falls kein Schattenspeicher + vorhanden ist. + + Eingang: A = 3 + E Index (immer geradzahlig: 0,2,4,...254) + Ausgang: BC Bereichslänge DIV 3 + HL Bereichsadresse + + Zweck: Für den angegebenen Index ist die Adresse eines Haupt­ + speicherbereichs und 1/3 der Länge dieses Bereichs zu­ + rückzumelden (Anzahl Einträge � 3 Bytes) Es sind also 128 + solcher Bereiche zur Verfügung zu stellen. Bei n K Schat­ + tenspeicher sollte jeder Bereich größer als 6*n/128 Bytes sein. + Alle Bereiche müssen gleich groß sein. + + Beispiel: Bei bis zu 256 K sollten 16-Byte-Bereiche + benutzt werden: + + shacc3: ld l,e + ld h,0 + add hl,hl + add hl,hl + add hl,hl + ld bc,schtab + add hl,bc ; DIV 2 * 16 + schtab + ld bc,5 ; 16 DIV 3 + ret + + schtab: defs 128*16 + + + + +#b("Blocktransfer im Speicher")# +#goalpage("ldir")# + + + +#b("Speicherfehler")# +#goalpage("memerr")# + +Falls die Hardware Speicherfehler aufgrund von Paritybits, ECC oder ähnlichem feststellen +und an SHard melden kann, sollte das zur Erhöhung der Systemsicherheit genutzt werden. + +Wenn SHard (z.B. über Interrupt) einen Speicherfehler mitgeteilt bekommt, sollte er wenn +möglich eine entsprechende Meldung ausgeben und das System brutal anhalten: + + rien#ub# #ue#ne#ub# #ue#vas#ub# #ue#plus: jr rien#ub# #ue#ne#ub# #ue#vas#ub# #ue#plus + + +Wenn Speicherfehler mit Sicherheit bemerkt werden, verhindert diese Reaktion, daß die +Fehler auf dem Hintergrund festgeschrieben werden und evtl. später zu Systemfehlern führen. + +Der Anwender kann dann durch Hardware-Reset auf den letzten Fixpunkt des EUMEL- +Systems zurücksetzen. So verliert er zwar evtl. die letzten Minuten seiner Arbeit, behält aber +auf alle Fälle ein konsistentes System. + + + + +#bb("4. ","Zeitgeber")# +#goalpage("zeit")# + +SHard muß einen Zeitgeberinterrupt erzeugen, der ca. 10 bis 100 mal pro Sekunde auftritt. +Dabei ist die 0-Routine 'timerinterrupt' aufzurufen. Ohne diesen Interrupt wird die Uhr nicht +geführt, und die Zeitscheibenlogik für das Timesharing fällt aus. + + #dx("timerinterrupt")# (0-Routine) + + Eingang: A seit letztem Zeitgeberinterrupt vergangene Zeit (in ms) + + Zweck: Wird von EUMEL-0 für interne Uhren und für das Schedu­ + ling (Zeitscheibenlogik) verwendet. Es werden keine hohen + Genauigkeitsanforderungen an die Zeitangaben bei #on("i")#einzel­ + nen#off("i")# Interrupts gestellt. Um EUMEL-0 eine genaue Real­ + zeituhr zu ermöglichen, sollte die so erzeugte Zeitangabe #on("i")#im + Mittel#off("i")# aber möglichst genau sein, d.h. die Summe der inner­ + halb einer Minute so übergebenen Werte sollte zwischen + 59995 und 60005 liegen. + + + +#bb("5. ","Kanäle")# +#goalpage("channel")# + +Einiges zum Kanalkonzept: + +Das System kennt die Kanäle 0..32. + + Kanal 0 ist der Systemhintergrund. + Die Kanäle 1..15 sind für Stream-IO (Terminals, Drucker, ...) vorgesehen. + Kanal 31 ist der Standard-Archivkanal. + Kanal 32 ist der Parameterkanal. + +Die Kanäle 2.. 30 können installationsabhängig verfügbar sein oder auch nicht. Deren Funk­ +tion ist dann Absprachesache zwischen Installation und SHard. + +Kanäle können über Block-IO (BLOCKOUT, BLOCKIN) oder Stream-IO (OUTPUT,..) ange­ +sprochen werden. Das System erfährt über IOCONTROL, welche Betriebsart des Kanals +sinnvoll ist. + +#on("i")##on("b")#Achtung: Alle Kanaloperationen müssen grundsätzlich für alle Kanäle (0...32) aufgerufen + werden können. Dabei können Operationen auf nicht vorhandenen Kanälen und + unsinnige Operationen (z.B. Stream-IO auf Kanal 0) leer implementiert wer­ + den.#off("b")# (Dafür werden im folgenden bei jeder SHard-Routine Vorschläge gemacht.)#off("i")# + + + +#bb("5.1 ","Stream-IO")# +#goalpage("stream")# + +Über Stream-IO wickelt das System die übliche zeichenorientierte Ein-/Ausgabe auf Termi­ +nals, Druckern, Plottern usw. ab. Stream-IO wird nur für die Kanäle 1...15 gemacht. + + #dx("inputinterrupt")# (0-Routine)#goalpage("inp")# + + Eingang: A Kanalnummer (1...15) + B eingegebenes Zeichen + C Fehlerbits: + Bit 0 = 1 Mindestens ein Zeichen ging + verloren. + Bit 1 = 1 Es wurde der BREAK-Zustand + (bei V24) erkannt. + Bit 2 = 1 Das Zeichen ist u.U. falsch + (Paritätsfehler). + + Ausgang: A Anzahl Zeichen, die noch übernommen werden kön­ + nen. + + Zweck: SHard muß EUMEL-0 durch Aufruf dieser Routine mitteilen, + daß eine Eingabe vorliegt. + + Hinweise: EUMEL-0 puffert die Zeichen. Siehe auch IOCONTROL: + "weiter". + + Bei Kanalnummern <1 oder >15 wird der Aufruf von + EUMEL-0 ignoriert. + + Falls die Hardware keine Inputinterrupts zur Verfügung stellt, + sollte ein Timer benutzt werden, um alle möglichen Input­ + quellen regelmäßig abzufragen. Dabei muß man allerdings den + goldenen Mittelweg zwischen zu häufiger (Systemdurchsatz + sinkt) und zu seltener Abfrage (Zeichen gehen verloren) + suchen. Man sollte dabei nicht nur an die menschliche Tipp­ + geschwindigkeit sondern auch an die höchste Baudrate + denken, die man für Rechnerkopplungen noch unterstützen + will. *) +#foot# +#f#*) Eine weitere Möglichkeit, auf manchen Kanälen ohne Interrupts auszukommen, wird bei der IOCONTROL-Funktion +"weiter" beschrieben (siehe S.#topage("weiter")#).#a# +#end# + + Falls SHard Flußkontrolle für den Kanal ausüben soll, muß er + die Rückmeldung in A auswerten. Dabei ist mit einem geeig­ + neten Schwellwert zu arbeiten, da in der Regel die sendende + Gegenstelle einer Sendeunterbrechung nicht sofort Folge + leistet. + + Achtung: #on("i")#Keinesfalls darf 'inputinterrupt' rekursiv aufgerufen werden. + Normalerweise wird das automatisch verhindert, wenn man + den zugehörigen Hardwareinterrupt erst nach der 0-Routine + wieder freigibt. Falls das nicht möglich ist und unter bestimm­ + ten Umständen das nächste Zeichen abgeholt werden muß, + bevor die 0-Routine beendet ist, muß SHard einen eigenen + Puffer implementieren:#off("i")# + + hardwareinterrupt: + IF input interrupt aktiv + THEN trage zeichen in shard puffer ein ; + gib hardware interrupt frei + ELSE input interrupt aktiv := true ; + gib hardware interrupt frei ; + input interrupt ; + disable interrupt ; + WHILE shard puffer enthaelt noch zeichen REP + nimm zeichen aus shard puffer ; + enable interrupt ; + input interrupt ; + disable interrupt + PER ; + input interrupt := false ; + enable interrupt + FI . + + + #d("OUTPUT")# + + Eingang: A Kanalnummer (1...15) + BC Anzahl auszugebender Zeichen + HL Adresse der Zeichenkette + Ausgang: BC Anzahl der übernommenen Zeichen + C-Flag gesetzt <=> alle Zeichen übernommen + + Zweck: Ausgabe einer Zeichenkette. Diese ist (möglichst ganz) zwi­ + schenzupuffern, denn die Ausführung von OUTPUT sollte kein + Warten auf IO enthalten. Der Ausgabepuffer muß mindestens + 50, besser 100 Zeichen fassen können. Durch eine Inter­ + ruptlogik oder etwas Äquivalentes ist sicherzustellen, daß + dieser Puffer parallel zur normalen Verarbeitung ausgegeben + wird. Wenn die auszugebende Zeichenkette nicht vollstän­ + dig in den Puffer paßt, sollten trotzdem so viele Zeichen wie + möglich übernommen werden. Im weiteren Verlauf ruft + EUMEL-0 dann wieder OUTPUT mit dem Rest der Zei­ + chenkette auf. + + Hinweis: OUTPUT kann mit BC=0 aufgerufen werden. Auch diese + leere Operation muß mit gesetztem C-Flag quittiert wer­ + den. + + Achtung: #on("i")#Keinesfalls darf innerhalb von OUTPUT die 0-Routine 'warte' + aufgerufen werden.#off("i")# + + Vorschlag: Falls der Kanal nicht existiert bzw. OUTPUT darauf unsinnig + ist, sollte vorgegaukelt werden, alle Zeichen seien ausge­ + geben (BC unverändert und C-Flag gesetzt). + + + +#b("Terminals")# +#goalpage("term")# + +"Normale" #ib#Terminal#ie(1,", normales")#s können ohne weitere Unterstützung des SHards angeschlossen wer­ +den. Die zur Anpassung an den EUMEL-Zeichensatz *) notwendigen #ib#Umcodierungen#ie# werden +von den höheren Ebenen aus eingestellt. Da diese Umsetztabellen vom SHard unabhängig +sind, stehen automatisch alle so angepaßten Terminaltypen allen EUMEL-Anwendern zur +Verfügung! +#foot# +#f#*) Siehe "EUMEL Benutzerhandbuch"#a# +#end# + +Für den Anschluß eines #on("b")##on("i")#integrierten #ib#Terminal#ie(1,", integriertes")#s#off("i")##off("b")#, in dessen Bildwiederholspeicher direkt gear­ +beitet wird, kann man häufig den Terminaltyp 'psi' verwenden (siehe auch "Exoten"). + +Näheres zu Terminaltypen und -anschlüssen findet man im "EUMEL Systemhandbuch" +unter den Stichwörtern #on("i")#Konfiguration#off("i")# und #on("i")#Konfigurierung#off("i")#. + + + +#bb("Drucker, ","Plotter")# +#goalpage("druck")# + +#ib#Drucker#ie# und Plotter werden vom EUMEL-System wie Terminals angesehen. Da in der Regel +der Rechner aber schneller Zeichen senden als der Drucker drucken kann, müssen solche +Geräte in der Regel mit Flußkontrolle angeschlossen werden (siehe S.#topage("fluss")#). + +Wenn Drucker oder Plotter über eine Parallelschnittstelle angeschlossen werden, kann man +auf diesem Kanal möglicherweise auf einen Ausgabepuffer verzichten. Voraussetzung ist +dabei, daß + + a) der Drucker einen eigenen Puffer hat und + b) der Puffer "schnell" gefüllt werden kann (< 0.1 ms/Zeichen). + +Dann kann man auf den bei der SHard-Routine OUTPUT geforderten Puffer verzichten und +die Zeichenkette direkt über die Parallelschnittstelle an den Drucker übergeben. Wenn der +Drucker 'Puffer voll' signalisiert, sollte die Zeichenübernahme bei OUTPUT abgebrochen +werden. *) #on("i")#Auf keinen Fall darf CPU-intensiv auf Freiwerden des Puffers gewartet werden!#off("i")# +#foot# +#f#*) siehe auch IOCONTROL "frout", S.#topage("frout")##a# +#end# + + + +#b("Exoten")# +#goalpage("exot")# + +Exotische #ib#Terminal#ie(1," exotisches")#s (im Sinne dieser Beschreibung) sind solche, für die eine Umsetztabelle +im System (siehe Konfiguratorbeschreibung) nicht ausreicht bzw. nicht nötig ist (Beispiele: +Terminals, in deren Bildwiederholspeicher direkt gearbeitet wird; Terminals, die soweit +programmierbar sind, daß sie den EUMEL-Zeichencode können). + +Für solche Terminals muß in der Konfiguration der Terminaltyp '#ib#psi#ie#' eingestellt werden. Dieser +wirkt ohne Umcodierungen, d.h. die EUMEL-Codes (siehe Benutzerhandbuch) werden direkt +dem SHard zugestellt (wie bei 'transparent'), jedoch mit folgenden Besonderheiten: + +Eingabeseitig werden zusätzlich folgende Codezuordnungen getroffen: + + Code Funktion + + 7 SV (Aktivierung: 'gib supervisor kommando:') + 17 STOP (Ausgabe auf diesen Kanal wird gestoppt) + 23 WEITER (Ausgabe läuft wieder weiter) + 4 INFO (System geht in Debugger, falls Debugoption) + + + +#bb("5.2 ","Block-IO")# +#goalpage("block")# + +Über Block-IO wickelt das System die Zugriffe zum Pagingmedium und zum Archiv ab. +Ferner ist daran gedacht, auch auf V.24-Schnittstellen Block-IO z.B. für Rechnerkopplung +zuzulassen. Die Kanalnummer in Reg. A unterscheidet diese Fälle. Außer beim Paging (A=0) +wird ein Block-IO durch die ELAN-Prozeduren 'blockin' und blockout' induziert. + +Bei Block-IO wird immer ein 512 Byte großer Hauptspeicherbereich mit übergeben. Dieser +kann (im Gegensatz zu OUTPUT) direkt benutzt werden, d.h. es muß keine Umpufferung +erfolgen. + +Dieser Hauptspeicherbereich darf nur bei BLOCKIN verändert werden. + +SHard darf (anders als bei OUTPUT) erst dann zur Aufrufstelle zurückgeben, wenn die +verlangte Operation abgeschlossen ist. Treten während der Operation Wartezeiten auf, so muß +SHard die 0-Routine 'warte' aufrufen, damit das System andere Prozesse weiterlaufen +lassen kann. + +EUMEL-0 definiert bestimmte Funktionen für Hintergrund (Kanal 0) und Archiv (Kanal 31). +Operationen auf anderen Kanälen kann SHard nach Belieben implementieren und deren +Leistung seinen Installationen über ELAN-Pakete zur Verfügung stellen. Das System vergibt +auch in Zukunft für den #ib##on("italic")#Funktionscode#ie##off("italic")# in Register BC nur positive Werte (Bit 7 von B = 0). +Der SHard kann selbst negative Codes einführen. + + + #d("BLOCKIN")# + + Eingang: A Kanalnummer (0...32) + BC Funktionscode 1 + DE Funktionscode 2 + HL Adresse des Hauptspeicherbereichs + Ausgang: A undefiniert (darf also verändert werden) + BC Rückmeldecode + HL darf verändert werden + + Der Inhalt des Hauptspeicherbereichs (... + +511) darf verändert sein. + + Zweck: "Einlesen" von Blöcken. Die genaue Wirkung hängt vom + Funktionscode und dem Kanal ab. + + Vorschlag: Falls der Kanal nicht existiert bzw. BLOCKIN darauf unsinnig + ist, sollte die Rückmeldung -1 in BC geliefert werden. + + + #d("BLOCKOUT")# + + Eingang: A Kanalnummer (0...32) + BC Funktionscode 1 + DE Funktionscode 2 + HL Adresse des Hauptspeicherbereichs + Ausgang: A undefiniert (darf also verändert werden) + BC Rückmeldecode + HL darf verändert werden + + Der Inhalt des Hauptspeicherbereichs darf #on("i")#nicht#off("i")# verändert + werden! + + Zweck: "Ausgeben" von Blöcken. Die genaue Wirkung hängt vom + Funktionscode und dem Kanal ab. + + Vorschlag: Falls der Kanal nicht existiert bzw. BLOCKOUT darauf un­ + sinnig ist, sollte die Rückmeldung -1 in BC geliefert wer­ + den. + + + #dx("warte")# (0-Routine) + + Ausgang: Alle Register undefiniert! + + Zweck: Diese Routine ist bei 'blockin' oder 'blockout' dann aufzu­ + rufen, wenn SHard im Augenblick nichts zu tun hat. Durch + den Aufruf von 'warte' erhalten andere Systemteile die + Möglichkeit, weiterzuarbeiten. Ein 'warte' kann bis zu ca. 1/4 + Sekunde Zeit aufnehmen. 'warte' darf nicht in Interrupt­ + routinen und Stream-IO verwendet werden! 'warte' zerstört + alle Register! SHard muß davon ausgehen, daß 'warte' sei­ + nerseits andere SHard-Komponenten aufruft. + + +Die Verwendung der 0-Routine 'warte' soll hier an einigen Beispielen verdeutlicht werden: + + + blockout auf platte : + WHILE platte noch nicht frei REP + warte + ENDREP ; + uebertrage schreibbefehl an controller ; + uebertrage daten an controller . + + blockin von platte : + WHILE platte noch nicht frei REP + warte + ENDREP ; + uebertrage lesebefehl an controller ; + WHILE daten noch nicht gelesen REP + warte + ENDREP ; + hole daten vom controller . + + + blockout auf floppy : + seekbefehl an controller ; + WHILE seek noch nicht fertig REP + warte + ENDREP ; + setze dma auf schreiben block zur floppy ; + schreibbefehl an controller ; + WHILE schreiben noch nicht fertig REP + warte + ENDREP . + + blockin von floppy : + seekbefehl an controller ; + WHILE seek noch nicht fertig REP + warte + ENDREP ; + setze dma auf lesen block von floppy ; + lesebefehl an controller ; + WHILE lesen noch nicht fertig REP + warte + ENDREP . + + + +#b("Block-IO bei Hintergrund und Archiv")# +#goalpage("bhgarch")# + +#ib#Hintergrund#ie# (Kanal 0) und #ib#Archiv#ie# (Kanal 31) unterscheiden sich in den Link-Bedingungen nur +in der Kanalnummer. Die Aufrufe von BLOCKIN und BLOCKOUT werden mit folgenden +Eingangsparametern versorgt: + + #on("b")#BLOCKIN#off("b")# A 0 bzw. 31 + B 0 + C Blocknummer DIV 65536 + DE Blocknummer MOD 65536 + HL Hauptspeicheradresse + + Der angegebene 512-Byte-Block ist in den Hauptspeicher + ab einzulesen. + + #on("b")#BLOCKOUT#off("b")# A 0 bzw. 31 + B 0 + C Blocknummer DIV 65536 + DE Blocknummer MOD 65536 + HL Hauptspeicheradresse + + Der Hauptspeicherbereich (...+511) ist auf den + angegebenen Block zu schreiben. + +Als Rückmeldungen sind zu liefern:#goalpage("errcod")# + + 0 Operation korrekt ausgeführt. + 1 Manuell behebbarer Fehler (z.B. Laufwerktür offen) + 2 Permanenter Fehler (z.B. Daten nicht lesbar) + 3 Versorgungsfehler (zu hohe Blocknummer) + +Zusätzlich zu der Rückmeldung muß bei BC <> 0 in HL die Adresse eines Fehlerstrings +(Längenbyte + Fehlertext) geliefert werden. *) +#foot# +#f#*) Diese Zusatzrückmeldung ist nur für die BLOCKIN/OUT Aufrufe auf Kanal 0/31 von Bedeutung. Sie wird nur von +EUMEL-0 beim Paging und im Hardwaretest ausgewertet.#a# +#end# + +#dx("Fehlerwiederholungen")#: Das EUMEL-System führt von sich aus Fehlerwiederho­ + lungen beim Hintergrund- und beim Archivzugriff + durch. SHard sollte deshalb im Fehlerfall die Opera­ + tion nicht selbst wiederholen, sondern einen Lese/ + Schreibfehler zurückmelden. So werden dem + EUMEL-System auch Soft-Errors gemeldet. In + manchen Fällen soll vor einem erneuten Lese- oder + Schreibversuch der Arm auf Spur 0 positioniert + werden o.ä. Um das zu erreichen, sollte SHard diese + "Reparaturaktion" direkt im Anschluß an den fehler­ + haften Versuch durchführen. + +#dx("Kontrollesen")#: Falls Kontrollesen (nach jedem Schreibzugriff) notwendig ist, + muß das allerdings vom SHard durchgeführt werden. + In der Regel reicht es dazu, den geschriebenen + Block "ohne Datentransport" zu lesen, so daß nur + CRC überprüft wird. + +Will SHard weitere Archivlaufwerke zur Verfügung stellen, so kann er dafür Kanalnummern +(30,29..) vergeben. Auf ELAN-Ebene kann die archivierende Task durch 'continue (x)' das +Laufwerk 'x' ansteuern. + +Hinweis: Das System versucht Hintergrund und Archiv parallel zu betreiben, d.h. wenn + SHard bei der Hintergrundbehandlung das UP 'warte' aufruft, kann 'warte' seiner­ + seits die Archivbehandlung des SHards aufrufen. Wenn beides z.B. denselben + Floppykontroller benutzt, muß SHard sicherstellen, daß das gut geht (z.B. durch + Semaphoren). + + + + +#bb("5.3 ","IO-Steuerung")# +#goalpage("iocontrol")# + +Die IO-Steuerung erlaubt Steuerung und Zustandsabfragen der Kanäle. IO-Steuerung wird +(außer bei Kanal 0) auch durch 'control' in ELAN induziert. + +Der Funktionscode in BC unterliegt denselben Konventionen wie bei Block-IO, d.h. das +System verwendet nur positive Codes. Der SHard-Schreiber kann auch negative Codes für +Sonderzwecke vorsehen. + + + #d("IOCONTROL")# + + Eingang: A Kanalnummer (0...32) + BC Funktionscode 1 + DE Funktionscode 2 + HL Funktionscode 3 + Ausgang: BC Rückmeldung + A darf verändert werden, in einigen Fällen zusätzliche + Rückmeldung + C-Flag (in einigen Fällen zusätzliche Meldung) + + Zweck: abhängig von 'Funktionscode 1' (s.u.) + +Das System verlangt folgende Informations- und Steuerleistungen über IOCONTROL: + + #d("IOCONTROL ""typ""")# + + Eingang: A Kanalnummer (0...31) + BC 1 + Ausgang: BC Kanaltyp + + Zweck: Informiert EUMEL-0, welche IO für den angegebenen Kanal + sinnvoll ist. Die Rückmeldung in BC wird bitweise interpre­ + tiert: + + Bit 0 gesetzt <=> 'inputinterrupt' kann kommen. + Bit 1 gesetzt <=> OUTPUT ist sinnvoll. + Bit 2 gesetzt <=> BLOCKIN ist sinnvoll. + Bit 3 gesetzt <=> BLOCKOUT ist sinnvol. + Bit 4 gesetzt <=> IOCONTROL "format" ist sinn­ + voll. + + Hinweis: #on("i")#Trotz dieser Informationsmöglichkeit wird nicht garantiert, daß + nur sinnvolle Operationen für den Kanal aufgerufen werden.#off("i")# + + + #dx("IOCONTROL ""frout""")##goalpage("frout")# + + Eingang: A Kanalnummer (1...15) + BC 2 + Ausgang: BC Anzahl Zeichen, die nächster OUTPUT übernimmt + C-Flag gesetzt <=> Puffer leer + + Zweck: Liefert Information über die Belegung des Puffers. Diese + Information wird von EUMEL-0 zum Scheduling benutzt. + + Achtung: #on("i")#Wenn EUMEL-0 längere Zeit kein OUTPUT gemacht hat, + muß irgendwann BC > 49 gemeldet werden.#off("i")# + + Hinweis: Unter Berücksichtigung des oben Gesagten darf "gelogen" + werden. Man kann z.B. immer 50 in BC zurückmelden, muß + dann aber schlechtere Nutzung der CPU bei Multi-User- + Systemen in Kauf nehmen. + + Falls auf dem angegebenen Kanal ein Drucker mit eigenem + Puffer über Parallelschnittstelle angeschlossen ist (siehe + S.#topage("druck")#) und man auf einen SHard-internen Puffer verzichtet hat, + sollte bei 'Druckerpuffer voll' 0 in BC und 'NC' zurückge­ + meldet werden. Wenn aber Zeichen übernommen werden + können, sollte 50 in BC und 'C-Flag gesetzt' gemeldet + werden. + + Vorschlag: Falls der Kanal nicht existiert oder nicht für Stream-IO zur + Verfügung steht, sollten 200 in BC und C-Flag gesetzt + zurückgemeldet werden. + + + + + #dx("IOCONTROL ""weiter""")##goalpage("weiter")# + + Eingang: A Kanalnummer (1...15) + BC 4 + Ausgang: - + + Zweck: Das System ruft "weiter" für den in A angegebenen Kanal + auf, wenn es wieder Eingabezeichen puffern kann. + + Hinweis: "weiter" wird von EUMEL-0 auch immer dann aufgerufen, + wenn ein Prozeß auf dem angegebenen Kanal auf Eingabe + wartet und keine Zeichen mehr gepuffert sind. Wenn der + betroffene Kanal von sich aus keine Interrupts erzeugt, kann + SHard dies benutzen, um durch Aufruf von 'inputinterrupt' ein + Eingabezeichen zuzustellen. + #on("i")#Diese Betriebsart sollte nicht für normale Terminalkanäle + eingesetzt werden. Denn dann wird die SV-Taste nur an + EUMEL-0 zugestellt, wenn ein Prozeß auf diesem Kanal auf + Eingabe wartet. Somit sind in dieser Betriebsart CPU-inten­ + sive Endlosschleifen nicht normal abbrechbar!#off("i")# + + + #d("IOCONTROL ""size""")# + + Eingang: AL Kanalnummer (0...31) + CX 5 + DX Schlüssel + Ausgang: CX Anzahl Blöcke MOD 65536 + AL Anzahl Blöcke DIV 65536 + + Zweck: EUMEL-0 ruft 'size' auf, um die Anzahl Blöcke zu erfahren, + die ein Block-IO-Kanal verkraften kann (Größe von Hin­ + tergrund und Archiven). Bei Archivlaufwerken, die mehrere + Formate bearbeiten können, dient dieser Aufruf auch zum + Einstellen des Formats für die folgenden blockin/blockout- + Operationen anhand des Schlüssels. + + Schlüssel: 0 Wenn möglich 'erkennend', sonst 'standard'. Im ersten + Fall erkennt SHard das Format der eingelegten Disket­ + te und stellt dieses ein. + + Die weiteren Schlüssel sind stets definierend. Dabei gibt es + die EUMEL-Standardformate: + + 1 5" 2D-40, Sektor 1..9, 512 Bytes + 2 5" 2D-80, Sektor 1..9, 512 Bytes + 3 5" HD-80, Sektor 1..15, 512 Bytes + 10 8" 1D-77, Sektor 0..15, 512 Bytes + 11 8" 2D-77, Sektor 0..15, 512 Bytes + + Zusätzlich kann man sämtliche Spezialformate angeben: + + 8192 * laufwerkstyp 1: 8" + 2: 5" + 3: 3" + + + 4096 * seiten 0: einseitig + 1: doppelseitig + + + 1024 * dichte 0: single + 1: double + 2: high + + + 256 * spuren 0: 35 + 1: 40 + 2: 77 + 3: 80 + + + 64 * sektorbytes 0: 128 + 1: 256 + 2: 512 + + + 32 * erster sektor 0: \#0 + 1: \#1 + + + sektoren pro spur 0 ... 31 + + So bezeichnet '8762' das Format 8" 1S-77 Sektor 1..26 a + 128 Bytes. + + Anmerkung: SHard sollte alle physisch möglichen EUMEL-Standard­ + formate unterstützen. Von den Spezialformaten sollten die für + den Datenaustausch wichtigen Formate berücksichtigt werden. + Die EUMEL-Standardformate (1,2,3,10,11) sollten auch über + die entsprechenden analytischen Codes erreicht werden. (Z.B. + bezeichnen 1 und 21929 dasselbe Format.) Die Numerierung + der Blöcke ist in jedem Fall seitenorientiert, d.h. entsprechend + den Standardformaten (siehe S.#topage("arch")#). + + Hinweis: Bei Archiven wird 'size' aufgerufen, nachdem der Archivträ­ + ger eingelegt wurde. D.h. SHard hat die Gelegenheit, die + Größe anhand des eingelegten Archivträgers zu bestimmen + (z.B. ob single- oder doublesided). + + Vorschlag: Diese Funktion sollte auf nicht vorhandenen und den + Stream-IO-Kanälen 0 liefern. Sie muß aber mindestens auf + Kanal 0 (Hintergrund) und Kanal 31 (Archiv) "echte" Werte + liefern. + + Achtung: #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die + 0-Routine 'warte' aufgerufen werden.#off("i")# + + + #d("IOCONTROL ""format""")# + + Eingang: A Kanalnummer (0...31) + BC 7 + Ausgang: BC Fehlercode wie bei Archiv-BLOCKOUT (siehe S.#topage("errcod")#) + + Zweck: Dient zum Formatieren eines Mediums. Diese Funktion kann + für jeden Kanal leer implementiert sein ('ret'). Sie sollte aber + "formatierend" (z.B. auf Kanal 31) arbeiten, falls auf diesem + Kanal die "typ"-Abfrage "Formatieren sinnvoll" liefert. Falls + (bei Diskettenlaufwerken) mehrere Formate möglich sind, + bestimmt der Schlüssel das gewünschte Format. + + Schlüssel: wie bei IOCONTROL "size" + + Hinweis: Falls für das Formatieren ein großer Speicherbereich benö­ + tigt wird, sollte das Formatieren von Disketten besser in + einem Boot-Dialog vor dem Start von EUMEL-0 angebo­ + ten werden. Denn sonst müßte der Pagingbereich unnötig + eingeschränkt werden. + Man kann das Formatieren einer Spur CPU-intensiv im­ + plementieren (d.h. ohne DMA im DI-Modus), wenn man in + Kauf nimmt, daß alle anderen Tasks des EUMEL-Systems in + dieser Zeit "stehen". Dann sollte man aber nach jeder Spur + mehrmals die 0-Routine 'warte' aufrufen. + + Achtung: #on("i")#Ausnahmsweise darf bei dieser IOCONTROL-Funktion die + 0-Routine 'warte' aufgerufen werden.#off("i")# + + + +#b("Konfigurierung serieller Schnittstellen")# +#goalpage("v24")# + +Bei Kanälen, die hardwaremäßig auf #ib#serielle Schnittstellen#ie# (#ib#V.24#ie#) zurückgeführt werden, sind +in der Regel die Größen + + - #ib#Baudrate#ie# (..., 2400, 4800, 9600, ...) + - #ib#Zeichenlänge#ie# (7 Bits, 8 Bits) + - #ib#Parität#ie# (keine, gerade, ungerade) + +einstellbar. Dafür muß SHard die IOCONTROL-Funktionen "baud" und "bits" zur Verfü­ +gung stellen. Diese werden in zwei Modi benutzt: + + a) #on("b")#einstellend#off("b")# + Läuft der aufrufende EUMEL-Prozeß auf dem privilegierten Steuerkanal (A = 32), + wird der als Parameter mit übergebene #on("i")#adressierte Kanal#off("i")# auf die geforderten Werte + eingestellt, sofern das möglich ist. + + b) #on("b")#abfragend#off("b")# + Läuft der aufrufende EUMEL-Prozeß nicht auf Kanal 32 (A <> 32), wird lediglich + abgefragt, ob der #on("i")#adressierte Kanal#off("i")# auf die übergebenen Werte eingestellt werden + könnte. + +Aufgrund des zweiten Modus können die höheren EUMEL-Ebenen dem Anwender bei der +Konfigurierung mitteilen, welche Werte sich auf dem jeweiligen Kanal einstellen lassen. Das +nutzt z.B. das Standard-Konfigurationsprogramm aus. + +Hinweis: Bei einigen Kanälen (z.B. bei einem integrierten Terminal oder einer Parallel­ + schnittstelle) sind Baudrateneinstellungen sinnlos. Bei anderen können sie nur + hardwaremäßig vorgenommen werden (Jumper, Dip Switches). In allen diesen + Fällen muß SHard bei allen Einstellungen 'unmöglich' melden. (Standardmäßig + wird der Anwender bei der Einstellung seiner Konfiguration dann auch nicht + danach gefragt.) + + + #d("IOCONTROL ""baud""")# + + Eingang: A eigener Kanal (1...15 / 32) + BC 8 + DE adressierter Kanal + HL Schlüssel + Ausgang: BC Rückmeldung (0 = ok, 1 = nicht möglich) + + Zweck: Wird diese Routine auf dem Steuerkanal (A=32) aufgerufen, + wird die angegebene Baudrate für den durch Register DE + adressierten Kanal eingestellt, falls das möglich ist. + Wird diese Routine auf einem anderen Kanal als 32 aufge­ + rufen, informiert sie den Aufrufer lediglich, ob eine derartige + Einstellung des adressierten Kanals möglich wäre. + + Schlüssel: 1 50 Baud + 2 75 Baud + 3 110 Baud + 4 134.5 Baud + 5 150 Baud + 6 300 Baud + 7 600 Baud + 8 1200 Baud + 9 1800 Baud + 10 2400 Baud + 11 3600 Baud + 12 4800 Baud + 13 7200 Baud + 14 9600 Baud + 15 19200 Baud + 16 38400 Baud + + Anmerkung: In der Regel werden nicht alle Baudraten vom SHard un­ + terstützt werden. Bei V.24 Schnittstellen sollten aber min­ + destens 2400, 4800 und 9600 Baud zur Verfügung stehen, + besser auch 300, 600, 1200 und 19200 Baud. + + Hinweis: Falls SHard-spezifisch weitere Baudraten implementiert + werden sollen, darf SHard hierfür negative Schlüsselwerte + (Register HL) vergeben. + + + #d("IOCONTROL ""bits""")# + + Eingang: A eigener Kanal (1...15 / 32) + BC 9 + DE adressierter Kanal + HL Schlüssel + Ausgang: BC Rückmeldung (0 = ok, 1 = nicht möglich) + + Zweck: Wird diese Routine auf dem Steuerkanal (A=32) aufgerufen, + wird die angegebene Zeichenlänge (Bits pro Zeichen) und + Parität für den durch Register DE adressierten Kanal einge­ + stellt, falls das möglich ist. + Wird diese Routine auf einem anderen Kanal als 32 aufge­ + rufen, informiert sie den Aufrufer lediglich, ob eine derartige + Einstellung des adressierten Kanals möglich wäre. + + + Schlüssel: stop * 32 + par * 8 + (bit - 1) + + stop: 0 1 Stopbit + 1 1.5 Stopbits + 2 2 Stopbits + + par: 0 keine Parität + 1 ungerade Parität + 2 gerade Parität + + bit: 1...8 Bits pro Zeichen + + + Anmerkung: In der Regel werden nicht alle Kombinationen vom SHard + unterstützt werden. Bei V.24 Schnittstellen sollten aber + möglichst 1 Stopbit, 7 und 8 Bits pro Zeichen und alle drei + Paritätseinstellungen zur Verfügung stehen. + + Hinweis: Falls SHard-spezifisch weitere Einstellungen implementiert + werden sollen, darf SHard hierfür negative Schlüsselwerte + (Register HL) vergeben. + + + + +#b("Flußkontrolle")# +#goalpage("fluss")# + +Die stromorientierten Kanäle (1...15) werden nicht nur zum Anschluß schneller Geräte (wie +Terminals) verwendet, sondern auch, um langsame Geräte (wie Drucker) anzuschließen, die +die Daten u.U. nicht so schnell übernehmen können, wie sie der Rechner schickt. Dabei ist +auf eine geeignete Flußkontrolle zu achten (nicht schneller senden, als der Andere emp­ +fangen kann). Dieses Problem stellt sich auch bei einer Rechner-Rechner-Kopplung. Hier +ist in der Regel sogar zweiseitige Flußkontrolle notwendig. + +Als Flußkontrolle ist die #ib#REQUEST TO SEND/CLEAR TO SEND#ie# Logik der V.24-Schnitt­ +stelle oder das #ib#XON/XOFF#ie#-Protokoll zu verwenden. Das letztere kann auch bei Parallel­ +schnittstellen eingesetzt werden. + +Zur eingabeseitigen Flußkontrollsteuerung kann SHard die Rückmeldung der 0-Routine +'inputinterrupt' (siehe S.#topage("inp")#) und die IOCONTROL-Funktion "weiter" (siehe S.#topage("weiter")#) verwen­ +den: + +Unterschreitet die Rückmeldung einen von SHard zu bestimmenden Schwellwert, muß SHard +auf der V.24-Schnittstelle das Signal 'REQUEST TO SEND' wegnehmen bzw. XOFF senden. +Dadurch wird bei den meisten Fremdrechnern ein weiteres Senden unterbrochen, sofern (im +ersten Fall) das Signal 'REQUEST TO SEND' dort mit dem V.24-Eingang 'CLEAR TO +SEND' verbunden ist. Wird von EUMEL-0 "weiter" aufgerufen, so kann auf dem enspre­ +chenden Kanal wieder empfangen werden (RTS setzen bzw. XON senden). + +Für die ausgabeseitige Flußkontrolle muß rechnerseitig ebenfalls das Signal 'CLEAR TO +SEND' bzw. der Empfang von XOFF/XON berücksichtigt werden. Wenn an der Schnittstelle +das 'CLEAR TO SEND' weggenommen wird, darf SHard keinen weiteren Output auf dieser +Schnittstelle machen, bis 'CLEAR TO SEND' wieder anliegt. Entsprechend muß der Empfang +von XOFF die Ausagbe anhalten und XON sie wieder starten. + +Bemerkung: Die meisten Systeme enthalten die CTS-Funktion schon in ihrer Hardware, + so daß im SHard dafür keine Vorkehrungen getroffen werden müssen. + + +Zur Einstellung der gewünschten Flußkontrolle eines Kanals dient die IOCONTROL-Funk­ +tion "flow". Ähnlich wie "baud" und "bits" wirkt auch "flow" nur auf Kanal 32 #on("i")#einstellend#off("i")# +und auf allen anderen Kanälen lediglich #on("i")#abfragend#off("i")#. + + + #d("IOCONTROL ""flow""")# + + Eingang: A eigener Kanal (1...15 / 32) + BC 6 + DE adressierter Kanal + HL Modus + Ausgang: BC Rückmeldung (0 = ok, 1 = nicht möglich) + + Zweck: Wird diese Routine auf dem Steuerkanal (A=32) aufgeru­ + fen, muß sie den gewünschten Flußkontrollmodus für den + adressierten Kanal einstellen. + Dabei sind folgende Modi festgelegt: + + HL= 0 Keine Flußkontrolle + HL= 1 XON/XOFF (in beide Richtungen) + HL= 2 RTS/CTS (in beide Richtungen) + HL= 5 XON/XOFF (nur ausgabeseitig) + HL= 6 RTS/CTS (nur ausgabeseitig) + HL= 9 XON/XOFF (nur eingabesetig) + HL=10 RTS/CTS (nur eingabeseitig) + + Wenn keine Flußkontrolle gewünscht wird (HL=0), muß SHard + "weiter" ignorieren; bei HL=1 oder HL=9 muß bei "stop" + XOFF und bei "weiter", sofern zuletzt XOFF geschickt wurde, + XON geschickt werden; bei HL=2 oder HL=10 muß bei + "stop" das Signal RTS auf low und bei "weiter" wieder auf + high gesetzt werden. Mit "stop" ist hierbei das Unterschreiten + des Schwellwertes bei der Rückmeldung von "inputinterrupt" + gemeint. + Bei HL=1 oder HL=5 müssen empfangene XON/XOFF-Zei­ + chen, bei HL=2 oder HL=6 das Signal CTS beachtet wer­ + den. + + Wird diese Routine auf einem anderen Kanal als 32 aufge­ + rufen, informiert sie den Aufrufer lediglich, ob der geforderte + Flußkontrollmodus auf dem adressierten Kanal einstellbar + wäre. + + Hinweis: Falls SHard-spezifisch weitere Flußkontrollmodi implemen­ + tiert werden sollen, darf SHard hierfür negative Moduswerte + (Register HL) vergeben. + + "weiter" wird von EUMEL-0 sehr oft aufgerufen. Es ist daher + nicht sinnvoll, jedesmal XON zu senden, da dies die Gegen­ + stelle damit überfluten würde. SHard muß sich merken, ob der + Kanal im XOFF-Zustand ist und nur dann bei "weiter" ein + XON senden. + +#b("Kalender")# +#goalpage("kalender")# + +Die Datums- und Uhrzeitabfrage ist bei Rechnern mit eingebauter Uhr unnötig. EUMEL holt +sich Datum und Uhrzeit dann von SHard. + + #d("IOCONTROL ""calendar""")# + + Eingang: CX 10 + DX (1=Minute, 2=Stunde, 3=Tag, 4=Monat, 5=Jahr) + gewünscht + Ausgang: CX Rückmeldung + + Zweck: Erfragen von Datum und Uhrzeit. Falls keine Uhr vorhanden + ist, muß bei jedem Aufruf -1 zurückgemeldet werden, bei + eingebauter Uhr jeweils das Gewünschte (Minute: 0..59, + Stunde: 0..23, Tag: 1..7, Monat: 1..12, Jahr: 0..99). Die Rück­ + meldung muß als BCD-Zahl erfolgen. + + Hinweis: Die Uhr darf zwischen zwei Aufrufen umspringen. Die daraus + resultierende Probleme werden auf höheren Ebenen abgehan­ + delt. + + + + +#bb("6. SHard-","Interface Version")# +#goalpage("shdver")# + +Die #ib#Versionsnummer#ie# der Interface-Spezifikation, auf der SHard aufbaut, muß als 1-Byte- +Konstante #ib#SHDVER#ie# in der SHard-Leiste stehen. Für das hier beschriebene Interface muß sie +den Wert 8 haben. + +So sind spätere Erweiterungen des SHard-Interfaces möglich, ohne daß alle SHard- +Moduln geändert werden müssen. + + + +#bb("7. ","ID-Konstanten")# +#goalpage("ID")# + +SHard muß direkt hinter SHDVER vier 2-Byte-Konstanten ablegen. Diese können von den +höheren Ebenen durch die ELAN-Prozedur + + INT PROC #ib#id#ie# (INT CONST no) + +abgefragt werden. Dabei werden id(0) bis id(3) von EUMEL-0 geliefert, während SHard in der +Leiste die Werte für id(4) bis id(7) zur Verfügung stellen muß: + + ID4 #ib#Lizenznummer#ie# des SHards *) +#foot# +#f#*) Dieser Wert muß mit der Nummer des Lizenzvertrags zwischen Implementierer und GMD übereinstimmen!#a# +#end# + + ID5 #ib#Installationsnummer#ie# des EUMEL-Anwenders **) +#foot# +#f#**) Diese Nummer vergibt der Lizenznehmer an die von ihm belieferten Anwender.#a# +#end# + + ID6 zur freien Verfügung + + ID7 zur freien Verfügung + + + + +#bb("8. ","Zusätzliche Leistungen")# +#goalpage("shdelan")# + +Will der SHard-Implementierer zusätzliche Leistungen anbieten, die mit den Standardopera­ +tionen nicht möglich sind, kann er weitere Codes für BLOCKIN, BLOCKOUT und +IOCONTROL zur Verfügung stellen. Um Überdeckungen mit Codes zu vermeiden, die von +EUMEL-0 intern verwendet oder erst später eingeführt werden, darf SHard für zusätzliche +Leistungen nur negative Werte als 'Funktionscode 1' verwenden. + + +Zum Ansprechen der neuen Leistungen stehen die ELAN-Prozeduren #on("i")#'#ib#blockout#ie#', '#ib#blockin#ie#'#off("i")# +und #on("i")#'#ib#control#ie#'#off("i")# zur Verfügung. + +Ferner steht dem SHard ein Parameterkanal (32) zur Verfügung. Funktionen, die (im Multi- +User) nicht jeder Task zur Verfügung stehen dürfen, müssen über diesen Kanal 32 abge­ +wickelt werden und dürfen nur dort wirken. + + + PROC blockout (ROW 256 INT CONST para, (* --> HL *) + INT CONST funktion1, (* --> BC *) + funktion2, (* --> DE *) + INT VAR antwort) (* <-- BC *) + + PROC blockin (ROW 256 INT VAR para, (* --> HL *) + INT CONST funktion1, (* --> BC *) + funktion2, (* --> DE *) + INT VAR antwort) (* <-- BC *) + + PROC control (INT CONST funktion1, (* --> BC *) + funktion2, (* --> DE *) + funktion3, (* --> HL *) + INT VAR antwort) (* <-- BC *) + +Hinweis: Der SHard darf für 'funktion 1' (BC) zusätzlich zu den hier beschriebenen Stan­ + dardcodes nur negative Codes vereinbaren. + + +Beispiel: + + Gibt eine Task, die durch 'continue (x)' an Kanal 'x' hängt, den Befehl + + control (-7,1200,13,antwort), + + so wird IOCONTROL mit (A='x', BC=-7, HL=13, DE=1200) aufgerufen. Verläßt + SHard 'control' mit BC = 1, so enthält 'antwort' anschließend eine 1. + + +Hinweis: Um die zusätzlichen Leistungen dem Anwender einfach (und abgesichert) zur + Verfügung zu stellen, sollte man sie in ein ELAN-Paket einbetten und dieses + ebenfalls an die Anwender ausliefern. + + Beispiel: PACKET zusatz DEFINES fanfare, ... : + + PROC fanfare (INT CONST tonhoehe, dauer) : + + IF dauer < 0 + THEN errorstop ("negative dauer") + ELIF tonhoehe < 16 + THEN errorstop ("infraschall") + ELIF tonhoehe > 20000 + THEN errorstop ("ultraschall") + ELSE control (-37, 20000 DIV tonhoehe, dauer) + FI + + ENDPROC fanfare ; + + . . . + + + + +#bb("9. ","Spezialroutinen")# +#goalpage("ke")# + +Als Testhilfe und zur Fehlerdiagnose kann SHard in seine Routinen Kontrollereignisse einbau­ +en. Das geschieht durch Aufruf der 0-Routine 'info'. Dieser EUMEL-Debugger wird im +Anhang A (siehe S.#topage("info")#) beschreiben. + + #dx("info")# (0-Routine) + + Aufruf: call info + jr weiter + defm ' text' + weiter: + + Zweck: Info wird aufgerufen. Dabei wird 'text' zur Identifikation des + Kontrollereignisses ausgegeben. #on("i")#Der übergebene Text muß + mit einem Blank beginnen!#off("i")# + + Hinweis: Bei Systemen "ohne Info" (nur solche dürfen an Anwender + ausgeliefert werden) wird nur der Info-Text ausgegeben und + EUMEL-0 angehalten. + + Achtung: Da der Info selbst die hier beschriebenen Stream-IO-Rou­ + tinen benutzt, darf man ihn von diesen Routinen aus (input­ + interrupt, OUTPUT, IOCONTROL "frout", IOCONTROL + "weiter") nicht aufrufen. Wenn die Ein-/Ausgabe auf Termi­ + nal 1 interruptgetrieben läuft, dürfen die Interrupts beim + Info-Aufruf natürlich nicht gesperrt sein. + + +Falls SHard für bestimmte Aktionen, die selten durchgeführt werden (z.B. Formatieren), viel +Speicher benötigt, kann er diesen dynamisch anfordern und später wieder freigeben. + + #dx("grab")# (0-Routine) + + Eingang: HL Anfangsadresse des zu reservierenden Bereichs im + Datensegment von EUMEL-0, muß auf 512 Byte + ausgerichtet sein. + BC Länge des zu reservierenden Bereichs in 512-Byte- + Kacheln + Ausgang: BC Rückmeldecode + + Zweck: Wenn möglich wird der zu verlangte Bereich von EUMEL-0 + "leergekämpft" und SHard zur Verfügung gestellt. + Rückmeldecode: 0 ok, Speicher steht zur Verfügung + 1 augenblicklich nicht möglich + 3 grundsätzlich nicht möglich + + Achtung: Der Aufruf von 'grab' wird in der Regel 'warte' und Block-IO + auf Kanal 0 induzieren. + + Hinweis: Es wird empfohlen, Speicher ab A000h anzufordern, da diese + Adresse stets im frei einplanbaren Paging-Bereich liegt. + + + #dx("free")# (0-Routine) + + Eingang: HL Anfangsadresse des freizugebenden Bereichs im + Datensegment von EUMEL-0, muß auf 512 Byte + ausgerichtet sein. + BC Länge des zu freizugebenden Bereichs in 512-Byte- + Kacheln + + Zweck: Der entsprechende Bereich muß vorher mit 'grab' beschafft + worden sein. Hiermit wird er wieder EUMEL-0 zur freien + Verfügung gestellt. + + +Für spezielle Fehlersituationen steht die 0-Routine 'shutup' zur Verfügung. Damit kann +SHard z.B. bei Netzausfall ein kontrolliertes Systemende erzwingen. Das ist allerdings nur +sinnvoll, wenn durch Batteriepufferung oder Ähnliches sichergestellt ist, daß noch genügend +Zeit bleibt, um alle Seiten auf den Hintergrund zurückzuschreiben. + + #dx("shutup")# (0-Routine) + + Zweck: Erzwingt Rückschreiben aller Seiten und Systemende, d.h. + entspricht der ELAN-Prozedur 'shutup'. + + Achtung: Der Aufruf von 'shutup' wird in der Regel 'warte' und Block- + IO auf Kanal 0 induzieren. +#page# +#cc("Teil 4: ","Tips zur Portierung")# +#goalpage("tips")# + + +#b("0-Version des SHards")# +#goalpage("0ver")# + + +Es wird empfohlen, zuerst eine "0-Version" des SHard zu entwickeln, die möglichst einfach +aufgebaut und nicht auf Effizienz und vollständige Ausnutzung der Betriebsmittel ausge­ +richtet sein sollte. Damit kann man rasch praktische Erfahrung gewinnen, die dann den +Entwurf und die Implementation des eigentlichen SHard erleichtert. Die 0-Version sollte + + - keinen Schattenspeicher kennen (SCHINF meldet 0), + + - nur die Kanäle 0 (Hintergrund), 1 (Terminal) und 31 (Archiv) behandeln, + + - keine Baudraten-, Zeichenlängen-, Paritäts- und Flußkontrolleinstellungen unter­ + stützen (immer 'nicht möglich' melden), + + - vorhandene (ROM-) Routinen möglichst nutzen, ohne sich um Unschönes wie + "busy wait" beim Floppy- bzw. Plattenzugriff zu grämen. + +Mit dieser 0-Version sollte man dann versuchen, EUMEL zu starten. Da der Hintergrund +beim ersten Mal noch leer ist, muß man das HG-Archiv (Archivfloppy mit EUMEL-0 und +höheren Ebenen) in das Archivlaufwerk einlegen und von dort laden. Der Vortest sollte sich +direkt nach dem Start folgendermaßen auf Terminal 1 melden: + + E U M E L - Vortest + + Terminals: 1, + RAM-Groesse (gesamt): 64 kB + Pufferbereich: ? kB + Hintergrund-Speicher: ? kB + + Speichertest: ************ + +Man sollte während der ****-Ausgabe des Speichertests irgendein Zeichen eingeben. Das +EUMEL-System muß dann in das ausführliche Start-Menü überwechseln. (Andernfalls +funktioniert die Eingabe nicht richtig!) + +Als nächstes sollte man versuchen, den Hintergrund vom Archiv aus zu laden. (Diese Mög­ +lichkeit wird im Start-Menü angeboten.) Nach dem Ende dieser Operation wird der +EUMEL-Lauf automatisch beendet. Jetzt kann man das HG-Archiv aus dem Archivlauf­ +werk entfernen und das System neu starten. Dann sollte EUMEL-0 vom Hintergrund geladen +werden. + +Bei Problemen kann der "Info" (siehe S.#topage("info")#) hilfreich sein. Voraussetzung für seine Ver­ +wendung ist aber, daß die Terminal Ein-/Ausgabe schon funktioniert. + +Beim Start des EUMEL-Systems kann (wie im Systemhandbuch beschrieben) durch den +Konfigurationsdialog der Terminaltyp von Kanal 1 eingestellt werden. Falls das verwendete +Terminal in dieser Liste nicht aufgeführt wird und auch keinem der aufgeführten (in Bezug auf +die Steuercodes) gleicht, kann man z.B. + + - den neuen Terminaltyp an einem anderen EUMEL-Rechner verfügbar machen + (Umsetztabellen definieren) und per Archiv zum neuen Rechner tragen, + + - die notwendigen Umcodierungen per SHard durchführen. + +Diese Problematik entsteht bei Rechnern mit integriertem Terminal in der Regel nicht, weil +Steuerzeichen dort sowieso algorithmisch interpretiert werden müssen. In diesem Fall wird +man direkt die EUMEL-Codes als Grundlage wählen, so daß keine Umsetzungen erfor­ +derlich sind. + +Bei einer provisorischen Anpassung kann man auf Invers-Video ohne weiteres verzichten. + + +Im Gegensatz zu der 0-Version sollte man bei der eigentlichen SHard-Implementierung +darauf achten, die Möglichkeiten der Hardware effizient zu nutzen. Der Testverlauf entspricht +dann wieder im wesentlichen dem oben beschriebenen Vorgang. + + + +#b("Typische Fehler")# +#goalpage("fehler")# + + + a) SHard-Routinen zerstören Registerinhalte bzw. sichern sie beim Interrupt nicht + vollständig. Hierbei sollte man auch an den zweiten Registersatz des Z80-Pro­ + zessors und an die Register IX und IY denken. + + b) 'call' bzw. 'ret' verändern den Stackpointer. + + c) Fehler bei der Interruptbehandlung führen zu Blockaden ("hängende Interrupts"). + + d) Cursorpositionierung außerhalb des Bildschirms bei einem internen Terminal + (Bildwiederholspeicher im Rechner) wird nicht abgefangen. Das führt dann zu + wildem Schreiben in den Hauptspeicher. + + e) 'warte' wird unerlaubt aufgerufen. ('warte' darf nur von BLOCKIN, BLOCKOUT, + IOCONTROL "size" und IOCONTROL "format" aus aufgerufen werden. Ferner + kann man 'warte' noch nicht beim Systemladen aufrufen!) + + f) OUTPUT-Verhaspler oder -Blockaden entstehen durch Fehlsynchronisation + zwischen dem Füllen des Ausgabepuffers durch die Routine OUTPUT und der + Interruptroutine, die den Puffer leert und ausgibt. + + g) IOCONTROL "frout" meldet in gewissen Situationen nie "mindestens 50 Zei­ + chen im Puffer frei" und "Puffer leer". Das kann schon im Vortest zu Output- + Blockaden führen. + + h) Obwohl "frout" einen Wert größer als x meldet, nimmt "output" nicht alle x + Zeichen an. + + i) IOCONTROL "size" meldet falsche Werte. + + j) IOCONTROL verkraftet keine beliebigen (auch unsinnige) Werte. + + k) BLOCKIN bzw. BLOCKOUT geben die Kontrolle an das System zurück, bevor alle + Daten übertragen sind. (Sofort nach der Rückgabe geht EUMEL-0 davon aus, + daß der Puffer frei ist und anderweitig benutzt werden kann!) + + l) Einem SIO-Baustein wird nach Ausgabe des letzten Zeichens oder nach Ände­ + rung des externen Status nicht mitgeteilt, daß keine Interrupts mehr erzeugt + werden sollen. (SIOs wiederholen Interrupts so lange, bis man es ihnen explizit + verbietet!) + + m) Die Stepping-Rate eines Festplattencontrollers wird falsch eingestellt, bezie­ + hungsweise die Platte wird nicht im 'buffered step mode' betrieben, obwohl sie + beschleunigend positionieren kann. Dadurch werden die Zugriffszeiten auf dem + Hintergrund unnötig verlangsamt. Man bedenke, daß man so einen Fehler leicht + übersieht, weil sich das System nicht fehlerhaft, sondern nur langsamer verhält. + Außerdem macht sich die Verlangsamung erst bemerkbar, wenn größere Teile des + Hintergrundes benutzt werden. + + n) Bei schnellem Zeichenempfang treten "Dreher" auf. Das deutet meistens auf + einen rekursiven Aufruf der 0-Routine 'inputinterrupt' hin. Dabei überholt dann + das zweite Zeichen das erste. + + o) Bei schnellem Zeichenempfang, speziell bei gleichzeitiger Ausgabe, gehen Einga­ + bezeichen verloren oder werden verfälscht. In der Regel ist das auf Timingpro­ + bleme bei der Interruptbehandlung zurückzuführen. Interrupts gehen verloren bzw. + die Zeichen werden nicht schnell genug abgeholt. + + +#b("Effizienzprobleme")# +#goalpage("eff")# + + a) Bei #on("i")##on("b")#V.24- und Parallelschnittstellen#off("i")##off("b")# ist schlechter Durchsatz in der Regel auf + Fehlverhalten von "frout" zurückzuführen. Auch kostet es in Multi-User-Sy­ + stemen sehr viel, wenn OUTPUT immer nur ein Zeichen übernimmt. (Dann läuft + der ganze Apparat der EUMEL-0-Maschine für jedes Zeichen wieder an.) + + Besonders bei der Parallelschnittstelle achte man darauf, daß nicht durch un­ + glückliches Timing häufig Blockaden auftreten. So kann zu kurzes 'busy wait' auf + Freiwerden der Parallelschnittstelle dazu führen, daß jedes zweite Zeichen + abgelehnt wird, so daß OUTPUT faktisch zeichenweise arbeitet. Andererseits darf + natürlich 'busy wait' auch nicht auf Millisekunden ausgedehnt werden. + + + b) Wenn #on("i")##on("b")#Floppies ohne DMA#off("i")##off("b")# angeschlossen werden, kann man bei Single- + User-Systemen ohne weiteres 'busy wait' einsetzen, um nach dem Seek- + Vorgang auf den Block zu warten. Im Multi-User sollte das aber wenn irgend + möglich umgangen werden, da eine halbe Umdrehung immerhin ca. 100 ms + kostet. + Falls nur ein Endeinterrupt nach jeder Floppyoperation zur Verfügung steht, kann + folgendes Verfahren günstig sein: + + seek befehl an controller ; + warten auf endeinterrupt ; + lesebefehl ohne datentransport auf sektor davor ; + warten auf endeinterrupt ; + lese oder schreib befehl auf adressierten sektor ; + cpu intensives warten und datentransport . + + Die Dummyoperation auf den Sektor vor dem adressierten dient dabei nur dazu, + ohne CPU-Belastung einen Zeitpunkt zu finden, wo man dem eigentlichen Sektor + möglichst nahe ist. Die Zeit, in der die CPU benötigt wird, sinkt damit auf ca. 25 + ms. Die Implementation dieses Algorithmus' ist aber nicht ganz einfach, da die + 0-Routine 'warte' wegen der verlangten kurzen Reaktionszeiten nicht verwendet + werden kann. Alle 'warte auf ...' müssen also durch Interrupts realisiert werden: + + setze interrupt auf lesen davor ; + stosse seek an ; + REP + warte + UNTIL komplette operation beendet ENDREP . + + lesen davor : + setze interrupt auf eigentliche operation ; + stosse lesen davor an . + + eigentliche operation : + ignoriere fehler beim datentransport ; + stosse lesen oder schreiben an ; + REP + REP UNTIL bereit ENDREP ; + uebertrage ein byte + UNTIL alles uebertragen ENDREP ; + melde komplette operation beendet . + + + c) Bei der Ansteuerung von #on("i")##on("b")#Harddisks#off("b")##off("i")# sollte man darauf achten, daß die 0-Rou­ + tine 'warte' nicht öfter als notwendig aufgerufen wird. Sonst wird das Paging zu­ + gunsten der CPU-intensiven Prozesse zu stark verlangsamt. Z.B. kann man bei + vielen Plattencontrollern auf eine eigene Seek-Phase verzichten: + + beginne seek ; beginne seek und lesen ; + REP REP + warte warte + UNTIL fertig PER ; UNTIL fertig PER + beginne lesen ; + REP + warte + UNTIL fertig PER + + Hier braucht die linke Fassung immer mindestens ein 'warte' mehr als die rechte. + Bei starker CPU Belastung wird sie deshalb bis zu 100 ms länger für das Einle­ + sen eines Blocks benötigen. + + Eine ähnliche Situation kann auftreten, wenn die Platte in 256-Byte-Sektoren + unterteilt ist, so daß zu jedem EUMEL-Block zwei Sektoren gehören. Wenn + möglich sollte dann zwischen diesen beiden Sektoren kein 'warte' aufgerufen + werden. Andererseits darf natürlich auch nicht längere Zeit CPU-intensiv gewar­ + tet werden. Evtl. lohnt es sich in solchem Fall, mit der Sektorverschränkung zu + experimentieren. + +#page# +#cc("Anhang A: EUMEL-","Debugger ""Info""")# +#goalpage("info")# + + +Für interne Testzwecke gibt es den "Info". Systeme "mit Info" und "ohne Info" unterschei­ +den sich nur im EUMEL-0-Teil (Urlader). Der SHard-Implementierer erhält zum Test +Hintergründe "mit Info" und zur Auslieferung solche "ohne Info". Infofähige Systeme dürfen +nur von den SHard-Implementierern verwendet werden. + + #on("i")##on("b")#Achtung: Infofähige Systeme dürfen auf keinen Fall an Anwender ausgeliefert wer­ + den, da vermittels Info alle Systemsicherungs- und Datenschutzmaßnah­ + men unterlaufen werden können.#off("i")##off("b")# *) +#foot# +#f#*) Ausnahmen von dieser Regel bedürfen der expliziten Zustimmung der EUMEL-Systemgruppe (GMD bzw. HRZ +Bielefeld) und des jeweiligen Anwenders. Solche System müssen immer durch spezielle Schlüsselworte abgesichert werden.#a# +#end# + + +#b("Aufruf des Info")# +#goalpage("aufrinf")# + +Zum Aufruf des Infos gibt es drei Möglichkeiten: + + a) Beim Start des EUMEL-Systems geht man durch Eingabe eines beliebigen Zei­ + chens während des Vortests in den ausführlichen Start-Dialog. Durch Eingabe von + 'I' gelangt man dann in den Info-Modus. #on("i")#(Diese Möglichkeit wird in dem Start­ + menü nicht aufgeführt.)#off("i")# + + b) Man kann den Info durch die ELAN-Prozedur 'ke' aufrufen. D.h. wenn das System + gestartet wurde und sich eine Task am Terminal mit "gib kommando" gemeldet + hat, kann man durch 'ke *return*' in den Info-Modus gelangen. + + c) Wenn sich am Terminal keine Task befindet, die auf Eingabe wartet, gelangt man + durch die Tastenfolge 'i *info*' (*info* meist = CTL d, zur Tastendefinition siehe + "Systemhandbuch, Konfigurierung") in den Info-Modus. + +Alle diese Möglichkeiten funktionieren nur bei infofähigen Systemen. + +Bei schweren Systemfehlern, die eine Weitermeldung an die höheren Ebenen des EUMEL- +Systems unmöglich machen, wird soweit möglich ebenfalls der Info aufgerufen. Bei Systemen +"ohne Info" wird lediglich eine Meldung auf Kanal 1 ausgegeben und das System angehalten. + +Bevor das System Infokommandos annimmt, muß mit dem Kommando 'P' ein Paßwort einge­ +geben werden. Lediglich dieses Kommando und das Kommando 'g' werden immer angenom­ +men. Das Paßwort kann mit dem Kommando 'yP' oder mit der ELAN-Prozedur "info +password" eingestellt werden. + +#b("Info-Format")# +#goalpage("forminf")# + +Der Info ist bildschirmorientiert. Beim Aufruf des Infos und nach den meisten Info-Kom­ +mandos werden die drei obersten Zeilen wie folgt aufgebaut: *) +#foot# +#f#*) Bildschirmgetreues Verhalten kann der Info allerdings erst nach der Konfigurierung des Kanals zeigen. Vorher (d.h. +insbesondere beim Aufruf aus dem Vortest heraus) werden Cursorpositionierungen in der Regel nicht korrekt durchgeführt.#a# + +#end# + +#limit(14.0)# +XY TEXT +F A C B E D L H F A C B E D L H IX SP IY PC +xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx xx +#limit(12.0)# + +wobei + + X den Miniprozeß bezeichnet, der den Übergang in den Info veranlaßt hat (A=Archiv, + E=Elan, L=Lader, M=Müllabfuhr), + + Y den Maxiprozeß (Task) bezeichnet, der gerade durch den Elan-Prozessor bear­ + beitet wird (Y ist code (tasknummer + code ("0"))), + + TEXT den Grund für den Info-Modus anzeigt, + +Die zweite und dritte Zeile zeigen die Inhalte der Z80-Register an (beide Registersätze). +In der untersten Zeile erscheint die Eingabeaufforderung 'info:'. + + +#b("Info-Kommandos")# +#goalpage("cmdinf")# + +Info-Kommandos können in der 'info:'-Zeile mit dem Format + + [] + +gegeben werden oder, wenn der Cursor sich im Dump befindet, mit dem Format + + + +wobei dann für die der Cursorposition entsprechende Dumpadresse (modulo 2**16) +gesetzt wird (siehe '*cup*'). + + ist immer in Hexaform einzugeben. + +'g' Der Info-Modus wird wieder verlassen. Dies ist allerdings bei harten Fehlern ge­ + sperrt. + +'z' Der Leitblock des angezeigten Maxiprozesses wird dargestellt, falls = 0 ist, + sonst der Leitblock der Task mit der Nummer . (Nur im ELAN-Miniprozeß). + +'q' Die Task mit der Nummer wird nach dem nächsten 'g'-Kommando in den + Info überführt. Dies ist nötig, wenn man sich die Datenräume dieser Task anschauen + will ('s'). + +'s' Dumps werden auf den Datenraum eingestellt. Ist =FF, so wird der + Realspeicher eingestellt. (s:=) + +'l' Dumps werden auf die Länge eingestellt. Desungeachtet kann man einen + versehentlich zu langen Dump durch eine beliebige Eingabe abbrechen. Dann wird + allerdings '*cup*' gesperrt (siehe unten). + +'p' Dumps werden auf die Byteadresse eingestellt (p:=; wmodus:= + FALSE). + +'w' Dumps werden auf die Wortadresse eingestellt. Die vor jeder Dumpzeile + ausgegebene Adresse ist dann auch eine Wortadresse. Ein Wort = 2 Bytes. (p:=2* + ; wmodus:=TRUE) + +'k' Block laden und per Dump anzeigen. Es erfolgt dabei eine Umstellung auf + den Realdatenraum (s=FF). + +'P' Paßworteingabe: P*return* + Erst nach diesem Kommando sind die übrigen Kommandos ausführbar. + +'x' Suchen nach Bytekette: + +--> xc text +--> xh xx xx ... +--> x + + Es wird nach 'text' bzw. Hexafolge 'xx xx ...' bzw. nach der durch das letzte + 'x'-Kommando eingestellten Bytekette gesucht. + Das Kommando ist durch *return* abzuschließen. + Die Suche beginnt ab Position 'p' und ist auf die Länge Seiten (512 Byte- + Einheiten) begrenzt (0=unendlich). + Eine beliebige Eingabe bricht die Suche vorzeitig ab. + +'*return*' + Es wird der eingestellte Dump ausgegeben (siehe 's','l','p','w'). Bei wmodus (siehe + 'p', 'w') werden Wortadressen ausgegeben. + +'o' Wie '*return*', jedoch wird zuvor p := p+l gesetzt (zum Weiterblättern). + +'r' Freigabe der anderen Miniprozesse. + + Zunächst werden bei Übergang in den Info alle Miniprozesse gesperrt, um eine + Verfälschung der Fehlersituation zu vermeiden. Bei manchen Kommandos an den Info + müssen aber andere Miniprozesse u.U. aktiv werden (z.B. beim 'k' der Lader). Wenn + dies erforderlich ist, meldet der Info: + 'paging erforderlich'. Man kann dann 'r' geben und das letzte Infokommando wieder­ + holen, oder mit anderen Kommandos fortfahren, falls man den Fehlerzustand noch so + beibehalten will. + +'y' Zweitfunktion ausführen. + +--> 'yP*return*' + Neues Paßwort einstellen (max. 9 Zeichen). Dieses bleibt auch nach 'shutup' + gültig. + +--> 'yt' Block von Archiv lesen. Dient zum Test des Archivs. + Es wird eine Kachel freigemacht und der Block mit der Nummer + eingelesen. Der Inhalt wird sofort angezeigt (wie Kommando 'k'). + +--> 'yb' Breakpoint an die Adresse setzen. Es wird ein Aufruf an den Info + abgesetzt. Nur im Realspeicher sinnvoll. Dieser Aufruf meldet sich mit + TEXT= 'test'. Wird er mit 'g' verlassen, so stellt Info zuvor die alten + Z80-Befehle wieder her und führt sie an ihrem originalen Ort aus. + +--> 'yc' wie 'yb', jedoch werden die originalen Z80-Befehle an einem anderen Ort + (im Info) ausgeführt. Sie dürfen daher z.B. keinen Relativsprung enthalten + und keine 'push'/'pop'-Befehle. Dafür bleibt dieser Breakpoint auch nach + dem zugehörigen 'g' im Code erhalten. Dieser Breakpoint meldet sich mit + TEXT='test 2'. 'yc' darf nicht gegeben werden, wenn der Info im 'test 2' + steht (Umhängen verboten). + + #on("i")#Achtung: Die Verwendung von 'yb' und 'yc' ist sehr kritisch durchzuführen. + Zu beachten ist, daß der in den Code eingesetzte Sprung (Z80 jp) + 3 Byte belegt.#off("i")# + + +--> 'yl' Lernmodus ein (wie beim Editor). + +--> 'ye' Ende Lernmodus. + +--> 'ya' Ausführen. Die zwischen 'yl' und 'ye' eingegebenen Zeichen werden dem + Info so vorgesetzt, als kämen sie von der Tastatur. + + Achtung: Rekursion ('ya' im Lernmodus) wird nicht abgefangen. Das Gelern­ + te wird nach jedem Kommando, das die ersten drei Zeilen + wiederaufbaut (z.B. *return*), in der Zeile vier angezeigt, wobei + für Steuerzeichen eine Ersatzdarstellung erscheint (%x mit + x=code (code (zeichen) +code ("A")), also z.B. %M für + *return*). + +--> 'y *return*' + Wie *return*, jedoch wird der Dump auch beim Ausführen (ya) ausgege­ + ben. (Ein gelerntes *return* führt im Ausführmodus nicht zum Dump). + +'*cup*' *) (Cursor up). Umschaltung in den Modus zum Ändern in Dumps. +#foot# +#f#*) Falls der Kanal noch nicht konfiguriert ist, muß man natürlich eine Taste betätigen, die den EUMEL-Code für Cursor +Up erzeugt. In der Regel ist das CTL c. Falls das Terminal ohne Konfigurierung keine Cursorpositionierungen durchführt, ist +dieser Modus nicht sehr gut benutzbar.#a# +#end# + Der Cursor fährt in den Dump und kann mit den Cursortasten dort bewegt + werden. Wird eine Hexazahl jetzt eingegeben, so wird diese als Inhalt des + Bytes eingetragen, auf dem der Cursor gerade steht. Dies funktioniert auch + auf beliebigen Datenräumen. Info beantragt dann bei der Speicherverwal­ + tung einen Schreibzugriff für die entsprechende Datenraumseite, so daß + Änderungen mit der Copy-on-Write-Logik erfolgen, also nur taskspezi­ + fisch sind (durch 'q' eingestellt). Für diese Task sind die Änderungen al­ + lerdings dann permanent, da sie auch auf den Hintergrund wirken. + + Hinweis: Dumpt man mit 'k' einen Block und ändert dann darin, so sind + diese Änderungen u.U. nur temporär, da der Info kein Rückschrei­ + ben des Blockes veranlaßt. + + Achtung: Jede Eingabe, die kein Positionierzeichen und kein gültiges + Zahlzeichen ist, beendet diesen Modus. Das neue Zeichen wird als + Info-Kommando aufgefaßt, wobei auf die aktuelle Adres­ + se gesetzt wird. + (Für 'yc' / 'yb' sinnvoll: Man setzt den Cursor auf die Stelle, an + der ein Break ausgelöst werden soll und gibt 'yc'/'yb'). + Somit wird dieser Änderungsmodus üblicherweise durch *return* + beendet. + +#b("Einige Systemadressen")# +#goalpage("sysaddr")# + +Der Info nützt nur wenig, wenn man nicht weiß, was man sich anschauen soll. Wesentliche +Angaben über die Systemstruktur enthält das 'Brikett' (interne Systemdokumentation für +Projekt Mikros der GMD). Da diese etwas allgemeiner gehalten ist, geht sie nicht auf imple­ +mentationsabhängige Konstanten ein. Diese sind hier aufgeführt. + +Ab 1500h liegt die 'ktab'. Sie enthält Informationen, welche Blöcke an welcher Stelle des +Arbeitsspeicher liegen: In der Kachel mit der Adresse 512*i befindet sich der Inhalt des +Blockes, dessen Nummer in ktab+i, ktab+100h+i steht. Ferner enthält die Tabelle, zu +welchem Datenraum (drid) und welcher Seite des Datenraums der Inhalt gehört. (Nur rele­ +vant, wenn die Prozeßnummer <> 255 ist). + +Steuerbits: 2**0 : Inhalt wird gerade transportiert (zum HG oder Archiv). + 2**1 : Inhalt ist identisch mit Inhalt auf HG. Wird beim Schreiben auf die + Kachel (per Software) zurückgesetzt. + 2**2 : Schreiberlaubnis (siehe Brikett). + 2**3 : Inhalt wurde kürzlich benutzt. Solche Kacheln werden 'weniger + stark' verdrängt. + + + ktab frei niederwertige Blocknummer + + +80h frei frei Steuerbits + + +100h frei höherwertige Blocknummer + + +180h frei frei Prozeßnummer + + +200h frei frei drid (prozeßspezifisch) + + +280h frei frei Seitennummer (höherw.) + + +300h frei frei Seitennummer (niederw.) + + ^ ^ + <-- unbenutzt --> ! +-- Beginn echter Kacheln + +-- Beginn der Anforderungen + + +Der 'Beginn echter Kacheln' hängt von der Größe der Z80-Teile ('urlader') ab (i.A. +30h < i < 40h). + +'Beginn der Anforderungen' liegt bei i=1Fh. Es handelt sich um Blocknummern von zu +ladenden Blöcken. Ist der höherwertige Teil der Blocknummer gleich FDh, so ist dies keine +Anforderung. + +Blocknummern > FF00h stehen für Blöcke mit dem Inhalt 512 FFh's und werden nie auf dem +Hintergrundmedium gespeichert. + + + +1E2Bh enthält den DR-Eintrag des drdr (siehe Brikett). + + +'musta': Das System fordert Checkpoints und Müllabfuhren über die Zelle 'musta' an. Diese + findet man mit dem Info durch + + xc musta + + (hierfür ist der Text 'musta' vor der Zelle abgesetzt). + + Die Zelle selbst enthält + + FFh : Keine Müllabfuhr oder Checkpoint + 01h : Müllabfuhr + 02h : Checkpoint + 03h : beides + 04h : Systemendecheckpoint + 0Bh : System auf Archiv schreiben ('save system') + F0h : Müllabfuhr und Checkpoint sind geperrt (nur durch Setzen im Info + möglich) + + Durch Einsetzen der Werte mit dem Info kann die entsprechende Operation veran­ + laßt werden. Beim Einsetzen darf der Info nicht im 'r'-Zustand (siehe Eingabe 'r') + stehen; zum Ausführen der Operation muß 'r' (man bleibt im Info) oder 'g' (Info + verlassen) gegeben werden. + + +1880h-18FFh: + enthält die Aktivierungstabelle. Ist (1880h+i)=01h, so ist die Task i aktiv. Hin­ + weis: 18FFh enthält immer 01h, ohne daß dieser Zelle eine Task zugeordnet ist. + + +#b("Leitblock")# +#goalpage("pcb")# + +Mit dem 'z'-Kommando wird der Leitblock einer Task dargestellt. Es werden Hexapaare, +gefolgt von einer Bezeichnung, ausgegeben. In der folgenden Beschreibung werden die +Hexapaare durch a,b,c dargestellt. + + a b c icount Der virtuelle Befehlszähler der Task steht auf (cMOD4)* + 10000h+b*100h+a = im Datenraum 4 dieser Task. + Durch die Eingabefolge: + 4sw*return* + kann man sich den Code, der ausgeführt werden soll, anse­ + hen. + + Bit 2**7 von c zeigt den Fehlerzustand an. + Bit 2**6 von c zeigt 'disable stop' (siehe Benutzerhandbuch) + an. + Bit 2**4 zeigt vorzeichenlose Arithmetik an (Compilierung). + + a b lbas Die lokale Basis steht auf 10000h+b*100h+c = im + Datenraum 4 (Wortadresse). + + a b hptop Der Arbeitsheap geht von 30000h (Byteadr.) bis (aMOD16)* + 10000h+b*100h+(aDIV16)*10h (Byteadr!). + + a b channel Die Task hängt an Kanal 100h*b+a (Terminalnummer). 0 = + kein Terminal angekoppelt. + + a b taskid Die Tasknummer der betrachteten Task ist a. (b ist die + Versionsnummer zum Abdichten von 'send'/ 'wait'). + +Um den Code, auf den der 'icount' zeigt, zu interpretieren, ziehe man das Brikett zu Rate. + + +Hinweis: Wenn der Info einen internen Fehler anzeigt, und auch bei 'ke', ist der durch 'z' + angezeigte Leitblock u.U. nicht aktualisiert. Man kann dies durch die Eingaben 'r', + 'g' erzwingen. (Der Info stellt wegen 'r' dem Interpreter einen Restart zu, der dann + beim 'g' den Leitblock aktualisiert und den Befehl erneut aufsetzt). Tritt dabei der + Fehler nicht wieder auf, handelte es sich um einen transienten Fehler (z.B. der + Codeblock war noch im Einlesen und ist jetzt voll da). So etwas kann z.B. passie­ + ren, wenn der SHard den Abschluß einer Leseoperation zu früh meldet. + diff --git a/doc/porting-z80/8/source-disk b/doc/porting-z80/8/source-disk new file mode 100644 index 0000000..ff072f3 --- /dev/null +++ b/doc/porting-z80/8/source-disk @@ -0,0 +1 @@ +porting/portdoc-z80-8.img diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.1 b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.1 new file mode 100644 index 0000000..24f2b03 --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.1 @@ -0,0 +1,650 @@ +#headandbottom("1","EUMEL-Benutzerhandbuch","TEIL 1 : Einleitung","1")# +#pagenr("%",1)##setcount(1)##block##pageblock# +#headeven# +#center#EUMEL-Benutzerhandbuch +#center#____________________________________________________________ + +#end# +#headodd# +#center#TEIL 1 : Einleitung +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +1 - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #rigth#1 - % +#end# + +TEIL 1 : Einleitung + + +1.1 Allgemeines über EUMEL + +Dieses Buch bietet eine Übersicht über die Standardprozeduren des Betriebssystem +EUMEL. Es bietet damit sowohl Hilfestellung für die Benutzung der standardmäßig +vorhandenen Kommandos als auch für die Programmierung, also die Erweiterung +dieses Kommandovorrats. Es ist jedoch kein Lehrbuch der Programmierung! + +In den ersten drei Kapiteln dieses Programmierhandbuches werden einige Grund­ +begriffe des Systems, die grundlegende Programmiersprache (ELAN) und der +EUMEL-Editor erläutert. + +Das vierte Kapitel bietet eine Übersicht über diejenigen Prozeduren und Operatoren, +die eher der 'Job-Control-Language' zugerechnet werden können, also häufig im +Kommandodialog benutzt werden. + +Im fünften Teil sind diejenigen Operationen beschrieben, die meistenteils für die +Programmierung benutzt werden. (Compiler, Operationen auf den elementaren Daten­ +typen, Dateien, Ein- und Ausgabe usw.). + +Diese Trennung ist jedoch recht willkürlich, es ist ja gerade eine der wichtigen Eigen­ +schaften dieses Betriebssystems, daß es keine Trennung zwischen der Kommando­ +sprache des Betriebssystems und Programmmiersprache für das System gibt. Jedes +Systemkommando ist Aufruf einer ELAN Prozedur, jede neue Prozedur stellt eine +Erweiterung des Kommandovorrats des Systems dar. + +Aus Gründen der Übersichtlichkeit der Zusammenstellung ist dieses Buch nicht frei +von Vorwärtsverweisen! + +#page# + +1.2 Struktur des Betriebssystems EUMEL + +Grundlegend für das Verständnis des Betriebssystems EUMEL ist der Begriff der +#on("b")#Task#off("b")#. Eine Task kann als theoretisch unendliche Wiederholung eines Systempro­ +gramms der Form: + + 'nimm Kommando entgegen' + 'verarbeite Kommando' + +aufgefaßt werden. Einige Tasks existieren bereits als Grundstock des Systems, +weitere werden von Benutzern des Systems erschaffen und dienen als persönliche +Arbeitsumgebung für den 'Eigentümer'. Eine Task kann als benutzereigener, unab­ +hängiger Computer im Computer betrachtet werden, denn sie kann Kommandos +entgegennehmen und ausführen und Daten verwalten und aufbewahren. + +Eine Task kann neu erzeugt werden, an einen Bildschirm gekoppelt werden und +beendet werden. + +Das Tasksystem ist in einer baumartigen Struktur angeordnet. Außer der Wurzel 'UR' +hat jede Task einen Vorgänger ('Vater-Task') und möglicherweise Nachfolger +('Sohn-Tasks'). + +#on("u")##ib#Task-Organisation#ie##off("u")# + + + SUPERVISOR + - + SYSUR + ARCHIVE + configurator + OPERATOR + shutup + + UR + PUBLIC + Benutzertask1 + Benutzertask2 + Benutzertask3 + ..... + + + +Jeder Benutzer arbeitet innerhalb eines EUMEL-Systems, indem er eine Task an +sein Terminal koppelt und dort Programme aufruft. + +Dateien sind grundsätzlich Eigentum einer Task. Es ist grundlegend für das Verständ­ +nis des Betriebssystems EUMEL, die Beziehung zwischen Tasks und Dateien zu +erkennen. + +Eine Task ist ein Prozeß, der gegebenenfalls Dateien besitzt. Dateien können nur in +einer Task existieren. Um eine Datei einer anderen Task zur Verfügung zu stellen, +wird eine Kopie der Datei an die andere Task geschickt, die sendende Task ist da­ +nach Eigentümer des 'Originals', die empfangende Task Eigentümer der 'Kopie'. + +Soll eine Hierarchie von Dateien aufgebaut werden, so ist sie über eine Hierarchie +von Tasks zu realisieren, da in einer Task alle Dateien gleichberechtigt sind. + +Bis zu dieser Stelle war stets von Dateien die Rede. Dateien sind jedoch ein Spezial­ +fall der grundlegenderen Struktur des Datenraumes. + +Ein #ib#Datenraum#ie# ist ein allgemeiner Datenbehälter. Ein Datenraum kann beliebige +Daten aufnehmen und erlaubt direkten Zugriff auf diese Daten. Die Struktur der Daten +im Datenraum unterscheidet sich nicht von der Struktur der Programmdaten. Der +'innere Datentyp' eines Datenraums wird vom Programmierer festgelegt. + +Vorgeprägt vom System gibt es Textdateien, jeder andere Datentyp muß vom Pro­ +grammierer geprägt werden, um so Dateien erzeugen zu können, die Objekte eben +dieses neuen Typs enthalten. +#page# + + +1.3 Eigenschaften des Betriebssystems + +Der erste Entwurf des Mikroprozessor-Betriebssystems EUMEL (#on("b")#E#off("b")#xtendable multi +#on("b")#U#off("b")#ser #on("b")#M#off("b")#icroprozessor #on("b")#EL#off("b")#AN system) entstand 1979 mit dem Anspruch, auf Mikrocom­ +putern den Anwendern Hilfsmittel und Unterstützungen zu bieten, wie sie sonst nur +auf Großrechnern zur Verfügung gestellt werden. + +Aspekte, die EUMEL von anderen Betriebssystemen für Mikrocomputer unterscheiden, +sind: + +- Hardwareunabhängigkeit +- Multitaskingkonzept +- Multiuserbetrieb +- Erweiterbarkeit +- virtuelle Speicherverwaltung +- Datensicherheit + + + +#on("u")##on("b")#Das EUMEL-Schichtenmodell#off("b")##off("u")# + +Die Hardwareunabhängigkeit des Betriebssystems EUMEL begründet sich in seinem +Aufbau aus Schichten (sogenannten virtuellen Maschinen), die einen klar definierten +Leistungsumfang haben. + +#center#beliebige Anwendungen +#center#Textverarbeitung, Datenbanken etc. + +#center#Systemdienste: Monitor, Dateiverwaltung, Editor +#center#Task-System +#center#Standardpakete (BOOL, INT, REAL, TEXT) +#center#ELAN-Compiler + +#center#EUMEL0 +#center#(virtueller Prozessor mit eigenem Befehlssatz) + +#center#SHard (Gerätetreiber) + +#center#Hardware + + +Jede Schicht erwartet und erhält von ihren Nachbarn wohldefinierte Eingaben und gibt +wohldefinierte Ausgaben weiter. Änderungen in einer Schicht müssen also in den +angrenzenden Schichten beachtet werden, aber nicht in allen Teilen des Systems. + +Um EUMEL auf Rechner mit einem neuen Prozessortyp zu portieren, wird zunächst +eine auf die Eigenheiten des Prozessors abgestimmte EUMEL0-Maschine entworfen +und eine Hardwareanpassung (#ib#SHard#ie# : Software/Hardware-Interface) für einen +Rechner mit diesem Prozessor hergestellt. Alle höheren Schichten des Systems +bleiben unberührt. Weitere mit diesem Prozessortyp ausgestattete Rechner können mit +EUMEL betrieben werden, indem ein SHard für dieses Rechnermodell geschrieben +wird. + +Aus Benutzersicht ist wichtig, daß dadurch jegliche Software, die auf irgendeinem +Rechner unter EUMEL verfügbar ist, auf jedem anderen Rechner, für den eine +EUMEL Portierung existiert, lauffähig ist und gleiches Verhalten zeigt. Eine Vernet­ +zung beliebiger Rechner, auf die EUMEL portiert ist, ist problemlos möglich. + +Desweiteren ist für den Benutzer des Systems von Bedeutung, daß er von der hard­ +warenahen Schicht entfernt ist. Weder die Programmiersprache noch irgendwelche +speziellen Systemfunktionen gewähren direkten Zugriff auf den Speicher oder Regi­ +sterinhalte. Diese Tatsache hat weitreichende Folgen in Hinsicht auf Datenschutz und +Systemsicherheit. + + + + +Multi-Tasking-/Multi-User-Betrieb +Wie einleitend dargestellt, besteht ein EUMEL-System aus diversen Tasks. Durch +eine Aufteilung der Prozessorzeit in Zeitscheiben ist eine (quasi) parallele Bedienung +mehrerer Tasks möglich. + +Die multi-user-Fähigkeit des Betriebssystems wird durch den Anschluß mehrerer +Bildschirmarbeitsplätze (Terminals) an V.24 Schnittstellen des Rechners erreicht. +Dabei wird jeder Schnittstelle eine sogenannte Kanalnummer zugeordnet. Jeder +Benutzer kann seine Task dann an einen Kanal (=Terminal) koppeln und an diesem +Terminal gleichzeitig mit anderen Benutzern arbeiten. + + + + +Prozeßkommunikation und Netzwerkfähigkeit +Grundlage der Kommunikation ist die 'Manager-Eigenschaft' von Tasks. Eine Task +ist 'Manager', wenn sie Aufträge anderer Tasks annehmen und ausführen kann. +Insbesondere kann ein Manager veranlaßt werden, eine an ihn geschickte Datei anzu­ +nehmen, bzw. eine ihm gehörende Datei an die fordernde Task zu schicken. + +Derartige Kommunikationslinien verlaufen normalerweise in der Baumstruktur des +Systems: z.B. ist die Task 'PUBLIC' (vergl. Seite 2) grundsätzlich Manager-Task. +Eine unterhalb von PUBLIC liegende Task kann eine Datei an PUBLIC senden, bzw. +von PUBLIC holen. + +Es ist auch möglich, eine Task für den Zugriff beliebiger anderer Tasks zu öffnen und +somit beliebige Kommunikationspfade aufzubauen. Prinzipiell ist damit auch schon der +Aufbau eines Netzwerkes beschrieben, denn sendende und empfangende Tasks +können sich auf verschiedenen Rechnern befinden. + +Durch selbst erstellte Programme kann der Eigentümer einer 'Manager-Task' die +Reaktion dieser Task auf einen Auftrag von außen bestimmen. Beispielsweise kann +ein Manager derart programmiert werden, daß er nur Dateien empfängt und ausdruckt, +aber niemals Dateien verschickt (Spool-Task). + + + +Erweiterbarkeit +Die Programmiersprache ELAN ist im EUMEL-System gleichzeitig Programmier- +und System-Kommandosprache (JCL), denn jedes Kommando ist Aufruf einer +ELAN-Prozedur und jede vom Benutzer geschriebene ELAN-Prozedur erweitert +den Kommandovorrat des Systems. + +Da alle EUMEL-Werkzeuge (einschließlich Editor) selbst ELAN-Programme sind, +kann das System vom Benutzer selbst durch Hinzufügen eigener ELAN-Programme +oder Programmpakete beliebig erweitert werden. Dabei können die bereits implemen­ +tierten Systemteile (z.B. die Fenstertechnik des Editors) genutzt werden. + +Ein Benutzer muß, um alle Möglichkeiten vom EUMEL zu nutzen, nur eine Sprache +lernen und nicht - wie bei anderen Betriebssystemen - zwei unterschiedliche, eine +Kommando- und eine Programmiersprache. + +ELAN selbst ist eine PASCAL-ähnliche Programmiersprache, die mit Hilfe der +schrittweisen Verfeinerung (Refinement-Konzept) die Top-Down-Programmierung +unterstützt. Das Paketkonzept, das der Modularisierung dient, und die freie Wahl von +Bezeichnernamen sind Voraussetzung für übersichtliche und effiziente Programmie­ +rung. + + + + +Virtuelle Speicherverwaltung +Im EUMEL-System wird der Hauptspeicherplatz nach dem #on("b")#Demand-Paging-Prinzip#off("b")# +verwaltet. Daten und Programme werden dazu in Seiten von 512 Byte aufgeteilt. Nur +diejenigen Seiten, die wirklich benötigt werden, werden vom Hintergrundspeicher +(Platte) in den Hauptspeicher geholt. Damit ist für den Benutzer bezüglich seiner +Programm- bzw. Dateigrößen nicht mehr der Hauptspeicher, sondern die Hinter­ +grundkapazität von Bedeutung. Die Durchsatzgeschwindigkeit (Performance) ist +abhängig von der Größe des RAM-Speichers und der Zugriffsgeschwindigkeit des +Hintergrundmediums. Das Demand-Paging-Verfahren ist Grundlage für den +Multi-User-Betrieb, wobei der Hauptspeicherplatz möglichst effizient zu nutzen und +kein Benutzer zu benachteiligen ist. + +Beim Duplizieren eines Datenraumes wird im EUMEL-System lediglich eine logische, +keine physische Kopie erzeugt. Zwei Seiten (zweier Datenräume) heißen dann gekop­ +pelt (geshared), wenn beide Seiten physisch demselben Block zugeordnet sind. Erst +bei einem Schreibzugriff werden die Seiten entkoppelt (entshared) und tatsächlich +physisch kopiert. Daher der Name "#on("b")#copy-on-write#off("b")#". + +Dieses Prinzip wird natürlich auch systemintern angewandt. Beispielsweise erbt eine +Sohn-Task den Kommandovorrat der Vater-Task, indem der Standard-Datenraum, +der die vorübersetzten ELAN-Prozeduren enthält, in der beschriebenen Weise kopiert +wird. Prozeduren, die später hinzugefügt werden, werden natürlich nicht vererbt, da +die Standard-Datenräume dann entkoppelt werden. + + + + +Datensicherheit +Störungen (inklusive Stromausfall) werden systemseitig durch eine automatische +#on("b")#Fixpoint-Rerun-Logik#off("b")# aufgefangen, indem zum Zeitpunkt eines Fixpunkts der Inhalt +des RAM Speichers, der seit dem letzten #ib#Fixpunkt#ie# verändert wurde auf den +permanenten Speicher (Festplatte) geschrieben wird. Somit kann nach einer Störung +immer auf den Systemzustand des letzten Fixpunktes aufgesetzt werden und die +Datenverluste halten sich in erträglichen Grenzen. + +Der Zeitraum zwischen zwei Fixpunkten beträgt standardmäßig 15 Minuten, kann aber +vom Benutzer anders eingestellt werden. + +Auch bei dieser Sicherung wird das Copy-on-write-Prinzip angewendet, so daß +Platz- und Zeitaufwand gering sind und den normalen Ablauf nicht stören. + +#page# + +1.4 Wichtige Begriffe + +- #on("b")##ib#archive#ie##off("b")#. Spezielle Task zur Verwaltung des Diskettenlaufwerks. Da für die + längerfristige Datenhaltung und zur zusätzlichen Datensicherung Dateien auf + Disketten geschrieben werden, besitzt das EUMEL-System für diese Aufgabe + eine besondere Task, die die Bedienung vereinfacht und exklusiven Zugriff auf das + Laufwerk garantiert. + +- #on("b")##ib#configurator#ie##off("b")#. Besondere Task im Systemzweig des EUMEL-Systems. In + dieser Task ist die #ib#Konfiguration#ie# von Kanälen möglich, d.h. Kanal und + angeschlossenenes Gerät werden aufeinander abgestimmt. + +- #on("b")##ib#editor#ie##off("b")#. Programm zur Dateibearbeitung am Bildschirm. Das Programm wird + durch das ( Monitor- ) Kommando 'edit' und die Eingabe des Namens der ge­ + wünschten Datei als Parameter gestartet. + + Da ein Bildschirm normalerweise auf 80 Zeichen Zeilenbreite und 24 Zeilen be­ + schränkt ist, kann der Editor als Fenster betrachtet werden, das über die mögli­ + cherweise weitaus größere Datei bewegt wird und durch das der betrachtete Aus­ + schnitt der Datei bearbeitet werden kann. + +- #on("b")##ib#manager task#ie##off("b")#. Task, die Aufträge von anderen Tasks entgegennehmen und + ausführen #on("u")#kann#off("u")#. Beispielsweise ist die Verwaltung von Dateien, die mehreren + Benutzern (= anderen Tasks) zugänglich sein sollen, eine typische Aufgabe für + einen Manager. + +- #on("b")##ib#Monitor#ie##off("b")#. Der Empfänger von Kommandos innerhalb einer Task ist der Monitor. Der + Monitor ist sichtbar durch eine Zeile, in der 'gib kommando' steht. In diese Zeile + werden #ib#Kommando#ie#s und erforderliche Parameter eingegeben. + +- #on("b")##ib#Supervisor#ie##off("b")#. Spezielle Task zur Überwachung eines EUMEL-Systems. Ein + Benutzer kann durch die Supervisor-Kommandos Leistungen von dieser Task + fordern: neue Task einrichten, Task wiederaufnehmen und diverse Informationen. + +- #on("b")##ib#Task#ie##off("b")#. Beliebig langlebiger Prozeß im EUMEL-System, der die Arbeits­ + umgebung für Benutzer bildet. Jede Task besitzt einen #ib#Standard-Datenraum#ie#, der + Code und Compilertabellen der Task enthält und kann weitere Datenräume + (Dateien) besitzen. + +#page# + +1.5 Die Notation in diesem Buch + +Beachten Sie bitte folgende Regeln der Aufschreibung: + +- Funktionstasten werden ebenso wie besondere Tastenkombinationen explizit als + Tasten dargestellt: + + + + +- Alles, was Sie am Bildschirm Ihres Rechners schreiben oder lesen sollen, ist in + Textbereiche, die einen Bildschirm darstellen, eingefaßt. + + Beispiel: + +____________________________________________________________________________ + gib kommando: + edit ("mein programm") + +____________________________________________________________________________ + + +- Innerhalb des Handbuchs sind in der Aufschreibung die Konventionen der Pro­ + grammiersprache ELAN berücksichtigt. Dabei sind folgende Besonderheiten zu + beachten: + + 1) Kommandos werden grundsätzlich klein geschrieben. + + 2) Dateinamen u.ä. sind Textdenoter und werden somit in Klammern und Anfüh­ + rungsstriche gesetzt. In diesem Buch steht an den Stellen, wo ein Dateiname + auftaucht #on("i")# 'dateiname' #off("i")#; den Namen, den Sie tatsächlich verwenden, können + Sie frei wählen. + + 3) Falls besondere Begriffe oder Beispiele innerhalb eines normalen Textes + auftreten, werden sie in einfache Anführungsstriche gesetzt. + + +#page# + +1.6 Die Funktionstasten des EUMEL-Systems + +Die Lage der EUMEL-Funktionstasten entnehmen Sie bitte der speziellen Installa­ +tionsanleitung zu dem von Ihnen benutzten Gerät. #l pos (0.0)##l pos(4.0)# + + + <^> <>> <<> Positionierungstasten +#table# + + Umschalttaste + + Eingabe-/ Absatztaste + + Kommandotaste + + Supervisortaste + + Verstärkertaste + + Löschtaste + + Einfügetaste + + Tabulatortaste + + Markiertaste + + Stoptaste + + Weitertaste +#tableend##clear pos# + +Weitere Informationen hierzu finden Sie in der Installationsanleitung zu dem von Ihnen +benutzten Rechner oder Terminal. +#page# + +1.7 Eine Beispielsitzung + +Im Folgenden wird eine Beispielsitzung skizziert, in der ein ELAN-Programm erstellt +und getestet wird. + + SUPERVISOR aufrufen + + + +____________________________________________________________________________ + + Terminal 2 + + + EUMEL Version 1.8/M + + + gib supervisor kommando: + begin("meine erste Task") + + + + ESC ? --> help + ESC b --> begin("") ESC h --> halt + ESC c --> continue("") ESC s --> storage info + ESC q --> break ESC t --> task info + +____________________________________________________________________________ + + + + +Durch das Kommando 'begin ("meine erste Task")', welches durch abgeschlos­ +sen werden muß, wird eine Task mit dem Namen 'meine erste Task' im Benutzer­ +zweig, also unterhalb von 'PUBLIC' angelegt. Würde diese Task bereits existieren, so +könnten Sie sie mit 'continue ("meine erste Task")' an das Terminal holen. + +____________________________________________________________________________ + + gib kommando : + edit ("mein erstes Programm") + +____________________________________________________________________________ + + +In der Task eröffnen Sie eine Datei mit dem Kommando 'edit ("dateiname")'. + + +____________________________________________________________________________ + + gib kommando : + edit ("mein erstes Programm") + "mein erstes Programm" neu einrichten (j/n) ? j + +____________________________________________________________________________ + + +Falls diese Datei neu ist, erfolgt eine Kontrollfrage (zur Kontrolle der gewünschten +Schreibweise des Dateinamens), die Sie durch bejahen. + + +____________________________________________________________________________ + ............ mein erstes Programm ............... Zeile 1 #markon# +_ +____________________________________________________________________________ + + + + + + +In die noch leere Datei tippen Sie nun den Programmtext ein. + + +____________________________________________________________________________ + ............ mein erstes Programm ............... Zeile 1 + _INT PROC ggt (INT CONST a, b): + INT VAR b kopie :: abs (b), a kopie :: abs (a); + WHILE b kopie <> 0 REPEAT + INT VAR rest := a kopie MOD b kopie; + a kopie := b kopie; + b kopie := rest + END REPEAT; + a kopie + END PROC gt; + + REP + lies 2 zahlen ein; + gib groessten gemeinsamen teiler aus + UNTIL no ("weitertesten") PER. + + lies 2 zahlen ein: + line; put ("2 Zahlen eingeben:"); + INT VAR a, b; + get (a); get (b). + + gib groessten gemeinsamen teiler aus: + put ("der größte gemeinsame Teiler von"); + put (a); put ("und"); put (b); put ("ist"); put (ggt (a,b)); + line. + +____________________________________________________________________________ + + +In dem Programmbeispiel wird ein Prozedur 'ggt' definiert, die den größten gemein­ +samen Teiler zweier Zahlen bestimmt. Die Prozedur soll für verschiedene Beispiele +getestet werden; dies geschieht in dem Hauptprogramm, das solange Zahlen einliest +und den größten gemeinsamen Teiler ausgibt, bis der Benutzer auf die Frage 'weiter­ +testen (j/n) ?' mit antwortet. + +Haben Sie das Programm eingegeben, so können Sie die Bearbeitung dieser Pro­ +grammdatei durch Drücken der Tasten (nacheinander!) beenden. + + +____________________________________________________________________________ + + gib kommando : + run ("mein erstes Programm") + +____________________________________________________________________________ + + +Um Ihr Programm zu übersetzen und auszuführen, geben Sie das Kommando +'run ("dateiname")'. + +Der Verlauf der Übersetzung, die zwei Läufe über das Programm erfordert, ist am +Zähler, der an der linken Seite des Bildschirms ausgegeben wird, zu erkennen. + +Werden beim Übersetzen des Programms Fehler entdeckt, so werden diese im 'note­ +book' parallel zur Programmdatei gezeigt. In dem Beispielprogramm wurde ein +Schreibfehler in Zeile 9 gemacht. + + +____________________________________________________________________________ + ............ mein erstes Programm ............... Zeile 1 + _INT PROC ggt (INT CONST a, b): + INT VAR b kopie :: abs (b), a kopie :: abs (a); + WHILE b kopie <> 0 REPEAT + INT VAR rest := a kopie MOD b kopie; + a kopie := b kopie; + b kopie := rest + END REPEAT; + a kopie + END PROC gt; + + REP + .................. notebook ..................... Zeile 1 #markon# + Zeile 9 FEHLER bei >> gt << + ist nicht der PROC Name + + +____________________________________________________________________________ + + + +Diesen Fehler müssen Sie nun verbessern. + +____________________________________________________________________________ + ............ mein erstes Programm ............... Zeile 9 + INT PROC ggt (INT CONST a, b): + INT VAR b kopie :: abs (b), a kopie :: abs (a); + WHILE b kopie <> 0 REPEAT + INT VAR rest := a kopie MOD b kopie; + a kopie := b kopie; + b kopie := rest + END REPEAT; + a kopie + END PROC ggt;_ + + REP + .................. notebook ..................... Zeile 1 + Zeile 9 FEHLER bei >> gt << + ist nicht der PROC Name + +____________________________________________________________________________ + + + + +Haben Sie das Programm korrigiert, so können Sie die Datei durch Drücken der +Tasten (nacheinander!) wieder verlassen. + + +____________________________________________________________________________ + + gib kommando : + run ("mein erstes Programm") + +____________________________________________________________________________ + + +Nach Eingabe von wird das Programm erneut übersetzt. + + +____________________________________________________________________________ + + Keine Fehler gefunden, 136 B Code, 82 B Paketdaten generiert + + + ******* ENDE DER UEBERSETZUNG ******* + + + 2 Zahlen eingeben: _ + +____________________________________________________________________________ + + +Das Programm war jetzt fehlerfrei. Nach der Übersetzung wurde die Ausführung +gestartet. Nun können Beispiele getestet werden. + +____________________________________________________________________________ + + 2 Zahlen eingeben: 125 250 + der größte gemeinsame Teiler von 125 und 225 ist 25 + weitertesten (j/n) ? + +____________________________________________________________________________ + + +Beantwortet man die Frage mit , so wird die Ausführung des Programms beendet. + + +____________________________________________________________________________ + + gib kommando : + +____________________________________________________________________________ + + +Um die Arbeit in der Task zu beenden, geben Sie auch an dieser Stelle +(nacheinander!) ein. + +Nach Verlassen der Task ist wiederum die EUMEL-Tapete auf dem Bildschirm. Jede +weitere Aktion wird wiederum von hier aus durch begonnen. Insbesondere vor +dem #ib#Ausschalten des Geräts#ie# muß nach eine Task des priviliegierten System­ +zweigs (oft: '#ib#shutup#ie#') mit an das Terminal gekoppelt werden, in der das +Kommando 'shutup' gegeben wird. + diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.2a b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.2a new file mode 100644 index 0000000..a204091 --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.2a @@ -0,0 +1,1845 @@ +#headandbottom("1","EUMEL-Benutzerhandbuch","TEIL 2 : ELAN","2")# +#pagenr("%",1)##setcount(1)##block##pageblock# +#headeven# +#center#EUMEL-Benutzerhandbuch +#center#____________________________________________________________ + +#end# +#headodd# +#center#TEIL 2 : ELAN +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +2 - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right# 2 - % +#end# + +TEIL 2: ELAN + +2.1 Besondere Eigenschaften von ELAN + +Kerneigenschaften von ELAN sind das #ib#Paketkonzept#ie# und die Methode des +#ib#Refinements#ie#. + +#on("b")#Paketkonzept:#off("b")# +ELAN bietet die Möglichkeit, neue Datentypen sowie Prozeduren und Operatoren auf +diesen Datentypen zu definieren. Eine solche Definition von Algorithmen und Daten­ +typen kann zu einer logischen Einheit, einem Paket, zusammengefaßt werden. Pakete +können in einer Task vorübersetzt werden und erweitern damit automatisch den +Sprachumfang. + +#on("b")#Methode des Refinements:#off("b")# +Die Methode des Refinements erlaubt das schrittweise Herleiten von Problemlösungen +von der jeweils geeigneten Terminologie herunter zu den von ELAN standardmäßig +angebotenen Sprachelementen. Durch diese Vorgehensweise wird in äußerst starkem +Maße ein strukturierter Programmentwurf gemäß dem Top-Down-Prinzip gefördert. + +Die Programmiersprache ELAN wird im EUMEL-System zu folgenden Zwecken +eingesetzt: + +- Systemimplementationssprache +- Kommandosprache +- Anwenderprogrammiersprache +#page# + +2.2 Lexikalische Elemente + +Unter lexikalischen Elementen einer Programmiersprache versteht man die Elemente, +in denen ein Programm notiert wird. + +In ELAN sind dies: + +- Schlüsselwörter +- Bezeichner +- Sonderzeichen +- Kommentare + + + + +2.2.1 Schlüsselwörter + +Einige Wörter haben in ELAN eine feste Bedeutung und können somit nicht frei +gewählt werden. Solche Wörter werden im EUMEL-System in Großbuchstaben +geschrieben, Leerzeichen dürfen nicht enthalten sein. + +Beispiele: + + +VAR +INT +WHILE + + +Wie später beschrieben wird, gibt es in ELAN auch die Möglichkeit, neue Schlüssel­ +wörter einzuführen. + + +#page# + +2.2.2 Bezeichner + +Bezeichner oder Namen werden benutzt, um Objekte in einem Programmtext zu +benennen und zu identifizieren (z.B: Variablennamen, Prozedurnamen). + +Namen werden in ELAN folgendermaßen formuliert: + +Das erste Zeichen eines Namens muß immer ein Kleinbuchstabe sein. Danach dürfen +bis zu 254 Kleinbuchstaben, aber auch Ziffern folgen. Zur besseren Lesbarkeit können +Leerzeichen in einem Namen erscheinen, die aber nicht zum Namen zählen. Sonder­ +zeichen sind in Namen nicht erlaubt. + +Beispiele für #on("b")#korrekte#off("b")# Bezeichner: + + +das ist ein langer name +x koordinate +nr 1 + + + +Beispiele für #on("b")#falsche#off("b")# Bezeichner: + + +x*1 +1 exemplar +Nr 1 +#page# + +2.2.3 Sonderzeichen + +Sonderzeichen sind Zeichen, die weder Klein- oder Großbuchstaben, noch Ziffern +sind. Sie werden in ELAN als Trennzeichen oder als Operatoren benutzt. + +In ELAN gibt es folgende Trennungszeichen: + +- das Semikolon (';') trennt Anweisungen +- der Doppelpunkt (':') trennt Definiertes und Definition +- der Punkt ('.') wird als Endezeichen für bestimmte Programmabschnitte, als Dezi­ + malpunkt und als Selektor-Zeichen für Datenstrukturen benutzt +- das Komma (',') trennt Parameter +- Klammernpaare ('(', ')') werden zum Einklammern von Parameterlisten oder Teil­ + ausdrücken benutzt +- mit Anführungszeichen ('"') werden Text-Denoter umrahmt +- eckige Klammernpaare ('[', ']') werden zur Subskription benutzt. + + +Als Operatornamen sind folgende Sonderzeichen erlaubt: + +- ein Sonderzeichen, sofern es nicht als Trennzeichen benutzt wird: + ! $ % & ' * + - / < = > ? § ^ ' ~ +- eine Kombination von zwei Sonderzeichen. Diese Kombination muß jedoch bereits + in ELAN existieren: + := <= >= <> ** + +#page# + +2.2.4 Kommentare + +Kommentare dienen ausschließlich der Dokumentation eines Programms. Sie werden +vom Compiler überlesen und haben somit keinen Einfluß auf die Ausführung eines +Programms. Sie dürfen an beliebigen Stellen eines Programmtextes geschrieben +werden, jedoch nicht innerhalb von Schlüsselwörtern und Namen. Ein Kommentar darf +über mehrere Zeilen gehen. In ELAN sind Kommentare nur in wenigen Fällen notwen­ +dig, da Programme durch andere Mittel gut lesbar geschrieben werden können. + +Ein Kommentar in ELAN wird durch Kommentarklammern eingeschlossen. Es gibt +folgende Formen von Kommentarklammern: + +(* Kommentar *) +{ Kommentar } +\#( Kommentar )# + +Die letzte Version '\#( Kommentar )\#' wird im EUMEL-System nicht +unterstützt; statt dessen gibt es noch folgende Möglichkeit: + +\# Kommentar \# + +Da bei der Kommentarkennzeichnung mit \# für Kommentaranfang und -ende das +gleiche Zeichen benutzt wird, ist eine Schachtelung hier nicht möglich. +#page# + +2.3 Datenobjekte + +Eine Klasse von Objekten mit gleichen Eigenschaften wird in Programmiersprachen +Datentyp genannt. Dabei hat ein Datentyp immer einen Namen, der die Klasse von +Objekten sinnvoll kennzeichnet. Als ein Datenobjekt wird ein Exemplar eines Daten­ +typs (also ein spezielles Objekt einer Klasse) bezeichnet. + +Datentypen sind in ELAN ein zentrales Konzept. Jedes der in einem ELAN- +Programm verwandten Datenobjekte hat einen Datentyp; somit kann man Datentypen +auch als Eigenschaften von Datenobjekten ansehen. Für jeden Datentyp sind nur +spezielle Operationen sinnvoll. Man kann nun Compilern die Aufgabe überlassen zu +überprüfen, ob stets die richtige Operation auf einen Datentyp angewandt wird. + + + +2.3.1 Elementare Datentypen + +Einige Datentypen spielen bei der Programmierung eine besondere Rolle, weil sie +häufig benötigt werden. + +In ELAN sind das die Datentypen für + +- ganze Zahlen (INT) +- reelle Zahlen (REAL) +- Zeichen und Zeichenfolgen (TEXT) +- Wahrheitswerte (BOOL). + +Diese Datentypen sind von der Sprache ELAN vorgegeben und werden elementare +Datentypen genannt. Für effiziente Rechnungen mit elementaren Datentypen gibt es +in den meisten Rechnern spezielle Schaltungen, so daß die Hervorhebung und be­ +sondere Rolle, die sie in Programmiersprachen spielen, gerechtfertigt ist. Zudem hat +man Werte-Darstellungen (Denoter) innerhalb von Programmen für die elementaren +Datentypen vorgesehen. + + + +2.3.1.1 Denoter für elementare Datentypen + +Die Darstellung eines Werts in einem Rechner zur Laufzeit eines Programms wird +Repräsentation genannt. Wenn es eindeutig ist, daß es sich nur um die Repräsenta­ +tion im Rechner handelt, spricht man kurz von Werten. Um mit Objekten elementarer +Datentypen arbeiten zu können, muß es in einem Programm die Möglichkeit geben, +Werte eines Datentyps zu bezeichnen (denotieren). Die Werte-Darstellungen, die in +ELAN Denoter genannt werden, sind für jeden Datentyp unterschiedlich. Wie bereits +erwähnt, haben alle Datenobjekte in ELAN (also auch Denoter) nur einen - vom +Compiler feststellbaren - Datentyp. Aus der Form eines Denoters ist also der Daten­ +typ erkennbar: + + + +INT-Denoter: +Sie bestehen aus einer Aneinanderreihung von Ziffern. + +Beispiele: + + +17 +007 +32767 +0 + + +Führende Nullen spielen bei der Bildung des Wertes keine Rolle (sie werden vom +ELAN-Compiler überlesen). Negative INT-Denoter gibt es nicht. Negative Werte +werden durch eine Aufeinanderfolge des monadischen Operators '-' (siehe 2.4.1.1) +und eines INT- Denoters realisiert. + + +REAL-Denoter: +Hier gibt es zwei Formen: +Die erste besteht aus zwei INT-Denotern, die durch einen Dezimalpunkt getrennt +werden. + +Beispiele: + + +0.314159 +17.28 + + +Der Dezimalpunkt wird wie ein Komma in der deutschen Schreibweise benutzt. Nega­ +tive REAL-Denoter gibt es wiederum nicht. + +Die zweite Form wird als "wissenschaftliche Notation" bezeichnet. Sie findet dann +Verwendung, wenn sehr große Zahlen oder Zahlen, die nahe bei Null liegen, darge­ +stellt werden müssen. + +Beispiele: + + +3.0 e5 +3.0e-5 + + +Der INT-Denoter hinter dem Buchstaben #on("b")#e#off("b")# gibt an, wie viele Stellen der Dezimal­ +punkt nach rechts (positive Werte) bzw. nach links (negative Werte) zu verschieben +ist. Dieser Wert wird Exponent und der Teil vor dem Buchstaben #on("b")#e#off("b")# Mantisse genannt. + + +TEXT-Denoter: +Sie werden in Anführungszeichen eingeschlossen. + +Beispiele: + + +"Das ist ein TEXT-Denoter" +"Jetzt ein TEXT-Denoter ohne ein Zeichen: ein leerer Text" +"" + + +Zu beachten ist, daß das Leerzeichen ebenfalls ein Zeichen ist. Soll ein Anführungs­ +zeichen in einem TEXT erscheinen (also gerade das Zeichen, welches einen Denoter +beendet), so muß es doppelt geschrieben werden. + +Beispiele: + + +"Ein TEXT mit dem ""-Zeichen" +"Ein TEXT-Denoter nur mit dem ""-Zeichen:" +"""" + + +Manchmal sollen Zeichen in einem TEXT-Denoter enthalten sein, die auf dem +Eingabegerät nicht zur Verfügung stehen. In diesem Fall kann der Code-Wert des +Zeichens angegeben werden. + +Beispiel: + + +"da"251"" + + +ist gleichbedeutend mit "daß". Der Code-Wert eines Zeichens ergibt sich aus der +EUMEL-Code-Tabelle (siehe 5.2.4.1), in der jedem Zeichen eine ganze Zahl zuge­ +ordnet ist. + + +BOOL-Denoter: +Es gibt nur zwei BOOL-Denoter: +TRUE für "wahr" und FALSE für "falsch". + + + +2.3.1.2 LET-Konstrukt für Denoter + +Neben der Funktion der Abkürzung von Datentypen (siehe 2.6.3) kann das LET- +Konstrukt auch für die Namensgebung für Denoter verwandt werden. + +Die LET-Vereinbarung sieht folgendermaßen aus: + + +#on("i")##on("b")#LET#off("i")##off("b")# Name #on("i")##on("b")#=#off("i")##off("b")# Denoter + + +Mehrere Namensgebungen können durch Komma getrennt werden. + + +____________________________________________________________________________ + .......................... Beispiele: ......................... + LET anzahl = 27; + LET pi = 3.14159, + blank = " "; +____________________________________________________________________________ + + +Der Einsatz von LET-Namen für Denoter hat zwei Vorteile: + +- feste Werte im Programm sind leicht zu ändern, da nur an einer Stelle des Pro­ + gramms der Denoter geändert werden muß + (z.B.: In Vereinbarungen von Reihungen (siehe 2.6.1) können LET-Denoter, im + Gegensatz zu Konstanten, als Obergrenze angegeben werden. Dieser + Wert kann dann auch an anderen Stellen des Programms, z.B. in Schlei­ + fen (siehe 2.4.2.5), benutzt werden. Bei Änderung der Reihungsgröße + braucht dann nur an einer Stelle des Programms der Wert geändert zu + werden.) +- der Name gibt zusätzliche Information über die Bedeutung des Denoters. + + + +2.3.2 Zugriffsrecht + +Von manchen Datenobjekten weiß man, daß sie nur einmal einen Wert erhalten +sollen. Sie sollen also nicht verändert werden. Oder man weiß, daß in einem Pro­ +grammbereich ein Datenobjekt nicht verändert werden soll. Um ein unbeabsichtigtes +Verändern zu verhindern, wird in ELAN dem Datenobjekt ein zusätzlicher Schutz +mitgegeben: das Zugriffsrecht oder Accessrecht. + +In der Deklaration eines Datenobjekts können folgende Accessattribute angegeben +werden: + +- #on("i")##on("b")#VAR #off("i")##off("b")# für lesenden und schreibenden (verändernden) Zugriff + +- #on("i")##on("b")#CONST#off("i")##off("b")# für nur lesenden Zugriff. + + + +2.3.3 Deklaration + +Damit man Datenobjekte in einem Programm ansprechen kann, gibt man einem +Datenobjekt einen Namen (wie z.B. einen Personennamen, unter der sich eine wirk­ +liche Person "verbirgt"). Will man ein Datenobjekt in einem Programm verwenden, so +muß man dem Compiler mitteilen, welchen Datentyp und welches Accessrecht das +Objekt haben soll. Das dient u.a. dazu, nicht vereinbarte Namen (z.B. verschriebene) +vom Compiler entdecken zu lassen. Weiterhin ist aus dem bei der Deklaration ange­ +gebenen Datentyp zu entnehmen, wieviel Speicherplatz für das Objekt zur Laufzeit zu +reservieren ist. + +Eine Deklaration oder Vereinbarung besteht aus der Angabe von + +- Datentyp +- Zugriffsrecht ( #on("i")##on("b")#VAR#off("i")##off("b")# oder #on("i")##on("b")#CONST#off("i")##off("b")#) +- Name des Datenobjekts. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT VAR mein datenobjekt; + +____________________________________________________________________________ + + +Verschiedene Datenobjekte mit gleichem Datentyp und Accessrecht dürfen in einer +Deklaration angegeben werden; sie werden durch Kommata getrennt. Mehrere Dekla­ +rationen werden - genauso wie Anweisungen - durch das Trennzeichen Semikolon +voneinander getrennt. + +____________________________________________________________________________ + .......................... Beispiele: ......................... + INT VAR mein wert, dein wert, unser wert; + BOOL VAR listen ende; + TEXT VAR zeile, wort; + +____________________________________________________________________________ + + +2.3.4 Initialisierung + +Um mit den vereinbarten Datenobjekten arbeiten zu können, muß man ihnen einen +Wert geben. Hat ein Datenobjekt noch keinen Wert erhalten, so sagt man, sein Wert +sei undefiniert. Das versehentliche Arbeiten mit undefinierten Werten ist eine beliebte +Fehlerquelle. Deshalb wird von Programmierern streng darauf geachtet, diese Fehler­ +kuelle zu vermeiden. Eine Wertgebung an ein Datenobjekt kann (muß aber nicht) +bereits bei der Deklaration erfolgen. In ELAN wird dies Initialisierung genannt. Für mit +CONST vereinbarte Datenobjekte ist die Initialisierung die einzige Möglichkeit, ihnen +einen Wert zu geben. Die Initialisierung von Konstanten ist zwingend vorgeschrieben +und wird vom Compiler überprüft. + +Die Initialisierung besteht aus der Angabe von + +- Datentyp +- Zugriffsrecht ( #on("i")##on("b")#VAR#off("i")##off("b")# oder #on("i")##on("b")#CONST#off("i")##off("b")#) +- Name des Datenobjekts +- Operator #on("i")##on("b")#::#off("i")##off("b")# oder #on("i")##on("b")#:=#off("i")##off("b")# +- Wert, den das Datenobjekt erhalten soll (Denoter, Ausdruck). + +____________________________________________________________________________ + .......................... Beispiele: ......................... + INT CONST gewuenschtes gehalt :: 12 000; + TEXT VAR zeile :: ""; + REAL CONST pi :: 3.14159, zwei pi := 2.0 * pi; + BOOL VAR bereits sortiert :: TRUE; +____________________________________________________________________________ +#page# + +2.4 Programmeinheiten + +Neben Deklarationen (Vereinbarungen) sind Programmeinheiten die Grundbestandteile +von ELAN. + + +Programmeinheiten können sein: + +#on("b")#- elementare Programmeinheiten #off("b")# + - Ausdruck + - Zuweisung + - Refinementanwendung + - Prozeduraufruf + +#on("b")#- zusammengesetzte Programmeinheiten #off("b")# + - Folge + - Abfrage + - Auswahl + - Wiederholung + +#on("b")#- abstrahierende Programmeinheiten #off("b")# + - Refinementbvereinbarung + - Prozedurvereinbarung + - Operatorvereinbarung + - Paketvereinbarung. +#page# + +2.4.1 Elementare Programmeinheiten + + +2.4.1.1 Ausdruck + +Ausdrücke sind eine Zusammenstellung von Datenobjekten (Denoter, VAR- oder +CONST-Objekte) und Operatoren. Jeder korrekte Ausdruck liefert einen Wert. Der +Typ des Ausdrucks wird bestimmt durch den Typ des Wertes, den der Ausdruck +liefert. + + +Operatoren + +Operatoren werden in ELAN durch ein oder zwei Sonderzeichen oder durch Groß­ +buchstaben als Schlüsselwort dargestellt (siehe 2.4.3.3). + +Als Operanden (also die Datenobjekte, auf die ein Operator "wirken" soll) dürfen +VAR- und CONST-Datenobjekte, Denoter oder Ausdrücke verwendet werden. Typ +der Operanden und des Resultats eines Operators werden in der Operatorvereinba­ +rung festgelegt (siehe 2.4.3.3). + +Man unterscheidet zwei Arten von Operatoren: + +#on("b")#- monadische Operatoren #off("b")# + Monadischen Operatoren haben nur einen Operanden, der rechts vom Operator­ + zeichen geschrieben werden muß. + + Beispiel: + + + - a + NOT x + + + Der '-' - Operator liefert den Wert von a mit umgekehrten Vorzeichen. a muß + dabei vom Datentyp INT oder REAL sein. + Der Operator 'NOT' realisiert die logische Negation. y muß vom Datentyp BOOL + sein. + + +#on("b")#- dyadische Operatoren #off("b")# + Dyadische Operatoren haben zwei Operanden. Das Operatorzeichen steht zwi­ + schen den beiden Operanden. + + Beispiele: + + + a + b + a - b + a * b + a DIV b + a ** b + x < y + x <> y + x AND y + x OR y + + + In den ersten fünf Beispielen werden jeweils die Werte von zwei INT-Objekten a + und b addiert (Operatorzeichen: '+'), subtrahiert ('-'), multipliziert ('*'), dividiert + (ganzzahlige Division ohne Rest: 'DIV') und potenziert ('**'). + Im sechsten und siebten Beispiel werden zwei BOOL-Werte x und y verglichen + und im achten und neunten Beispiel die logische Operation 'und' (Operator 'AND') + bzw. 'oder' (Operator 'OR') durchgeführt. + + +Priorität von Operatoren + +Es ist erlaubt, einen Ausdruck wiederum als Operanden zu verwenden. Praktisch +bedeutet dies, daß mehrere Operatoren und Datenobjekte zusammen in einem Aus­ +druck geschrieben werden dürfen. + +Beispiele: + + +a + 3 - b * c +- a * b + + +Die Reihenfolge der Auswertung kann man durch Angabe von Klammern steuern. + +Beispiel: + + +(a + b) * (a + b) + + +Es wird jeweils erst 'a + b' ausgewertet und dann erst die Multiplikation durchge­ +führt. In ELAN ist es erlaubt, beliebig viel Klammernpaare zu verwenden (Regel: die +innerste Klammer wird zuerst ausgeführt). Es ist sogar zulässig, Klammern zu ver­ +wenden, wo keine notwendig sind, denn überflüssige Klammernpaare werden überle­ +sen. Man muß jedoch beachten, daß Ausdrücke, und damit auch z.B. #on("b")#(a)#off("b")#, immer +Accessrecht CONST haben. + +Beispiel: + + +((a - b)) * 3 * ((c + d) * (c - d)) + + +Somit können beliebig komplizierte Ausdrücke formuliert werden. + +Um solche Ausdrücke einfacher zu behandeln und sie so ähnlich schreiben zu kön­ +nen, wie man es in der Mathematik gewohnt ist, wird in Programmiersprachen die +Reihenfolge der Auswertung von Operatoren festgelegt. In ELAN wurden neun Ebe­ +nen, Prioritäten genannt, festgelegt: + + +#on("bold")#Priorität Operatoren +#off("bold")# + + 9 alle monadischen Operatoren + 8 ** + 7 *, /, DIV, MOD + 6 +, - + 5 =, <>, <, <=, >, >= + 4 AND + 3 OR + 2 alle übrigen, nicht in dieser Tabelle aufgeführten + dyadischen Operatoren + 1 := + +(Die erwähnten Operatoren in der Tabelle werden in der Beschreibung der Standard­ +prozeduren und -Operatoren besprochen). + +Operatoren mit der höchsten Priorität werden zuerst ausgeführt, dann die mit der +nächst niedrigeren Priorität usw.. Operatoren mit gleicher Priorität werden von links +nach rechts ausgeführt. Dadurch ergibt sich die gewohnte Abarbeitungsfolge wie beim +Rechnen. + +Beispiel: + + +-2 + 3 * 2 ** 3 + +a) -2 +b) 2 ** 3 +c) 3 * (2 ** 3) +d) ((-2)) + (3 * (2 ** 3)) + + +Wie bereits erwähnt, ist es immer erlaubt, Klammern zu setzen. Ist man sich also +über die genaue Abarbeitungsfolge nicht im Klaren, so kann man Klammern verwen­ +den. + + + +2.4.1.2 Zuweisung + +Ein spezieller Operator ist die Zuweisung. + +Form: + + +Variable #on("i")##on("b")#:=#off("i")##off("b")# Wert + + +Dieser Operator hat immer die geringste Priorität, wird also immer als letzter einer +Anweisung ausgeführt. Die Zuweisung wird verwendet, um einer Variablen einen +neuen Wert zu geben. Der Operator ':=' liefert kein Resultat (man sagt auch, er +liefert keinen Wert) und verlangt als linken Operanden ein VAR-Datenobjekt, an den +der Wert des rechten Operanden zugewiesen werden soll). Der Wert des linken Oper­ +anden wird also verändert. Der rechte Operand wird nur gelesen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + a := b; + +____________________________________________________________________________ + + +Hier wird der Wert von 'b' der Variablen 'a' zugewiesen. Der vorher vorhandene Wert +von 'a' geht dabei verloren. Man sagt auch, der Wert wird überschrieben. + +Als rechter Operand des ':='-Operators darf auch ein Ausdruck stehen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + a := b + c; + +____________________________________________________________________________ + + +Hier wird das Resultat von 'b + c' an die Variable 'a' zugewiesen. Man beachte +dabei die Prioritäten der Operatoren '+' (Priorität 6) und ':=' (Priorität 1): die Addition +wird vor der Zuweisung ausgeführt. Die Auswertung von Zuweisungen mit Ausdrücken +muß immer so verlaufen, da die Zuweisung stets die niedrigste Priorität aller Operato­ +ren hat. + +Oft kommt es vor, daß ein Objekt auf der linken und rechten Seite des Zuweisungs­ +operators erscheint, z.B. wenn ein Wert erhöht werden soll. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + a := a + 1; + +____________________________________________________________________________ + + +Hier wird der "alte", aktuelle Wert von 'a' genommen, um '1' erhöht und dem Objekt +'a' zugewiesen. Man beachte, daß hier in einer Anweisung ein Datenobjekt unter­ +schiedliche Werte zu unterschiedlichen Zeitpunkten haben kann. + + + +2.4.1.3 Refinementanwendung + +In ELAN ist es möglich, Namen für Ausdrücke oder eine bzw. mehrere Anweisungen +zu vergeben. Das Sprachelement, das diese Namensgebung ermöglicht, heißt Refi­ +nement. Die Ausführung eines solchen Namens heißt Refinementanwendung, die +Namensgebung heißt Refinementvereinbarung (siehe 2.4.3.1). Die Ausdrücke oder +Anweisungen bilden den Refinementrumpf. Ein Refinement kann man in einem Pro­ +gramm unter dem Refinementnamen ansprechen. Man kann sich die Ausführung so +vorstellen, als würden der Refinementrumpf immer dort eingesetzt, wo der Name des +Refinements als Operation benutzt wird. + + + +2.4.1.4 Prozeduraufruf + +Eine Prozedur ist eine Sammlung von Anweisungen und Daten, die zur Lösung einer +bestimmten Aufgabe benötigt werden. Eine Prozedur wird in einer Prozedurvereinba­ +rung definiert (siehe 2.4.3.2). Eine solche Prozedur kann man in einem Programm +unter einem Namen (eventuell unter Angabe von Parametern) ansprechen. Man +spricht dann vom Aufruf einer Prozedur oder einer Prozeduranweisung. + +Formen des Prozeduraufrufs: + +- #on("b")#Prozeduren ohne Parameter#off("b")# werden durch den Prozedurnamen angesprochen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + pause; + +____________________________________________________________________________ + + + (Die Prozedur 'pause' wartet bis ein Zeichen eingegeben wird) + + +- #on("b")#Prozeduren mit Parameter#off("b")# werden durch + + + Prozedurnamen #on("i")##on("b")#(#off("i")##off("b")# aktuelle Parameterliste #on("i")##on("b")#)#off("i")##off("b")# + + + aufgerufen. Eine Parameterliste ist entweder ein Datenobjekt oder mehrere durch + Kommata getrennte Datenobjekte. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + pause (10); + +____________________________________________________________________________ + + + (Mit der Prozedur 'pause (INT CONST zeitgrenze)' kann für eine Zeitdauer von + 'zeitgrenze' in Zehntel-Sekunden gewartet werden. Die Wartezeit wird durch + Erreichen der Zeitgrenze oder durch Eingabe eines Zeichens abgebrochen) + + + Bei den aktuellen Parametern ist folgendes zu beachten: + + a) Wird ein VAR-Parameter in der Definition der Prozedur vorgeschrieben, darf + kein Ausdruck als aktueller Parameter "übergeben" werden, weil an einen + Ausdruck nichts zugewiesen werden kann. Ausdrücke haben - wie bereits + erwähnt - das Accessrecht CONST. + +____________________________________________________________________________ + ........................ Gegenbeispiel: ....................... + TEXT VAR text1, text2; + text1 := "Dieses Beispiel "; + text2 := "Fehlermeldung"; + insert char (text1 + text2, "liefert eine", 17); + +____________________________________________________________________________ + + + (Die Prozedur 'insert char (TEXT VAR string, TEXT CONST char, INT CONST + pos)' fügt das Zeichen 'char' in den Text 'string' an der Position 'pos' ein) + + b) Wird ein CONST-Parameter verlangt, dann darf in diesem Fall ein Ausdruck + als aktueller Parameter geschrieben werden. Aber auch ein VAR-Datenobjekt + darf angegeben werden. In diesem Fall wird eine Wandlung des Accessrechts + (CONSTing) vorgenommen: der aktuelle Parameter erhält sozusagen für die + Zeit der Abarbeitung der Prozedur das Accessrecht CONST. + + + In ELAN sind auch Prozeduren als Parameter erlaubt. Die Prozedur als aktueller + Parameter wird in der Parameterliste folgendermaßen angegeben: + + + Resultattyp #on("i")##on("b")#PROC#off("i")##off("b")# #on("i")##on("b")#(#off("i")##off("b")# virtuelle Parameterliste #on("i")##on("b")#)#off("i")##off("b")# Procname + + + Die Angabe des Resultattyps entfällt, wenn es sich nicht um eine wertliefernde + Prozedur handelt. Die virtuelle Parameterliste inklusive der Klammern entfällt, falls + die Prozedur keine Parameter hat. Die virtuelle Parameterliste beschreibt die + Parameter der Parameterprozedur. Es werden Datentyp und Zugriffsrecht eines + jeden Parameters angegeben, jedoch ohne Namen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + wertetabelle (REAL PROC (REAL CONST) sin, + untergrenze, obergrenze, schrittweite); + + + (Die Prozedur 'sin' wird an die Prozedur 'wertetabelle' übergeben) + +____________________________________________________________________________ + + +2.4.2 Zusammengesetzte Programmeinheiten + + +2.4.2.1 Folge + +Mehrere in einer bestimmten Reihenfolge auszuführende Anweisungen werden als +Folge bezeichnet. In ELAN kann man eine oder mehrere Anweisungen in eine Pro­ +grammzeile schreiben oder eine Anweisung über mehrere Zeilen. Das setzt jedoch +voraus, daß die Anweisungen voneinander getrennt werden. Die Trennung von Anwei­ +sungen erfolgt in ELAN durch das Trennsymbol Semikolon. Es bedeutet soviel wie: +"führe die nächste Anweisung aus". + +____________________________________________________________________________ + ........................... Beispiel: ......................... + put ("mein"); + put (1); + put (". Programm") + +____________________________________________________________________________ + + +(Die Prozedur 'put' gibt den als Parameter angegebenen Wert auf dem Ausgabegerät +aus) + + + +2.4.2.2 Abfrage + +Mit Abfragen steuert man die bedingte Ausführung von Anweisungen. Abhängig von +einer Bedingung wird in zwei verschiedene Programmabschnitte verzweigt. + +Der formale Aufbau einer Abfrage sieht folgendermaßen aus: + + +#on("i")##on("b")#IF#off("i")##off("b")# Bedingung + #on("i")##on("b")#THEN#off("i")##off("b")# Abschnitt + #on("i")##on("b")#ELSE#off("i")##off("b")# Abschnitt +#on("i")##on("b")#END IF#off("i")##off("b")# + + +Der ELSE-Teil darf dabei auch fehlen. Anstelle von #on("i")##on("b")#END IF#off("i")##off("b")# darf auch die Abkürzung #on("i")##on("b")#FI#off("i")##off("b")# (IF von hinten gelesen) benutzt werden. + +In folgenden Beispielen wird der Absolutbetrag von 'a' ausgegeben: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT VAR a; + get (a); + IF a < 0 + THEN a := -a + END IF; + put (a) + +____________________________________________________________________________ + + +Die Umkehrung des Vorzeichens von a im THEN-Teil wird nur durchgeführt, wenn +der BOOLesche Ausdruck ('a < 0') den Wert TRUE liefert. Liefert er den Wert +FALSE, wird die Anweisung, die der bedingten Anweisung folgt (nach END IF), ausge­ +führt. Das obige Programm kann auch anders geschrieben werden: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT VAR a; + get (a); + IF a < 0 + THEN put (-a) + ELSE put (a) + END IF + +____________________________________________________________________________ + + +Der THEN-Teil wird wiederum ausgeführt, wenn die BOOLesche Bedingung erfüllt +ist. Liefert sie dagegen FALSE, wird der ELSE-Teil ausgeführt. + +Die bedingte Anweisung ermöglicht es, abhängig von einer Bedingung eine oder +mehrere Anweisungen ausführen zu lassen. Dabei können im THEN- bzw. ELSE- +Teil wiederum bedingte Anweisungen enthalten sein. + + +Abfragekette +Bei Abfrageketten kann das ELIF-Konstrukt eingesetzt werden. (ELIF ist eine Zu­ +sammenziehung der Worte ELSE und IF). + +Anstatt + +____________________________________________________________________________ + ........................... Beispiel: ......................... + IF bedingung1 + THEN aktion1 + ELSE IF bedingung2 + THEN aktion2 + ELSE aktion3 + END IF + END IF; + +____________________________________________________________________________ + + +kann man besser + +____________________________________________________________________________ + ........................... Beispiel: ......................... + IF bedingung1 + THEN aktion1 + ELIF bedingung2 + THEN aktion2 + ELSE aktion3 + END IF; + +____________________________________________________________________________ + + +schreiben. + + + +2.4.2.3 Auswahl + +Die Auswahl wird benutzt, wenn alternative Anwendungen in Abhängikeit von Werten +eines Datenobjekts ausgeführt werden sollen. + +Der formale Aufbau der Auswahl sieht folgendermaßen aus: + + +#on("i")##on("b")#SELECT#off("i")##off("b")# INT-Ausdruck #on("i")##on("b")#OF#off("i")##off("b")# + #on("i")##on("b")#CASE#off("i")##off("b")# 1. Liste von INT-Denotern #on("i")##on("b")#:#off("i")##off("b")# Abschnitt + #on("i")##on("b")#CASE#off("i")##off("b")# 2. Liste von INT-Denotern #on("i")##on("b")#:#off("i")##off("b")# Abschnitt + . + . + . + #on("i")##on("b")#CASE#off("i")##off("b")# n. Liste von INT-Denotern #on("i")##on("b")#:#off("i")##off("b")# Abschnitt + #on("i")##on("b")#OTHERWISE#off("i")##off("b")# Abschnitt +#on("i")##on("b")#END SELECT#off("i")##off("b")# + + +Eine Liste von INT-Denotern besteht aus einem oder mehreren durch Kommata ge­ +trennten INT-Denotern. Der OTHERWISE-Teil darf auch fehlen. Man sollte ihn +jedoch verwenden, um Fehlerfälle abzufangen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + SELECT monat OF + CASE 2: IF schaltjahr + THEN tage := 29 + ELSE tage := 28 + END IF + CASE 4, 6, 9, 11: tage := 30 + CASE 1, 3, 5, 7, 8, 10 ,12: tage := 31 + OTHERWISE kein monat + END SELECT; + +____________________________________________________________________________ + + +(In diesem Programmausschnitt werden die Tage eines Monats bestimmt) + + + +2.4.2.4 Wertliefernde Abfrage und + wertliefernde Auswahl + + +Soll eine Abfrage oder eine Auswahl einen Wert liefern, dann darf der ELSE- bzw. +der OTHERWISE-Teil nicht fehlen und alle Zweige müssen einen Wert liefern. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + SELECT monat OF + CASE 2: IF schaltjahr + THEN 29 + ELSE 28 + END IF + CASE 4, 6, 9, 11: 30 + CASE 1, 3, 5, 7, 8, 10 ,12: 31 + OTHERWISE kein monat; 0 + END SELECT; + +____________________________________________________________________________ + + +2.4.2.5 Wiederholung + +Die Wiederholung dient zur mehrfachen Ausführung von Anweisungen, meist in Ab­ +hängigkeit von einer Bedingung. Darum wird die Wiederholungsanweisung oft auch +Schleife genannt und die in ihr enthaltenen Anweisungen Schleifenrumpf. + +Es gibt verschiedene Schleifentypen: + +- Endlosschleife +- abweisende Schleife +- nicht abweisende Schleife +- Zählschleife. + + +Endlosschleife +Bei der Endlosschleife wird nicht spezifiziert, wann die Schleife beendet werden soll. + +Form: + + +#on("i")##on("b")#REPEAT#off("i")##off("b")# + Abschnitt +#on("i")##on("b")#END REPEAT#off("i")##off("b")# + + +Anstelle von #on("i")##on("b")#REPEAT#off("i")##off("b")# darf die Abkürzung #on("i")##on("b")#REP#off("i")##off("b")# und anstelle von #on("i")##on("b")#END REPEAT#off("i")##off("b")# +das Schlüsselwort #on("i")##on("b")#PER#off("i")##off("b")# (REP von hinten gelesen) +benutzt werden. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + break; + REPEAT + fixpoint; + pause (18000) + END REPEAT + +____________________________________________________________________________ + + +Wird dieses Programm in einer Task im SYSUR-Zweig ausgeführt, so führt diese +Task Fixpunkte im Abstand von 30 Minuten durch. + + + +Abweisende Schleife +Bei der abweisenden Schleife wird die Abbruchbedingung an den Anfang der Schleife +geschrieben. + +Form: + + +#on("i")##on("b")#WHILE#off("i")##off("b")# Bedingung #on("i")##on("b")#REPEAT#off("i")##off("b")# + Abschnitt +#on("i")##on("b")#END REPEAT#off("i")##off("b")# + + +Bei jedem erneuten Durchlauf der Schleife wird überprüft, ob der BOOLesche Aus­ +druck den Wert TRUE liefert. Ist das nicht der Fall, wird die Bearbeitung mit der +Anweisung fortgesetzt, die auf das Schleifenende folgt. Die Schleife wird abweisende +Schleife genannt, weil der Schleifenrumpf nicht ausgeführt wird, wenn die Bedingung +vor Eintritt in die Schleife bereits FALSE liefert. + + +Nicht abweisende Schleife +Anders verhält es sich bei der nicht abweisenden Schleife. Bei der nicht abweisenden +Schleife wird die Abbruchbedingung an das Ende der Schleife geschrieben. + +Form: + + +#on("i")##on("b")#REPEAT#off("i")##off("b")# + Abschnitt +#on("i")##on("b")#UNTIL#off("i")##off("b")# Bedingung #on("i")##on("b")#END REPEAT#off("i")##off("b")# + + +Hier wird der Schleifenrumpf auf jeden Fall einmal bearbeitet. Am Ende des Rumpfes +wird die BOOLesche Bedingung abgefragt. Liefert sie den Wert FALSE, wird die +Schleife erneut abgearbeitet. Liefert die Bedingung den Wert TRUE, wird die Schleife +abgebrochen und mit der ersten Anweisung hinter der Schleife in der Bearbeitung +fortgefahren. + +Bei den beiden letztgenannten Arten der Wiederholungsanweisung ist es wichtig, daß +Elemente der BOOLeschen Bedingung in der Schleife verändert werden, damit das +Programm terminieren kann, d.h. die Schleife abgebrochen wird. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + TEXT VAR wort, satz :: ""; + REPEAT + get (wort); + satz CAT wort; + satz CAT " " + UNTIL wort = "." PER; + +____________________________________________________________________________ + + +Dises Programm liest solange Wörter ein und verbindet diese zu einem Satz, bis ein +Punkt eingegeben wurde. + + + +Zählschleife +Zählschleifen werden eingesetzt, wenn die genaue Anzahl der Schleifendurchläufe +bekannt ist. + +Form: + + +#on("i")##on("b")#FOR#off("i")##off("b")# Laufvariable #on("i")##on("b")#FROM#off("i")##off("b")# Anfangswert #on("i")##on("b")#UPTO#off("i")##off("b")# Endwert #on("i")##on("b")#REPEAT#off("i")##off("b")# + Abschnitt +#on("i")##on("b")#END REPEAT#off("i")##off("b")# + + +Bei Zählschleifen wird eine Laufvariable verwendet, die die INT-Werte von 'Anfangs­ +wert' bis 'Endwert' in Schritten von 1 durchläuft. 'Anfangswert' und 'Endwert' können +beliebige INT-Ausdrücke sein. Diese Schleife zählt "aufwärts". Wird anstatt #on("i")##on("b")#UPTO#off("i")##off("b")# +das Schlüsselwort #on("i")##on("b")#DOWNTO#off("i")##off("b")# verwendet, wird mit Schritten von 1 "abwärts" gezählt. + +Form: + + +#on("i")##on("b")#FOR#off("i")##off("b")# Laufvariable #on("i")##on("b")#FROM#off("i")##off("b")# Endwert #on("i")##on("b")#DOWNTO#off("i")##off("b")# Anfangswert #on("i")##on("b")#REPEAT#off("i")##off("b")# + Abschnitt +#on("i")##on("b")#END REPEAT#off("i")##off("b")# + + +Die Laufvariable darf in der Schleife nicht verändert werden. Nach dem normalen +Schleifenende ist der Wert der Laufvariablen nicht definiert. + + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT VAR summe :: 0, i; + FOR i FROM 1 UPTO 100 REPEAT + summe INCR i + END REPEAT + +____________________________________________________________________________ + + +Dieses Programm berechnet die Summe der natürlichen Zahlen von 1 bis 100. + + +Die verschiedenen Schleifenarten können kombiniert werden: + + +#on("i")##on("b")#FOR#off("i")##off("b")# Laufvariable #on("i")##on("b")#FROM#off("i")##off("b")# Anfangswert #on("i")##on("b")#UPTO#off("i")##off("b")# Endwert +#on("i")##on("b")#WHILE#off("i")##off("b")# Bedingung #on("i")##on("b")#REPEAT#off("i")##off("b")# + Abschnitt +#on("i")##on("b")#END REPEAT#off("i")##off("b")# + + + +#on("i")##on("b")#FOR#off("i")##off("b")# Laufvariable #on("i")##on("b")#FROM#off("i")##off("b")# Anfangswert #on("i")##on("b")#UPTO#off("i")##off("b")# Endwert #on("i")##on("b")#REPEAT#off("i")##off("b")# + Abschnitt +#on("i")##on("b")#UNTIL#off("i")##off("b")# Bedingung #on("i")##on("b")#END REPEAT#off("i")##off("b")# + + + + + +#on("i")##on("b")#WHILE#off("i")##off("b")# Bedingung #on("i")##on("b")#REPEAT#off("i")##off("b")# + Abschnitt +#on("i")##on("b")#UNTIL#off("i")##off("b")# Bedingung #on("i")##on("b")#END REPEAT#off("i")##off("b")# + +#page# + +2.4.3 Abstrahierende Programmeinheiten + + +2.4.3.1 Refinementvereinbarung + +In ELAN ist es möglich, Namen für Ausdrücke oder eine bzw. mehrere Anweisungen +zu vergeben. Das Sprachelement, das diese Namensgebung ermöglicht, heißt Refi­ +nement. Die Ausführung eines solchen Namens heißt Refinementanwendung (siehe +2.4.1.3), die Namensgebung heißt Refinementvereinbarung. Die Ausdrücke oder +Anweisungen bilden den Refinementrumpf. + +Werden in einem Programm Refinements benutzt, dann wird der Programmteil bis +zum ersten Refinement durch einen Punkt abgeschlossen. Die Refinementvereinba­ +rung sieht folgendermaßen aus: + + +Name #on("i")##on("b")#:#off("i")##off("b")# + Abschnitt #on("i")##on("b")#.#off("i")##off("b")# + + + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT VAR a, b, x; + einlesen von a und b; + vertauschen von a und b; + vertauschte werte ausgeben. + + einlesen von a und b: + get (a); + get (b). + + vertauschen von a und b: + x := a; + a := b; + b := x. + + vertauschte werte ausgeben: + put (a); + put (b). + +____________________________________________________________________________ + + +Für den Namen 'einlesen von a und b' werden die Anweisungen 'get (a); get (b)' vom +ELAN-Compiler eingesetzt. Man kann also die ersten vier Zeilen des Programms als +eigentliches Programm ansehen, wobei die Namen durch die betreffenden Anwei­ +sungen ersetzt werden. Ein Refinement hat also keinen eigenen Datenbereich, d.h. +Vereinbarungen, die in Refinements gemacht werden, gelten auch außerhalb des +Refinements. + + + +Vorteile der Refinementanwendung +Durch die sinnvolle Verwendung von Refinements wird ein Programm im Programm +und nicht in einer separaten Beschreibung dokumentiert. Weiterhin kann ein Pro­ +gramm "von oben nach unten" ("top down") entwickelt werden: Das obige - zuge­ +geben einfache - Beispielprogramm wurde in drei Teile zerlegt und diese durch +Namen beschrieben. Bei der Beschreibung von Aktionen durch Namen wird gesagt +was gemacht werden soll. Es wird noch nicht beschrieben wie, denn auf dieser Stufe +der Programmentwicklung braucht man sich um die Realisierung der Refinements +(noch) keine Sorgen zu machen. Das erfolgt erst, wenn das Refinement programmiert +werden muß. Dabei können wiederum Refinements verwendet werden usw., bis man +auf eine Ebene "heruntergestiegen" ist, bei der eine (jetzt: Teil-) Problemlösung sehr +einfach ist und man sie direkt hinschreiben kann. Man beschäftigt sich also an jedem +Punkt der Problemlösung nur mit einem Teilaspekt des gesamten Problems. Zudem +sieht man - wenn die Refinements einigermaßen vernünftig verwendet werden - +dem Programm an, wie die Problemlösung entstanden ist. + +Die Verwendung von Refinements hat also eine Anzahl von Vorteilen. +Refinements ermöglichen: + +- "top down" - Programmierung +- Strukturierung von Programmen und damit effiziente Fehlersuche und gute Wart­ + barkeit +- Dokumentation im Programmtext. + + +Wertliefernde Refinements +Refinements können auch dort verwendet werden, wo ein Wert erwartet wird, z.B. in +einem Ausdruck oder einer 'put'-Anweisung. In diesem Fall muß die letzte Anwei­ +sung des Refinements einen Wert liefert. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT VAR a :: 1, b :: 2, c :: 3; + put (resultat). + + resultat: + (a * b + c) ** 3. + +____________________________________________________________________________ + + +Man kann auch ein wertlieferndes Refinement mit mehreren Anweisungen schrei­ +ben. + +Allgemeine Regel: +Die letzte Anweisung eines Refinements bestimmt, ob es einen Wert liefert - und +wenn ja, von welchen Datentyp. + + + +2.4.3.2 Prozedurvereinbarung + +Eine Prozedur ist eine Sammlung von Anweisungen und Daten, die zur Lösung einer +bestimmten Aufgabe benötigt werden. + +Der formale Aufbau einer Prozedur sieht folgendermaßen aus: + + +#on("i")##on("b")#PROC#off("i")##off("b")# Prozedurname #on("i")##on("b")#:#off("i")##off("b")# + Prozedurrumpf +#on("i")##on("b")#END PROC#off("i")##off("b")# Prozedurname + + +Der Prozedurrumpf kann Deklarationen, Anweisungen und Refinements enthalten. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PROC loesche bildschirm ab aktueller cursorposition: + out (""4"") + END PROC loesche bildschirm ab aktueller cursorposition + +____________________________________________________________________________ + + +Verwendung von Prozeduren +Prozeduren werden verwendet, wenn + +- Anweisungen und Datenobjekte unter einem Namen zusammengefaßt werden + sollen ("Abstraktion") +- gleiche Anweisungen von mehreren Stellen eines Programms verwandt werden + sollen (Codereduktion), u.U. mit verschieden Datenobjekten (Parameter) +- Datenobjekte nur innerhalb eines Programmteils benötigt werden und diese nicht + von dem gesamten Programm angesprochen werden sollen. + +In den folgenden Programmfragmenten werden zwei Werte vertauscht. In der ersten +Lösung wird ein Refinement, in der zweiten eine Prozedur verwandt. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + IF a > b + THEN vertausche a und b + END IF; + put (a); + put (b); + vertausche a und b. + + vertausche a und b: + INT CONST x :: a; + a := b; + b := x. + +____________________________________________________________________________ + + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PROC vertausche a und b: + INT CONST x :: a; + a := b; + b := x + END PROC vertausche a und b; + + IF a > b + THEN vertausche a und b + END IF; + put (a); + put (b); + vertausche a und b; + +____________________________________________________________________________ + + +Beim ersten Hinsehen leisten beide Programme das Gleiche. Es gibt jedoch drei +wichtige Unterschiede: + +1) Das Refinement 'vertausche a und b' wird zweimal (vom ELAN-Compiler) ein­ + gesetzt, d.h. der Code ist zweimal vorhanden. Die Prozedur dagegen ist vom Code + nur einmal vorhanden, wird aber zweimal - durch das Aufführen des Prozedur­ + namens - aufgerufen. + +2) Die Variable 'x' ist in der ersten Programmversion während des gesamten Ablauf + des Programms vorhanden, d.h. ihr Speicherplatz ist während dieser Zeit belegt. + Solche Datenobjekte nennt man statische Datenobjekte oder auch (aus Gründen, + die erst etwas später offensichtlich werden) Paket-Objekte. Das Datenobjekt 'x' + der rechten Version dagegen ist nur während der Bearbeitung der Prozedur vor­ + handen, sein Speicherplatz wird danach freigegeben. Solche Datenobjekte, die nur + kurzfristig Speicher belegen, werden dynamische Datenobjekte genannt. + + Prozeduren sind also ein Mittel, um die Speicherbelegung zu beeinflussen. + +3) Da Refinements keinen eigenen Datenbereich haben, kann die Variable 'x' in der + ersten Programmversion - obwohl sie in einem Refinement deklariert wurde - + von jeder Stelle des Programms angesprochen werden. Solche Datenobjekte + werden globale Datenobjekte genannt. Das Datenobjekt 'x' der Prozedur dagegen + kann nur innerhalb der Prozedur angesprochen werden, es ist also ein lokales + Datenobjekt der Prozedur. Innerhalb der Prozedur dürfen globale Datenobjekte + (also Objekte, die außerhalb von Prozeduren deklariert wurden) auch angespro­ + chen werden. + + Eine Prozedur in ELAN bildet im Gegensatz zu Refinements einen eigenen Gültig­ + keitsbereich hinsichtlich Datenobjekten und Refinements, die innerhalb der Pro­ + zedur deklariert werden. Prozeduren sind somit ein Mittel, um die in ihr dekla­ + rierten Datenobjekte hinsichtlich der Ansprechbarkeit nach Außen "abzuschotten". + + + +Prozeduren mit Parametern +Prozeduren mit Parametern erlauben es, gleiche Anweisungen mit unterschiedlichen +Datenobjekten auszuführen. + +Form: + + +#on("i")##on("b")#PROC#off("i")##off("b")# Prozedurname #on("i")##on("b")#(#off("i")##off("b")# formale Parameterliste #on("i")##on("b")#)#off("i")##off("b")# #on("i")##on("b")#:#off("i")##off("b")# + Prozedurrumpf +#on("i")##on("b")#END PROC#off("i")##off("b")# Prozedurnamen + + +Die Parameterliste besteht aus einem oder mehreren durch Kommata getrennten Para­ +metern. Ein Parameter wird mit Datentyp, Accessrecht und Namen angegeben. +Ähnlich wie bei der Datendeklaration braucht man für aufeinanderfolgende Parameter +mit gleichem Datentyp und gleichem Accessrecht die Attribute nur einmal anzugeben. +Parameter mit Accessrecht #on("i")##on("b")#CONST#off("i")##off("b")# sind Eingabeparameter, Parameter mit Access­ +recht #on("i")##on("b")#VAR#off("i")##off("b")# realisieren Ein-/Ausgabeparameter. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PROC vertausche (INT VAR a, b): + INT VAR x :: a; + a := b; + b := x + END PROC vertausche; + + INT VAR eins :: 1, + zwei :: 2, + drei :: 3; + vertausche (eins, zwei); + vertausche (zwei, drei); + vertausche (eins, zwei); + put (eins); put (zwei); put (drei) + +____________________________________________________________________________ + + +Die Datenobjekte 'a' und 'b' der Prozedur 'vertausche' werden formale Parameter +genannt. Sie stehen als Platzhalter für die bei einem Prozeduraufruf einzusetzenden +aktuellen Parameter (in obigen Beispiel die Datenobjekte 'eins', 'zwei' und 'drei'). + + + +Prozeduren als Parameter +Es ist auch möglich, Prozeduren als Parameter zu definieren. + +Eine Prozedur als Parameter wird folgendermaßen in der Parameterliste spezifiziert: + +Resultattyp #on("i")##on("b")#PROC#off("i")##off("b")# #on("i")##on("b")#(#off("i")##off("b")# virtuelle Parameterliste #on("i")##on("b")#)#off("i")##off("b")# Prozedurname + + +Die Angabe des Resultattyps entfällt, wenn es sich nicht um eine wertliefernde Proze­ +dur handelt. Die virtuelle Parameterliste inklusive der Klammern entfällt, falls die +Prozedur keine Parameter hat. Die virtuelle Parameterliste beschreibt die Parame­ +ter der Parameterprozedur. Es werden Datentyp und Zugriffsrecht eines jeden Para­ +meters angegeben, jedoch ohne Namen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PROC wertetabelle (REAL PROC (REAL CONST) funktion, + REAL CONST untergrenze, obergrenze, + schrittweite): + + REAL VAR wert; + putline ("W E R T E T A B E L L E"); + putline ("-----------------------"); + wert := untergrenze; + REPEAT + put (text (wert, 10, 5)); + put (text (funktion (wert), 10, 5)); + line; + wert INCR schrittweite + UNTIL wert > obergrenze PER + + END PROC wertetabelle; + + (* Prozeduraufruf: *) + wertetabelle (REAL PROC (REAL CONST) sin, 0.0, pi, 0.2) + +____________________________________________________________________________ + + +Wertliefernde Prozeduren +Eine wertliefernde Prozedur sieht folgendermaßen aus: + + +Resultattyp #on("i")##on("b")#PROC#off("i")##off("b")# Prozedurname #on("i")##on("b")#(#off("i")##off("b")# formale Parameterliste #on("i")##on("b")#)#off("i")##off("b")# #on("i")##on("b")#:#off("i")##off("b")# + wertliefernder Prozedurrumpf +#on("i")##on("b")#END PROC#off("i")##off("b")# Prozedurnamen + + + +Die Parameterliste inklusive Klammerung kann fehlen. Der Prozedurrumpf muß einen +Wert mit dem in Resultattyp angegeben Datentyp liefern. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT PROC max (INT CONST a, b): + IF a > b + THEN a + ELSE b + END IF + END PROC max; + + put (max (3, 4)) + +____________________________________________________________________________ + + +(In diesem Beispiel wird das Maximum von 'a' und 'b' ermittelt und ausgegeben) + +#page# + +2.4.3.3 Operatorvereinbarung + +Operatoren können in ELAN ähnlich wie Prozeduren definiert werden. Operatoren +müssen einen und können maximal zwei Operatoren besitzen (monadische und dyadi­ +sche Operatoren). + +Form: + + +Resultattyp #on("i")##on("b")#OP#off("i")##off("b")# Opname #on("i")##on("b")#(#off("i")##off("b")# ein oder zwei Parameter #on("i")##on("b")#)#off("i")##off("b")# #on("i")##on("b")#:#off("i")##off("b")# + Operatorrumpf +#on("i")##on("b")#END OP#off("i")##off("b")# Opname + + +Der Resultattyp wird nur bei wertliefernden Operatoren angegeben. + +Als Operatornamen sind erlaubt: + +- ein Sonderzeichen, sofern es nicht als Trennzeichen benutzt wird: + ! $ % & ' * + - / < = > ? § ^ ' ~ +- eine Kombination von zwei Sonderzeichen. Diese Kombination muß jedoch bereits + in ELAN existieren: + := <= >= <> ** +- ein Schlüsselwort (siehe 2.2.1). + + + +Vereinbarung eines monadischen Operators +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT OP SIGN (REAL CONST argument): + IF argument < 0.0 THEN -1 + ELIF argument = 0.0 THEN 0 + ELSE 1 + FI + END OP SIGN + +____________________________________________________________________________ + + +(Der Operator 'SIGN' liefert abhängig vom Vorzeichen des übergebenen Wertes den +INT-Wert -1, 0 oder 1) + + + +Vereinbarung eines dyadischen Operators +____________________________________________________________________________ + ........................... Beispiel: ......................... + TEXT OP * (INT CONST anzahl, TEXT CONST t): + INT VAR zaehler :: anzahl; + TEXT VAR ergebnis :: ""; + WHILE zaehler > 0 REP + ergebnis := ergebnis + t; + zaehler := zaehler - 1 + END REP; + ergebnis + END OP *; + +____________________________________________________________________________ + + +(Der Operator '*' verkettet 'anzahl'- mal den Text 't') + + + +2.4.3.4 Paketvereinbarung + +Pakete sind in ELAN eine Zusammenfassung von Datenobjekten, Prozeduren, Opera­ +toren und Datentypen. Diese bilden den Paketrumpf. Elemente eines Pakets (Prozedu­ +ren, Operatoren, Datentypen) können außerhalb des Pakets nur angesprochen werden, +wenn sie in der Schnittstelle des Pakets, die auch "interface" genannt wird, aufge­ +führt werden. Mit anderen Worten: es können alle Elemente eines Pakets von außen +nicht angesprochen werden, sofern sie nicht über die Schnittstelle "nach außen ge­ +reicht" werden. Pakete können separat übersetzt werden, so daß der "Zusammen­ +bau" eines umfangreichen Programms aus mehreren Paketen möglich ist. + +Der formale Aufbau eines Pakets sieht folgendermaßen aus: + + +#on("i")##on("b")#PACKET#off("i")##off("b")# Paketname #on("i")##on("b")#DEFINES#off("i")##off("b")# Schnittstelle #on("i")##on("b")#:#off("i")##off("b")# + Paketrumpf +#on("i")##on("b")#END PACKET#off("i")##off("b")# Paketname + + +In der Schnittstelle werden Prozeduren und Operatoren nur mit ihrem Namen, durch +Kommata getrennt, angegeben. Weiterhin können Datentypen und mit CONST verein­ +barte Datenobjekte in der Schnittstelle aufgeführt werden, aber keine VAR-Datenob­ +jekte, weil diese sonst über Paket-Grenzen hinweg verändert werden könnten. + +Im Gegensatz zu einer Prozedur kann ein PACKET nicht aufgerufen werden (nur die +Elemente der Schnittstelle können benutzt werden). + +Pakete werden zu folgenden Zwecken eingesetzt: + +- Spracherweiterung +- Schutz vor fehlerhaftem Zugriff auf Datenobjekte +- Realisierung von abstrakten Datentypen. + + + +Spracherweiterung +____________________________________________________________________________ + ........................... Beispiel: ......................... + PACKET fuer eine prozedur DEFINES swap: + + PROC swap (INT VAR a, b): + INT CONST x :: a; + b := a; + a := x + END PROC swap + + END PACKET fuer eine prozedur + +____________________________________________________________________________ + + +Dies ist ein Paket, das eine Tausch-Prozedur für INT-Datenobjekte bereitstellt. Das +PACKET kann übersetzt und dem ELAN-Compiler bekannt gemacht werden +(EUMEL: "insertieren"). Ist das geschehen, kann man 'swap' wie alle anderen Proze­ +duren (z.B. 'put', 'get') in einem Programm verwenden. Tatsächlich werden die mei­ +sten Prozeduren und Operatoren (aber auch einige Datentypen), die in ELAN zur +Verfügung stehen, nicht durch den ELAN-Compiler realisiert, sondern durch solche +PACKETs. Um solche Objekte einigermaßen zu standardisieren, wurde in der +ELAN-Sprachbeschreibung festgelegt, welche Datentypen, Prozeduren und Operato­ +ren in jedem ELAN-System vorhanden sein müssen. Solche Pakete werden Stan­ +dard-Pakete genannt. Jeder Installation - aber auch jedem Benutzer - steht es +jedoch frei, zu den Standard-Paketen zusätzliche Pakete dem Compiler bekannzu­ +geben, und damit den ELAN-Sprachumfang zu erweitern. + + + +Schutz vor fehlerhaftem Zugriff auf Datenobjekte +____________________________________________________________________________ + ........................... Beispiel: ......................... + PACKET stack handling DEFINES push, pop, init stack: + + LET max = 1000; + ROW max INT VAR stack; (* siehe Kapitel Reihung, 2.6.1. *) + INT VAR stack pointer; + + PROC init stack: + stack pointer := 0 + END PROC init stack; + + PROC push (INT CONST dazu wert): + stack pointer INCR 1; + IF stack pointer > max + THEN errorstop ("stack overflow") + ELSE stack [stack pointer] := dazu wert + END IF + END PROC push; + + PROC pop (INT VAR von wert): + IF stack pointer = 0 + THEN errorstop ("stack empty") + ELSE von wert := stack [stack pointer]; + stack pointer DECR 1 + END IF + END PROC pop + + END PACKET stack handling; + +____________________________________________________________________________ + + +Dieses Packet realisiert einen Stack. Den Stack kann man über die Prozeduren 'init +stack', 'push' und 'pop' benutzen. +#page# +____________________________________________________________________________ + ........................... Beispiel: ......................... + init stack; + werte einlesen und pushen; + werte poppen und ausgeben. + + werte einlesen und pushen: + INT VAR anzahl :: 0, wert; + REP + get (wert); + push (wert); + anzahl INCR 1 + UNTIL ende kriterium END REP. + + werte poppen und ausgeben: + INT VAR i; + FOR i FROM 1 UPTO anzahl REP + pop (wert); + put (wert) + END REP. + +____________________________________________________________________________ + + +Die Datenobjekte 'stack' und 'stack pointer' haben nur Gültigkeit innerhalb des +PACKETs 'stack handling'. + +Anweisungen wie z.B. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + put (stack [3]); + stack [27] := 5 + +____________________________________________________________________________ + + + +außerhalb des PACKETs 'stack handling' sind also verboten und werden vom +ELAN-Compiler entdeckt. + +Ein PACKET bietet also auch einen gewissen Schutz vor fehlerhafter Verwendung von +Programmen und Datenobjekten. Wichtig ist weiterhin, daß die Realisierung des +Stacks ohne weiteres geändert werden kann, ohne daß Benutzerprogramme im 'main +packet' geändert werden müssen, sofern die Schnittstelle nicht verändert wird. Bei­ +spielsweise kann man sich entschließen, den Stack nicht durch eine Reihung, son­ +dern durch eine Struktur zu realisieren. Davon bleibt ein Benutzerprogramm unbe­ +rührt. + + + +Realisierung von abstrakten Datentypen +Der Vollständigkeit halber wird folgendes Beispiel hier gezeigt. Wie neue Datentypen +definiert werden, wird in Kapitel 2.7.1. erklärt. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PACKET widerstaende DEFINES WIDERSTAND, REIHE, PARALLEL, + :=, get, put: + + TYPE WIDERSTAND = INT; + + OP := (WIDERSTAND VAR l, WIDERSTAND CONST r): + CONCR (l) := CONCR (r) + END OP :=; + + PROC get (WIDERSTAND VAR w): + INT VAR i; + get (i); + w := WIDERSTAND : (i) + END PROC get; + + PROC put (WIDERSTAND CONST w): + put (CONCR (w)) + END PROC put; + + WIDERSTAND OP REIHE (WIDERSTAND CONST l, r): + WIDERSTAND : ( CONCR (l) + CONCR (r)) + END OP REIHE; + + WIDERSTAND OP PARALLEL (WIDERSTAND CONST l, r): + WIDERSTAND : + ((CONCR (l) * CONCR (r)) DIV (CONCR (l) + CONCR (r))) + END OP PARALLEL + + END PACKET widerstaende + +____________________________________________________________________________ + + +Dieses Programm realisiert den Datentyp WIDERSTAND und mit den Operationen +eine Fachsprache. + + + +2.4.4 Terminatoren für Refinements, + Prozeduren und Operatoren + + +Das LEAVE-Konstrukt wird verwendet, um eine benannte Anweisung (Refinement, +Prozedur oder Operator) vorzeitig zu verlassen. Es ist auch möglich, geschachtelte +Refinements zu verlassen. + +Form: + +#on("i")##on("b")#LEAVE#off("i")##off("b")# Name + + +Durch eine (optionale) WITH-Angabe kann auch eine wertliefernde benannte Anwei­ +sung verlassen werden. + +Form: + +#on("i")##on("b")#LEAVE#off("i")##off("b")# Name #on("i")##on("b")#WITH#off("i")##off("b")# Ausdruck + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT OP ** (INT CONST basis, exp): + IF exp = 0 + THEN LEAVE ** WITH 1 + ELIF exp < 0 + THEN LEAVE ** WITH 0 + FI; + + INT VAR zaehler, ergebnis; + ergebnis := basis; + FOR zaehler FROM 2 UPTO exp REP + ergebnis := ergebnis * basis + PER; + ergebnis + END OP ** + +____________________________________________________________________________ + + +(Diese Operation realisiert die Exponentiation für INT-Werte) + + + +2.4.5 Generizität von Prozeduren + und Operatoren + + +In ELAN ist es möglich, unterschiedlichen Prozeduren bzw. Operatoren gleiche +Namen zu geben. Solche Prozeduren (Operatoren) werden generische Prozeduren +(Operatoren) genannt. Die Identifizierung erfolgt durch Anzahl, Reihenfolge und Daten­ +typ der Parameter (Operanden). + +Deshalb werden Prozeduren und Operatoren unter Angabe des Prozedur- bzw. des +Operatorkopfes dokumentiert. + +Beispiele: + + +INT OP MOD (INT CONST l, r) +REAL OP MOD (REAL CONST l, r) + + +Der MOD-Operator liefert den Rest einer Division. Er ist sowohl für INT- wie auch +für REAL-Datenobjekte definiert. + + + +PROC put (INT CONST wert) +PROC put (REAL CONST wert) +PROC put (TEXT CONST wert) + + +Die put-Prozedur ist für INT-, REAL- und TEXT-Datenobjekte definiert. + + + +Priorität von generischen Operatoren +Bei der Neudefinition von Operatoren kann man bereits benutzte Sonderzeichen oder +Schlüsselwörter benutzen. In diesem Fall bekommt der neudefinierte Operator die +gleiche Priorität wie der bereits vorhandene Operator. + + + +2.4.6 Rekursive Prozeduren + und Operatoren + + +Alle Prozeduren und Operatoren dürfen in ELAN rekursiv sein. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT PROC fakultaet (INT CONST n): + IF n > 0 + THEN fakultaet (n-1) * n + ELSE 1 + END IF + END PROC fakultaet + +____________________________________________________________________________ + + +Die Fakultätsfunktion ist kein gutes Beispiel für eine Rekursion, denn das Programm +kann leicht in eine iterative Version umgewandelt werden: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT PROC fakultaet (INT CONST n): + INT VAR prod :: 1, i; + FOR i FROM 2 UPTO n REP + prod := prod * i + END REP; + prod + END PROC fakultaet + +____________________________________________________________________________ + + +Die Umwandlung von einem rekursiven Programm in ein iteratives ist übrigens immer +möglich, jedoch oft nicht so einfach, wie in dem Beispiel der Ackermann-Funktion: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT PROC acker (INT CONST m, n): + IF m = 0 + THEN n + 1 + ELIF n = 0 + THEN acker (m-1, 0) + ELSE acker (m - 1, acker (m, n - 1)) + ENDIF + END PROC acker + +____________________________________________________________________________ + + +Das eigentliche Einsatzgebiet von rekursiven Algorithmen liegt aber bei den 'back­ +track'-Verfahren. Diese werden eingesetzt, wenn eine exakte algorithmische Lösung +nicht bekannt ist oder nicht gefunden werden kann und man verschiedene Versuche +machen muß, um zu einem Ziel (oder Lösung) zu gelangen. + diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.2b b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.2b new file mode 100644 index 0000000..c2103ba --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.2b @@ -0,0 +1,1395 @@ +#headandbottom("52","EUMEL-Benutzerhandbuch","TEIL 2 : ELAN","2")# +#pagenr ("%", 52)##setcount(1)##block##pageblock# +#headeven# +#center#EUMEL-Benutzerhandbuch +#center#____________________________________________________________ + +#end# +#headodd# +#center#TEIL 2 : ELAN +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +2 - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#2 - % +#end# + + +2.5 Programmstruktur + +Ein ELAN-Programm kann aus mehreren Moduln (Bausteinen) aufgebaut sein, die in +ELAN PACKETs genannt werden. Das letzte PACKET wird "main packet" genannt, +weil in diesem das eigentliche Benutzerprogramm (Hauptprogramm) enthalten ist. +Dies soll eine Empfehlung sein, in welcher Reihenfolge die Elemente eines PACKETs +geschrieben werden sollen: + +Ein "main packet" kann aus folgenden Elementen bestehen: + +a) Deklarationen und Anweisungen. Diese müssen nicht in einer bestimmten Reihen­ + folge im Programm erscheinen, sondern es ist möglich, erst in dem Augenblick zu + deklarieren, wenn z.B. eine neue Variable benötigt wird. Es ist jedoch gute Pro­ + grammierpraxis, die meisten Deklarationen an den Anfang eines Programms oder + Programmteils (Refinement, Prozedur) zu plazieren. + + ; + + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT VAR erste zahl, zweite zahl; + + page; + put ("erste Zahl = "); get (erste zahl); + put ("zweite Zahl ="); get (zweite zahl) + +____________________________________________________________________________ + + +b) Deklarationen, Refinements und Anweisungen. In diesem Fall ist es notwendig, die + Refinements hintereinander zu plazieren. Refinement-Aufrufe und/oder + Anweisungen sollten textuell vorher erscheinen. + + ; + . + + + Innerhalb der Refinements sind Anweisungen und/oder Deklarationen möglich. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT VAR erste zahl, zweite zahl; + + loesche bildschirm; + lies zwei zahlen ein. + + loesche bildschirm: + page. + + lies zwei zahlen ein: + put ("erste Zahl = "); get (erste zahl); + put ("zweite Zahl ="); get (zweite zahl). + +____________________________________________________________________________ + + +c) Deklarationen, Prozeduren und Anweisungen. Werden Prozeduren vereinbart, + sollte man sie nach den Deklarationen plazieren. Danach sollten die Anweisungen + folgen: + + ; + ; + + + Mehrere Prozeduren werden durch ";" voneinander getrennt. In diesem Fall sind + die Datenobjekte aus den Deklarationen außerhalb von Prozeduren statisch, d.h. + während der gesamten Laufzeit des Programm vorhanden. Solche Datenobjekte + werden auch PACKET-Daten genannt. Im Gegensatz dazu sind die Datenobjekte + aus Deklarationen in Prozeduren dynamische Datenobjekte, die nur während der + Bearbeitungszeit der Prozedur existieren. Innerhalb einer Prozedur dürfen wieder­ + um Refinements verwendet werden. Ein Prozedur-Rumpf hat also den formalen + Aufbau wie unter a) oder b) geschildert. + + Die Refinements und Datenobjekte, die innerhalb einer Prozedur deklariert wurden, + sind lokal zu dieser Prozedur, d.h. können von außerhalb nicht angesprochen + werden. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT VAR erste zahl, zweite zahl; + + PROC vertausche (INT VAR a, b): + INT VAR x; + + x := a; + a := b; + b := x + END PROC vertausche; + + put ("erste Zahl = "); get (erste zahl); + put ("zweite Zahl ="); get (zweite zahl); + IF erste zahl > zweite zahl + THEN vertausche (erste zahl, zweite zahl) + FI + +____________________________________________________________________________ + + +d) Deklarationen, Prozeduren, Anweisungen und PACKET-Refinements. Zusätzlich + zu der Möglichkeit c) ist es erlaubt, neben den Anweisungen außerhalb einer + Prozedur auch Refinements zu verwenden: + + ; + ; + . + + + Diese Refinements können nun in Anweisungen außerhalb der Prozeduren benutzt + werden oder auch durch die Prozeduren (im letzteren Fall spricht man analog zu + globalen PACKET-Daten auch von PACKET-Refinements oder globalen Refine­ + ments). In PACKET-Refinements dürfen natürlich keine Datenobjekte verwandt + werden, die lokal zu einer Prozedur sind. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + INT VAR erste zahl, zweite zahl; + + PROC vertausche (INT VAR a, b): + INT VAR x; + + x := a; + a := b; + b := x + END PROC vertausche; + + loesche bildschirm; + lies zwei zahlen ein; + ordne die zahlen. + + loesche bildschirm: + page. + + lies zwei zahlen ein: + put ("erste Zahl = "); get (erste zahl); + put ("zweite Zahl ="); get (zweite zahl). + + ordne die zahlen: + IF erste zahl > zweite zahl + THEN vertausche (erste zahl, zweite zahl) + FI + +____________________________________________________________________________ +#page# + +2.6 Zusammengesetzte Datentypen + +In ELAN gibt es die Möglichkeit, gleichartige oder ungleichartige Datenobjekte zu +einem Objekt zusammenzufassen. + + +2.6.1 Reihung + +Die Zusammenfassung gleichartiger Datenobjekte, wird in ELAN eine Reihung (ROW) +genannt. Die einzelnen Objekte einer Reihung werden Elemente genannt. + +Eine Reihung wird folgendermaßen deklariert: + +- Schlüsselwort #on("i")##on("b")#ROW#off("i")##off("b")# +- Anzahl der zusammengefaßten Elemente + (INT-Denoter oder durch LET definierter Name) +- Datentyp der Elemente +- Zugriffsrecht ( #on("i")##on("b")#VAR#off("i")##off("b")# oder #on("i")##on("b")#CONST#off("i")##off("b")# ) +- Name der Reihung. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + ROW 10 INT VAR feld + +____________________________________________________________________________ + + +Im obigen Beispiel wird eine Reihung von 10 INT-Elementen deklariert. ROW 10 INT +ist ein (neuer, von den elementaren unterschiedlicher) Datentyp, für den keine Opera­ +tionen definiert sind, außer der Zuweisung. Das Accessrecht (VAR im obigen Bei­ +spiel) und der Name ('feld') gilt - wie bei den elementaren Datentypen - für diesen +neuen Datentyp, also für alle 10 Elemente. + +Warum gibt es keine Operationen außer der Zuweisung? Das wird sehr schnell +einsichtig, wenn man bedenkt, daß es ja sehr viele Datentypen (zusätzlich zu den +elementaren) gibt, weil Reihungen von jedem Datentyp gebildet werden können: + + +ROW 1 INT ROW 1 REAL +ROW 2 INT ROW 2 REAL + : : +ROW maxint INT ROW maxint REAL + +ROW 1 TEXT ROW 1 BOOL +ROW 2 TEXT ROW 2 BOOL + : : +ROW maxint TEXT ROW maxint BOOL + + +Für die elementaren INT-, REAL-, BOOL- und TEXT-Datentypen sind unter­ +schiedliche Operationen definiert. Man müßte nun für jeden dieser zusammengesetz­ +ten Datentypen z.B. auch 'get'- und 'put'-Prozeduren schreiben, was allein vom +Schreibaufwand sehr aufwendig wäre. Das ist der Grund dafür, daß es keine vorgege­ +bene Operationen auf zusammengesetzte Datentypen gibt. + +Zugegebenermaßen könnte man mit solchen Datentypen, die nur über eine Operation +verfügen (Zuweisung), nicht sehr viel anfangen, wenn es nicht eine weitere vorgege­ +bene Operation gäbe, die Subskription. Sie erlaubt es, auf die Elemente einer Reih­ +ung zuzugreifen und den Datentyp der Elemente "aufzudecken". + +Form: + +Rowname #on("i")##on("b")#[#off("i")##off("b")# Indexwert #on("i")##on("b")#]#off("i")##off("b")# + +Beispiel: + + +feld [3] + + +bezieht sich auf das dritte Element der Reihung 'feld' und hat den Datentyp INT. Für +INT-Objekte haben wir aber einige Operationen, mit denen wir arbeiten können. + +____________________________________________________________________________ + ........................... Beispiele: ........................ + feld [3] := 7; + feld [4] := feld [3] + 4; + +____________________________________________________________________________ + + +Eine Subskription "schält" also vom Datentyp ein ROW ab und liefert ein Element der +Reihung. Die Angabe der Nummer des Elements in der Reihung nennt man Subskript +oder Index (in obigem Beispiel '3'). Der Subskript wird in ELAN in eckigen Klammern +angegeben, um eine bessere Unterscheidung zu den runden Klammern in Ausdrücken +zu erreichen. Ein subskribiertes ROW-Datenobjekt kann also überall da verwendet +werden, wo ein entsprechender Datentyp benötigt wird (Ausnahme: nicht als Schlei­ +fenvariable). + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PROC get (ROW 10 INT VAR feld): + INT VAR i; + FOR i FROM 1 UPTO 10 REP + put (i); put ("tes Element bitte:"); + get (feld [i]); + line + END REP + END PROC get; + + PROC put (ROW 10 INT CONST feld): + INT VAR i; + FOR i FROM 1 UPTO 10 REP + put (i); put ("tes Element ist:"); + put (feld [i]); + line + END REP + END PROC put + +____________________________________________________________________________ + + +In diesen Beispielen werden Reihungen als Parameter benutzt. + +Diese beiden Prozeduren werden im folgenden Beispiel benutzt um 10 Werte einzu­ +lesen und die Summe zu berechnen: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + ROW 10 INT VAR werte; + lies werte ein; + summiere sie; + drucke die summe und einzelwerte. + + lies werte ein: + get (werte). + + summiere sie: + INT VAR summe :: 0, i; + FOR i FROM 1 UPTO 10 REP + summe INCR werte [i] + END REP. + + drucke die summe und einzelwerte: + put (werte); + line; + put ("Summe:"); put (summe). + +____________________________________________________________________________ + + +Da es möglich ist, von jedem Datentyp eine Reihung zu bilden, kann man natürlich +auch von einer Reihung eine Reihung bilden: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + ROW 5 ROW 10 INT VAR matrix + +____________________________________________________________________________ + + +Für eine "doppelte" Reihung gilt das für "einfache" Reihungen gesagte. Wiederum +existieren keine Operationen für dieses Datenobjekt (außer der Zuweisung), jedoch ist +es durch Subskription möglich, auf die Elemente zuzugreifen: + + +matrix [3] + + +liefert ein Datenobjekt mit dem Datentyp ROW 10 INT. + +Subskribiert man jedoch 'matrix' nochmals, so erhält man ein INT: + + +matrix [2] [8] + + +(jede Subskription "schält" von Außen ein ROW vom Datentyp ab). +#page# + +2.6.2 Struktur + +Strukturen sind Datenverbunde wie Reihungen, aber die Komponenten können unglei­ +chartige Datentypen haben. Die Komponenten von Strukturen heißen Felder (Reihun­ +gen: Elemente) und der Zugriff auf ein Feld Selektion (Reihungen: Subskription). Eine +Struktur ist - genauso wie bei Reihungen - ein eigener Datentyp, der in einer +Deklaration angegeben werden muß. + +Die Deklaration einer Struktur sieht folgendermaßen aus: + +- Schlüsselwort #schl ("STRUCT#off("i")##off("b")# +- unterschiedliche Datenobjekte in Klammern. Die Datenobjekte werden mit Datentyp und Namen angegeben +- Zugriffsrecht ( #on("i")##on("b")#VAR#off("i")##off("b")# oder #on("i")##on("b")#CONST#off("i")##off("b")# ) +- Name der Struktur. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + STRUCT (TEXT name, INT alter) VAR ich + +____________________________________________________________________________ + + +Wiederum existieren keine Operationen auf Strukturen außer der Zuweisung und der +Selektion, die es erlaubt, Komponenten aus einer Struktur herauszulösen. + +Die Selektion hat folgende Form: + +Objektname #on("i")##on("b")#.#off("i")##off("b")# Feldname + +Beispiele: + + +ich . name +ich . alter + + +Die erste Selektion liefert einen TEXT-, die zweite ein INT-Datenobjekt. Mit diesen +(selektierten) Datenobjekten kann - wie gewohnt - gearbeitet werden (Ausnahme: +nicht als Schleifenvariable). + +Zum Datentyp einer Struktur gehören auch die Feldnamen: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + STRUCT (TEXT produkt name, INT artikel nr) VAR erzeugnis + +____________________________________________________________________________ + + +Die obige Struktur ist ein anderer Datentyp als im ersten Beispiel dieses Abschnitts, +da die Namen der Felder zur Unterscheidung hinzugezogen werden. Für Strukturen - +genauso wie bei Reihungen - kann man sich neue Operationen definieren. + +Im folgenden Programm werden eine Struktur, die Personen beschreibt, die Prozedu­ +ren 'put', 'get' und der dyadische Operator HEIRATET definiert. Anschließend werden +drei Paare verHEIRATET. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PROC get (STRUCT (TEXT name, vorname, INT alter) VAR p): + put ("bitte Nachname:"); get ( p.name); + put ("bitte Vorname:"); get ( p.vorname); + put ("bitte Alter:"); get ( p.alter); + line + END PROC get; + + PROC put (STRUCT (TEXT name, vorname, INT alter) CONST p): + put (p.vorname); put (p.name); + put ("ist"); + put (p.alter); + put ("Jahre alt"); + line + END PROC put; + + OP HEIRATET + (STRUCT (TEXT name, vorname, INT alter) VAR w, + STRUCT (TEXT name, vorname, INT alter) CONST m): + w.name := m.name + END OP HEIRATET; + +____________________________________________________________________________ + + +____________________________________________________________________________ + ........................... Beispiel: ......................... + ROW 3 STRUCT (TEXT name, vorname, INT alter) VAR frau, + mann; + + personendaten einlesen; + heiraten lassen; + paardaten ausgeben. + + personendaten einlesen: + INT VAR i; + FOR i FROM 1 UPTO 3 REP + get (frau [i]); + get (mann [i]) + END REP. + + heiraten lassen: + FOR i FROM 1 UPTO 3 REP + frau [i] HEIRATET mann [i] + END REP. + + paardaten ausgeben: + FOR i FROM 1 UPTO 3 REP + put (frau [i]); + put ("hat geheiratet:"); line; + put (mann [i]); line + END REP. + +____________________________________________________________________________ + + +Reihungen und Strukturen dürfen miteinander kombiniert werden, d.h. es darf eine +Reihung in einer Struktur erscheinen oder es darf eine Reihung von einer Struktur +vorgenommen werden. Selektion und Subskription sind in diesen Fällen in der Reihen­ +folge vorzunehmen, wie die Datentypen aufgebaut wurden (von außen nach innen). +#page# + +2.6.3 LET-Konstrukt für zusammengesetzte Datentypen + + +Die Verwendung von Strukturen oder auch Reihungen kann manchmal schreibauf­ +wendig sein. Mit dem LET-Konstrukt darf man Datentypen einen Namen geben. +Dieser Name steht als Abkürzung und verringert so die Schreibarbeit. Zusätzlich wird +durch die Namensgebung die Lesbarkeit des Programms erhöht. + +Form: + +#on("i")##on("b")#LET#off("i")##off("b")# Name #on("i")##on("b")#=#off("i")##off("b")# Datentyp + +Der Name darf nur aus Großbuchstaben (ohne Blanks) bestehen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + LET PERSON = STRUCT (TEXT name, vorname, INT alter); + + PROC get (PERSON VAR p): + put ("bitte Nachname:"); get ( p.name); + put ("bitte Vorname:"); get ( p.vorname); + put ("bitte Alter:"); get ( p.alter); + line + END PROC get; + + PROC put (PERSON CONST p): + put (p.vorname); put (p.name); put ("ist"); + put (p.alter); put ("Jahre alt"); line + END PROC put; + + OP HEIRATET (PERSON VAR f, PERSON CONST m): + f.name := m.name + END OP HEIRATET; + + ROW 3 PERSON VAR mann, frau; + +____________________________________________________________________________ + + +Überall, wo der abzukürzende Datentyp verwandt wird, kann stattdessen der Name +PERSON benutzt werden. Wohlgemerkt: PERSON ist kein neuer Datentyp, sondern +nur ein Name, der für STRUCT (....) steht. Der Zugriff auf die Komponenten des +abgekürzten Datentyps bleibt erhalten (was bei abstrakten Datentypen, die später +erklärt werden, nicht mehr der Fall ist). + +Neben der Funktion der Abkürzung von Datentypen kann das LET-Konstrukt auch +zur Namensgebung für Denoter verwandt werden (siehe 2.3.1.2). + + + +2.6.4 Denoter für zusammengesetzte + Datentypen (Konstruktor) + + +Oft ist es notwendig, Datenverbunden Werte zuzuweisen (z.B.: bei der Initialisierung). +Dies kann durch normale Zuweisungen erfolgen: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + LET PERSON = STRUCT (TEXT name, vorname, INT alter); + + PERSON VAR mann; + + mann.name := "meier"; + mann.vorname := "egon"; + mann.alter := 27 + +____________________________________________________________________________ + + +Eine andere Möglichkeit für die Wertbesetzung von Datenverbunden ist der Konstruk­ +tor: + +Form: + +Datentyp #on("i")##on("b")#:#off("i")##off("b")# #on("i")##on("b")#(#off("i")##off("b")# Wertliste #on("i")##on("b")#)#off("i")##off("b")# + +In der Wertliste wird für jede Komponente des Datentyps, durch Kommata getrennt, +ein Wert aufgeführt. Besteht eine der Komponenten wiederum aus einem Datenver­ +bund, muß innerhalb des Konstruktors wiederum ein Konstruktor eingesetzt werden. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + LET PERSON = STRUCT (TEXT name, vorname, INT alter); + + PERSON VAR mann, frau; + + frau := PERSON : ( "niemeyer", "einfalt", 65); + frau HEIRATET PERSON : ( "meier", "egon", 27) + +____________________________________________________________________________ + + +Ein Konstruktor ist also ein Mechanismus, um ein Datenobjekt eines Datenverbundes +in einem Programm zu notieren. + +Konstruktoren sind natürlich für Reihungen auch möglich: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + ROW 7 INT VAR feld; + feld := ROW 7 INT : ( 1, 2, 3, 4, 5, 6, 7); +____________________________________________________________________________ +#page# + +2.7 Abstrakte Datentypen + + +2.7.1 Definition neuer Datentypen + +Im Gegensatz zur LET-Vereinbarung für Datentypen, bei der lediglich ein neuer +Name für einen bereits vorhandenen Datentyp eingeführt wird und bei der somit auch +keine neuen Operationen definiert werden müssen (weil die Operationen für den +abzukürzenden Datentyp verwandt werden können), wird durch eine TYPE-Verein­ +barung ein gänzlich neuer Datentyp eingeführt. + +Form: + +#on("i")##on("b")#TYPE#off("i")##off("b")# Name #on("i")##on("b")#=#off("i")##off("b")# Feinstruktur + +Der Name darf nur aus Großbuchstaben (ohne Blanks) bestehen. Die Feinstruktur +(konkreter Typ, Realisierung des Datentyps) kann jeder bereits definierte Datentyp +sein. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + TYPE PERSON = STRUCT (TEXT name, vorname, INT alter) + +____________________________________________________________________________ + + +Der neudefinierte Datentyp wird abstrakter Datentyp genannt. Im Gegensatz zu +Strukturen und Reihungen stehen für solche Datentypen noch nicht einmal die Zuwei­ +sung zur Verfügung. Ein solcher Datentyp kann genau wie alle anderen Datentypen +verwendet werden (Deklarationen, Parameter, wertliefernde Prozeduren, als Kompo­ +nenten in Reihungen und Strukturen usw.). + +Wird der Datentyp über die Schnittstelle des PACKETs anderen Programmteilen zur +Verfügung gestellt, so müssen Operatoren und/oder Prozeduren für den Datentyp +ebenfalls "herausgereicht" werden. Da dann der neudefinierte Datentyp genauso wie +alle anderen Datentypen verwandt werden kann, aber die Komponenten (Feinstruktur) +nicht zugänglich sind, spricht man von abstrakten Datentypen. + +Welche Operationen sollten für einen abstrakten Datentyp zur Verfügung stehen? +Obwohl das vom Einzelfall abhängt, werden meistens folgende Operationen und +Prozeduren definiert: + +- 'get'- und 'put'-Prozeduren. +- Zuweisung (auch für die Initialisierung notwendig). +- Denotierungs-Prozedur (weil kein Konstruktor für den abstrakten Datentyp außer­ + halb des definierenden PACKETs zur Verfügung steht) + + + +2.7.2 Konkretisierung + +Um neue Operatoren und/oder Prozeduren für einen abstrakten Datentyp zu schrei­ +ben, ist es möglich, auf die Komponenten des Datentyps (also auf die Feinstruktur) +mit Hilfe des Konkretisierers zuzugreifen. Der Konkretisierer arbeitet ähnlich wie die +Subskription oder Selektion: er ermöglicht eine typmäßige Umbetrachtung vom ab­ +strakten Typ zum Datentyp der Feinstruktur. + +Form: + +#on("i")##on("b")#CONCR#off("i")##off("b")# #on("i")##on("b")#(#off("i")##off("b")# Ausdruck #on("i")##on("b")#)#off("i")##off("b")# + +____________________________________________________________________________ + ........................... Beispiel: ......................... + TYPE MONAT = INT; + + PROC put (MONAT CONST m): + put ( CONCR (m)) + END PROC put; + +____________________________________________________________________________ + + +Der Konkretisierer ist bei Feinstrukturen notwendig, die von elementarem Datentyp +sind. Besteht dagegen die Feinstruktur aus Reihungen oder Strukturen, dann wird +durch eine Selektion oder Subskription eine implizite Konkretisierung vorgenommen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + TYPE LISTE = ROW 100 INT; + + LISTE VAR personal nummer; + ... + personal nummer [3] := ... + (* das gleiche wie *) + CONCR (personal nummer) [3] := ... + +____________________________________________________________________________ + + +2.7.3 Denoter für abstrakte + Datentypen (Konstruktor) + + +Denoter für neudefinierte Datentypen werden mit Hilfe des Konstruktors gebildet: + +Form: + +Datentyp #on("i")##on("b")#:#off("i")##off("b")# #on("i")##on("b")#(#off("i")##off("b")# Wertliste #on("i")##on("b")#)#off("i")##off("b")# + +In der Wertliste wird für jede Komponente des Datentyps, durch Kommata getrennt, +ein Wert aufgeführt. Besteht eine der Komponenten wiederum aus einem Datenver­ +bund, muß innerhalb des Konstruktors wiederum ein Konstruktor eingesetzt werden. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + TYPE GEHALT = INT; + + GEHALT VAR meins :: GEHALT : (10000); + +____________________________________________________________________________ + + +Besteht die Feinstruktur aus einem Datenverbund, muß der Konstruktor u.U. mehrfach +geschachtelt angewandt werden: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + TYPE KOMPLEX = ROW 2 REAL; + + KOMPLEX CONST x :: KOMPLEX : ( ROW 2 REAL : ( 1.0, 2.0)); + +____________________________________________________________________________ + + +Auf die Feinstruktur über den Konkretisierer eines neudefinierten Datentyps darf nur in +dem PACKET zugegriffen werden, in dem der Datentyp definiert wurde. Der Konstruk­ +tor kann ebenfalls nur in dem typdefinierenden PACKET verwandt werden. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PACKET widerstaende DEFINES WIDERSTAND, REIHE, PARALLEL, + :=, get, put: + + TYPE WIDERSTAND = INT; + + OP := (WIDERSTAND VAR l, WIDERSTAND CONST r): + CONCR (l) := CONCR (r) + END OP :=; + + PROC get (WIDERSTAND VAR w): + INT VAR i; + get (i); + w := WIDERSTAND : (i) + END PROC get; + + PROC put (WIDERSTAND CONST w): + put (CONCR (w)) + END PROC put; + + WIDERSTAND OP REIHE (WIDERSTAND CONST l, r): + WIDERSTAND : ( CONCR (l) + CONCR (r)) + END OP REIHE; + + WIDERSTAND OP PARALLEL (WIDERSTAND CONST l, r): + WIDERSTAND : + ((CONCR (l) * CONCR (r)) DIV (CONCR (l) + CONCR (r))) + END OP PARALLEL + + END PACKET widerstaende + +____________________________________________________________________________ + + +Dieses Programm realisiert den Datentyp WIDERSTAND und mit den Operationen +eine Fachsprache, mit dem man nun leicht WIDERSTANDs-Netzwerke berechnen +kann, wie z.B. folgendes: + + + + +---R4---+ + | | + +---R1---+ +---R5---+ + | | | | + ---+ +---R3---+ +--- + | | | | + +---R2---+ +---R6---+ + | | + +---R7---+ + + +Zur Berechnung des Gesamtwiderstandes kann nun folgendes Programm geschrieben +werden: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + ROW 7 WIDERSTAND VAR r; + widerstaende einlesen; + gesamtwiderstand berechnen; + ergebnis ausgeben. + + widerstaende einlesen: + INT VAR i; + FOR i FROM 1 UPTO 7 REP + put ("bitte widerstand R"); put (i); put (":"); + get (r [i]); + END REP. + + gesamtwiderstand berechnen: + WIDERSTAND CONST rgesamt :: (r [1] PARALLEL r [2]) REIHE + r [3] REIHE (r [4] PARALLEL r [5] PARALLEL r [6] + PARALLEL r [7]). + + ergebnis ausgeben: + line; + put (rgesamt). +____________________________________________________________________________ +#page# + +2.8 Dateien + +Dateien werden benötigt, wenn + +- Daten über die Abarbeitungszeit eines Programms aufbewahrt werden sollen; +- der Zeitpunkt oder Ort der Datenerfassung nicht mit dem Zeitpunkt oder Ort der + Datenverarbeitung übereinstimmt; +- die gesamte Datenmenge nicht auf einmal in den Zentralspeicher eines Rechners + paßt; +- die Anzahl und/oder Art der Daten nicht von vornherein bekannt sind. + +Eine Datei ("file") ist eine Zusammenfassung von Daten, die auf Massenspeichern +aufbewahrt wird. Dateien sind in bestimmten Informationsmengen, den Sätzen ("re­ +cords") organisiert. + + + +2.8.1 Datentypen FILE und DIRFILE + +In ELAN gibt es zwei Arten von Dateien. Sie werden durch die Datentypen FILE +und DIRFILE realisiert: + + + +FILE: +sequentielle Dateien. Die Sätze können nur sequentiell gelesen bzw. geschrieben +werden. Eine Positionierung ist nur zum nächsten Satz möglich. + + +DIRFILE: +indexsequentielle Dateien. Die Positionierung erfolgt direkt mit Hilfe eines Schlüssels +("key") oder Index, kann aber auch sequentiell vorgenommen werden. + +#on("b")#Wichtig: #off("b")# +DIRFILEs sind auf dem EUMEL-System standardmäßig nicht implementiert! Deswe­ +gen wird auf diesen Dateityp hier nicht weiter eingegangen. +#page# + +2.8.2 Deklaration und Assoziierung + +Dateien müssen in einem ELAN-Programm - wie alle anderen Objekte auch - +deklariert werden. + +Form: + +#on("i")##on("b")#FILE#off("i")##off("b")# #on("i")##on("b")#VAR#off("i")##off("b")# interner Dateibezeichner + +____________________________________________________________________________ + ........................... Beispiel: ......................... + FILE VAR f + +____________________________________________________________________________ + + +Dabei ist zu beachten, daß im EUMEL-System alle FILEs als VAR deklariert werden +müssen, denn jede Lese/Schreib-Operation verändert einen FILE. + +Dateien werden normalerweise vom Betriebsystem eines Rechners aufbewahrt und +verwaltet. Somit ist eine Verbindung von einem ELAN-Programm, in dem eine Datei +unter einem Namen - wie jedes andere Datenobjekt auch - angesprochen werden +soll, und dem Betriebssystem notwendig. Dies erfolgt durch die sogenannte Assozi­ +ierungsprozedur. Die Assoziierungsprozedur 'sequential file' hat die Aufgabe, eine in +einem Programm deklarierte FILE VAR mit einer bereits vorhandenen oder noch +einzurichtenden Datei des EUMEL-Systems zu koppeln. + +Form: + +#on("i")##on("b")#sequential file#off("i")##off("b")# #on("i")##on("b")#(#off("i")##off("b")# Betriebsrichtung, Dateiname #on("i")##on("b")#)#off("i")##off("b")# + +Es gibt folgende Betriebsrichtungen (TRANSPUTDIRECTIONs): + + +input: +Die Datei kann vom Programm nur gelesen werden. Durch 'input' wird bei der Asso­ +ziierung automatisch auf den ersten Satz der Datei positioniert. Ist die zu lesende +Datei nicht vorhanden, wird ein Fehler gemeldet. + + +output: +Die Datei kann vom Programm nur beschrieben werden. Durch 'output' wird bei der +Assoziierung automatisch hinter den letzten Satz der Datei positioniert (bei einer +leeren Datei also auf den ersten Satz). Ist die Datei vor der Assoziierung nicht vor­ +handen, wird sie automatisch eingerichtet. + + +modify: +Im EUMEL-System gibt es noch die Betriebsrichtung 'modify'. +Die Datei kann vom Programm in beliebiger Weise gelesen und beschrieben werden. +Im Gegensatz zu den Betriebsrichtungen 'input' und 'output', bei denen ausschließlich +ein rein sequentielles Lesen oder Schreiben erlaubt ist, kann bei 'modify' beliebig +positioniert, gelöscht, eingefügt und neu geschrieben werden. + +Nach erfolgter Assoziiierung ist auf den zuletzt bearbeiteten Satz positioniert. Die +Datei wird automatisch eingerichtet, wenn sie vor der Assoziierung nicht vorhanden +war. + +Der zweite Parameter der Assoziierungsprozedur gibt an, unter welchem Namen die +Datei in der Task existiert oder eingerichtet werden soll. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + FILE VAR meine datei :: sequential file (output, "xyz"); + +____________________________________________________________________________ + + +Folgendes Beispiel zeigt ein Programm, welches eine Datei liest und auf dem Ausga­ +bemedium ausgibt: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + FILE VAR f :: sequential file (input, "datei1"); + TEXT VAR satz; + WHILE NOT eof (f) REP + getline (f, satz); + putline (satz); + END REP. + +____________________________________________________________________________ + + +Eine genau Übersicht der für Dateien existierende Operatoren und Prozeduren finden +Sie im Teil 5.3. +#page# + +2.9 Abstrakte Datentypen + im EUMEL-System + + + +2.9.1 Datentyp TASK + +Tasks müssen im Rechnersystem eindeutig identifiziert werden; sogar im EUMEL- +Rechner-Netz sind Tasks eindeutig identifizierbar. Dazu wird der spezielle Datentyp +'TASK' benutzt, denn die Identifizierung einer Task über den Namen ist nicht eindeu­ +tig. Der Benutzer kann ja einen Tasknamen ändern, eine Task löschen und eine +neue Task mit gleichem Namen einrichten, die jedoch nicht gleich reagiert. Somit +werden Tasks eindeutig über Variablen vom Datentyp TASK identifiziert. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + TASK VAR plotter := task ("PLOTTER 1") + +____________________________________________________________________________ + + +Die Taskvariable 'plotter' bezeichnet jetzt die Task im System, die augenblicklich den +Namen "PLOTTER 1" hat. Die Prozedur 'task' liefert den systeminternen Taskbe­ +zeichner. + +Nun sind Taskvariablen auch unter Berücksichtigung der Zeit und nicht nur im aktuel­ +len Systemzustand eindeutig. Der Programmierer braucht sich also keine Sorgen +darüber zu machen, daß seine Taskvariable irgendwann einmal eine "falsche" Task +(nach Löschen von "PLOTTER 1" neu eingerichtete gleichen oder anderen Namens) +identifiziert. Wenn die Task "PLOTTER 1" gelöscht worden ist, bezeichnet 'plotter' +keine gültige Task mehr. + +Unbenannte Tasks haben alle den Pseudonamen "-". Sie können nur über Taskvari­ +ablen angesprochen werden. + + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PROC generate shutup manager: + TASK VAR son; + begin ("shutup", PROC shutup manager, son) + END PROC generate shutup manager; + + PROC shutup manager: + disable stop; + command dialogue (TRUE); + REP + break; + line; + IF yes ("shutup") + THEN clear error; + shutup + FI + PER + END PROC shutup manager + +____________________________________________________________________________ + + +Ein Taskvariable wird zum Beispiel als Parameter für die Prozedur 'begin' benötigt. + +begin + #on("b")#PROC begin (TEXT CONST son name, PROC start, + TASK VAR new task)#off("b")# + Die Prozedur richtet eine Sohntask mit Namen 'son name' (im Beispiel: shutup) + ein, die mit der Prozedur 'start' (im Beispiel: shutup manager) gestartet wird. 'new + task' (im Beispiel: son) identifiziert den Sohn, falls die Sohntask korrekt eingerich­ + tet wurde. +#page# + +2.9.2 Datentyp THESAURUS + +Ein Thesaurus ist ein Namensverzeichnis, das bis zu 200 Namen beinhalten kann. +Dabei muß jeder Name mindestens ein Zeichen und höchstens 100 Zeichen lang sein. +Steuerzeichen (code < 32) werden im Namen folgendermaßen umgesetzt: + +#on("i")##on("b")#steuerzeichen#off("b")##off("i")# wird umgesetzt in #on("i")##on("b")#"""" + code(steuerzeichen) + """"#off("b")##off("i")# + +Ein Thesaurus ordnet jedem eingetragenen Namen einen Index zwischen 1 und 200 +(einschließlich) zu. Diese Indizes bieten dem Anwender die Möglichkeit, Thesauri zur +Verwaltung benannter Objekte zu verwenden. (Der Zugriff erfolgt dann über den Index +eines Namens in einem Thesaurus). So werden Thesauri u.a. von der Dateiverwaltung +benutzt. Sie bilden die Grundlage der ALL- und SOME-Operatoren. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + initialisiere; + arbeite thesaurus ab. + + initialisiere: + THESAURUS VAR eine auswahl :: SOME (myself); + TEXT VAR thesaurus element; + INT VAR index :: 0. + + arbeite thesaurus ab: + REPEAT + get (eine auswahl, thesaurus element, index); + IF thesaurus element = "" + THEN LEAVE arbeite thesaurus ab + FI; + fuehre aktionen durch + PER. + + fuehre aktionen durch: + edit (thesaurus element); + lineform (thesaurus element); + pageform (thesaurus element); + print (thesaurus element). + +____________________________________________________________________________ + + +Dieses Beispiel führt für eine Auswahl der in der Task befindlichen Dateien nachein­ +ander die Kommandos 'edit', 'lineform', 'pageform' und 'print' aus. + +Die benutzten Operatoren und Prozeduren leisten folgendes: + +#ix("SOME")# + #on("b")#THESAURUS OP SOME (TASK CONST task) #off("b")# + Der Operator bietet das Verzeichnis der in der angegeben Task befindlichen + Dateien zum Editieren an. Namen, die nicht gewünscht sind, müssen aus dem + Verzeichnis gelöscht werden. + + +#ix("get")# + #on("b")#PROC get (THESAURUS CONST t, TEXT VAR name, INT VAR index) + #off("b")# Die Prozedur liefert den nächsten Eintrag aus dem angegebenen Thesaurus 't'. + 'Nächster' heißt hier, der kleinste vorhandene mit einem Index größer als 'index'. + Dabei wird in 'name'der Name und in 'index'der Index des Eintrags geliefert. +#page# + +2.9.3 Datenräume + +Datenräume sind die Grundlage von Dateien im EUMEL-System. Einen Datenraum +kann man sich als eine Sammlung von Daten vorstellen (u.U. leer). Man kann einem +Datenraum durch ein Programm einen Datentyp "aufprägen". Nach einem solchen +"Aufpräge"-Vorgang kann der Datenraum wie ein "normaler" Datentyp behandelt +werden. + +Standarddateien (FILEs) sind eine besondere Form von Datenräumen. Sie können nur +Texte aufnehmen, da sie ja hauptsächlich für die Kommunikation mit dem Menschen +(vorwiegend mit Hilfe des Editors bzw. Ein-/ Ausgabe) gedacht sind. Will man Zahlen +in einen FILE ausgeben, so müssen diese zuvor in Texte umgewandelt werden. Hier­ +für stehen Standardprozeduren zur Verfügung (z.B. 'put (f, 17)'). + +Will man aber Dateien zur Kommunikation zwischen Programmen verwenden, die +große Zahlenmengen austauschen, verursachen die Umwandlungen von Zahlen in +TEXTe und umgekehrt unnötigen Rechenaufwand. Zu diesem Zweck werden im +EUMEL-System Datenräume eingesetzt, die es gestatten, beliebige Strukturen +(Typen) in Dateien zu speichern. Solche Datenräume kann man weder mit dem Editor +noch mit dem Standarddruckprogramm (print) bearbeiten, da diese ja den Typ des in +dem Datenraum gespeicherten Objektes nicht kennen. + + + +2.9.3.1 Datentyp DATASPACE + +Datenräume können als eigener Datentyp (DATASPACE) in einem Programm behan­ +delt werden. Somit können Datenräume (als Ganzes) ohne Kenntnis eines eventuell +(vorher oder später) aufgeprägten Typs benutzt werden. + +Als Operationen auf DATASPACE-Objekte sind nur Transporte, Löschen und Zuwei­ +sung zugelassen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + DATASPACE VAR ds + +____________________________________________________________________________ + + +Für Datenräume ist die Zuweisung definiert. Der Zuweisungsoperator (':=') bewirkt +eine Kopie des Datenraums vom rechten auf den linken Operanden. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + DATASPACE VAR datenraum :: nilspace; + +____________________________________________________________________________ + + +Die Prozedur 'nilspace' liefert einen leeren Datenraum. Der Datenraum 'datenraum' ist +also eine Kopie des leeren Datenraums. + +Die Prozeduren und Operatoren für Datenräume werden im Teil 5.4.7 beschrieben. +#page# + +2.9.3.2 BOUND-Objekte + +Wie bereits erwähnt, kann man einem Datenraum einen Datentyp aufprägen. Dazu +werden #ib#BOUND#ie#-Objekte benutzt. Mit dem Schlüsselwort #on("i")##on("b")#BOUND#off("i")##off("b")#, welches in der +Deklaration vor den Datentyp gestellt wird, teilt man dem ELAN-Compiler mit, daß +die Werte eines Datentyps in einem Datenraum gespeichert sind bzw. gespeichert +werden sollen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + BOUND ROW 1000 REAL VAR liste + +____________________________________________________________________________ + + +Die Ankopplung des BOUND-Objekts an eine Datei erfolgt mit dem Operator #on("i")##on("b")#:=#off("i")##off("b")#. + +Form: + +BOUND-Objekt #on("i")##on("b")#:=#off("i")##off("b")# Datenraum + +____________________________________________________________________________ + ........................... Beispiel: ......................... + BOUND ROW 1000 REAL VAR gehaltsliste := new ("Gehälter") + +____________________________________________________________________________ + + +Die Prozedur 'new' kreiert dabei einen leeren Datenraum (hier mit dem Namen 'Ge­ +hälter'), der mit Hilfe der Zuweisung (hier: Initialisierung) an die Variable 'gehaltsliste' +gekoppelt wird. + +Nun kann man mit der 'gehaltsliste' arbeiten wie mit allen anderen Feldern auch. Die +Daten, die in 'gehaltsliste' gespeichert, werden eigentlich im Datenraum 'Gehälter' +abgelegt. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + gehaltsliste [5] := 10 000.0; (* Traumgehalt *) + gehaltsliste [index] INCR 200.0; (* usw. *) + +____________________________________________________________________________ + + +Man kann auch Prozeduren schreiben, die auf der Gehaltsliste arbeiten. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PROC sort (ROW 1000 REAL VAR liste): + ... + END PROC sort; + ... + sort (CONCR (gehaltsliste)); + ... + +____________________________________________________________________________ + + +Man beachte, daß der formale Parameter der Prozedur 'sort' nicht mit BOUND spezi­ +fiziert werden darf (BOUND wird nur bei der Deklaration des Objekts angegeben). Das +ist übrigens ein weiterer wichtiger Vorteil von BOUND-Objekten: man kann alle +Prozeduren des EUMEL-Systems auch für BOUND-Objekte verwenden, nur die +Datentypen müssen natürlich übereinstimmen. + + +Häufige Fehler bei der Benutzung von Datenräumen + +- Wenn man an ein DATASPACE-Objekt zuweist (z.B.: DATASPACE VAR ds := + new ("mein datenraum")), so erhält man, wie bereits erwähnt, eine Kopie des + Datenraums in 'ds'. Koppelt man jetzt 'ds' an ein BOUND-Objekt an und führt + Änderungen durch, so wirken diese nur auf die Kopie und nicht auf die Quelle. + Für Änderungen in der Quelle, also in der vom Datei-Manager verwalteten Datei, + ist stets direkt anzukoppeln. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + BOUND ROW 10 INT VAR reihe; + INT VAR i; + + PROC zeige dsinhalt (TEXT CONST datenraum): + BOUND ROW 10 INT VAR inhalt := old (datenraum); + INT VAR j; + line; + putline ("Inhalt:" + datenraum); + FOR j FROM 1 UPTO 10 REP + put (inhalt (j)) + PER + END PROC zeige dsinhalt; + + (* falsch: es wird auf der Kopie gearbeitet: *) + DATASPACE VAR ds := new ("Gegenbeispiel: Zahlen 1 bis 10"); + reihe := ds; + besetze reihe; + zeige dsinhalt ("Gegenbeispiel: Zahlen 1 bis 10"); + + (* richtig: es wird auf dem Datenraum gearbeitet: *) + reihe := new ("Beispiel: Zahlen 1 bis 10"); + besetze reihe; + zeige dsinhalt ("Beispiel: Zahlen 1 bis 10"). + + besetze reihe: + FOR i FROM 1 UPTO 10 REP + reihe (i) := i + PER. + +____________________________________________________________________________ + + + Der Datenraum 'Gegenbeispiel: Zahlen 1 bis 10' wird nicht mit Werten besetzt, + sondern die Kopie dieses Datenraums, der unbenannte Datenraum 'ds'. Auf dem + direkt angekoppelten Datenraum 'Beispiel: Zahlen 1 bis 10' werden die Werte + gespeichert. + + +- Wenn man ein DATASPACE-Objekt benutzt, ohne den Datei-Manager zu + verwenden, so muß man selbst dafür sorgen, daß dieses Objekt nach seiner + Benutzung wieder gelöscht wird. Das Löschen geschieht durch die Prozedur + 'forget'. Ein automatisches Löschen von DATASPACE-Objekten erfolgt nicht bei + Programmende (sonst könnten sie ihre Funktion als Datei nicht erfüllen). Nur + durch 'forget' oder beim Löschen einer Task werden alle ihr gehörenden + DATASPACE-Objekte gelöscht und der belegte Speicherplatz freigegeben. + + +- Ferner ist zu beachten, daß vor der Ankopplung an ein BOUND-Objekt das + DATASPACE-Objekt initialisiert wird (im Normalfall mit 'nilspace'). + +____________________________________________________________________________ + ........................... Beispiel: ......................... + DATASPACE VAR ds := nilspace; + BOUND ROW 1000 REAL VAR real feld := ds; + .... + real feld [index] := wert; + .... + forget (ds) (* Datenraum löschen, + damit der Platz wieder verwendet wird *) + +____________________________________________________________________________ + + +- Will man auf die Feinstruktur eines BOUND-Objekts zugreifen, so muß man + strenggenommen den Konkretisierer benutzen: + + Form: + + #on("i")##on("b")#CONCR#off("i")##off("b")# #on("i")##on("b")#(#off("i")##off("b")# Ausdruck #on("i")##on("b")#)#off("i")##off("b")# + + Der Konkretisierer ermöglicht eine typmäßige Umbetrachtung vom BOUND-Objekt + zum Datentyp der Feinstruktur. Ist der Zugriff jedoch eindeutig, so wird 'CONCR' + automatisch vom Compiler ergänzt. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + BOUND INT VAR i := old ("i-Wert"); + INT VAR x; + x := wert. + + wert: + IF x < 0 + THEN 0 + ELSE CONCR (i) + FI. + +____________________________________________________________________________ + + +In diesem Beispiel muß der Konkretisierer benutzt werden, da sonst der Resultattyp +des Refinements nicht eindeutig ist (BOUND oder INT?). + + + +2.9.3.3 Definition neuer Dateitypen + +Durch die Datenräume und die Datentyp-Definition von ELAN ist es für Programmie­ +rer relativ einfach, neue Datei-Datentypen zu definieren. In der Regel reicht der +Datentyp FILE für "normale" Anwendungen aus, jedoch kann es manchmal sinnvoll +und notwendig sein, neue Datei-Typen für spezielle Aufgaben zu definieren. + +In diesem Abschnitt soll an dem Beispiel DIRFILE (welcher zwar im ELAN-Standard +definiert, aber nicht im EUMEL-System realisiert ist) gezeigt werden, wie ein neuer +Datei-Datentyp definiert wird: + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PACKET dirfiles DEFINES DIRFILE, :=, dirfile, getline, ...: + + LET maxsize = 1000; + + TYPE DIRFILE = BOUND ROW maxsize TEXT; + (* DIRFILE besteht aus TEXTen; Zugriff erfolgt ueber einen + Schluessel, der den Index auf die Reihung darstellt *) + + OP := (DIRFILE VAR dest, DATASPACE CONST space): + CONCR (dest) := space + END OP :=; + + DATASPACE PROC dirfile (TEXT CONST name): + IF exists (name) + THEN old (name) + ELSE new (name) + FI + END PROC dirfile; + + PROC getline (DIRFILE CONST df, INT CONST index, + TEXT VAR record): + IF index <= 0 + THEN errorstop ("access before first record") + ELIF index > maxsize + THEN errorstop ("access after last record") + ELSE record := df [index] + FI + END PROC getline; + + PROC putline (DIRFILE CONST df, INT CONST index, + TEXT VAR record): + ... + END PROC putline; + + ... + END PACKET dirfiles; + +____________________________________________________________________________ + + +Die Prozedur 'dirfile' ist die Assoziierungsprozedur für DIRFILEs (analog 'sequential +file' bei FILEs). 'dirfile' liefert entweder einen bereits vorhandenen Datenraum oder +richtet einen neuen ein. Um eine Initialisierung mit der 'dirfile'-Prozedur vorneh­ +men zu können, braucht man auch einen Zuweisungsoperator, der den Datenraum an +den DIRFILE-Datentyp koppelt. + +Zugriffe auf einen DIRFILE sind nun relativ einfach zu schreiben. Im obigen Beispiel +wird nur die Prozedur 'getline' gezeigt. + +Nun ist es möglich, Programme zu schreiben, die den DIRFILE-Datentyp benut­ +zen. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + DIRFILE VAR laeufer :: dirfile ("Nacht von Borgholzhausen"); + INT VAR nummer; + TEXT VAR name; + + REP + put ("Startnummer bitte:"); + get (nummer); + line; + put ("Name des Laeufers:"); + get (name); + putline (laeufer, nummer, name); + line + UNTIL no ("weiter") END REP; + ... + +____________________________________________________________________________ +#page# + +2.9.4 Datentyp INITFLAG + +Im Multi-User-System ist es oft notwendig, Pakete beim Einrichten einer neuen +Task in dieser neu zu initialisieren. Das muß z.B. bei der Dateiverwaltung gemacht +werden, da die neue Task ja nicht die Dateien des Vaters erbt. Mit Hilfe von +INITFLAG-Objekten kann man zu diesem Zweck feststellen, ob ein Paket in dieser +Task schon initialisiert wurde. + + +INITFLAG + #on("b")#TYPE INITFLAG #off("b")# + Erlaubt die Deklaration entsprechender Flaggen. + +:= + #on("b")#OP := (INITFLAG VAR flag, BOOL CONST flagtrue) #off("b")# + Erlaubt die Initialisierung von INITFLAGs + +initialized + #on("b")#BOOL PROC initialized (INITFLAG VAR flag) #off("b")# + Wenn die Flagge in der Task A auf TRUE oder FALSE gesetzt wurde, dann liefert + sie beim ersten Aufruf den entsprechenden Wert, danach immer TRUE (in der + Task A!). + + Beim Einrichten von Söhnen wird die Flagge in den Sohntasks automatisch auf + FALSE gesetzt. So wird erreicht, daß diese Prozedur in den neu eingerichteten + Söhnen und Enkeltasks genau beim ersten Aufruf FALSE liefert. + +____________________________________________________________________________ + ........................... Beispiel: ......................... + PACKET stack DEFINES push, pop: + + INITFLAG VAR in this task := FALSE ; + INT VAR stack pointer ; + ROW 1000 INT VAR stack ; + + PROC push (INT CONST value) : + + initialize stack if necessary ; + .... + + END PROC push ; + + PROC pop (INT VAR value) : + + initialize stack if necessary ; + .... + + END PROC pop ;. + + initialize stack if necessary : + IF NOT initialized (in this task) + THEN stack pointer := 0 + + FI . + + END PACKET stack +____________________________________________________________________________ + diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.3 b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.3 new file mode 100644 index 0000000..eade335 --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.3 @@ -0,0 +1,728 @@ +#headandbottom("1","EUMEL-Benutzerhandbuch","TEIL 3 : Editor","3")# +#pagenr("%",1)##setcount##block##pageblock# +#headeven# +#center#EUMEL-Benutzerhandbuch +#center#____________________________________________________________ + +#end# +#headodd# +#center#TEIL 3 : Editor +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +3 - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#3 - % +#end# + +TEIL 3: Der Editor + +Mit dem #ib#EUMEL-Editor#ie# steht für den Teil der Programmierung, der aus der Eingabe +von Programmtext besteht, dasselbe komfortable Werkzeug zur Verfügung, wie für die +Textverarbeitung. Merkmale des EUMEL-Editors sind die einfache Fenstertechnik +und die übersichtliche Bedienung durch wenige Funktionstasten. + +Eine mit dem Editor erzeugte Textdatei ist maximal 4075 Zeilen lang, die maximale +Breite einer Zeile beträgt 16000 Zeichen. + + + +3.1 Ein- und Ausschalten des Editors + +Der Editor wird eingeschaltet durch Eingabe von: + +____________________________________________________________________________ + gib kommando : + #ib#edit#ie# ("dateiname") + +____________________________________________________________________________ + + +Falls eine Datei unter dem eingegebenen Namen existiert, wird ein Fenster auf dieser +Datei an der Stelle geöffnet, an der zuletzt ein Zugriff auf diese Datei stattfand. + +Existiert noch keine Datei unter dem angegebenen Namen in der Task, folgt eine +Anfrage, ob eine Datei unter dem eingegebenen Namen neu eingerichtet werden soll: + +____________________________________________________________________________ + gib kommando : + edit("dateiname") + "dateiname" neu einrichten (j/n) ? + +____________________________________________________________________________ + + +Die Abfrage dient der Kontrolle der Schreibweise. Man kann ggf. das Einrichten der +Datei ablehnen, den Dateinamen verbessern und das Kommando erneut geben. + +Bei korrekter Schreibweise bejahen Sie die Kontrollfrage#u# 1)#e#mit + +#center# oder + + +Es erscheint ein leerer Editorbildschirm. Die oberste Zeile des Bildschirms ist die +#ib#Titelzeile#ie#. In ihr kann nicht geschrieben werden. Sie zeigt jedoch verschiedene nütz­ +liche Dinge an: den Namen der Datei, die Nummer der aktuellen Zeile, in der gerade +geschrieben wird, Tabulatormarken, Einfügemodus, Lernmodus usw. + +____________________________________________________________________________ + #mark on# ............... dateiname ....................#mark off# Zeile 1 #mark on# #mark off# + _ + +____________________________________________________________________________ + + + +Wollen Sie die #ib#Schreibarbeit beenden#ie# und den #ib#Editor ausschalten#ie#, so drücken Sie die +beiden Tasten + + + +nacheinander. Sie haben damit den #ib#Editor verlassen#ie# und befinden sich wieder auf +Monitor-Ebene. +#page# + +3.2 Die Funktionstasten + +Die Funktionstasten realisieren diejenigen Fähigkeiten des Editor, die über die reine +Zeicheneingabe hinausgehen. Wo die Tasten auf Ihrem Gerät liegen, hängt von dem +jeweiligen Gerätetyp ab. Die Wirkung der Tasten ist im Weiteren erläutert. + +#l pos (0.0)##l pos(4.0)# +#table# +#free(0.5)# +#taste1(" SHIFT ")# Umschalttaste +#tableend# +#free(0.5)# + <^> <>> <<> Positionierungstasten +#table# +#free(0.5)# + Eingabe-/ Absatztaste +#free(0.5)# + Kommandotaste +#free(0.5)# + Verstärkertaste +#free(0.5)# + Tabulatortaste +#free(0.5)# + Markiertaste +#free(0.5)# + Löschtaste +#free(0.5)# + Einfügetaste +#free(0.5)# + Supervisortaste +#free(0.5)# + Stoptaste +#free(0.5)# + Weitertaste +#tableend##clear pos# +#free(0.5)# +Es kann sein, daß Tasten nicht richtig beschriftet sind. Die Installations-anleitung +muß dann die Entsprechungen beschreiben. Natürlich können sich weitere Funktions­ +tasten außer den im folgenden beschriebenen auf Ihrer Tastatur befinden. Diese +haben standardmäßig jedoch keine besondere Bedeutung für den Editor. + +#page# + +3.3 Die Wirkung der Funktionstasten + + + +#ib#Umschalttaste#ie# + +Wird diese Taste gleichzeitig mit einer anderen betätigt, so wird ein Buchstabe in +Großschreibung, bei den übrigen Tasten das obere Zeichen, ausgegeben. So wird z.B. +anstelle der "9" das Zeichen ")" ausgegeben. +#free(0.5)# +<>> <<> + + <^> + +Positionierungstasten + +#ib#Positionierung des Cursors#ie# um eine Spalten-/Zeilenposition in die jeweilige Richtung. +#free(0.5)# + + +#ib#Eingabetaste / Absatztaste#ie#, Carriage Return, kurz: 'CR' + +Diese Taste schließt die aktuelle Zeile explizit ab und es wird an den Beginn der +nächsten Zeile positioniert. Einrückungen werden beibehalten. + +Der EUMEL-Editor ist auf automatischen Wortumbruch voreingestellt, d.h. ein Wort, +das über das 77. Zeichen der aktuellen Zeile herausreichen würde, wird automatisch +in die nächste Zeile gerückt (siehe 'word wrap' 4.2.5). Die Absatztaste wird also +benötigt, um explizite Zeilenwechsel und Einrückungen bei der Textformatierung zu +erhalten. Eine Absatzmarke wird durch ein 'blank' hinter dem letzten Zeichen der +Zeile erzeugt und ist im Editor an der Inversmarkierung am rechten Bildschirmrand zu +erkennen. + +Im EUMEL-System werden Kommandos auf einer Kommandozeile, auf der alle +Editorfunktionen zur Verfügung stehen, eingegeben. Auf dieser Ebene beendet die +Taste also ausdrücklich die Kommandoeingabe, das gegebene Kommando wird an­ +schließend analysiert und ausgeführt. + + + +"#ib#Verstärkertaste#ie#"; wird als Vorschalttaste bedient. + +In Kombination mit anderen Funktionstasten wird deren Wirkung verstärkt. + + + + +Steht der Cursor nicht am unteren Bildrand, so wird er dorthin positioniert. Steht er +am unteren Bildrand, so wird um einen Bildschirminhalt "weitergeblättert". + +Entsprechend werden auch die Tasten : <^> <>> <<> mit der HOP-Taste verstärkt. + +#page# + + +#ib#Einfügen von Textpassagen#ie#. Die HOP-Taste in Verbindung mit RUBIN und RUBOUT +wird zum 'verstärkten' Löschen und Einfügen verwendet. + +Ab der aktuellen Position des Cursors 'verschwindet' der restliche Text. Es kann wie +bei der anfänglichen Texteingabe fortgefahren werden. Die Anzeige '#ib#REST#ie#' in der +Titelzeile erinnert daran, daß noch ein Resttext existiert. Dieser erscheint nach einem +neuerlichen Betätigen der beiden Tasten HOP RUBIN wieder auf dem Bildschirm (die +Anzeige 'REST' verschwindet dann wieder). + +____________________________________________________________________________ + ................ dateiname ..................... Zeile 4 + In diesem Text soll vor dem zweiten Satz  + etwas eingefügt werden. Hierzu wird der + Cursor an die Position geführt, an der  + ein beliebiger Text eingefügt werden soll.#absatz# + +____________________________________________________________________________ + + +Nach Betätigen der Taste #on("i")##on("b")#HOP#off("i")##off("b")# und #on("i")##on("b")#RUBIN#off("i")##off("b")#sieht der Bildschirm wie folgt aus: + +____________________________________________________________________________ + .............. dateiname ........REST.......... Zeile 4 + In diesem Text soll vor dem zweiten Satz  + etwas eingefügt werden. + + +____________________________________________________________________________ + + + +Nun kann beliebig viel Text eingefügt werden. Nochmaliges Betätigen von HOP und +RUBIN führt den Text-Rest wieder bündig heran. + +#page# + + +Löscht die Zeile ab Cursor-Position bis Zeilenende. + +____________________________________________________________________________ + ................ dateiname ..................... Zeile 4 + Soll eine ganze Zeile oder ein Textrest  + gelöscht werden, so positioniert man an die  + Stelle, ab der gelöscht werden soll. Rest löschen.... + Nach HOP RUBOUT ist der Zeilenrest gelöscht.#absatz# + +____________________________________________________________________________ + + + +Nach Betätigen der Tasten #on("i")##on("b")#HOP#off("i")##off("b")# und #on("i")##on("b")#RUBOUT#off("i")##off("b")# sieht der Bildschirm wie folgt aus. + +____________________________________________________________________________ + ............... dateiname .................... Zeile 4 + Soll eine ganze Zeile oder ein Textrest  + gelöscht werden, so positioniert man an die  + Stelle, ab der gelöscht werden soll. + Nach HOP RUBOUT ist der Zeilenrest gelöscht.#absatz# + +____________________________________________________________________________ + + + +Steht der Cursor am Zeilenanfang, wird nach HOP RUBOUT dementsprechend die +ganze Zeile gelöscht und die Lücke durch Nachrücken der Folgezeilen geschlossen +(HOP RUBOUT betätigen). +#page# + + +#ib#Tabulatortaste#ie# + +Mit der Tabulatortaste werden die eingestellten Tabulatorpositionen angesprungen. +Jeder Tastendruck läßt den Cursor auf die nächste eingestellte Tabulatorposition +springen. + +#on("i")#Voreingestellte#off("i")# Tabulatorpositionen sind die beiden Schreibgrenzen, Textanfang in der +Zeile und Ende der Zeile. + +Weitere Tabulatorpositionen können durch Positionierung auf die gewünschte Spalte +und #on("i")##on("b")#HOP#off("i")##off("b")# #on("i")##on("b")#TAB#off("i")##off("b")# gesetzt werden. Sie können gelöscht werden, indem sie mit #on("i")##on("b")#TAB#off("i")##off("b")# +angesprungen und mit #on("i")##on("b")#HOP#off("i")##off("b")# #on("i")##on("b")#TAB#off("i")##off("b")# +ausgeschaltet werden. + +Die gesamte eingestellte Tabulalation kann durch #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#TAB#off("i")##off("b")# ein-/ und ausge­ +schaltet werden. + +Die eingestellten Tabulatorpositionen erkennen Sie an den Tabulatorzeichen (Dachzei­ +chen) in der obersten Bildschirmzeile. +#page# + + +#ib#Ein- bzw. Ausschalten der Markierung#ie#. + +Bei Betätigung dieser Taste wird in einen speziellen #ib#Markierzustand#ie# geschaltet. Alles, +was Sie jetzt schreiben bzw. durch Bewegen des Cursors in Richtung Dateiende +kennzeichnen, steht als #on("i")#markierter#off("i")# Bereich für die Bearbeitung zur Verfügung. Zur +besseren Sichtbarkeit wird der markierte Bereich invers zum übrigen Text dargestellt. + +Wird der Cursor in eine Richtung bewegt, wird das gesamte Textstück zwischen +Einschaltpunkt der Markierung und aktueller Cursorposition markiert. Rückwärtsbewe­ +gungen des Cursors verkürzen den markierten Bereich wieder. + +Durch erneutes Betätigen der MARK-Taste schalten Sie den Markier-Zustand +wieder aus. + +Mit weiteren Kommandos kann der Bereich nun bearbeitet werden: + + Markierten Abschnitt in 'Scratch'-Datei kopieren. + +

Markierten Abschnitt herauskopieren. + + Markierten Abschnitt löschen. + + +Der mit #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#p#off("i")##off("b")# oder#on("i")##on("b")#d#off("i")##off("b")# kopierte Bereich kann beliebig oft in derselben oder einer +anderen Datei ein/angefügt werden. + +Der mit #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#RUBOUT#off("i")##off("b")# gelöschte Abschnitt kann genau einmal durch #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#RUBOUT#off("i")##off("b")# +an anderer Stelle derselben Datei eingefügt werden. + +(vgl. ESC-Taste, Operationen auf Markierungen, 3-#topage("ESC")#) +#page# + + +#ib#Ein- bzw. Ausschalten des Einfügemodus.#ie# + +Das Betätigen der Taste schaltet in den Einfügemodus. Der Zustand wird durch das +Wort "RUBIN" im linken Drittel der Titelzeile der Datei angezeigt. Vor dem Zeichen, +auf dem der Cursor steht, wird eingefügt. Nochmaliges Betätigen der Taste schaltet +den Einfügemodus aus. +#free(1.0)# + + +#ib#Löschtaste#ie# + +Das Zeichen, auf dem der Cursor steht, wird gelöscht. Wenn der Cursor, wie bei +fortlaufender Eingabe üblich, hinter dem letzten Zeichen einer Zeile steht, wird das +letzte Zeichen gelöscht. + +#page# + +3.4 ESC Kommandos + + + +#ib#Kommandotaste#ie# + +Mit der ESC-Taste in Kombination mit einer Folgetaste werden vordefinierte Aktionen +ausgelöst. Es gibt Aktionen, die vorprogrammiert zur Verfügung stehen, und Sie selbst +können weitere hinzufügen. + +Der Kommandodialog wird eingeschaltet durch: + + + + +____________________________________________________________________________ + ............... Beispiel ..................... Zeile 4 + + gib kommando:                                              + +____________________________________________________________________________ + + +Der Kommandodialog ermöglicht die Eingabe von beliebigen Kommandos ohne den +Editor verlassen zu müssen. Insbesondere Such- und Kopieroperationen stellen auch +für den Programmierer nützliches Werkzeug dar (siehe 3.5). + +Auf der Kommandozeile kann jedes Kommando gegeben werden. Die Kommandozeile +kann wie eine normale Textzeile editiert werden. Nach #on("i")##on("b")#CR#off("i")##off("b")# verschwindet die Kom­ +mandozeile und das Kommando wird ausgeführt. + +Falls ein Fehler auftritt erfolgt eine entsprechende Fehlermeldung in der Kopfzeile und +die Kommandozeile erscheint erneut. + +Um ein weiteres Editor-Fenster zu 'öffnen', betätigt man im Editor + +   + +Betätigt man ESC e ungefähr in der Mitte des Bildschirms, hat man das Fenster auf +die neue Datei in der unteren Hälfte des Bildschirms und die 'alte' Datei in der +oberen Bildschirmhälfte. Zunächst wird der Dateiname erfragt. Nach dessen Eingabe +und #on("i")##on("b")#CR#off("i")##off("b")# wird ein Fenster auf eröffnet. Die obere linke Ecke des Fensters befindet +sich an der aktuellen Cursor-Position. Dabei darf sich der Cursor nicht zu sehr am +rechten oder unteren Rand befinden, weil das Fenster sonst zu klein würde. In diesem +'Fenster' kann man dann genauso arbeiten wie im 'normalen' Editor. + +Mit der Tastenfolge + +   + +wechselt man von einem Fenster (zyklisch) in das benachbarte. Es gibt eine Hier­ +archie zwischen den Fenstern in der Reihenfolge, in der eines im anderen einge­ +richtet worden ist. Gibt man + +   + +in einem Fenster, so verschwindet dieses und alle darin eingeschachtelten Fenster, +und man befindet sich im übergeordneten Fenster. + +Durch + +  

oder    + +schreibt man einen markierten Teil in eine 'Scratch'-Datei (nicht editierbarer +Zwischenspeicher); durch ESC p wird ein markierter Text aus der Ursprungsdatei +entfernt und in die 'Scratch'-Datei geschrieben. Im Gegensatz dazu wird er durch +ESC d kopiert. Durch + +   + +fügt man ihn in eine andere (oder dieselbe) Datei ein. Im Unterschied zu ESC RUBIN +wird die temporäre Datei dadurch nicht entleert. + +Die für ESC p, bzw. ESC d benutzte #ib#'Scratch'-Datei#ie#, die nicht editierbar ist, ist nicht +mit dem sogenannten Notizbuch zu verwechseln. Das Notizbuch ist eine Datei, in der +alle Editorfunktionen benutzt werden können, auf die jedoch ohne Angabe eines +Dateinamens durch + + + +ab der aktuellen Cursorposition ein Fenster eröffnet wird. Das Notizbuch nimmt +insbesondere Fehlermeldungen und Meldungen bei der Übersetzung von Programmen +auf. + + + +erlaubt vom äußeren Fenster aus alle eingeschachtelten Fenster zu verlassen. +#page# + +Vorbelegte Tasten + +#ib#ESC q#ie# Verlassen des Editors bzw. der eingeschachtelten Fenster. + +#ib#ESC e#ie# Weiteres Editorfenster einschalten. + +#ib#ESC n#ie# Notizbuch 'anzeigen'. + +#ib#ESC v#ie# Dateifenster auf ganzen Bildschirm vergrößern + bzw. Bildschirm rekonstruieren (eingeschachteltes Fenster verlas­ + sen). + +#ib#ESC w#ie# Dateiwechsel beim Fenstereditor. + +#ib#ESC f#ie# Nochmalige Ausführung des letzten Kommandos. + +#ib#ESC b#ie# Das Fenster wird auf den linken Rand der aktuellen (ggf. verscho­ + benen) Zeile gesetzt. + +ESC > Zum nächsten Wortanfang. + +ESC < Zum vorherigen Wortanfang. + +#ib#ESC 1#ie# Zum Anfang der Datei. + +#ib#ESC 9#ie# Zum Ende der Datei. +#page# + +Operationen auf Markierungen + + +#goalpage("ESC")# +#ib#ESC RUBOUT#ie# Markiertes "vorsichtig" löschen. + +#ib#ESC RUBIN#ie# Mit ESC RUBOUT vorsichtig Gelöschtes einfügen. + +#ib#ESC p#ie# Markiertes löschen und in die Notiz-Datei schreiben. Kann mit ESC + g an anderer Stelle reproduziert werden. + +#ib#ESC d#ie# Duplizieren: + Markiertes in die Notiz-Datei kopieren, anschließend die + Markierung abschalten. Kann mit ESC g beliebig oft reproduziert + werden. + +#ib#ESC g#ie# Mit ESC p gelöschten oder mit ESC d duplizierten Text an aktuelle + Cursor-Stelle schreiben, d.h. Notiz-Datei an aktueller Stelle einfü­ + gen. +#page# + +Zeichen schreiben +Diese Tasten sind standardmäßig so vorbelegt wie hier aufgeführt, sie können aber +von Benutzern und in Anwenderprogrammen geändert werden. + +#ib#ESC a#ie# Schreibt ein ä. +#ib#ESC A#ie# Schreibt ein Ä. +#ib#ESC o#ie# Schreibt ein ö. +#ib#ESC O#ie# Schreibt ein Ö. +#ib#ESC u#ie# Schreibt ein ü. +#ib#ESC U#ie# Schreibt ein Ü. +#ib#ESC s#ie# Schreibt ein ß. +#ib#ESC (#ie# Schreibt eine [. +#ib#ESC )#ie# Schreibt eine ]. +#ib#ESC <#ie# Schreibt eine {. +#ib#ESC >#ie# Schreibt eine }. +#ib#ESC \##ie# Schreibt ein \#, das auch gedruckt werden kann. +#ib#ESC ­#ie# Schreibt einen (geschützten) Trennstrich, siehe Textverarbeitung. +#ib#ESC k#ie# Schreibt ein (geschütztes) "k", siehe Textverarbeitung. +#ib#ESC blank#ie# Schreibt ein (geschütztes) Leerzeichen, siehe Textverarbeitung. +#free(0.7)# + +Kommando auf Taste legen + +#ib#ESC ESC#ie# Kommandodialog einschalten + +#ib#ESC ! taste#ie# Im Kommandodialog: + Geschriebenes Kommando auf Taste legen. + +#ib#ESC ? taste#ie# Im Kommandodialog: + Auf 'taste' gelegtes Kommando zum Editieren anzeigen. + +#ib#ESC k#ie# Im Kommandodialog: + Das zuletzt editierte Kommando (einzeilige ELAN-Programm) + anzeigen. + + +Der Lernmodus +Der Lernmodus ermöglicht beliebige Tastensequenzen zu speichern und auf eine +Taste 't' zu legen. Durch #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#t#off("i")##off("b")# wird die gesamte Sequenz ausgeführt. + +Nicht belegt werden können die vom System vorbelegten Tasten (3-14). + +Beispielsweise könnte es für einen Programmierer sinnvoll sein die Tastenfolge +'THEN' 'CR' '>' '>' '>' '>' auf die Taste #on("i")##on("b")#T#off("i")##off("b")# zu legen. Durch #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#T#off("i")##off("b")# wird 'THEN' in +die aktuelle Zeile geschrieben und der Cursor mit passender Einrückung in die +Einrückung in die Folgezeile gesetzt. + + +#ib#ESC HOP#ie# #ib#Lernen einschalten#ie#. + +#ib#ESC HOP taste#ie# #ib#Lernen ausschalten#ie# und Lernsequenz auf 'taste'legen. + +#ib#ESC HOP HOP#ie# #ib#Gelerntes vergessen#ie#. Bedingung ist, daß man die Lernsequenz in + der Task löscht, in der man sie hat lernen lassen. + + +#on("b")# +#center#A C H T U N G : +Der Lernmodus bleibt eingeschaltet, auch wenn der Editor beendet wird. Dann werden +die folgenden Monitor-Kommandos usw. usf. 'gelernt'. Durch unsinniges 'Lernen' +lassen sich schlimmstenfalls beliebige Verwüstungen anrichten. + +Der Lernmodus wird in der Editor-Kopfzeile angezeigt. Falls der Editor beendet wird, +ohne den Lernmodus auszuschalten, erfolgt eine Warnung auf Monitor-Ebene. + +Um den Lernmodus zu beenden drücken Sie: + + + +Dadurch wird der Lernmodus ausgeschaltet und nichts gelernt, die Gefahr ist gebannt.#off("b")# + +#page# + + +#ib#SUPERVISOR-Taste#ie# + +Betätigen Sie diese Taste im Editor, dann unterbrechen Sie Ihre Editierarbeit und +erhalten die Meldung + +____________________________________________________________________________ + + Terminal 2 + + + EUMEL Version 1.8/M + + + gib supervisor kommando: + + + + + ESC ? --> help + ESC b --> begin("") ESC h --> halt + ESC c --> continue("") ESC s --> storage info + ESC q --> break ESC t --> task info + +____________________________________________________________________________ + + + +Wollen Sie nun im Editor fortfahren bzw. haben Sie irrtümlich die SV-Taste betätigt, +dann geben Sie das Kommando + +____________________________________________________________________________ + + gib supervisor kommmando : + continue ("meine task") + +____________________________________________________________________________ + + + +(falls Ihre Task, in der Sie arbeiteten, wirklich "meine task" hieß!) + +Um Ihren in Bearbeitung befindlichen Text wieder vollständig auf dem Bildschirm zu +sehen, betätigen die die Tasten + + + +Sie sind wieder an der Stelle, an der Sie den Text mit der SV-Taste verlassen ha­ +ben, und können normal weiterarbeiten. + +#on("u")#Achtung:#off("u")# Die SV-Taste kann, je nach Terminal, durch das Betätigen von zwei +Tasten gleichzeitig realisiert sein (oft 'CTRL b'). Beachten Sie die Beschreibung Ihrer +Tastatur! + + + +#on("b")# +Für die Programmierung ist die Tastenfolge von Bedeutung, da hier­ +durch der Fehler 'halt vom Terminal' erzeugt wird. Dadurch können unerwünscht +laufende Programme abgebrochen werden. +#off("b")# +#page# + + +#ib#Unterbrechen einer Ausgabe#ie# (oft auch als CTRL a realisiert). + +Haben Sie diese Taste aus Versehen betätigt, erkennen Sie dies daran, daß der +Editor nicht "reagiert". Betätigen Sie die WEITER-Taste (oft auch CTRL c). +#free(1.0)# + + +Unterbrochene Ausgabe fortsetzen. + +Ein mit der STOP-Taste angehaltene Ausgabe können Sie durch Betätigen der +#ib#WEITER-Taste#ie# fortsetzen. + + +#on("u")#VORSICHT:#off("u")# Die STOP-Taste unterbricht nur die Ausgabe auf den Bildschirm. Zei­ + chen, die während des STOP eingegeben werden, werden gespeichert + und nach 'WEITER' ausgegeben! + + +#page# + +3.5 Positionieren, Suchen, Ersetzen + im Kommandodialog + + +Um das Editorfenster auf eine bestimmte Zeile zu positionieren wird einfach diese +Zeilennummer angegeben. + +____________________________________________________________________________ + ............... Beispiel ..................... Zeile 4 + + gib kommando: 123                                           + +____________________________________________________________________________ + + + +Falls die Zeilenzahl der Datei geringer als die angegebene Zeilennummer ist, wird auf +die letzte Zeile positioniert. + + +Um das Editorfenster auf ein bestimmtes Textstück zu positionieren, wird der gesuch­ +te Text, ggf. mit Suchrichtung angegeben. + +____________________________________________________________________________ + ............... Beispiel ..................... Zeile 4 + + gib kommando: "END PROC"                                   + +____________________________________________________________________________ + + +Die Suchrichtung kann durch 'D' (down) oder 'U' (up) zusätzlich spezifiziert werden. + +____________________________________________________________________________ + ............... Beispiel ..................... Zeile 4 + + gib kommando: U "INT VAR schleifenzaehler"                  + +____________________________________________________________________________ + + + +Um beliebige Texte durch andere zu ersetzen, dienen die Operatoren 'C' (change) +bzw. 'CA' (change all). + +Bei Ausführung dieses Kommandos wird zunächst nach #on("u")#unten#off("u")# in der editierten Datei +nach dem zu ersetzenden Text gesucht. Wenn der Text gefunden wird, wird er durch +den hinter dem Operator stehenden Text ersetzt. + +____________________________________________________________________________ + ............... Beispiel ..................... Zeile 4 + + gib kommando: "lb" C "lange bezeichnung"                    + +____________________________________________________________________________ + + + +Bei Anwendung von 'CA' wird jedes Auftreten des gesuchten Textes ab der +Cursorposition durch den Ersatztext ersetzt, bis das Dateiende errreicht ist. + +Weitere Erklärungen zum Suchen und Ersetzen in 5.5. +#page# + +Weitere Hilfen + + +Textabschnitt an anderer Stelle der Datei einsetzen: + +- Abschnitt markieren und mit #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#d#off("i")##off("b")# zwischenspeichern. + +- Zweites Editorfenster auf die Datei mit #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#e#off("i")##off("b")# öffnen. + +- Nach #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#ESC#off("i")##off("b")# Zeilennummer oder Suchbegriff angeben und mit #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#g#off("i")##off("b")# Abschnitt an der gewünschte Stelle einsetzen. + + + +Textabschnitt schnell herauskopieren und sichern: + +- Gewünschten Abschnitt markieren + +- #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#ESC#off("i")##off("b")# PUT("dateiname") #on("i")##on("b")#CR#off("i")##off("b")# + Der Abschnitt wird in die Datei 'dateiname' geschrieben. Falls die Frage 'dateina­ + me' löschen (j/n) verneint wird, wird der Abschnitt, an das Ende der Datei angefügt. + Dadurch können Textabschnitte schnell gesammelt werden. + + +Komplette Datei in die editierte Datei einfügen: + +- #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#ESC#off("i")##off("b")# GET("dateiname") #on("i")##on("b")#CR#off("i")##off("b")# + Der komplette Inhalt von 'dateiname' wird an die aktuelle Position geschrieben. + + +Breitere Zeile erzeugen: + +- #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#ESC#off("i")##off("b")# limit(123) #on("i")##on("b")#CR#off("i")##off("b")# + Die Zeilenbreite wird auf 123 Zeichen geändert. Der maximal zulässige Wert ist + 16000. Dieser Wert bezieht sich auf den Zeilenumbruch. Bei Zeilenbreite > 77 wird + nur die aktuelle Zeile verschoben. Um für den ganzen Bildschirm die rechte Seite + der Datei zu sehen, kann die linken Spalte des Bildschirmfenster neu gesetzt wer­ + den: + + #on("i")##on("b")#ESC#off("i")##off("b")# #on("i")##on("b")#ESC#off("i")##off("b")# margin(60) #on("i")##on("b")#CR#off("i")##off("b")# + + Die Normaleinstellung wird durch 'limit(77)' und 'margin(1)' wiederhergestellt. + diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.4 b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.4 new file mode 100644 index 0000000..650d945 --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.4 @@ -0,0 +1,1692 @@ +#headandbottom("1","EUMEL-Benutzerhandbuch","TEIL 4 : Kommandosprache","4")# +#pagenr("%",1)##setcount(1)##block##pageblock# +#headeven# +#center#EUMEL-Benutzerhandbuch +#center#____________________________________________________________ + +#end# +#headodd# +#center#TEIL 4 : Kommandosprache +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +4 - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#4 - % +#end# +TEIL 4: Kommandosprache + +In Teil 4 sind diejenigen Kommandos beschrieben, die erfahrungsgemäß eher der +Handhabung der Arbeitsumgebung zuzurechnen sind. Es ist den Verfassern bewußt, +daß Auswahl und Zusammenstellung recht willkürlich sind, weil eine klare Abgrenzung +zum Teil 5, welcher die Kommandos, die dem Thema: 'Programmierung' zugeordnet +werden, nicht möglich ist. + +Der Teil 4 ist in die Themen: + +- 4.1. Supervisor-Kommandos + +- 4.2.1 Hilfs- und Informationsprozeduren + +- 4.2.2 Thesaurus + +- 4.2.3 Tasks + +- 4.2.4 Handhabung von Dateien + +- 4.2.5 Editor + +- 4.2.6 Dateitransfer + +- 4.2.7 Passwortschutz + +- 4.2.8 Archiv + +gegliedert. Insbesondere zu 4.2.4 ist anzumerken, daß nur Kommandos, die ganze +Dateien betreffen hier erläutert sind. Kommandos, die Dateiinhalte betreffen (Suchen, +Ersetzen etc.) sind in 3.5, bzw. 5.3 beschrieben. +#page# + +4.1 Supervisor + +Es gibt genau sieben vom Supervisor akzeptierte Kommandos. Diese Kommandos +können gegeben werden wenn nach dem Einschalten des Geräts oder dem Abkoppeln +einer Task die SV-Taste gedrückt wurde und die sogenannte EUMEL-Tapete +erscheint. + +____________________________________________________________________________ + + Terminal 2 + + + EUMEL Version 1.8.1/M + + + gib supervisor kommando: + + + + + ESC ? --> help + ESC b --> begin("") ESC h --> halt + ESC c --> continue("") ESC s --> storage info + ESC q --> break ESC t --> task info + +____________________________________________________________________________ + + + + +Desweiteren kann in einer Task gedrückt werden, um durch einen +Programmabbruch einzuleiten. + +Im Gegensatz zu den im weiteren beschriebenen, durch ELAN Prozeduren realisierten +Kommandos, sind diese Supervisor-Kommandos nicht als Prozeduren im System und +mithin nicht durch 'help (...)' anzeigbar. +#page# +'begin' + #on("b")#PROC begin (TEXT CONST taskname) #off("b")# + Richtet eine neue Task als Sohn von PUBLIC ein. + + + #on("b")#PROC begin (TEXT CONST taskname, vatertask) #off("b")# + Richtet eine neue Task als Sohn der Task 'vatertask' ein, falls die Vater-Task + eine Manager-Task ist. Falls diese Task keinen Managerstatus besitzt, passiert + nichts! In diesem Falle muß das Kommando durch abgebrochen werden. + + + FEHLER : "taskname" existiert bereits + "vatertask" gibt es nicht + + + + +'continue' + #on("b")#PROC continue (TEXT CONST taskname) #off("b")# + Eine existierende Task wird an das Terminal des Benutzers angekoppelt. + + FEHLER : "taskname" gibt es nicht + + + Falls 'begin' oder 'continue' trotz korrekter Voraussetzungen kein Resultat zeigen, + 'hängt' die betroffene Task. Beim 'begin' Kommando kann das der Fall sein, falls + die Vater-Task nicht durch 'break' abgekoppelt wurde, sondern mit < SV > verlas­ + sen wurde. In diesem Fall muß das Kommando durch abgebrochen werden, + die Vater-Task angekoppelt und mit korrekt abgekoppelt werden. +#page# +'break' + #on("b")#PROC break #off("b")# + Das Terminal wird vom Rechner abgekoppelt. + + + +'halt' + #on("b")#PROC halt #off("b")# + Das laufende Programm der dem Terminal aktuell zugeordneten Task wird abge­ + brochen. + + Falls in der an das Terminal gekoppelten Task ein laufendes Programm abgebro­ + chen werden soll, muß zunächst durch der Supervisor aufgerufen werden. + Durch das Supervisor-Kommando 'halt' wird der Fehler 'halt from terminal' + induziert. Das Programm wird wie durch jeden anderen Fehler abgebrochen, falls + nicht 'disable stop' gesetzt wurde! + + + +#page# +'storage info' + #on("b")#PROC storage info #off("b")# + Informationsprozedur über den belegten und den verfügbaren Hintergrund-Spei­ + cher des gesamten Systems in KByte#u#1)#e#. + +#foot# + + 1) Bei der derzeit aktuellen '+' Version EUMEL 1.8.1/M+ sind die beiden Anga­ + ben mit 4 zu multiplizieren ! +#end# + Das Terminal wird unmittelbar abgekoppelt! + + + +'task info' + #on("b")#PROC task info #off("b")# + Informiert über alle Tasknamen im System unter gleichzeitiger Angabe der Vater/ + Sohn-Beziehungen durch Einrückungen. + + + + +'help' + #on("b")#PROC help #off("b")# + Kurzbeschreibung der SV-Kommandos. +#page# + +4.2 Monitor + +Unter dem Stichwort Monitor-Kommandos sind an dieser Stelle Kommandos be­ +schrieben, die ständig zur Handhabung der Arbeitsumgebung benutzt werden. +Gleichwohl sei sofort darauf hingewiesen, daß jedes ELAN Programm dem Monitor zur +Ausführung übergeben werden kann. Es gibt also keine speziellen Monitor- +Kommandos, sondern nur eine Reihe von Prozeduren (=Kommandos), die in dieser +Umgebung erfahrungsgemäß besonders häufig benutzt werden. + + +#on("u")#4.2.1 Hilfs- und Informationsprozeduren#off("u")# + +- Pakete, Prozeduren : packets, bulletin , help + Parameter + +- Tasksystem zeigen : task info , task status + +- Speicherplatz zeigen : storage , storage info + + +#on("u")#4.2.2 Thesaurus #off("u")# + +- besondere Thesauri : ALL , all , SOME , remainder + +- Verknüpfung : + , - , / + + +#on("u")#4.2.3 Taskoperationen#off("u")# + +- besondere Tasknamen : archive , brother , father , myself + printer , public , son , supervisor +- Terminal abkoppeln : break +- Task löschen : end +- Manager-Task : global manager , free global manager +- Umbenennen der Task : rename myself + +#page# +#on("u")#4.2.4 Handhabung von Dateien #off("u")# + + : copy , edit , forget , list , rename , show + + +#on("u")#4.2.5 Editor #off("u")# + +- Editieren : edit , editget , show +- Tastenbelegung : kommando auf taste (legen) , + lernsequenz auf taste (legen) , + std tastenbelegung , + taste enthält kommando , + word wrap + + +#on("u")#4.2.6 Transfer #off("u")# + +- Datei holen : fetch , fetchall +- Datei senden : save , saveall +- Drucken : print +- Datei löschen : erase + + +#on("u")#4.2.7 Passwortschutz #off("u")# + +- 'begin' absichern : begin password +- 'continue' absichern : task password +- Dateien absichern : enter password +- Systemzweig sichern : family password + + +#on("u")#4.2.8 Das Archiv #off("u")# + +- Reservieren/freigeben : archive , release +- Formatieren : format +- Löschen : clear +- Kontrollesen : check + + +#page# + +4.2.1 Hilfsprozeduren + +Die drei Prozeduren listen ihre Ausgabe jeweils in eine temporäre Datei, die mit +'show' (s. 4.2.5) gezeigt wird. + + +'packets' + #on("b")#PROC packets #off("b")# + Auflisten der Namen aller insertierten Pakete in der Task. + + + + + + +'bulletin' + #on("b")#PROC bulletin (TEXT CONST paket name) #off("b")# + Listen aller in der DEFINES-Liste des Pakets mit dem Namen "paket name" + enthaltenen Prozeduren. + + FEHLER : ... ist kein Paketname + + + #on("b")#PROC bulletin #off("b")# + Es wird eine Liste aller bisher insertierten Objekte erstellt. Diese Liste ist paket­ + weise sortiert. 'bulletin' zeigt also eine Liste #on("u")#aller#off("u")# Prozeduren an, die in der Task + benutzt werden können. +#page# +'help' + #on("b")#PROC help (TEXT CONST name) #off("b")# + Listen aller Prozeduren / Operatoren mit dem Namen "name". Der Name des + Packets in dessen Schnittstelle die Prozedur steht wird mit ausgegeben. + + Falls es kein Objekt des erfragten Namens gibt, erfolgt die Ausgabe: + + unbekannt "name". + + Beispiel: +____________________________________________________________________________ + + gib kommando : + help("save") + +____________________________________________________________________________ + + + liefert: + +____________________________________________________________________________ + +PACKET nameset: + + save........... (THESAURUS CONST, TASK CONST) + save........... (THESAURUS CONST) + +PACKET globalmanager: + + save........... (DATASPACE CONST, TEXT CONST, TASK CONST) + save........... (TEXT CONST, TASK CONST) + save........... (TEXT CONST) + save........... + +____________________________________________________________________________ + + + + Desweiteren kann auch nach Prozedurnamen gesucht werden, die nur annähernd + bekannt sind, indem ein Suchmuster spezifiziert wird. Das Suchmuster besteht aus + dem bekannten Teil des Namens und dem Operator '*', der vor und/oder nach + dem Suchbegriff gesetzt werden kann. '*' bezeichnet eine beliebige (auch leere) + Zeichenkette. + + Beispiel: Gesucht werden die verschiedenen 'info' Prozeduren: + +____________________________________________________________________________ + gib kommando : + help("*info*") + +____________________________________________________________________________ + + + +____________________________________________________________________________ + + taskinfo....... (INT CONST, INT CONST) + taskinfo....... (INT CONST, FILE VAR) + taskinfo....... (INT CONST) + taskinfo....... + editinfo....... (FILE VAR, INT CONST) + editinfo....... (FILE CONST) --> INT + storageinfo.... + +____________________________________________________________________________ + + + + Dieser Stern darf nicht mit dem 'joker' des 'Pattern Matching' verwechselt werden. + In der 'help' Prozedur darf '*' #on("u")#nicht#off("u")# in den Suchbegriff eingesetzt werden, sondern + nur an Wortanfang und -Ende gesetzt werden. + + +#page# + +Informationsprozeduren + +'storage' + #on("b")#INT PROC storage (TASK CONST task) #off("b")# + Informationsprozedur über den logisch belegten Hintergrund-Speicher der Task. + (Angabe in KByte, bzw. 4KB Einheiten bei der '+'-Version) + + +____________________________________________________________________________ + + gib kommando : + put(storage(myself)) + 1234 + + gib kommando : + +____________________________________________________________________________ + + +'storage info' + #on("b")#PROC storage info #off("b")# + Informationsprozedur über den belegten und den verfügbaren Hintergrund-Spei­ + cher des gesamten Systems. Die Ausgabe erfolgt in KByte, bei der aktuellen + '+'-Version in 4 KByte Einheiten. + + +____________________________________________________________________________ + + gib kommando : + storage info + 1234K von 12000K + + gib kommando : +____________________________________________________________________________ +#page# + +'task info' + #on("b")#PROC task info #off("b")# + Informiert über alle Tasknamen im System unter gleichzeitiger Angabe der Vater/ + Sohn-Beziehungen (Angabe durch Einrückungen). + + + #on("b")#PROC task info (INT CONST art) #off("b")# + Informiert über alle Tasks im System. Mit 'art' kann man die Art der Zusatz- + Information auswählen. + + art=1: entspricht 'task info' ohne Parameter, d.h. es gibt nur die Tasknamen + unter Angabe der Vater/Sohn-Beziehungen aus. + + art=2: gibt die Tasknamen aus. Zusätzlich erhalten Sie Informationen über die + verbrauchte CPU-Zeit der Task, die Priorität, den Kanal, an dem die + Task angekoppelt ist, und den eigentlichen Taskstatus. Hierbei bedeuten: + + 0 -busy- Task ist aktiv. + 1 i/o Task wartet auf Beendigung des Outputs oder auf + Eingabe. + 2 wait Task wartet auf Sendung von einer anderen Task. + 4 busy-blocked Task ist rechenwillig, aber blockiert#u#1)#e#. + 5 i/o -blocked Task wartet auf I/O, ist aber blockiert. + 6 wait-blocked Task wartet auf Sendung, ist aber blockiert. Ach­ + tung: Die Task wird beim Eintreffen einer Sendung + automatisch entblockiert. + > 6 dead + + art=3: wie 2, aber zusätzlich wird der belegte Speicher angezeigt. (Achtung: + Prozedur ist zeitaufwendig!). + +#foot# + +1) Eine Blockierung kann von 'Scheduler' veranlaßt werden + (siehe Systemhandbuch) +#end# + +#page# +____________________________________________________________________________ + + gib kommando : + task info(2) + +____________________________________________________________________________ + + + + liefert: + +____________________________________________________________________________ + + ............................ ............................... + 15.05.87 10:39 CPU PRIO CHAN STATUS + SUPERVISOR.......................... 0000:19:47 0 - wait + -................................ 0000:07:54 0 - wait + SYSUR............................ 0000:34:02 0 - wait + shutup dialog................ 0000:05:26 0 - i/o + configurator................. 0000:04:17 0 - wait + OPERATOR..................... 0000:00:14 0 - i/o + ARCHIVE...................... 0000:10:33 0 31 wait + net.......................... 0006:41:56 0 - wait + net timer................ 0000:02:48 2 - i/o + net port................. 0000:40:23 0 7 wait + PRINTER...................... 0000:05:59 0 - wait + -........................ 0000:00:11 0 - wait + UR.................................. 0000:02:11 0 - wait + PUBLIC........................... 0002:02:03 0 - wait + task1........................ 0000:41:50 0 - -busy- + task2........................ 0000:03:10 0 - i/o + task3........................ 0000:57:28 0 1 -busy- + +____________________________________________________________________________ + + +#page# + + + #on("b")#PROC task info (INT CONST art, FILE VAR infodatei) #off("b")# + Wie oben, die Ausgabe wird jedoch in die Datei 'infodatei' geschrieben. + +____________________________________________________________________________ + + FILE VAR info := sequential file(output,"infodatei") ; + taskinfo(3, info); + +____________________________________________________________________________ + + + #on("b")#PROC task info ( INT CONST art, stationsnr) #off("b")# + Ermöglicht im Netzbetrieb 'task info' über die Station mit der Nummer 'stationsnr'. + +____________________________________________________________________________ + + gib kommando : + taskinfo(1,12) ; + +____________________________________________________________________________ +#page# +'task status' + + #on("b")#PROC task status #off("b")# + Informationsprozedur über den Zustand der eigenen Task. Informiert über + - Name der Task, Datum und Uhrzeit; + - verbrauchte CPU-Zeit; + - belegten Speicherplatz; + - Kanal, an den die Task angekoppelt ist; + - Zustand der Task (rechnend u.a.m.); + - Priorität. + + #on("b")#PROC task status (TASK CONST t) #off("b")# + Wie obige Prozedur, aber über die Task mit dem internen Tasknamen 't'. + + +____________________________________________________________________________ + + gib kommando : + task status (public) + + 15.05.87 10:30 TASK: PUBLIC + + Speicher: 1234K + CPU Zeit: 0011.12:23 + Zustand : wait, (Prio 0), Kanal - + +____________________________________________________________________________ +#page# + +4.2.2 Thesaurus + +Ein #ib#Thesaurus#ie# ist ein #ib#Namensverzeichnis#ie#, das bis zu 200 Namen beinhalten kann. +Dabei muß jeder Namen mindestens ein Zeichen und darf höchstens 100 Zeichen +lang sein. Steuerzeichen (code < 32) in Namen werden umgesetzt (siehe 2.9.2). + +Thesauri werden unter anderem von der Dateiverwaltung benutzt, um das Dateiver­ +zeichnis einer Task zu führen. + +Man kann einen Thesaurus selbst erstellen, indem eine Datei z.B. mit Namen von +Dateien gefüllt wird. Diese Datei kann dann als Thesaurus für weitere Aktionen die­ +nen. + + + +- Thesaurus liefern : ALL , all , SOME , remainder +- Auswählen : LIKE +- Verknüpfen : + , - , / + + + +#on("b")#ACHTUNG#off("b")# : Bei der Verwendung von Thesaurus Operationen in Verbindung mit +'fetch', 'save' etc. ist zu beachten, daß mit 'SOME', 'ALL' und 'all' zunächst nur eine +Auswahl aus einer Liste getroffen wird. Zusätzlich muß das Ziel oder die Quelle des +Dateitransfers vereinbart werden. + +Ein beliebter Fehler ist z.B.: 'fetch (ALL archive)'. + +Hier ist nicht weiter spezifiziert, von wo Dateien geholt werden sollen - also werden +sie von 'father' geholt! (s. 4.2.5) + +Falls die Dateien vom Archiv geholt werden sollen, ist das Archiv als Quelle zu be­ +nennen: + +Also : 'fetch (ALL archive, archive)' = Hole alle Dateien, die in dem Thesaurus von + 'archive' sind von der Task 'archive'. +#page# +'ALL' + THESAURUS OP ALL (TASK CONST task) + Liefert einen Thesaurus, der alle Dateinamen der angegebenen Task enthält. + + + + #on("b")#THESAURUS OP ALL (TEXT CONST dateiname) #off("b")# + Liefert einen Thesaurus, der die in der angegebenen Datei vorhandenen Namen + (jede Zeile ein Name) enthält. + + + + +'all' + #on("b")#THESAURUS PROC all #off("b")# + Liefert einen Thesaurus, der alle Dateinamen der eigenen Task enthält. Entspricht + 'ALL myself'. + + + + +'SOME' + #on("b")#THESAURUS OP SOME (THESAURUS CONST thesaurus) #off("b")# + Bietet den angegebenen Thesaurus zum editieren an. Dort können nicht erwünsch­ + te Namen gestrichen werden. + + + + #on("b")#THESAURUS OP SOME (TASK CONST task) #off("b")# + Aufruf von: SOME ALL task. + + + #on("b")#THESAURUS OP SOME (TEXT CONST dateiname) #off("b")# + Aufruf von: SOME ALL dateiname. + +#page# +'remainder' + #on("b")#PROC remainder #off("b")# + Liefert nach einem 'errorstop' die noch nicht bearbeiteten Dateien. + +____________________________________________________________________________ + + gib kommando : + save all (archive) + + '"....." kann nicht geschrieben werden (Archiv voll)' + +____________________________________________________________________________ + + + + Nachdem man eine neue Floppy ins Archivlaufwerk gelegt hat, kann man mit + + +____________________________________________________________________________ + gib kommando : + save (remainder, archive) + +____________________________________________________________________________ + + den Rest der Dateien auf die nächste Floppy sichern. +#page# +'LIKE' + #on("b")#THESAURUS OP LIKE (THESAURUS CONST thesaurus, TEXT CONST muster) #off("b")# + Alle im Thesaurus enthaltenen Dateien, die dem 'muster' entsprechen sind im + Ergebnisthesaurus enthalten. + + (Die Syntax von 'muster' ist bei der Beschreibung des Pattern-Matching (5.4) + beschrieben) + + +____________________________________________________________________________ + + gib kommando : + print (all LIKE "*.p") + +____________________________________________________________________________ + + + Alle Dateien, deren Name mit '.p' endet, werden gedruckt. + +#page# +'+' + #on("b")#THESAURUS OP + (THESAURUS CONST links, rechts) #off("b")# + Liefert die Vereinigungsmenge von 'links' und 'rechts'. + Achtung: Die Vereinigungsmenge enthält keine Namen mehrfach. + + #on("b")#THESAURUS OP + (THESAURUS CONST links, TEXT CONST rechts)#off("b")# + Fügt dem Thesaurus 'rechts' zu, wenn 'rechts' noch nicht im Thesaurus enthal­ + ten ist. + + + + +'-' + #on("b")#THESAURUS OP - (THESAURUS CONST links, rechts) #off("b")# + Liefert die Differenzmenge. Achtung: Die Differenzmenge enthält keine Namen + mehrfach. + + #on("b")#THESAURUS OP - (THESAURUS CONST links, TEXT CONST rechts)#off("b")# + Nimmt den Namen 'rechts' aus dem Thesaurus. + +____________________________________________________________________________ + + gib kommando : + fetch(ALL father - ALL myself) + +____________________________________________________________________________ + + +'/' + #on("b")#THESAURUS OP / (THESAURUS CONST links, rechts) #off("b")# + Liefert die Schnittmenge + Achtung: Die Schnittmenge enthält keine Namen mehrfach. + + +#page# + +4.2.3 Tasks + +Zur Identifizierung von Tasks dienen sogenannte 'interne Taskbezeichner'. Ein solcher +Taskbezeichner wird beim Einrichten einer neuen Task vergeben. Interne Taskbe­ +zeichner sind auch unter Berücksichtigung der Zeit eindeutig. + +Der Zugriff auf interne Taskbezeichner erfolgt über Prozeduren und Operatoren, die +auf Objekte des Datentyps TASK (siehe 2.9.1) angewandt werden. + +Zusätzlich zum internen Tasknamen, der nicht auszugeben ist, haben Tasks meistens +einen Namen#u#1) #e#. +#foot# + +1) Unbenannte Tasks haben den Pseudonamen "-". +#end# + +Aus Benutzersicht können benannte Tasks innerhalb eines Rechners vollständig und +eindeutig über ihren Namen identifiziert werden. + + +- Task liefern : / , task , niltask + +- Verwandtschaften : brother , father , myself , son + +- Ausgezeichnete Tasks : archive , printer , public , supervisor + +- Namen liefern : name + +- Tasknamen ändern : rename myself + +- Reservieren bes. Tasks : reserve + +#page# +'/' + #on("b")#TASK OP / (TEXT CONST taskname) #off("b")# + Liefert die Task des angegebenen Namens, falls sie existiert. Der eigene Katal­ + og wird automatisch aktualisiert + + (identisch mit der PROC task (TEXT CONST taskname). + + FEHLER : "taskname" gibt es nicht + + + #on("b")#TASK OP / (INT CONST station number, TEXT CONST name) #off("b")# + Liefert im Netzbetrieb die Task des angegebenen Namen von der Station mit der + angegebenen Nummer. + + + +'niltask' + #on("b")#TASK CONST niltask #off("b")# + Bezeichner für "keine Task". So liefern die Prozeduren 'son', 'brother' und 'father' + als Resultat 'niltask', wenn keine Sohn-, Bruder- oder Vatertask existiert. + + + +'task' + #on("b")#TASK PROC task (TEXT CONST taskname) #off("b")# + Liefert die Task des angegebenen Namens, falls sie existiert. Der eigene Katal­ + og wird automatisch aktualisiert. + + FEHLER : "taskname" gibt es nicht + + + #on("b")#TASK PROC task (INT CONST channel number) #off("b")# + Liefert den Namen der Task, die an dem angegebenen Kanal hängt. +#page# +'brother' + #on("b")#TASK PROC brother (TASK CONST task) #off("b")# + Liefert den nächsten Bruder von 'task'. Falls kein Bruder existiert, wird 'niltask' + geliefert. Aktualisiert den eigenen Katalog nicht automatisch! + + + +'father' + #on("b")#TASK PROC father #off("b")# + Liefert die eigene Vatertask. + + + #on("b")#TASK PROC father (TASK CONST task) #off("b")# + Liefert den Vater von 'task'. Existiert kein Vater (z.B. bei UR), wird niltask gelie­ + fert. Aktualisiert den eigenen Katalog nicht automatisch! + + + +'myself' + #on("b")#TASK PROC myself #off("b")# + Liefert eigenen Task-Bezeichner. + + + +'son' + #on("b")#TASK PROC son (TASK CONST task) #off("b")# + Liefert den ersten Sohn von 'task'. Falls keiner im Katalog vermerkt ist, wird + 'niltask' geliefert. Aktualisiert den eigenen Katalog nicht automatisch! + + +#page# +'archive' + #on("b")#TASK PROC archive #off("b")# + Liefert den internen Taskbezeichner der aktuellen Task mit Namen ARCHIVE. + Diese Prozedur dient zum schnellen und bequemen Ansprechen der Archivtask. + + + +'printer' + #on("b")#TASK PROC printer #off("b")# + Liefert den internen Taskbezeichner der aktuellen Task mit Namen #ib#PRINTER#ie#. + Diese Prozedur dient zum schnellen und bequemen Ansprechen des Druckspoo­ + lers. + + +'public' + #on("b")#TASK PROC public #off("b")# + Liefert den internen Taskbezeichner der Task #ib#PUBLIC#ie#. + + + + +'supervisor' + #on("b")#TASK PROC supervisor #off("b")# + Liefert den internen Taskbezeichner des Supervisors. + + +#page# +'name' + #on("b")#TEXT PROC name (TASK CONST task) #off("b")# + Liefert den Namen von 'task'. Die Task muß noch im System existieren, sonst ist + der Name nicht mehr bekannt. Falls die 'task' noch nicht im eigenen Katalog + enthalten ist, wird er aktualisiert. + + + +'rename myself' + #on("b")#PROC rename myself (TEXT CONST neuer name) #off("b")# + Name der eigenen Task wird in 'neuer name' geändert. Wirkt wie Löschung und + Wiedereinrichten der Task in Bezug auf alle TASK VAR's die sich auf diese Task + beziehen. + + FEHLER : Task existiert bereits + Name unzulässig + => anderen Namen wählen + + + +'reserve' + #on("b")#PROC reserve (TASK CONST task) #off("b")# + Reservieren einer Task für den ausschließlichen Dialog mit der Task, in der das + Kommando gegeben wurde. + + #on("b")#PROC reserve (TEXT CONST message, TASK CONST task) #off("b")# + Wie 'reserve (TASK CONST task)' mit Übergabe einer 'message'. + + + Die reservierte Task muß ein spezieller Manager, (z.B. /"DOS" aus dem Werkzeug + MS-DOS-DAT) sein ! +#page# + +4.2.4 Handhabung von Dateien + +'copy' + #on("b")#PROC copy (TEXT CONST quelle, ziel) #off("b")# + Kopiert die Datei 'quelle' in eine neue Datei mit dem Namen 'ziel' in der Benut­ + zer-Task. + + FEHLER : "ziel" existiert bereits + "quelle" gibt es nicht + zu viele Dateien + + + +'forget' + #on("b")#PROC forget (TEXT CONST dateiname) #off("b")# + Löschen einer Datei mit dem Namen 'dateiname' in der Benutzer-Task. + + FEHLER : "datei" gibt es nicht + + + #on("b")#PROC forget (THESAURUS CONST thesaurus) #off("b")# + Löscht die im 'thesaurus' enthaltenen Dateien in der Benutzer-Task. + + Im Dialog erfolgt vor dem Löschen einer Datei standardmäßig die Abfrage: + + +____________________________________________________________________________ + + gib kommando : + forget("einedatei") + "einedatei" löschen(j/n) ? + +____________________________________________________________________________ + +#page# +'list' + #on("b")#PROC list #off("b")# + Listet alle Dateien der Benutzer-Task mit Namen und Datum des letzten Zugriffs + auf dem Terminal auf. + + + #on("b")#PROC list (TASK CONST task) #off("b")# + Listet alle Dateien der angegebenen 'task' mit Namen und Datum der letzten + Änderung auf dem Terminal auf. Die Task muß Manager sein. + + + #on("b")#PROC list (FILE VAR liste) #off("b")# + Listet alle Dateinamen in die Datei 'liste', die mit 'output'(s. 5.3.5) assoziiert sein + muß. + + + #on("b")#PROC list (FILE VAR liste, TASK CONST manager) #off("b")# + Listet alle Dateien der Task 'manager' mit Namen und Datum der letzten Ände­ + rung in die Datei 'liste'. + + +____________________________________________________________________________ + + gib kommando : + FILE VAR f:= sequential file (output,"list");list(f,archive) + +____________________________________________________________________________ + +#page# +'rename' + #on("b")#PROC rename (TEXT CONST altername, neuername) #off("b")# + Umbenennen einer Datei von 'altername' in 'neuername'. + + + + FEHLER : "neuername" gibt es bereits + "altername" gibt es nicht +#page# + +4.2.5 Editor-Prozeduren + +'edit' + #on("b")#PROC edit (TEXT CONST dateiname) #off("b")# + Ruft den Editor mit 'dateiname' auf. + + + #on("b")#PROC edit #off("b")# + a) Im Monitor: + Ruft den Editor mit den zuletzt verwandten Dateinamen auf. + + b) Im Editor: + Der Dateiname wird erfragt. + + Für jedes 'edit' gilt: + Wurde 'edit' zum ersten Mal aufgerufen, nimmt das Fenster den gesamten Bild­ + schirm ein. Bei erneutem 'edit'-Aufruf wird ein Fenster nach rechts unten ab der + aktuellen Cursor-Position eröffnet. + + + #on("b")#PROC edit (THESAURUS CONST t) #off("b")# + Editieren aller in dem Thesaurus 't' enthaltenen Dateien nacheinander. + + + Weitere 'edit-Prozeduren', die z.B. Variation der Fenstergröße etc. zulassen, sind + in 5.4.6 beschrieben. + +#page# +'editget' + #on("b")#PROC editget (TEXT VAR editsatz) #off("b")# + Ausgabe einer (Kommando)zeile, in der Editorfunktionen zur Verfügung + stehen siehe Teil 5.5.1.4. + + + +'show' + #on("b")#PROC show (TEXT CONST dateiname) #off("b")# + Die Datei wird am Bildschirm gezeigt. Positionierung und Suchen funktionieren wie + in 'edit', Aktionen die Änderungen in der Datei bewirken würden, werden nicht + angenommen. + + + + #on("b")#PROC show #off("b")# + 'show' auf der zuletzt bearbeiteten Datei. + +#page# +'kommando auf taste legen' + #on("b")#PROC kommando auf taste legen (TEXT CONST taste, elan programm)#off("b")# + Die Taste 'taste' wird mit dem angegebenen ELAN-Programm belegt. Durch + wird das Programm direkt ausgeführt. + +____________________________________________________________________________ + + gib kommando : + kommando auf taste legen ("a","fetch (SOME archive,archive)") + +____________________________________________________________________________ + + + +'kommando auf taste' + #on("b")#TEXT PROC kommando auf taste (TEXT CONST taste)#off("b")# + Falls 'taste' mit einem ELAN-Programm belegt ist, liefert die Prozedur den + Programmtext, andernfalls den leeren Text niltext. + +____________________________________________________________________________ + + gib kommando : + put (kommando auf taste("f")) + +____________________________________________________________________________ + + + +'taste enthaelt kommando' + #on("b")#BOOL PROC taste enthaelt kommando (TEXT CONST taste)#off("b")# + Liefert TRUE falls 'taste' mit einem ELAN-Programm belegt ist. + + +'lernsequenz auf taste legen' + #on("b")#PROC lernsequenz auf taste legen (TEXT CONST taste, sequenz)#off("b")# + 'taste' wird mit der Zeichenfolge 'sequenz' belegt. Durch wird die + Zeichenfolge an der aktuellen Position ausgegeben. + + Als Zeichenfolge sind natürlich auch einzelne Zeichen und EUMEL-Codes zuläs­ + sig. + + Die vom System vorbelegten Tasten sind in 3.4 'Zeichen schreiben' aufgelistet. + +____________________________________________________________________________ + + gib kommando : + lernsequenz auf taste legen ("x","gib kommando :"13""2""2"") + +____________________________________________________________________________ + + + +'lernsequenz auf taste' + #on("b")#TEXT PROC lernsequenz auf taste (TEXT CONST taste) #off("b")# + Liefert die auf 'taste' gelegte Zeichenfolge. + + +'std tastenbelegung' + #on("b")#PROC std tastenbelegung #off("b")# + Die Standard-Tastenbelegung (s.3.4) wird (wieder) hergestellt. + + +'word wrap' + #on("b")#PROC word wrap (BOOL CONST b) #off("b")# + Der automatische Zeilenumbruch wird durch 'word wrap (FALSE)' aus- und durch + 'word wrap (TRUE)' eingeschaltet. Wird diese Prozedur während des Editierens + aufgerufen, gilt die Einstellung für die aktuelle Textdatei. Wird die Prozedur als + Monitor-Kommando gegeben, so gilt die Eingabe als Voreinstellung für neue + Dateien. +#page# + +4.2.6 Dateitransfer + +Unter diesem Abschnitt sind diejenigen Prozeduren beschrieben, die der simplen +Kommunikation mit Manager-Tasks dienen: Holen oder Senden einer Dateikopie, +Löschen in der Manager-Task. + +#on("b")#ACHTUNG : Für alle Prozeduren gilt: falls die Manager-Task nicht existiert, wird eine +Fehlermeldung erzeugt, existiert eine Task des angegebenen Namens, die aber nicht +Managertask ist, so terminieren die Prozeduren nicht! +#off("b")# + + +'fetch' + #on("b")#PROC fetch (TEXT CONST dateiname, TASK CONST manager) #off("b")# + Kopiert die Datei 'dateiname' aus der Task 'manager' + + + #on("b")#PROC fetch (THESAURUS CONST th, TASK CONST manager) #off("b")# + Kopiert alle Dateien, deren Namen im Thesaurus th enthalten sind, aus der Task + 'manager'. + + +____________________________________________________________________________ + + gib kommando : + fetch(ALL(12/"PUBLIC"), 12/"PUBLIC") + +____________________________________________________________________________ + + + + Mit diesem Kommando werden (in einem EUMEL Netz) alle Dateien der Task + 'PUBLIC' des Rechners mit der Stationsnummer 12 in diesem Netz kopiert. + +#page# +____________________________________________________________________________ + + gib kommando : + fetch(SOME archive , archive) + +____________________________________________________________________________ + + + + Bietet den Thesaurus von 'ARCHIVE' an, nach Auswahl werden alle Dateien deren + Namen nicht gelöscht wurden, von der Diskette kopiert. + + + #on("b")#PROC fetch (TEXT CONST dateiname) #off("b")# + Kopiert die Datei 'dateiname' aus der Task 'father' + + + #on("b")#PROC fetch (THESAURUS CONST th) #off("b")# + Kopiert alle Dateien, deren Namen in 'th' sind aus der Task 'father'. + + + +'fetchall' + + #on("b")#PROC fetchall #off("b")# + entspricht: fetch (ALL father, father) + + + #on("b")#PROC fetchall (TASK CONST manager)#off("b")# + entspricht: fetch(ALL manager, manager) + +#page# +'save' + #on("b")#PROC save (TEXT CONST dateiname, TASK CONST manager) #off("b")# + Kopiert die Datei 'dateiname' in die Task 'manager' + + + #on("b")#PROC save (THESAURUS CONST th, TASK CONST manager) #off("b")# + Kopiert alle Dateien, deren Namen im Thesaurus th enthalten sind, in die Task + 'manager'. + +____________________________________________________________________________ + + gib kommando : + save(all, (12/"PUBLIC")) + +____________________________________________________________________________ + + + Mit diesem Kommando werden (in einem EUMEL Netz) alle Dateien der eigenen + Task in die Task 'PUBLIC' des Rechners mit der Stationsnummer 12 in diesem + Netz kopiert. + +____________________________________________________________________________ + + gib kommando : + save(SOME myself, manager) + +____________________________________________________________________________ + + + Bietet den eigenen Thesaurus an, nach Auswahl werden alle Dateien deren + Namen nicht gelöscht wurden, zur Task 'manager' kopiert. + + + #on("b")#PROC save (TEXT CONST dateiname) #off("b")# + Kopiert die Datei 'dateiname' in die Task 'father' + + + #on("b")#PROC save (THESAURUS CONST th) #off("b")# + Kopiert alle Dateien, deren Namen in 'th' enthalten sind, in die Task 'father'. + + + #on("b")#PROC save #off("b")# + Kopiert die zuletzt bearbeitete Datei in die Task 'father' + + + + +'saveall' + #on("b")#PROC saveall #off("b")# + entspricht: save (all, father) + + + #on("b")#PROC saveall (TASK CONST manager) #off("b")# + entspricht: save (ALL myself, manager) + +#page# +'erase' + #on("b")#PROC erase (TEXT CONST dateiname, TASK CONST manager) #off("b")# + Löscht die Datei 'dateiname' aus der Task 'manager' + + + #on("b")#PROC erase (THESAURUS CONST th, TASK CONST manager) #off("b")# + Löscht alle Dateien, deren Namen im Thesaurus th enthalten sind, aus der Task + 'manager'. + + + #on("b")#PROC erase (TEXT CONST dateiname) #off("b")# + Löscht die Datei 'dateiname' aus der Task 'father' + + + #on("b")#PROC erase (THESAURUS CONST th) #off("b")# + Löscht alle Dateien, deren Namen in 'th' sind, aus der Task 'father' + + + #on("b")#PROC erase #off("b")# + Löscht die zuletzt bearbeitete Datei aus der Task 'father' + + +#page# +'print' + Das Kommando 'print' beinhaltet den Auftrag an die Task 'PRINTER' die enthal­ + tene(n) Datei(en) auszudrucken. + + Voraussetzung ist natürlich, daß die Druckersoftware ordnungsgemäß benutzt + wurde, um 'PRINTER' einzurichten. Siehe dazu Systemhandbuch Teil 6. + + + #on("b")#PROC print (TEXT CONST dateiname) #off("b")# + Kopiert die Datei 'dateiname' in die Task 'PRINTER'. + + + #on("b")#PROC print (THESAURUS CONST th) #off("b")# + Kopiert alle Dateien, deren Namen im Thesaurus 'th' enthalten sind, in die Task + 'PRINTER'. + + + #on("b")#PROC print #off("b")# + Kopiert die zuletzt bearbeitete Datei in die Task 'PRINTER'. + + +#page# + +4.2.7 Passwortschutz + +Der Passwortschutz im EUMEL-System ist in verschiedener Ausprägung möglich. +Einfachste Möglichkeit ist der Schutz einer Task durch ein Passwort. Falls diese Task +nicht Manager ist, können alle Daten und Programme, die nur in dieser Task zur +Verfügung stehen, auch nur vom Besitzer der Task benutzt werden. + +Ähnlich kann auch von einer Manager-Task aus der gesamte Zweig unterhalb dieser +Task mit einem Passwort geschützt werden: beispielsweise kann es empfehlenswert +sein, den Systemzweig komplett zu schützen, indem in SYSUR ein entsprechendes +Passwort vereinbart wird. + +Ein Umgehen des Passwortschutzes bei Manager-Tasks (durch Einrichten einer +Sohn-Task und 'fetchall') wird durch ein 'begin password' verhindert. + +Auch einzelne Dateien lassen sich schützen, indem Lese/Schreibpasswörter für den +Dateitransfer vereinbart werden. + +Generell gilt für die Verwendung von Passworten: + +- Passworte, die zu naheliegend gewählt sind (Vorname des Lebenspartners o.ä.) + sind meistens sinnlos, falls wirklich Datenschutz bezweckt ist. + +- Passworte, die so raffiniert sind, daß sogar ihr Schöpfer sie vergißt, führen zu + 100%igem Datenverlust, da die betroffene Task oder Datei nur noch gelöscht + werden kann. + +- Die Vereinbarung von "-" als Passwort bewirkt, daß die entsprechende Aktion + nicht mehr durchgeführt werden kann. Wird z.B. '-' als 'task password' + eingegeben, so kann die Task nie wieder an ein Terminal gekoppelt werden. + +- Passwörter können geändert werden, indem das entsprechende Kommando noch + einmal mit dem neuen Passwort gegeben wird. + +#page# +'begin password' + + #on("b")#PROC begin password (TEXT CONST passwort) #off("b")# + + Auf Supervisor-Ebene wird vor Einrichten einer neuen Task als Sohn der Task in + der das 'begin password' gegeben wurde, dieses erfragt. + + Das Password vererbt sich auf die hinzukommenden Sohn-Tasks. + +____________________________________________________________________________ + + #on("b")#SYSUR#off("b")# + maintenance : + begin password ("alles dicht") + +____________________________________________________________________________ + + +bewirkt: + +____________________________________________________________________________ + + Terminal 2 + + + EUMEL Version 1.8.1/M + + + gib supervisor kommando: + begin ("sabotage","SYSUR") + Passwort: + + + ESC ? --> help + ESC b --> begin("") ESC h --> halt + ESC c --> continue("") ESC s --> storage info + ESC q --> break ESC t --> task info + + +____________________________________________________________________________ + + +#page# +'enter password' + #on("b")#PROC enter password (TEXT CONST datei, schreibpass, lesepass) + #off("b")# + Hiermit können ausgewählte Dateien einer Manager-Task geschützt werden. Die + angegebene Datei wird mit Schreib- und Lesepassword versehen. Die Pass­ + wörter werden in der eigenen Task nicht berücksichtigt. + + Bei einem lesenden Zugriff (fetch) von irgendeiner Task aus auf die entsprechende + Datei in der Manager-Task muß das Lesepasswort, bei schreibendem Zugriff + (save/erase) das Schreibpasswort vereinbart sein. + + +____________________________________________________________________________ + + maintenance : + enter password ("wichtige datei","sicher","heit") + +____________________________________________________________________________ + + + + + #on("b")#PROC enter password (TEXT CONST password) #off("b")# + Passwort für den Dateitransfer einstellen. Falls zwei verschiedene Passwörter für + Lesen und Schreiben vereinbart werden sollen, so sind sie als ein Text durch "/" + getrennt einzugeben. + +____________________________________________________________________________ + + gib kommando : + enter password ("sicher/heit") + + gib kommando : + save(SOME all) + +____________________________________________________________________________ +#page# +'family password' + #on("b")#PROC family password (TEXT CONST geheim) #off("b")# + Einstellen eines Passworts für den Zweig des Systems , der unterhalb der (Mana­ + ger) Task liegt, in der das 'family password' eingegeben wurde. Dabei erhalten + alle Tasks, die kein Password oder dasselbe wie diese Manager-Task haben, das + 'family password'. Tasks in dem Zweig, die ein eigenes anderes besitzen, behal­ + ten dieses. + +____________________________________________________________________________ + + PUBLIC + + Task1 "" + + Task2 family password("fingerweg") + Task21 geheim + Task22 "" + + Task3 "" + Task31 "" + +____________________________________________________________________________ + + + + +bewirkt: + +____________________________________________________________________________ + PUBLIC + + Task1 "" + + Task2 fingerweg + Task21 geheim + Task22 fingerweg + + Task3 "" + Task31 "" + +____________________________________________________________________________ + + +#page# + +'task password' + + #on("b")#PROC task password (TEXT CONST geheim) #off("b")# + Einstellen eines Passworts für die Task in der es gegeben wird. Ist eine Task mit + einem Passwort geschützt, so wird durch den Supervisor nach dem 'continue'- + Kommando das Passwort angefragt (Entsprechend dem 'begin password'). Nur + nach Eingabe des richtigen Passworts gelangt man in die gewünschte Task. Das + Passwort kann durch nochmaligen Aufruf von 'task password' geändert werden, + z.B. wenn es in regelmäßigen Abständen geändert werden muß, um personenbe­ + zogene Daten zu schützen. + +#page# + +4.2.8 Das Archiv + +Mit dem Terminus 'Archiv' wird beim EUMEL-System ein Diskettenlaufwerk bezeich­ +net, das nur Datensicherungsaufgaben dient. Falls ein Rechner eins von zwei vorhan­ +denen Diskettenlaufwerk als Arbeitsspeicher benutzt, so wird dieses als Hintergrund +bezeichnet. Falls Sie einen derartigen Rechner benutzen, können Sie der Installa­ +tionsanleitung entnehmen, welches Laufwerk welcher Aufgabe zugeordnet ist. + +Das #ib#Archiv#ie# übernimmt im EUMEL-System die Verwaltung der langfristigen Daten­ +haltung. Das Archiv sollen Sie benutzen, um: + +- Sicherungskopien wichtiger Dateien außerhalb des Rechners zu besitzen; + +- nicht benötigte Dateien außerhalb einer Task zu halten (Speicherplatzersparnis!); + +- Dateien auf andere Rechner zu übertragen. + +Das Archiv wird im EUMEL-System durch die Task 'ARCHIVE', die das Disketten­ +laufwerk des Rechners verwaltet, realisiert. + +- reservieren : archive + +- freigeben : release + +- löschen : clear , format + +- prüfen : check + +#page# +'archive' + #on("b")#PROC archive (TEXT CONST archivname) #off("b")# + Reservierung der Task ARCHIVE für den exklusiven Dialog mit der aufrufenden + Task. 'archivname' wird bei allen folgenden Archivoperationen mit dem der Disket­ + te zugewiesenen (und hoffentlich auf dem Aufkleber vermerkten) Namen abgegli­ + chen. + + + +'release' + #on("b")#PROC release (TASK CONST archive) #off("b")# + Nach diesem Kommando kann die Task 'ARCHIVE' mit ihren Leistungen von einer + anderen Task in Anspruch genommen werden. Falls dieses Kommando nicht + gegeben wird, aber seit 5 Minuten kein Dialog mit 'archive' stattfand, kann eine + andere Task durch die Anforderung 'archive("diskettenname")' das Archiv reser­ + vieren. Durch diese Maßnahme wird verhindert, daß ein vergeßlicher Benutzer bei + einem System mit mehreren Benutzern das Archiv blockiert. + +#page# + +'clear' + #on("b")#PROC clear (TASK CONST archive) #off("b")# + Löschen des Disketten-Inhaltsverzeichnisses und Zuweisung des in der Reservie­ + rung eingegebenen Namens. + +____________________________________________________________________________ + + gib kommando : + archive("name"); #ib#clear#ie# (archive) + +____________________________________________________________________________ + + + Durch die Ausführung des Kommandos erhält die eingelegte Diskette den in der + Reservierung angegebenen Namen. #on("b")#Das Inhaltsverzeichnis, das sich auf der + Diskette befindet, wird gelöscht. Damit sind die Daten, die sich eventuell auf + dieser Diskette befanden, nicht mehr auffindbar#off("b")#. Die Diskette entspricht einer neu + formatierten Diskette#u#1)#e#. + + Man kann also eine beschriebene Diskette nicht umbenennen, ohne die darauf + befindlichen Daten zu löschen. + + #foot# + + #u#1)#e# Das Kommando 'format' enthält implizit 'clear'. +#end# + + Eine Neuformatierung ist demnach bei Wiederverwendung der Diskette nicht + notwendig. + +#page# +'format' + #on("b")#PROC format (TASK CONST archive) #off("b")# + Formatieren einer Diskette. Vor der erstmaligen Benutzung einer Archivdiskette + muß diese formatiert, d.h. in Spuren und Sektoren für die Positionierung des + Schreib-/Lesekopfes des Diskettenlaufwerks eingeteilt werden, um überhaupt ein + Beschreiben der Diskette zu ermöglichen. Die Einteilung ist geräteabhängig, häufi­ + ge Formate sind: + + 40 Spuren zu je 9 Sektoren (360 K) + 80 Spuren zu je 9 Sektoren (720 K). + + Die #on("b")#Erst#off("b")#benutzung einer #ib#Archivdiskette#ie# erfordert nach der Reservierung des Ar­ + chivs das Kommando: + +____________________________________________________________________________ + + gib kommando : + archive("diskname"); + + gib kommando : + format (archive); + +____________________________________________________________________________ + + +Erst nach einer Kontrollabfrage: + +____________________________________________________________________________ + + gib kommando: + format (archive) + + Archiv "diskname" formatieren ? (j/n) + +____________________________________________________________________________ + + + + wird tatsächlich formatiert und die Diskette steht mit dem Namen "diskname" für + Archivoperationen zur Verfügung. + +#page# + + #on("b")#PROC format (INT CONST code, TASK CONST archive) #off("b")# + Bei einigen Rechnern ist es möglich, die Formatierung zu variieren. Falls beim + Formatieren auf einem solchen Rechner ein anderes als das Standardformat + erzeugt werden soll, so ist die Codierung des gewünschten Formats mitanzuge­ + ben. + + + Beispiel: Für ein Gerät mit 5,25 Zoll Disketten wäre z.B. einstellbar: + code 0 : Standardformat + code 1 : 2D , 40 Spuren , 9 Sektoren + code 2 : 2D , 80 Spuren , 9 Sektoren + code 3 : HD , 80 Spuren ,15 Sektoren + + 'format (archive)' erzeugt ebenso wie 'format (0,archive)' eine + standardformatierte Diskette, 'format (3,archive)' erzeugt eine High + Density Formatierung (HD Floppy benutzen!). + +#on("b")# + ACHTUNG: Wird eine bereits beschriebene Diskette noch einmal formatiert, so + sind alle Daten, die auf der Diskette waren, verloren. + + Die Umformatierung einer Diskette (z.B. von 720K auf 360K) auf + unterschiedlichen Laufwerken kann zu Problemen führen. +#off("b")# +#page# +'check' + #on("b")#PROC check (TEXT CONST dateiname, TASK CONST task) #off("b")# + Überprüft, ob die Datei 'dateiname' auf dem Archiv lesbar ist. + + + #on("b")#PROC check (THESAURUS CONST t, TASK CONST task) #off("b")# + Überprüft, ob die in dem Thesaurus 't' enthaltenen Dateien auf dem Archiv lesbar + sind. + + + Mit diesem Kommando kann nach dem Beschreiben einer Diskette überprüft wer­ + den, ob die Datei(en) lesbar sind. Hierdurch können also verschmutzte oder + beschädigte Disketten erkannt werden. + + +____________________________________________________________________________ + + gib kommando : + save (all , archive) + + gib kommando : + check (ALL archive, archive) + +____________________________________________________________________________ + +#page# + +Beispiel: + + +____________________________________________________________________________ + + gib kommando : + archive ("neu") + + gib kommando : + format (archive) + +____________________________________________________________________________ + + +liefert zunächst die Kontollfrage: + +____________________________________________________________________________ + + gib kommando : + format (archive) + + Archiv "neu" formatieren ? (j/n) + +____________________________________________________________________________ + + +Nach Eingabe 'j' + +____________________________________________________________________________ + + gib kommando : + saveall (archive) + + gib kommando : + archive("alt") (* nächste Diskette *) + + gib kommando : + fetch(SOME archive ,archive) + +____________________________________________________________________________ + + +Der Thesaurus des Archivs wird angezeigt: +#page# +____________________________________________________________________________ + + .................alt (100 K belegt von 720 K)............... + + 01.02.87 25 K "handbuch teil 1" + 01.03.87 23 K "handbuch teil 2" + 01.04.87 20 K "handbuch teil 3" + 01.05.87 32 K "handbuch teil 4" + +____________________________________________________________________________ + + + + + +Zum Abschluß Archiv freigeben! +____________________________________________________________________________ + + gib kommando : + release(archive) + +____________________________________________________________________________ +#page# + +Fehlermeldungen des Archivs +Versucht man, eine Datei vom Archiv zu holen, kann es vorkommen, daß das Ar­ +chiv-System + +____________________________________________________________________________ + + gib kommando : + fetch ("datei", archive) + #ib#Lese-Fehler (Archiv)#ie# + +____________________________________________________________________________ + + + +meldet und den Lese-Vorgang abbricht. Dies kann auftreten, wenn die Floppy +beschädigt oder aus anderen Gründen nicht lesbar ist (z.B. nicht justierte Disket­ +ten-Geräte). In einem solchen Fall vermerkt das Archiv-System intern, daß die Datei +nicht korrekt gelesen werden kann. Das sieht man z.B. bei 'list (archive)'. Dort ist der +betreffende Datei-Name mit dem Zusatz 'mit Lese-Fehler' gekennzeichnet. Um +diese Datei trotzdem zu lesen, muß man sie unter ihrem Dateinamen mit dem Zusatz +'mit Lese-Fehler' lesen. + +____________________________________________________________________________ + + gib kommando: + fetch ("datei mit Lese-Fehler", archive) + +____________________________________________________________________________ + + + +Die Datei wird in diesem Fall trotz Lese-Fehler (Informationsverlust!) vom Archiv +gelesen. +#page# + +Weitere Fehlermeldungen des Archivs: + + +FEHLER : Lesen unmöglich (Archiv) + Die Archiv-Diskette ist nicht eingelegt oder die Tür des Laufwerks ist nicht + geschlossen. + => Diskette einlegen bzw. Tür schließen. + +FEHLER : Schreiben unmöglich (Archiv) + Die Diskette ist schreibgeschützt. + => falls wirklich gewünscht, Schreibschutz entfernen. + +FEHLER : Archiv nicht angemeldet + Das Archiv wurde nicht angemeldet + => 'archive ("name")' geben. + +FEHLER : Lese-Fehler (Archiv) + Siehe Lesen unmöglich + +FEHLER : Schreibfehler (Archiv) + Die Diskette kann nicht (mehr) beschrieben werden. + => Andere Diskette verwenden. + +FEHLER : Speicherengpass + Im System ist nicht mehr genügend Platz, um eine Datei vom Archiv zu + laden. + => ggf. Dateien löschen. + +FEHLER : RERUN bei Archiv-Zugriff Das System wurde bei einer Archiv-Operation + durch Ausschalten bzw. Reset unterbrochen. + +FEHLER : "dateiname" gibt es nicht + Die Datei "dateiname" gibt es nicht auf dem Archiv. + => mit 'list(archive)' Archiv prüfen. + +FEHLER : Archiv heißt ... + Die eingelegte Diskette hat einen anderen als den eingegebenen Archivna­ + men. + => Kommando 'archive' mit korrektem Namen geben. + +FEHLER : Archiv wird von Task ... benutzt + Das Archiv wurde von einem anderen Benutzer reserviert. + => Abwarten. + +FEHLER : "dateiname" kann nicht geschrieben werden (Archiv voll) + Die Datei ist zu groß für die eingelegte Diskette. + => Andere Diskette für diese Datei nehmen. + +FEHLER : Archiv inkonsistent + Die eingelegte Diskette hat nicht die Struktur einer Archiv-Diskette. + => 'format (archive)' vergessen. + +FEHLER : save/erase wegen Lese-Fehler verboten + Bei Archiven mit Lese-Fehler sind Schreiboperationen verboten, weil ein + Erfolg nicht garantiert werden kann. + diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.5 b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.5 new file mode 100644 index 0000000..a921572 --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.5 @@ -0,0 +1,1329 @@ +#pagenr("%",1)##setcount(1)##block##pageblock# +#headeven# +#center#EUMEL-Benutzerhandbuch +#center#____________________________________________________________ + +#end# +#headodd# +#center#TEIL 5 : Programmierung +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +5 - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#5 - % +#end# + +TEIL 5: Programmierung + + +5.1 Der ELAN-Compiler + +Der ELAN-Compiler des EUMEL-Systems dient zweierlei Aufgaben: zum einen der +Übersetzung von ELAN-Programmen, zum anderen der Verwaltung der taskeigenen +Modulbibliothek. + +Diese Moduln, in ELAN Pakete (siehe 2.4.3.4ff.) genannt, stellen als vorübersetzte, +und damit abrufbereite#u#1)#e# Prozeduren den Kommandovorrat einer Task dar. + +Der Codebereich einer Task liegt in ihrem Standarddatenraum (ds4). Die Größe dieses +Codebereiches beträgt 256K. Der Inhalt besteht zunächst aus den von der Vatertask +ererbten (durch Kopie des ds4 dieser Task) Moduln, im weiteren allen in dieser Task +neu hinzu insertierten Packeten. +#on("b")# + + +ACHTUNG: Durch ständiges Neuinsertieren eines Packets kann der + Codebereich der betroffenen Task zum Überlaufen + gebracht werden! + + +#foot# + +1) Die von anderen Systemen her gewohnten Phasen 'Binden' und 'Laden' sind + durch das EUMEL-ELAN-Compiler-Konzept unnötig. +#end# +Jedes Kommando im EUMEL-System ist der Aufruf einer, in der Schnittstelle eines +bereits insertierten Packetes stehenden, Prozedur. + +Kommandos für den ELAN-Compiler: + +- Übersetzen : do , insert , run , runagain + +- Protokollieren : check , checkon/off , + prot , protoff , warnings on/off + + +#page# +'do' + #on("b")#PROC do (TEXT CONST program)#off("b")# + Übersetzen und Ausführen von 'program' von einem Programm aus. 'program' + muß ein ausführbares ELAN Programm sein. + + +____________________________________________________________________________ + + ........................... Beispiel .......................... + PACKET reo DEFINES reorganize all: + + PROC reorganize all(THESAURUS CONST thes): + do (PROC (TEXT CONST) reorganize ,thes) + (* Die Prozedur 'reorganize' (siehe 5-52), die einen*) + (* Dateinamen als Parameter verlangt, wird auf alle *) + (* Dateien des Thesaurus 'thes' angewandt. *) + END PROC reorganize all; + END PACKET reo; + +____________________________________________________________________________ + + +'insert' + #on("b")#PROC insert (TEXT CONST dateiname) #off("b")# + Insertieren eines oder mehrerer PACKETs aus der Datei 'dateiname'. Der Pro­ + grammtext muß sich in #on("u")#einer#off("u")# Datei befinden. + + + #on("b")#PROC insert #off("b")# + Insertieren eines oder mehrerer PACKETs. Der Dateiname ist der zuletzt benutzte + Dateiname. + + + #on("b")#PROC insert (THESAURUS CONST t) #off("b")# + Insertieren aller PACKETs, die in den Dateien des Thesaurus 't' enthalten sind. + + +#page# +'run' + #on("b")#PROC run #off("b")# + Übersetzen und Ausführen eines ELAN-Programms. Der Programmtext muß sich + in einer Datei befinden. Der Dateiname ist der zuletzt benutzte Dateiname. + + + #on("b")#PROC run (TEXT CONST dateiname) #off("b")# + Wie oben. Der Programmtext wird aus der Datei mit dem Namen 'dateiname' + geholt. + + + +'runagain' + #on("b")#PROC runagain #off("b")# + Nochmaliges Ausführen des zuletzt mit 'run' übersetzten ELAN-Programms. + Wurde in der letzten Übersetzung ein Fehler gefunden, erfolgt die Meldung: + + FEHLER : "run again nicht möglich" + +#page# +'check' + #on("b")#BOOL PROC check #off("b")# + Informationsprozedur, die TRUE liefert, wenn 'check' eingeschaltet ist. + + #on("b")#PROC check on #off("b")# + Einschalten der Generierung von Zeilennummern durch den ELAN-Compiler. Der + bei der Übersetzung erzeugte Code wird ca. 25% umfangreicher! + Voreinstellung im 'PUBLIC'- Zweig: 'check on'. + + #on("b")#PROC check off #off("b")# + Ausschalten der Generierung von Zeilennummern durch den ELAN-Compiler. + Voreinstellung im 'SYSUR' - Zweig: 'check off. + + +'prot' + #on("b")#BOOL PROC prot #off("b")# + Informationsprozedur, die TRUE liefert, gdw. 'prot' eingeschaltet ist. + + #on("b")#PROC prot (TEXT CONST dateiname) #off("b")# + Einschalten des Compilerlistings auf dem Bildschirm. Das Listing wird gleichzeitig + in die Datei 'dateiname' geschrieben. + + #on("b")#PROC prot off #off("b")# + Ausschalten des Listings. + + +'warnings' + #on("b")#BOOL PROC warnings #off("b")# + Informationsprozedur, die TRUE liefert gdw. 'warnings' eingeschaltet ist. + + #on("b")#PROC warnings on #off("b")# + Warnungen werden wie Fehlermeldungen ins Notizbuch ausgegeben. + + #on("b")#PROC warnings off#off("b")# + Warnungen werden nicht mit in das Notizbuch ausgegeben. +#page# + +5.1.1 Fehlermeldungen des ELAN-Compilers +erfolgen stets in der Form: + +#ib#COMPILER ERROR#ie#: + +wobei folgende Werte annehmen kann: + +#on("bold")# Bedeutung und eventuelle Abhilfe#off ("bold")#: + + 101 Überlauf der Namenstabelle + Die Anzahl der Namen aller sichtbaren Pakete ist zu groß oder es wurden + die Anführungstriche eines TEXT-Denoters vergessen. + => Keine Abhilfe. + + 102 Überlauf der Symboltabelle + Die Anzahl der deklarierten Objekte ist zu groß. + => Programm in Pakete unterteilen. + + 103 Überlauf des Zwischencodebereiches + => Programm in Pakete unterteilen. + + 104 Überlauf der Permanenttabelle + Zu viele Pakete insertiert. + => Keine (neue Task beginnen). + + 106 Paketdatenadresse zu groß + Im Paket wird zuviel Platz ( > 64K ) von globalen Datenobjekten und + Denotern eingenommen. + => Keine Abhilfe. + + 107 Lokale Datenadresse zu groß + Im Paket wird zuviel Platz ( > 32K ) von lokalen Datenobjekten belegt. + => Keine Abhilfe. + #page# + 204 Überlauf des Compilerstack + => Keine Abhilfe. + + 301 Modulnummern-Überlauf + Zu viele sichtbare Pakete, Prozeduren und Operatoren ( > 2048 ). + => Keine Abhilfe. + + 303 + siehe 304 + + 304 Zu viele Ansprungadressen + In dem gerade übersetzten Modul (Prozedur, Operator oder Paketrumpf) + werden vom Compiler zu viele Marken benötigt (mehr als 2000). Marken + werden z.B. für die Codegenerierung von Auswahl (IF ...) und Wieder­ + holung (REP ...) gebraucht. Insbesondere bei SELECT-Anweisungen + werden 'casemax - casemin + 2' Marken benötigt, wobei 'casemax' der + INT-Wert des maximalen, 'casemin' der des minimalen CASE-Wertes + ist. Dieser Fehler ist somit fast immer auf zu viele und/oder zu weit ge­ + spannte SELECT-Anweisungen zurückzuführen. + => SELECT-Anweisungen über mehrere Prozeduren verteilen oder + Spannweiten verringern. + + 305 Codeüberlauf + Der insgesamt erzeugte sichtbare Code ist zu umfangreich ( > 256K ). + => Keine Abhilfe. + + 306 Paketdatenadresse zu groß + Insgesamt zu viele Datenobjekte in den Paketen ( > 128K ). + => Keine Abhilfe. + + 307 Temporäre Datenadresse zu groß + Zu viele (lokale) Datenobjekte in einer Prozedur ( > 32K ). + => Prozedur in mehrere unterteilen, so daß die Datenobjekte sich über + mehrere Prozeduren verteilen. + + 308 Modulcode-Überlauf + Ein Modul (Prozedur, Operator oder Paket-Initialisierungsteil) ist zu groß + ( > 7.5 KB Code). + => In mehrere Prozeduren oder Pakete zerlegen. + + 309 Zuviele Paketdaten + (Insgesamt mehr als 128K Paketdaten) + => Keine Abhilfe + + +#page# + +5.2 Standardtypen + + +5.2.1 Bool + +Der Wertebereich für Datenobjekte vom Typ BOOL besteht aus den Werten TRUE +und FALSE. + +'AND' + #on("b")#BOOL OP AND (BOOL CONST a, b) #off("b")# + Logisches UND, liefert TRUE gdw. a und b TRUE sind. + + +'CAND' + #on("b")#BOOL OP CAND #off("b")# + Bedingtes logisches UND, entspricht: 'IF a THEN b ELSE false FI'. Der zweite + Operand wird nicht ausgewertet, falls er für das Ergebnis nicht relevant ist. + + +'COR' + #on("b")#BOOL OP COR #off("b")# + Bedingtes logisches ODER, entspricht: 'IF a THEN true ELSE b FI'. Der zweite + Operand wird nicht ausgewertet, falls er für das Ergebnis nicht relevant ist. + + +'false' + #on("b")#BOOL CONST false #off("b")# + + +'NOT' + #on("b")#BOOL OP NOT (BOOL CONST a) #off("b")# + Logische Negation. + + +'OR' + #on("b")#BOOL OP OR (BOOL CONST a, b) #off("b")# + Logisches ODER, liefert TRUE gdw. a und/oder b TRUE ist. + + +'true' + #on("b")#BOOL CONST true #off("b")# + + +'XOR' + #on("b")#BOOL OP XOR (BOOL CONST a, b) #off("b")# + Exklusives ODER, liefert TRUE gdw. entweder a oder b TRUE ist. + +#page# + +5.2.2 Integer-Arithmetik + +Ein Datenobjekt vom Typ INT belegt im Speicher 2 Bytes. Zulässige INT - Werte +sind die ganzen Zahlen von -32768 bis +32767 einschließlich. + +Falls größere ganze Zahlen benötigt werden, muß das Packet 'LONGINT', welches +sich auf dem Archive 'std.zusatz' befindet, nachinsertiert werden (siehe 6.1.2). + +Operationen für Integers: + +- Vergleich : = , <> , < , <= , > , >= + +- Verknüpfung : + , - , * , ** , DECR , DIV , INCR + +- Sonstiges : abs , ABS , initialize random , max , maxint , min , + minint , MOD , random , sign , SIGN , text +#page# +':=' + #on("b")#INT OP := (INT VAR a, INT CONST b) #off("b")# + Zuweisung. + + +'=' + #on("b")#BOOL OP = (INT CONST a, b) #off("b")# + Vergleich. + + +'<>' + #on("b")#BOOL OP <> (INT CONST a, b) #off("b")# + Vergleich auf Ungleichheit. + + +'<' + #on("b")#BOOL OP < (INT CONST a, b) #off("b")# + Vergleich auf kleiner. + + +'<=' + #on("b")#BOOL OP <= (INT CONST a, b) #off("b")# + Vergleich auf kleiner gleich. + + +'>' + #on("b")#BOOL OP > (INT CONST a, b) #off("b")# + Vergleich auf größer. + + +'>=' + #on("b")#BOOL OP >= (INT CONST a, b) #off("b")# + Vergleich auf größer gleich. + +#page# +'+' + #on("b")#INT OP + (INT CONST a) #off("b")# + Monadischer Operator (Vorzeichen, ohne Wirkung). + + #on("b")#INT OP + (INT CONST a, b) #off("b")# + Addition. + + +'-' + #on("b")#INT OP - (INT CONST a) #off("b")# + Vorzeichen-Umkehrung. + + + #on("b")#INT OP - (INT CONST a, b) #off("b")# + Subtraktion. + + +'*' + #on("b")#INT OP * (INT CONST a, b) #off("b")# + Multiplikation. + + +'**' + #on("b")#INT OP ** (INT CONST arg, exp) #off("b")# + Exponentiation mit 'exp' >= 0 + + +'DECR' + #on("b")#OP DECR (INT VAR links, INT CONST rechts) #off("b")# + Wirkt wie links := links - rechts + + +'DIV' + #on("b")#INT OP DIV (INT CONST a, b) #off("b")# + INT-Division. + + FEHLER : + - DIV durch 0 + + +'INCR' + #on("b")#OP INCR (INT VAR links, INT CONST rechts) #off("b")# + Wirkt wie links := links + rechts + +#page# +'abs' + #on("b")#INT PROC abs (INT CONST argument) #off("b")# + Absolutbetrag eines INT-Wertes. + + + #on("b")#INT OP ABS (INT CONST argument) #off("b")# + Absolutbetrag eines INT-Wertes. + + +'initialize random' + #on("b")#PROC initialize random (INT CONST wert) #off("b")# + Initialisieren der 'random'-Prozedur, um nicht reproduzierbare Zufallszahlen zu + bekommen. Diese 'initialize random'-Prozedur gilt für den "INT-Random Gene­ + rator". + + +'max' + #on("b")#INT PROC max (INT CONST links, rechts) #off("b")# + Liefert den Größten der beiden INT-Werte. + + +'maxint' + #on("b")#INT CONST maxint #off("b")# + Größter INT-Wert im EUMEL-System (32 767). + + +'min' + #on("b")#INT PROC min (INT CONST links, rechts) #off("b")# + Liefert den Kleinsten der beiden INT-Werte. + + + min ( 3.0, 2.0) ==> 2.0 + min (-2.0, 3.0) ==> -2.0 + + + +'minint' + #on("b")#INT CONST minint #off("b")# + Kleinster INT-Wert im EUMEL-System (-32768). + + +'MOD' + #on("b")#INT OP MOD (INT CONST links, rechts) #off("b")# + Liefert den Rest einer INT-Division. + + + 3 MOD 2 ==> 1 + -3 MOD 2 ==> 1 + + + FEHLER : + - DIV durch 0 + + +'random' + #on("b")#INT PROC random (INT CONST lower bound, upper bound) #off("b")# + Pseudo-Zufallszahlen-Generator im Intervall 'upper bound' und 'lower bound' + einschließlich. Es handelt sich hier um den "INT Random Generator". + + +'real' + #on("b")#REAL PROC real (INT CONST a) #off("b")# + Konvertierungsprozedur. + +#page# +'sign' + #on("b")#INT PROC sign (INT CONST argument) #off("b")# + Feststellen des Vorzeichens eines INT-Wertes. Folgende Werte werden geliefert: + + + argument > 0 ==> 1 + argument = 0 ==> 0 + argument < 0 ==> -1 + + + + #on("b")#INT OP SIGN (INT CONST argument) #off("b")# + Feststellen des Vorzeichens eines INT-Wertes. + + +'text' + #on("b")#TEXT PROC text (INT CONST zahl) #off("b")# + Konvertierung des INT Wertes 'zahl' in den kürzest möglichen Text. Das Vorzei­ + chen bleibt erhalten. + + #on("b")#TEXT PROC text (INT CONST zahl, länge) #off("b")# + Konvertierung des INT Wertes 'zahl' in einen Text der Länge 'länge'. Das + Vorzeichen bleibt erhalten. Falls der Text kürzer als 'länge' ist, wird er links + (vorne) mit Leerzeichen aufgefüllt, falls er länder ist wird 'länge' mal "*" + ausgegeben. + +____________________________________________________________________________ + + out ("X:"); out(text(12345,7)) ; line; + out ("Y:"); out(text(12345,3)) ; + (* ergibt *) + X: 12345 + Y:*** + +____________________________________________________________________________ +#page# + +5.2.3 Real-Arithmetik + +Für den Datentyp REAL gibt es außer den üblichen Verknüpfungs- und Vergleichs­ +operationen noch eine Anzahl mathematischer Prozeduren und Operationen. Teilweise +stehen diese in mehr als einer Version zur Verfügung. + +Jedes Datenobjekt vom Typ REAL belegt im Speicher 8 Byte. + +REALs haben eine 13-stellige #ib#Mantisse#ie#, die im Rechner dezimal geführt wird. (Das +heißt, bei Konversionen zwischen interner und TEXT-Darstellung treten keine Run­ +dungsfehler auf.) Der Wertebereich wird durch folgende Eckwerte abgegrenzt: +#dpos(0.5,".")##lpos(4.5)# + +#table# + 9.999999999999e+126 größter REAL-Wert + 0.000000000001 kleinster positiver REAL-Wert mit x + 1.0 > 1.0 + 9.999999999999e-126 kleinster positiver REAL-Wert > 0.0 + -9.999999999999e-126 größter negativer REAL-Wert + -9.999999999999e+126 kleinster REAL-Wert + +#clearpos# +#tableend# + +- Vergleiche : = , <> , < , <= , > , >= + +- Verknüpfungen : + , - , * , / , ** , DECR , INCR + +- Diverse : abs , arctan , arctand , cos , cosd , decimal + exponent , e , exp , floor , frac , initialize + random , int , ln , log2 , log10 , max , + maxreal , min , MOD , pi , random , round , + sign , SIGN , sin , sind , smallreal , sqrt , + tan , tand , text + +#page# +':=' + #on("b")#REAL OP := (REAL VAR a, REAL CONST b) #off("b")# + Zuweisung. + + +'=' + #on("b")#BOOL OP = (REAL CONST a, b) #off("b")# + Vergleich. + + +'<>' + #on("b")#BOOL OP <> (REAL CONST a, b) #off("b")# + Vergleich auf Ungleichheit. + + +'<' + #on("b")#BOOL OP < (REAL CONST a, b) #off("b")# + Vergleich auf kleiner. + + +'<=' + #on("b")#BOOL OP <= (REAL CONST a, b) #off("b")# + Vergleich auf kleiner gleich. + + +'>' + #on("b")#BOOL OP > (REAL CONST a, b) #off("b")# + Vergleich auf größer. + + +'>=' + #on("b")#BOOL OP >= (REAL CONST a, b) #off("b")# + Vergleich auf größer gleich. + +#page# +'+' + #on("b")#REAL OP + (REAL CONST a) #off("b")# + Monadischer Operator (Vorzeichen, ohne Wirkung). + + + #on("b")#REAL OP + (REAL CONST a, b) #off("b")# + Addition. + + +'-' + #on("b")#REAL OP - (REAL CONST a) #off("b")# + Vorzeichen-Umkehrung. + + + #on("b")#REAL OP - (REAL CONST a, b) #off("b")# + Subtraktion. + + +'*' + #on("b")#REAL OP * (REAL CONST a, b) #off("b")# + Multiplikation. + + +'/' + #on("b")#REAL OP / (REAL CONST a, b) #off("b")# + Division. + + FEHLER : + - Division durch 0 + + +'**' + #on("b")#REAL OP ** (REAL CONST arg, exp) #off("b")# + Exponentiation. + + #on("b")#REAL OP ** (REAL CONST arg, INT CONST exp) #off("b")# + Exponentiation. + + +'DECR' + #on("b")#OP DECR (REAL VAR links, REAL CONST rechts) #off("b")# + Wirkt wie links := links - rechts + + +'INCR' + #on("b")#OP INCR (REAL VAR links, REAL CONST rechts) #off("b")# + Wirkt wie links := links + rechts + +#page# +'abs' + #on("b")#REAL PROC abs (REAL CONST wert) #off("b")# + Absolutbetrag eines REAL-Wertes. + + #on("b")#REAL OP ABS (REAL CONST wert) #off("b")# + Absolutbetrag eines REAL-Wertes. + + +'arctan' + #on("b")#REAL PROC arctan (REAL CONST x) #off("b")# + Arcus Tangens-Funktion. Liefert einen Wert in Radiant. + + +'arctand' + #on("b")#REAL PROC arctand (REAL CONST x) #off("b")# + Arcus Tangens-Funktion. Liefert einen Wert in Grad. + + +'cos' + #on("b")#REAL PROC cos (REAL CONST x) #off("b")# + Cosinus-Funktion. 'x' muß in Radiant angegeben werden. + + +'cosd' + #on("b")#REAL PROC cosd (REAL CONST x) #off("b")# + Cosinus-Funktion. 'x' muß in Winkelgrad angegeben werden. + + +'decimal exponent' + #on("b")#INT PROC decimal exponent (REAL CONST mantisse) #off("b")# + Liefert aus einem REAL-Wert den dezimalen Exponenten als INT-Wert. + + +'e' + #on("b")#REAL PROC e #off("b")# + Eulersche Zahl (2.718282). + + +'exp' + #on("b")#REAL PROC exp (REAL CONST z) #off("b")# + Exponentialfunktion. + + +'floor' + #on("b")#REAL PROC floor (REAL CONST real) #off("b")# + Schneidet die Nachkommastellen des REAL-Wertes 'real' ab. + + +'frac' + #on("b")#REAL PROC frac (REAL CONST z) #off("b")# + Liefert die Stellen eines REAL-Wertes hinter dem Dezimalpunkt. + + +'initialize random' + #on("b")#PROC initialize random (REAL CONST z) #off("b")# + Initialisieren der 'random'-Prozedur mit verschiedenen Werten für 'z', um nicht + reproduzierbare Zufallszahlen zu bekommen. Diese Prozedur gilt für den + 'REAL-Random Generator'. + + +'int' + #on("b")#INT PROC int (REAL CONST a) #off("b")# + Konvertierungsprozedur. Die Nachkommastellen werden abgeschnitten. + Bsp: int (3.9) => 3 + + +'ln' + #on("b")#REAL PROC ln (REAL CONST x) #off("b")# + Natürlicher Logarithmus. + + FEHLER : + - ln mit negativer Zahl + Nur echt positive Argumente sind zulässig. + + +'log2' + #on("b")#REAL PROC log2 (REAL CONST z) #off("b")# + Logarithmus zur Basis 2. + + FEHLER : + - log2 mit negativer zahl + Nur echt positive Argumente sind zulässig. + + +'log10' + #on("b")#REAL PROC log10 (REAL CONST x) #off("b")# + Logarithmus zur Basis 10. + + FEHLER : + - log10 mit negativer zahl + Nur echt positive Argumente sind zulässig. + + +'max' + #on("b")#REAL PROC max (REAL CONST links, rechts) #off("b")# + Liefert den Größten der beiden REAL-Werte. + + +'maxreal' + #on("b")#REAL CONST maxreal #off("b")# + Größter REAL-Wert im EUMEL-System (9.999999999999e126). + + +'min' + #on("b")#REAL PROC min (REAL CONST links, rechts) #off("b")# + Liefert den Kleinsten der beiden REAL-Werte. + + +'MOD' + #on("b")#REAL OP MOD (REAL CONST links, rechts) #off("b")# + Modulo-Funktion für REALs (liefert den Rest). Beispiele: + + + 5.0 MOD 2.0 ==> 1.0 + 4.5 MOD 4.0 ==> 0.5 + + + +'pi' + #on("b")#REAL CONST pi #off("b")# + Die Zahl pi (3.141593). + + +'random' + #on("b")#REAL PROC random #off("b")# + Pseudo-Zufallszahlen-Generator im Intervall 0 und 1. Es handelt sich hier um + den "REAL Random Generator". + + +'round' + #on("b")#REAL PROC round (REAL CONST real, INT CONST digits) #off("b")# + Runden eines REAL-Wertes auf 'digits' Stellen. Für positive Werte wird auf + Nachkommastellen gerundet. Beispiel: + + + round (3.14159, 3) + + + liefert '3.142'. Für negative 'digits'-Werte wird auf Vorkommastellen gerundet. + + + round (123.456, -2) + + + liefert '100.0'. Abweichung vom Standard: Es wird mit 'digits'-Ziffern gerundet. + + +'sign' + #on("b")#INT PROC sign (REAL CONST argument) #off("b")# + Feststellen des Vorzeichens eines REAL-Wertes. + + #on("b")#INT OP SIGN (REAL CONST argument) #off("b")# + Feststellen des Vorzeichens eines REAL-Wertes. + + +'sin' + #on("b")#REAL PROC sin (REAL CONST x) #off("b")# + Sinus-Funktion. 'x' muß in Radiant (Bogenmaß) angegeben werden. + + +'sind' + #on("b")#REAL PROC sind (REAL CONST x) #off("b")# + Sinus-Funktion. 'x' muß im Winkelgrad angegeben werden. + + +'smallreal' + #on("b")#REAL PROC smallreal #off("b")# + Kleinster darstellbarer REAL-Wert im EUMEL-System für den + + + 1.0 - smallreal <> 1.0 + 1.0 + smallreal <> 1.0 + + + gilt (1.0E-12). + + +'sqrt' + #on("b")#REAL PROC sqrt (REAL CONST z) #off("b")# + Wurzel-Funktion. + + FEHLER : + - sqrt von negativer Zahl + Das Argument muß größer gleich 0.0 sein. + + +'tan' + #on("b")#REAL PROC tan (REAL CONST x) #off("b")# + Tangens-Funktion. 'x' muß in Radiant angegeben werden. + + +'tand' + #on("b")#REAL PROC tand (REAL CONST x) #off("b")# + Tangens-Funktion. 'x' muß in Winkelgrad angegeben werden. + + +'text' + #on("b")#TEXT PROC text (REAL CONST real) #off("b")# + Konvertierung eines REAL-Wertes in einen TEXT. Ggf. wird der TEXT in Expo­ + nenten-Darstellung geliefert. + + #on("b")#TEXT PROC text (REAL CONST real, laenge) #off("b")# + Konvertierung eines REAL-Wertes in einen TEXT. Der TEXT wird in Exponen­ + ten-Darstellung geliefert. Um diese Darstellung zu ermöglichen ist der Wert + 'laenge' größer oder gleich 8 anzugeben. + + #on("b")#TEXT PROC text (REAL CONST real, INT CONST laenge, fracs)#off("b")# + Konvertierung eines REAL-Wertes in einen TEXT. Dabei gibt 'laenge' die Länge + des Resultats einschließlich des Dezimalpunktes und 'fracs' die Anzahl der Dezi­ + malstellen an. Kann der REAL-Wert nicht wie gewünscht dargestellt werden, wird + + + laenge * "*" + + + geliefert. + +#page# + +5.2.4 Text + +Jedes Datenobjekt vom Typ TEXT besteht aus einem festen Teil von 16 Bytes und +möglicherweise aus einem flexiblen Teil auf dem #on("i")##on("b")#Heap#off("i")##off("b")#. Im festen Teil werden Texte +bis zur Länge von 13 Zeichen untergebracht. Wenn eine TEXT-Variable einen Wert +mit mehr als 13 Zeichen Länge annimmt, werden alle Zeichen auf dem Heap unterge­ +bracht. Genauer ergibt sich folgendes Bild: + + kurzer Text (Länge <= 13): + + Heap-Link 2 Bytes + Textlänge 1 Byte + Text 13 Bytes + + langer Text (Länge > 13): + + Heap-Link 2 Bytes + 255 1 Byte + Länge 2 Bytes + ungenutzt 11 Bytes + +Wenn eine Variable einmal Platz auf dem Heap bekommen hat, behält sie diesen +vorbeugend auch dann, wenn sie wieder einen kurzen Text als Wert erhält. So muß +wahrscheinlich kein neuer Platz auf dem Heap zugewiesen werden, wenn sie wieder +länger wird. Das gilt allerdings nur bis zur nächsten #ib#Garbage Collection#ie# auf den +TEXT-Heap, denn dabei werden alle Heap-Container minimal gemacht bzw. ge­ +löscht, wenn sie nicht mehr benötigt werden. Der Platz auf dem Heap wird in Vielfa­ +chen von 16 Bytes vergeben. In Fremddatenräumen wird in jedem #ib#Container#ie# neben +dem eigentlichen Text auch die Containerlänge untergebracht. +#page# +Beispiele: TEXT-Länge Speicherbedarf (Byte) + + 0 16 + 13 16 + 14 32 + 15 48 + 30 48 + 31 64 + 46 64 + 47 80 + 62 80 + + +Die Heapgröße eines Fremddatenraums berechnet sich als: + + 1024 * 1024 = 1048056 - stat Bytes + +'stat' ist dabei die statische Größe der Datenstruktur, die dem Datenraum aufgeprägt +wurde. Bei einem BOUND ROW 1000 TEXT ergibt sich also eine Heapgröße von + + 1048056 - (1000 * 16) = 1032056 Bytes. + + + +'heap size' + #on("b")#INT PROC heap size #off("b")# + Informationsprozedur für die Größe (in KB) des TEXT-Heaps. + +#page# + +TEXT- Operationen: + +- Vergleich : = , <> , < , <= , > , >= + LEXEQUAL , LEXGREATER , + LEXGREATEREQUAL + +- Verkettung : + , * , CAT + +- Veränderung : change , change all , code , compress , delete + char , insert char , length , LENGTH , max + text length , pos , real , replace , SUB , + subtext , text +#page# + +Der EUMEL-Zeichensatz +#goalpage("codetab")# +Das EUMEL System definiert einen Zeichensatz, der gewährleistet, daß gleiche Text­ +zeichen auf allen Maschinen gleich codiert werden. + Die interne Darstellung wird durch die folgende EUMEL-Codetabelle +beschrieben. Der Zeichensatz beruht auf dem ASCII-Zeichensatz mit Erweiterungen. +Der in der Tabelle freie Bereich (z.B code(127) bis code(213)) ist nicht einheitlich +verfügbar und wird deshalb nicht beschrieben. Die Codierung bildet mithin auch +Grundlage für Vergleiche und Sortierungen. + +Die Korrekte Darstellung dieser Zeichen auf Bildschirm, Drucker etc. setzt natürlich +eine korrekte Konfiguration der Geräte voraus. Die Anpassung eines Geräts an diesen +Zeichensatz ist im EUMEL-Systemhandbuch in Teil 2 beschrieben. + + + I 0 1 2 3 4 5 6 7 8 9 +---+-------------------------------------- +3 I SP ! " \# $ % & ' + I +4 I ( ) * + , - . / 0 1 + I +5 I 2 3 4 5 6 7 8 9 : ; + I +6 I < = > ? § A B C D E + I +7 I F G H I J K L M N O + I +8 I P Q R S T U V W X Y + I +9 I Z [ \ ] ^ _ ` a b c + I +10 I d e f g h i j k l m + I +11 I n o p q r s t u v w + I +12 I x y z { | } ~ + I +13 I +. I +. I +. I +20 I + I +21 I Ä Ö Ü ä ö ü + I +22 I k ­ \# SP + I +23 I + I +24 I + I +25 I ß +#page# +':=' + #on("b")#TEXT OP := (TEXT VAR a, TEXT CONST b) #off("b")# + Zuweisung. + + +'=' + #on("b")#BOOL OP = (TEXT CONST links, rechts) #off("b")# + Vergleich von zwei Texten auf Gleichheit (Texte mit ungleichen Längen sind + immer ungleich). + + +'<>' + #on("b")#BOOL OP <> (TEXT CONST links, rechts) #off("b")# + Vergleich von zwei Texten auf Ungleichheit (Texte mit ungleichen Längen sind + stets ungleich). + + +'<' + #on("b")#BOOL OP < (TEXT CONST links, rechts) #off("b")# + Vergleich zweier Texte auf kleiner ('links' kommt lexikographisch vor 'rechts'). + + +'<=' + #on("b")#BOOL OP <= (TEXT CONST links, rechts) #off("b")# + Vergleich von zwei Texten auf kleiner gleich ('links' kommt lexikographisch vor + oder ist gleich 'rechts'). + + +'>' + #on("b")#BOOL OP > (TEXT CONST links, rechts) #off("b")# + Vergleich zweier Texte auf größer ('links' kommt lexikographisch nach 'rechts'). + + +'>=' + #on("b")#BOOL OP >= (TEXT CONST links, rechts) #off("b")# + Vergleich zweier Texte auf größer gleich ('links' kommt lexikographisch nach oder + ist gleich 'rechts'). + +#page# +'LEXEQUAL' + #on("b")#BOOL OP LEXEQUAL (TEXT CONST links, rechts) #off("b")# + Prüfung auf lexikalische Gleichheit. + + +'LEXGREATER' + #on("b")#BOOL OP LEXGREATER (TEXT CONST links, rechts) #off("b")# + Prüfung ob der Text 'links' lexikalisch größer als 'rechts' ist. + + +'LEXGREATEREQUAL' + #on("b")#BOOL OP LEXGREATEREQUAL (TEXT CONST links, rechts) #off("b")# + Prüfung ob der Text 'links' lexikalisch größer oder gleich dem Text 'rechts' ist. + + + + Die drei Operatoren prüfen nach folgenden Regeln: + + - Buchstaben haben die aufsteigende Reihenfolge 'A' bis 'Z'. Dabei werden kleine + und große Buchstaben gleich behandelt. + + - Umlaute werden wie üblich ausgeschrieben. (Ä = Ae usw.) + (ß = ss) + + - Alle Sonderzeichen (auch Ziffern) außer ' '(Leerzeichen) und '-' werden igno­ + riert, diese beiden Zeichen werden gleich behandelt. + +#page# +'+' + #on("b")#TEXT OP + (TEXT CONST links, rechts) #off("b")# + Verkettung der Texte 'links' und 'rechts' in dieser Reihenfolge. Die Länge des + Resultats ergibt sich aus der Addition der Längen der Operanden. + + +'*' + #on("b")#TEXT OP * (INT CONST faktor, TEXT CONST quelle) #off("b")# + 'faktor' fache Erstellung von 'quelle' und Verkettung. Dabei muß + + + times >= 0 + + + sein, sonst wird 'niltext' geliefert. + + +'CAT' + #on("b")#OP CAT (TEXT VAR links, TEXT CONST rechts) #off("b")# + hat die gleiche Wirkung wie + + + links := links + rechts + + + Hinweis: Der Operator 'CAT' hat eine geringere Heap-Belastung als die Opera­ + tion mit expliziter Zuweisung. + +#page# +'change' + #on("b")#PROC change (TEXT VAR senke, TEXT CONST alt, neu) #off("b")# + Ersetzung des (Teil-) TEXTes 'alt' in 'senke' durch 'neu' bei dem erstmaligen + Auftreten. Ist 'alt' nicht in 'senke' vorhanden, so wird keine Meldung abgesetzt + (Abweichung vom Standard). Die Länge von 'senke' kann sich dabei verändern. + Beispiel: + + + TEXT VAR mein text :: "EUMEL-Benutzerhandbuch"; + change (mein text, "Ben", "N"); + (* EUMEL-Nutzerhandbuch *) + + + #on("b")#PROC change (TEXT VAR senke, INT CONST von, bis, TEXT CONST neu) #off("b")# + Der TEXT 'neu' wird in den TEXT 'senke' anstatt des TEXTes, der zwischen 'von' + und 'bis' steht, eingesetzt. Die Länge von 'senke' kann sich dabei verändern. + Beispiel: + + + TEXT VAR mein text :: "EUMEL-Benutzerhandbuch"; + change (mein text, 7, 9, "N"); (* wie oben *) + + + +'change all' + #on("b")#PROC change all (TEXT VAR senke, TEXT CONST alt, neu) #off("b")# + Der Teiltext 'alt' wird durch 'neu' in 'senke' ersetzt. Im Unterschied zur 'chan­ + ge'-Prozedur findet die Ersetzung nicht nur bei dem erstmaligen Auftreten von + 'alt' statt, sondern so oft, wie 'alt' in 'senke' vorhanden ist. Beispiel: + + + TEXT VAR x :: "Das ist ein Satz"; + change all (x, " ", ""); (* DasisteinSatz *) + +#page# +'code' + #on("b")#TEXT PROC code (INT CONST code) #off("b")# + Wandelt einen INT-Wert 'code' in ein Zeichen um. 'code' muß + + + 0 <= code <= 255 + + + sein. + + #on("b")#INT PROC code (TEXT CONST text) #off("b")# + Wandelt ein Zeichen 'text' in einen INT-Wert um. Ist + + + LENGTH text <> 1 + + + dann wird der Wert -1 geliefert (also bei mehr als ein Zeichen oder niltext). + (Codetabelle auf Seite 5- #topage("codetab")#) + + +'compress' + #on("b")#TEXT PROC compress (TEXT CONST text) #off("b")# + Liefert den TEXT 'text' ohne führende und nachfolgende Leerzeichen. + + +'delete char' + #on("b")#PROC delete char (TEXT VAR string, INT CONST delete pos)#off("b")# + Löscht ein Zeichen aus dem Text 'string' an der Position 'delete pos'. Für + + + delete pos <= 0 + + + oder + + + delete pos > LENGTH string + + + wird keine Aktion vorgenommen. + +#page# +'insert char' + #on("b")#PROC insert char (TEXT VAR string, TEXT CONST char,INT CONST insert pos)#off("b")# + Fügt ein Zeichen 'char' in den Text 'string' an der Position 'insert pos' ein. Für + + + insert pos > LENGTH string + 1 + + + wird keine Aktion vorgenommen. Daher ist es möglich, mit dieser Prozedur auch + am Ende eines Textes (Position: LENGTH string + 1) ein Zeichen anzufügen. + + +'length' + #on("b")#INT PROC length (TEXT CONST text) #off("b")# + Anzahl von Zeichen ("Länge") von 'text' einschließlich Leerzeichen. + + +'LENGTH' + #on("b")#INT OP LENGTH (TEXT CONST text) #off("b")# + Anzahl von Zeichen ("Länge") von 'text' einschließlich Leerzeichen. + + +'max text length' + #on("b")#INT CONST max text length #off("b")# + Maximale Anzahl von Zeichen in einem TEXT (32 000). + +#page# +'pos' + #on("b")#INT PROC pos (TEXT CONST quelle, pattern) #off("b")# + Liefert die erste Position des ersten Zeichens von 'pattern' in 'quelle', falls 'pat­ + tern' gefunden wird. Wird 'pattern' nicht gefunden oder ist 'pattern' niltext, so wird + der Wert '0' geliefert. Beispiel: + + + TEXT VAR t1 :: "abcdefghijk...xyz", + t2 :: "cd"; + ... pos (t1, t2) ... (* liefert 3 *) + ... pos (t2, t1) ... (* liefert 0 *) + + + + #on("b")#INT PROC pos (TEXT CONST quelle, pattern, INT CONST von)#off("b")# + Wie obige Prozedur, jedoch wird erst ab der Position 'von' ab gesucht. Dabei gilt + folgende Einschränkung: + + + length (pattern) < 255 + + + + #on("b")#INT PROC pos (TEXT CONST quelle, low char, high char, INT CONST von#off("b")# + Liefert die Position des ersten Zeichens 'x' in 'quelle' ab der Position 'von', so daß + + + low char <= x <= high char + + + 'low char' und 'high char' müssen TEXTe der Länge 1 sein. Wird kein Zeichen in + 'quelle' in dem Bereich zwischen 'low char' und 'high char' gefunden, wird der + Wert '0' geliefert. Beispiel: + +____________________________________________________________________________ + + (*Suche nach dem ersten Zeichen <> blank nach einer Leerspalte*) + TEXT VAR zeile :: "BlaBla Hier gehts weiter"; + INT VAR pos erstes blank :: pos (zeile, " "), + ende leerspalte :: + pos (zeile, ""33"",""254"", pos erstes blank); + +____________________________________________________________________________ + +#page# +'real' + #on("b")#REAL PROC real (TEXT CONST text) #off("b")# + Konvertierung eines TEXTes 'text' in einen REAL-Wert. Achtung: Zur Zeit werden + keine Überprüfungen vorgenommen, d.h. in dem TEXT muß ein REAL-Wert + stehen. + + +'replace' + #on("b")#PROC replace (TEXT VAR senke, INT CONST position, TEXT CONST quelle)#off("b")# + Ersetzung eines Teiltextes in 'senke' durch 'quelle' an der Position 'position' in + 'senke'. Es muß gelten + + + 1 <= position <= LENGTH senke + + + d.h. 'position' muß innerhalb von 'senke' liegen und 'quelle' muß von der Posi­ + tion 'position' ab in 'senke' einsetzbar sein. Dabei bleibt die Länge von 'senke' + unverändert. + + +'SUB' + #on("b")#TEXT OP SUB (TEXT CONST text, INT CONST pos) #off("b")# + Liefert ein Zeichen aus 'text' an der Position 'pos'. Entspricht + + + subtext (text, pos, pos) + + + Anmerkung: Effizienter als obiger Prozedur-Aufruf. Für + + + pos <= 0 + pos > LENGTH text + + + wird niltext geliefert. + +#page# +'subtext' + #on("b")#TEXT PROC subtext (TEXT CONST quelle, INT CONST von) #off("b")# + Teiltext von 'quelle', der bei der Position 'von' anfängt. Die Länge des Resultats + ergibt sich also zu + + + LENGTH quelle - von + 1 + + + d.h. von der Position 'von' bis zum Ende von 'quelle'. 'von' muß innerhalb von + 'quelle' liegen. Ist von < 1, dann wird 'quelle' geliefert. Falls von > LENGTH + quelle ist, wird niltext geliefert. + + + #on("b")#TEXT PROC subtext (TEXT CONST quelle, INT CONST von, bis)#off("b")# + Teiltext von 'quelle' von der Position 'von' bis einschließlich der Position 'bis'. Die + Länge des Resultats ist also + + + bis - von + 1 + + + Dabei muß gelten + + + 1 <= von <= bis <= LENGTH quelle + + + d.h. die Positionen 'von' und 'bis' müssen in dieser Reihenfolge innerhalb von + 'quelle' liegen. Ist + + + bis >= LENGTH quelle + + + wird 'subtext (quelle, von)' ausgeführt. Für die Bedingungen für 'von' siehe vor­ + stehende Beschreibung von 'subtext'. + + +'text' + #on("b")#TEXT PROC text (TEXT CONST quelle, INT CONST laenge) #off("b")# + Teiltext aus 'quelle' mit der Länge 'laenge', beginnend bei der Position 1 von + 'quelle'. Es muß gelten + + + 1 <= laenge <= LENGTH quelle + + + d.h. der gewünschte Teiltext muß aus 'quelle' ausblendbar sein. + Wenn gilt: + + laenge > LENGTH quelle + + + wird der zu liefernde TEXT mit der an 'laenge' fehlenden Zeichen mit Leerzeichen + aufgefüllt. + + #on("b")#TEXT PROC text (TEXT CONST quelle, INT CONST laenge, von)#off("b")# + Teiltext aus 'quelle' mit der Länge 'laenge', beginnend an der Position 'von' in + dem TEXT 'quelle'. Entspricht + + + text (subtext (quelle, von, LENGTH quelle),laenge) + + + Es muß + + + laenge >= 0 + 1 <= von <= LENGTH quelle + + + gelten, d.h. 'von' muß eine Position angeben, die innerhalb von 'quelle' liegt. Für + + + laenge > LENGTH quelle - von + 1 + + + also wenn die angegebene Länge 'laenge' größer ist als der auszublendende Text, + wird das Resultat rechts mit Leerzeichen aufgefüllt. Wenn + + + laenge < LENGTH quelle - von + 1 + + + d.h. wenn die angegebene Länge kleiner ist als der Teiltext von 'von' bis zum + letzten Zeichen von 'quelle', wird das Resultat mit der Länge + + + LENGTH quelle - von + 1 + + + geliefert. + diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.5b b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.5b new file mode 100644 index 0000000..d91bcc9 --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.5b @@ -0,0 +1,1481 @@ +#pagenr("%",40)##setcount(1)##block##pageblock# +#headeven# +#center#EUMEL-Benutzerhandbuch +#center#____________________________________________________________ + +#end# +#headodd# +#center#TEIL 5 : Programmierung +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +5 - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#5 - % +#end# + +5.3 Der Datentyp FILE (Textdateien) + +Der Datentyp FILE definiert Dateien von sequentieller Struktur, die Texte enthalten. +Ein Objekt vom Datentyp FILE ist charakterisiert durch: + +1) seine Betriebsrichtung : input = nur lesender Zugriff + (TRANSPUTDIRECTION) output= nur schreibender Zugriff + modify= lesender und schreibender Zugriff. +2) seinen Namen. + +Betriebsrichtung und Name werden in der Assoziierungsprozedur 'sequential file' +(siehe Kap 2.8.2) festgelegt. + + +____________________________________________________________________________ + + ........................... Beispiel .......................... + TEXT VAR name := ausgabe ; + + FILE VAR f := sequential file(output,name) ; + + +____________________________________________________________________________ + + + +Das Festlegen einer Betriebsrichtung impliziert eine Kontrolle der Benutzung der +betreffenden Datei, hilft somit Programmierfehler zu vermeiden. + +ACHTUNG : #on("b")##on("u")#Alle#off("b")##off("u")# Prozeduren, die auf FILEs zugreifen, verlangen Objekte vom Typ + FILE VAR, da die Lese/Schreiboperationen als ändernd betrachtet wer­ + den (müssen). + +#page# + +5.3.1 Assoziierung + +'sequential file' + #on("b")#FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, DATASPACE VAR ds) #off("b")# + Assoziierung einer sequentiellen Datei mit dem Dataspace 'ds' und der Betriebs­ + richtung 'mode' (vergl. 'modify', 'input' bzw. 'output'). Diese Prozedur dient zur + Assoziierung eines temporären Datenraums in der Benutzer-Task, der nach der + Beendigung des Programmlaufs nicht mehr zugriffsfähig ist (weil der Name des + Datenraums nicht mehr ansprechbar ist). Somit muß der Datenraum explizit vom + Programm gelöscht werden. + + + #on("b")#FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,TEXT CONST name)#off("b")# + Assoziierung einer sequentiellen Datei mit dem Namen 'name' und der Betriebs­ + richtung 'mode' (vergl. 'input' bzw. 'output'). Existiert der FILE bereits, dann wird + mit 'input' auf den Anfang des FILEs, bei 'output' hinter den letzten Satz der datei + positioniert. Existiert dagagen der FILE noch nicht und ist die + TRANSPUTDIRECTION 'output' oder 'modify', wird ein neuer FILE eingerich­ + tet. + + FEHLER : "name" gibt es nicht" + Es wurde versucht, einen nicht vorhandenen FILE mit 'input' zu asso­ + ziieren. + +#page# + +'input' + #on("b")#PROC input (FILE VAR f) #off("b")# + Ändern der Verarbeitungsart von 'modify' oder 'output' in 'input'. Dabei wird auf + den ersten Satz der Datei positioniert. + + #on("b")#TRANSPUTDIRECTION CONST input #off("b")# + Assoziierung in Zusammenhang mit der Prozedur 'sequential file' einer sequentiel­ + len Datei mit der 'TRANSPUTDIRECTION' 'input' (nur lesen). + + +'output' + #on("b")#PROC output (FILE VAR file) #off("b")# + Ändern der Verarbeitungsart von 'input' oder 'modify' in 'output'. Dabei wird hinter + den letzten Satz der Datei positioniert. + + #on("b")#TRANSPUTDIRECTION CONST output #off("b")# + In Verbindung mit der Prozedur 'sequential file' kann eine Datei assoziiert werden + mit der Betriebsrichtung 'output' (nur schreiben). + + +'modify' + #on("b")#PROC modify (FILE VAR f) #off("b")# + Ändern der Betriebsrichtung von 'input' oder 'output' in die Betriebsrichtung 'mo­ + dify'. + + #on("b")#TRANSPUTDIRECTION CONST modify #off("b")# + Diese Betriebsrichtung erlaubt das Vorwärts- und Rückwärts-Positionieren und + das beliebige Einfügen und Löschen von Sätzen. 'modify' wird für die Assoziie­ + rungsprozedur 'sequential file' benötigt. + + + +#page# + +5.3.2 Informationsprozeduren + +'eof' + #on("b")#BOOL PROC eof (FILE CONST file) #off("b")# + Informationsprozedur auf das Ende eines FILEs. Liefert den Wert TRUE, sofern + hinter den letzten Satz eines FILEs positioniert wurde. + + +'line no' + #on("b")#INT PROC line no (FILE CONST file) #off("b")# + Liefert die aktuelle Zeilennummer. + + +'lines' + #on("b")#PROC lines (FILE VAR f) #off("b")# + Liefert die Anzahl der Zeilen der Datei 'f'. + + +'headline' + #on("b")#TEXT PROC headline (FILE CONST f) #off("b")# + Liefert den Inhalt der Kopfzeile der Datei 'f'. + + #on("b")#PROC headline (FILE VAR f, TEXT CONST ueberschrift) #off("b")# + Setzt #ib#'ueberschrift' in die Kopfzeile#ie# der Datei 'f'. +#page# + +5.3.3 Betriebsrichtung INPUT + +In der Betriebsrichtung 'input' sind nur Leseoperationen auf der Datei zugelassen. Die +Assoziierungsprozedur 'sequential file' bewirkt: + +1) Falls die Eingabedatei noch nicht existiert, wird eine Fehlermeldung ausgegeben. + +2) Falls es eine Datei des Namens gibt, wird auf das erste Zeichen des ersten + Satzes positioniert. + + + +'get' + #on("b")#PROC get (FILE VAR f, INT VAR number) #off("b")# + Lesen des nächsten Wortes aus der Datei 'f' und Konvertierung des Wortes zu + einem Integer-Objekt. + + #on("b")#PROC get (FILE VAR f, REAL VAR number) #off("b")# + Lesen des nächsten Wortes aus der Datei 'f' und Konvertierung des Wortes zu + einem Real-Objekt. + + + #on("b")#PROC get (FILE VAR f, TEXT VAR text) #off("b")# + Lesen des nächsten Wortes aus der Datei 'f'. + + #on("b")#PROC get (FILE VAR f, TEXT VAR text, TEXT CONST delimiter)#off("b")# + Lesen eines TEXT-Wertes 'text' von der Datei 'f', bis das Zeichen 'delimiter' + angetroffen wird. Ein eventueller Zeilenwechsel in der Datei wird dabei übergan­ + gen. + + #on("b")#PROC get (FILE VAR f, TEXT VAR text, INT CONST maxlength)#off("b")# + Lesen eines TEXT-Wertes 'text' von der Datei 'f' mit 'maxlength' Zeichen. Ein + eventueller Zeilenwechsel in der Datei wird dabei nicht übergangen. + + + +'getline' + #on("b")#PROC get line (FILE VAR file, TEXT VAR record) #off("b")# + Lesen der nächsten Zeile aus der sequentiellen Datei 'file'. + Mögliche Fehler bei Betriebsrichtung 'input': + + "Datei zu" + Die Datei 'file' ist gegenwärtig nicht assoziiert. + + "Leseversuch nach Dateiende" + Es wurde versucht, über die letzte Zeile einer Datei zu lesen. + + "Leseversuch auf output file" + Es wurde versucht, von einem mit 'output' assoziierten FILE zu lesen. + + "Unzulässiger Zugriff auf modify-FILE" + +#page# + +5.3.4 Betriebsrichtung OUTPUT + +In der Betriebsrichtung 'output' sind nur Schreiboperationen auf der Datei zugelassen. +Die Assoziierungsprozedur 'sequential file' bewirkt: + +1) Falls die Ausgabedatei noch nicht existiert, wird sie angelegt und auf den ersten + Satz positioniert. + +2) Falls es bereits eine Datei des Namens gibt, wird hinter den letzten Satz positio­ + niert, die Datei wird also fortgeschrieben. + + +'put' + #on("b")#PROC put (FILE VAR f, INT CONST number) #off("b")# + Ausgabe eines INT-Wertes 'number' in die Datei 'f'. Dabei wird ein Leerzeichen + an die Ausgabe angefügt. + + #on("b")#PROC put (FILE VAR f, REAL CONST number) #off("b")# + Ausgabe eines REAL-Wertes 'number' in die Datei 'f'. Dabei wird ein Leerzei­ + chen an die Ausgabe angefügt. + + #on("b")#PROC put (FILE VAR f, TEXT CONST text) #off("b")# + Ausgabe eines TEXT-Wertes 'text' in die Datei 'f'. Dabei wird ein Leerzeichen an + die Ausgabe angefügt. + + + +'putline' + #on("b")#PROC putline (FILE VAR file, TEXT CONST record) #off("b")# + Ausgabe eines TEXTes 'record' in die Datei 'file'. Danach wird auf die nächste + Zeile positioniert. 'file' muß mit 'output' assoziiert sein. + + +'write' + #on("b")#PROC write (FILE VAR f, TEXT CONST text) #off("b")# + Schreibt 'text' in die Datei 'f' (analog 'put (f, text)'), aber ohne Trennblank. + + +'line' + #on("b")#PROC line (FILE VAR file) #off("b")# + Positionierung auf die nächste Zeile der Datei 'file'. Wird versucht, über das Ende + eines mit 'input' assoziierten FILEs zu positionieren, wird keine Aktion vorgenom­ + men. + + #on("b")#PROC line (FILE VAR file, INT CONST lines) #off("b")# + Positionierung mit 'lines' Zeilen Vorschub in der Datei 'file'. + + + FEHLER: "Datei zu!" + Die Datei 'file' ist gegenwärtig nicht assoziiert. + + "Schreibversuch auf input-File" + Es wurde versucht, auf einen mit 'input' assoziierten FILE zu + schreiben. + + + Bei Textdateien, die mit dem Editor weiterbearbeitet werden sollen, ist also zu + beachten: ine Ausgabe mit 'put' setzt ein 'blank' hinter die Ausgabe. Falls dieses + Leerzeichen das letzte Zeichen in der Zeile ist, wird eine Absatzmarke in der Zeile + gesetzt. Wird mit 'write' oder 'putline' ausgegeben, steht kein Leerzeichen und + somit keine Absatzmarke am Zeilenende. +#page# + +5.3.5 Betriebsrichtung MODIFY + +In der Betriebsrichtung 'modify' sind Lese- und Schreiboperationen auf der Datei +zugelassen. Desweiteren ist beliebiges Positionieren in der Datei erlaubt. Neue Sätze +können an beliebiger Stelle in die Datei eingefügt werden, die sequentielle Struktur +der Datei bleibt erhalten. Die Assoziierungsprozedur 'sequential file' bewirkt: + +1) Falls die Ausgabedatei noch nicht existiert, wird sie angelegt. + +2) Falls es bereits eine Datei des Namens gibt, ist undefiniert wo positioniert ist. Die + erste Positionierung muß explizit vorgenommen werden! + + + +'col' + #on("b")#PROC col (FILE VAR f, INT CONST position) #off("b")# + Positionierung auf die Spalte 'position' innerhalb der aktuellen Zeile. + + #on("b")#INT PROC col (FILE CONST f) #off("b")# + Liefert die aktuelle Position innerhalb der aktuellen Zeile. + + +'down' + #on("b")#PROC down (FILE VAR f) #off("b")# + Positionieren um eine Zeile vorwärts. + + #on("b")#PROC down (FILE VAR f, INT CONST number) #off("b")# + Positionieren um 'number' Zeilen vorwärts. + + +'to line' + #on("b")#PROC to line (FILE VAR f, INT CONST number) #off("b")# + Positionierung auf die Zeile 'number'. + + +'up' + #on("b")#PROC up (FILE VAR f) #off("b")# + Positionieren um eine Zeile rückwärts. + + #on("b")#PROC up (FILE VAR f, INT CONST number) #off("b")# + Positionieren um 'number' Zeilen rückwärts. + +#page# +'delete record' + #on("b")#PROC delete record (FILE VAR file) #off("b")# + Der aktuelle Satz der Datei 'file' wird gelöscht. Der folgende Satz wird der aktuelle + Satz. + + +'insert record' + #on("b'PROC insert record (FILE VAR file) #off("b")# + Es wird ein leerer Satz in die Datei 'file' vor die aktuelle Position eingefügt. Dieser + Satz kann anschließend mit 'write record' beschrieben werden (d.h. der neue Satz + ist jetzt der aktuelle Satz). + + + +'read record' + #on("b")#PROC read record (FILE CONST file, TEXT VAR record) #off("b")# + Liest den aktuellen Satz der Datei 'file' in den TEXT 'record'. Die Position wird + dabei nicht verändert. + + + +'write record' + #on("b")#PROC write record (FILE VAR file, TEXT CONST record) #off("b")# + Schreibt einen Satz in die Datei 'file' an die aktuelle Position. Dieser Satz muß + bereits vorhanden sein, d.h. mit 'write record' kann keine leere Datei beschrieben + werden, sondern es wird der Satz an der aktuellen Position überschrieben. Die + Position in der Datei wird nicht verändert. + + +#page# + +5.3.6 FILE -Ausschnitte + +Ähnlich den Editorfunktionen 'ESC RUBOUT' und 'ESC RUBIN', die erlauben ganze +Abschnitte einer Datei zu löschen und das Gelöschte an anderer Stelle wiedereinzu­ +fügen, gibt es die Möglichkeit per Programm solche Segmente +eines 'modify-FILEs' zu verschieben. + + +'clear removed' + #on("b")#PROC clear removed (FILE VAR f) #off("b")# + Das mit 'remove' entfernte Segment wird gelöscht und nicht an anderer Stelle + eingefügt. + + +'reinsert' + #on("b")#PROC reinsert (FILE VAR f) #off("b")# + Das mit 'remove' entfernte Segment wird vor die aktuelle Zeile wiedereingefügt. + + +'remove' + #on("b")#PROC remove (FILE VAR f, INT CONST size) #off("b")# + Löscht 'size' Zeilen vor der aktuellen Position aus 'f'. Das Segment wird in einen + internen Puffer geschrieben. + + +'reorganize' + #on("b")#PROC reorganize (TEXT CONST datei)#off("b")# + Reorganisation von 'datei'. Die durch Löschen und Einfügen aus vielen + Segmenten bestehende Datei wird zu einem Segment zusammengefügt, die + aktuelle Position ist danach das erste Zeichen der ersten Zeile. + + Durch diese Prozedur kann ggf. Speicherplatz gespart werden. + + #on("b")#PROC reorganize#off("b")# + Reorganisation der zuletzt bearbeiteten Datei. + + +'segments' + #on("b")#PROC segments (FILE VAR f) #off("b")# + Liefert die Anzahl der Segmente von 'f'. Eine große Anzahl von Segmenten kann + langsamere Zugriffe zur Folge haben. + +#page# + +5.4 Suchen und Ersetzen in Textdateien + +Such- und Ersetzungsprozeduren können sowohl interaktiv beim Editieren (siehe +dazu 3.3), als auch in Prozeduren, die auf FILEs (siehe 5.3) arbeiten, angewandt +werden. + +Die dazu dienenden Prozeduren sind im Paket 'pattern match' enthalten. Mit 'Pattern +Matching' (Muster treffen) wird ein Verfahren bezeichnet Gleichheit von Objekten +anhand von Regeln, denen diese Objekte genügen, zu überprüfen. + +Da oft nach Texten gesucht werden muß, deren genaue Ausprägung nicht bekannt ist, +oder deren Auftreten nur in einem bestimmten Zusammenhang interessiert, gibt es die +Möglichkeit feststehende Textelemente mit Elementen ungewisser Ausprägung zu +kombinieren, also Textmuster zu erzeugen. + +Um einen Text zu suchen, muß die Suchrichtung und der gesuchte Text oder ein +Muster, welches diesen Text beschreibt, angegeben werden. + +- Aufbauen von Textmustern : + , - , OR , any , bound , notion + +- Suchen nach Textmustern : down , downety , up , uppety + +- Treffer registrieren : LIKE , UNLIKE , at , pattern found + +- Treffer herausnehmen : ** , match , matchend , matchpos , + somefix , word + +- Ändern in Dateien : change + + +Nach einem erfolgreichen Suchvorgang ist stets auf das erste Zeichen der zu such­ +enden Zeichenkette positioniert. + + +Eine besondere Funktion kommt dem 'joker' zu: Dieses Symbol (Defaultwert: '*') steht +für eine beliebige Zeichenkette beliebiger Länge. Insbesondere bei Ersetzungsaktionen +in denen dieses Zeichen zur Musterbeschreibung verwendet wird, ist daher Vorsicht +geboten und sorgfältig zu testen. + +#page# + +5.4.1 Aufbau von Textmustern + +'+' + #on("b")#TEXT OP + (TEXT CONST links, rechts) #off("b")# + Verkettung der Texte 'links' und 'rechts' zu 'linksrechts'. Falls das Ergebnis länger + als die maximal zulässige Textlänge ist, ist es undefiniert. + + Wenn 'muster1' einen beliebigen Text finden sollte, ( Siehe: PROC any) wird das + Ende des von 'muster1' erkannten Textes durch den Anfang des von 'muster2' + erkannten Textes im Nachhinein definiert. + + + +'-' + #on("b")#TEXT OP - (TEXT CONST alphabet) #off("b")# + Der Operator liefert das zu 'alphabet' komplementäre Alphabet, also alle Zeichen + gemäß der EUMEL Codetabelle (5.2.4), die nicht in 'alphabet' enthalten sind. + Sinnvoll im Zusammenhang mit der Textprozedur 'any'. + + +'OR' + #on("b")#TEXT OP OR (TEXT CONST links, rechts) #off("b")# + Liefert die Alternative von 'links' und 'rechts'. Die Reihenfolge spielt beim Suchen + keine Rolle. + + + +'any' + Die Textprozedur 'any' liefert einen unbekannten Text unbestimmter Länge. + Dieser Text sollte entweder durch festen Text sinnvoll eingegrenzt werden, oder + direkt eingeschränkt werden. + + + #on("b")#TEXT PROC any #off("b")# + Beschreibt einen beliebigen Text. + + #on("b")#TEXT PROC any (INT CONST laenge) #off("b")# + Beschreibt einen beliebigen Text der angebenen Länge. + + + #on("b")#TEXT PROC any (TEXT CONST alphabet) #off("b")# + Beschreibt einen beliebigen Text, der nur aus Zeichen besteht, die in 'alphabet' + enthalten sind. + + + #on("b")#TEXT PROC any (INT CONST laenge, TEXT CONST alphabet) #off("b")# + Beschreibt einen Text der vorgegebenen Länge, der nur aus den in 'alphabet' + vorgegebenen Zeichen besteht. + + +____________________________________________________________________________ + + ........................... Beispiel .......................... + Die Textprozedur 'any' liefert einen unbekannten Text unbe­ + stimmter Länge. Dieser Text sollte entweder durch festen Text + sinnvoll eingegrenzt werden, oder direkt eingeschränkt werden. +gib kommando: D("D" OR "d" + any (2,"aeirs") + Sucht nach bestimmten Artikeln: 'der', 'die', 'das' etc. + +____________________________________________________________________________ + + + +'bound' + #on("b")#TEXT PROC bound #off("b")# + Bezeichnet ein Muster der Länge null, das nur am Zeilenanfang oder am Zeilenen­ + de gefunden wird. Ein Präfix 'bound' fordert, daß das gesuchte Muster in der + ersten Spalte beginnen muß, ein Postfix 'bound' fordert, daß das Muster mit dem + Zeilenende abschließt. + +____________________________________________________________________________ + + ........................... Beispiel .......................... + Die Textprozedur 'any' liefert einen unbekannten Text unbe­ + stimmter Länge. Dieser Text sollte entweder durch festen + Textsinnvoll eingegrenzt werden, oder direkt eingeschränkt + werden. +gib kommando: U(bound + any (" ")) + +____________________________________________________________________________ + + + + liefert Treffer bei eingerückten Zeilen. + + + +'notion' + #on("b")#PROC notion (TEXT CONST suchwort) #off("b")# + Mit dieser Prozedur kann ein #on("u")#Wort#off("u")# spezifiziert werden, nach dem gesucht werden + soll. Bei der Suche nach 'suchwort' wird nur dann ein Treffer geliefert, wenn + 'suchwort' als Wort, also begrenzt von ' ' (blank), '.' , ',' oder anderen Sonderzei­ + chen ist. + + #on("b")#PROC notion (TEXT CONST suchwort, INT CONST reg) #off("b")# + Wie oben, der Treffer wird im Register 'reg' gespeichert. + +#page# + +5.4.2 Suche nach Textmustern + +'down' + #on("b")#PROC down (FILE VAR f, TEXT CONST muster) #off("b")# + Suche nach 'muster' in der Datei 'f' in Richtung Dateiende. Wird 'muster' gefun­ + den, ist die Position das erste Zeichen von 'muster'. Andernfalls steht man hinter + dem letzten Zeichen der Datei. + + Achtung: 'down' sucht vom nächsten Zeichen rechts ab, so daß wiederholtes + Suchen keine Endlosschleife ergibt. + + + #on("b")#PROC down (FILE VAR f, TEXT CONST muster, INT CONST number)#off("b")# + Wie obiges 'down', es wird aber maximal nur 'number'-Zeilen weit nach 'muster' + gesucht. + + + +'downety' + #on("b")#PROC downety (FILE VAR f, TEXT CONST muster) #off("b")# + Suche nach 'muster' in der Datei 'f' in Richtung Dateiende. Wird 'muster' gefun­ + den, ist die Position das erste Zeichen von 'muster'. Andernfalls steht man auf + dem letzten Zeichen der Datei. + + Achtung: 'downety' sucht (im Gegensatz zu 'down') vom aktuellen Zeichen an. + Daher muß explizit vorwärts positioniert werden. + + + #on("b")#PROC downety (FILE VAR f, TEXT CONST muster, INT CONST number) #off("b")# + Wie obiges 'downety', aber maximal nur 'number'-Zeilen weit. +#page# +'up' + #on("b")#PROC up (FILE VAR f, TEXT CONST muster) #off("b")# + Suche nach 'muster' in der Datei 'f' in Richtung Dateianfang. Wird 'muster' + gefunden, ist die Position das erste Zeichen von 'muster'. Andernfalls steht man + auf dem ersten Zeichen der Datei. + + Achtung: 'up' sucht vom nächsten Zeichen links ab, so daß wiederholtes Suchen + keine Endlosschleife ergibt. + + + #on("b")#PROC up (FILE VAR f, TEXT CONST muster, INT CONST number)#off("b")# + Wie obiges 'up', aber maximal nur 'number'-Zeilen weit. + + + +'uppety' + #on("b")#PROC uppety (FILE VAR f, TEXT CONST muster) #off("b")# + Suche nach 'muster' in der Datei 'f' in Richtung Dateianfang. Wird 'muster' + gefunden, ist die Position das erste Zeichen von 'muster'. Andernfalls steht man + auf dem ersten Zeichen der Datei. + + Achtung: 'uppety' sucht (im Gegensatz zu 'up') vom aktuellen Zeichen. + + + #on("b")#PROC uppety (FILE VAR f, TEXT CONST muster, INT CONST number)#off("b")# + Wie obiges 'uppety', aber maximal nur 'number'-Zeilen weit. + +#page# + +5.4.3 Treffer registrieren + +'LIKE' + #on("b")#BOOL OP LIKE (TEXT CONST text , muster) #off("b")# + Liefert TRUE, falls der Text 'text' 'muster' entspricht. In 'muster' kann das + Spezialzeichen '*' verwandt werden, das abkürzend für die Konkatenation mit + 'any' steht. + + Daraus folgt, daß das Suchen oder Ersetzen des Zeichens '*' nur durch + any (1,"*") zu bewerkstelligen ist. + + +____________________________________________________________________________ + + ........................... Beispiel .......................... + \#Druckdateien aus Thesaurus löschen\# + gib kommando:"*.p" C "" + 16.04.87 "Handbuch teil1" + 04.05.87 "Handbuch teil1.p" + 16.04.87 "Handbuch teil2" + 06.05.87 "Handbuch teil2.p" + +____________________________________________________________________________ + + + + aber: + +____________________________________________________________________________ + + ........................... Beispiel .......................... + \#Vordere Kommentarklammern löschen \# + gib kommando:"(" + any(1,"*") C "" + lernsequenz auf taste legen("a" , "archive") ; + (* lernsequenz auf taste legen("(" , ""91"") ; *) + (* lernsequenz auf taste legen(")" , ""93"") ; *) + kommando auf taste legen("P" , "print("""")"8""8""11"") . + +____________________________________________________________________________ + + + +'UNLIKE' + #on("b")#BOOL OP UNLIKE (TEXT CONST text , muster) #off("b")# + Wirkt wie: '(NOT text LIKE muster)' +#page# + +5.4.4 Treffer herausnehmen + +Mit Hilfe der 'Register' ist es möglich identifizierte Texte zwischenzuspeichern und in +weiteren Aktionen weiterzuverwenden. + + +'**' + #on("b")#TEXT OP ** (TEXT CONST muster, INT CONST register)#off("b")# + Der als 'muster' erkannte Text wird einem 'Register' mit der Nummer 'register' + zugeordnet. Es können 256 Register (1 bis 256) benutzt werden. + + +'match' + #on("b")#TEXT PROC match (INT CONST nr) #off("b")# + Liefert den Text der dem Register 'nr' zuletzt zugeordnet wurde. + + +'matchpos' + #on("b")#INT PROC matchpos (INT CONST nummer) #off("b")# + Liefert die Spaltennummer, auf der das dem Register 'nummer' zugeordnete Mu­ + ster in der Zeile beginnt. + +____________________________________________________________________________ + + ........................... Beispiel .......................... + + gib kommando:D("file"+any+"("+(any ** (1)... + +____________________________________________________________________________ +#page# + +5.4.5 Ändern in Dateien + +'change' + #on("b")#PROC change (FILE VAR datei, INT CONST von, bis , TEXT CONST neuertext)#off("b")# + In der Datei wird in der aktuellen Zeile in den Ausschnitt zwischen 'von' und 'bis' + der Text 'neuertext' eingesetzt. + + entspricht: + + +____________________________________________________________________________ + + ........................... Beispiel .......................... + FILE VAR file := sequential file (modify, name) + TEXT VAR zeile; + . + . + read record (file ,zeile); + change (zeile, von, bis ,"neuertext"); + write record (file, zeile); + . + +____________________________________________________________________________ + +#page# + +5.4.6 Editor-Prozeduren + +'edit' + #on("b")#edit (TEXT CONST datei)#off("b")# + Editieren der Datei 'datei'. Das Editorfenster ist maximal groß (von 1,1 bis + max,max). Der Standard-Kommandointerpreter ist gültig, so daß Eingaben, die + mit #schl("ESC")# beginnen, interpretiert werden, wie in 3.4 'Vorbelegte Tasten' beschrie­ + ben. + + #on("b")#edit#off("b")# + Wie oben, editiert wird die Datei mit dem zuletzt benutzten Namen. + + #on("b")#edit (THESAURUS CONST thes)#off("b")# + Wie oben, editiert werden alle Dateien, deren Namen im Thesaurus 'thes' enthal­ + ten sind. + + #on("b")#edit (TEXT CONST datei, INT CONST von x, von y, bis x, bis y)#off("b")# + Editieren der Datei 'datei'. Das Editorfenster hat die linke obere Ecke bei 'von x, + von y' und die rechte untere Ecke bei 'bis x, bis y'. + + #on("b")#edit (FILE VAR f)#off("b")# + Editieren der als 'sequential file' assoziierten Textdatei 'f'. + + #on("b")#edit (FILE VAR, INT CONST von x, von y, bis x, bis y)#off("b")# + Editieren der als 'sequential file' assoziierten Textdatei in einem Fenster mit der + linken, oberen Ecke 'von x, von y' und der rechten, unteren Ecke 'bis x, bis y'. + + #on("b")#edit (FILE VAR f, TEXT CONST res, + PROC (TEXT CONST) kdo interpreter)#off("b")# + Editieren der als 'sequential file' assoziierten Textdatei 'f'. In 'res' werden reser­ + vierte Zeichen übergeben, die von der Prozedur 'kdo interpreter' als Kommandos + interpretiert werden, wenn sie als ESC-Sequenz eingegeben werden. + Beispiel : #schl("ESC ")# #schl("e")# + +#page# +'editget' + #on("b")#editget (TEXT VAR ausgabe) #off("b")# + Aufruf des Zeileneditor. An der aktuellen Cursorposition wird eine Zeile ausgegeben in + der 'ausgabe' steht. Für diese Zeile stehen alle Editiermöglichkeiten zur + Verfügung, 'ausgabe' kann also beliebig überschrieben, ergänzt etc. werden. Die + Eingabe wird durch #schl("CR")# abgeschlossen. Im Gegensatz zur Prozedur 'get' ist auch + eine leere Eingabe möglich. + + #on("b")#editget (TEXT VAR ausgabe, INT CONST zeile, INT CONST scroll, + TEXT CONST sep, TEXT CONST res, TEXT VAR exit) #off("b")# + Wie oben, die Zeilenlänge ist jedoch auf 'zeile' Zeichen begrenzt. Die Eingabe + wird durch #schl("CR")# oder durch eine Cursorbewegung über die Position 'zeile' hinaus + abgeschlossen. + + Die Angabe 'scroll' setzt die Breite des Zeilenfensters fest, wird diese Breite + überschritten, so wird 'ausgabe' gerollt. + + In 'sep' (Separator) können Zeichen festgesetzt werden, mit denen die Eingabe + beendet wird (zusätzlich zu CR !). + + In 'res' (reservierte Tasten) können Tasten festgelegt werden, die in Verbindung + mit die Eingabe beenden. + + Wurde der Zeileneditor durch einen Separator verlassen, so steht in 'exit' dieses + Zeichen. Falls der Zeileneditor durch eine reservierte Taste verlassen, so enthält + 'exit' 'ESC' und die Taste. + + #on("b")#editget (TEXT VAR ausgabe, INT CONST zeile, INT CONST scroll)#off("b")# + Bedeutung der Parameter siehe oben. + + #on("b")#editget (TEXT VAR ausgabe, TEXT CONST sep, TEXT CONST res, + TEXT VAR exit) #off("b")# + Bedeutung der Parameter siehe oben. + + #on("b")#editget (TEXT VAR ausgabe, INT CONST zeile, TEXT VAR exit) #off("b")# + Bedeutung der Parameter siehe oben. +#page# + +5.4.7 Sortierung von Textdateien + +Für die Sortierung von Textdateien gibt es zwei Sortierprogramme: + +- Sortierung nach ASCII : sort + +- Sortierung nach + deutschem Alphabet : lexsort + + +'sort' + #on("b")#PROC sort (TEXT CONST datei) #off("b")# + Diese Prozedur sortiert die Datei 'datei' zeilenweise gemäß der von der EUMEL + Codetabelle (siehe 5.2.4) vorgegebenen Reihenfolge. Zur Sortierung werden die + Zeilen vom ersten Zeichen der Zeile beginnend, zeichenweise verglichen und + dementsprechend sortiert. + + #on("b")#PROC sort (TEXT CONST datei, INT CONST position) #off("b")# + Sortierkriterien wie oben, jedoch wird bei Vergleich und Sortierung der Satz erst + ab der Position 'position' beachtet. Sortiert wird der ganze Satz! + + +'lex sort' + #on("b")#PROC lex sort (TEXT CONST datei) #off("b")# + Zeilenweise Sortierung nach lexikographischer Reihenfolge gemäß DIN 5007. Zu + den Vergleichen werden die Operatoren LEXEQUAL, LEXGRATER, + LEXGRATEREQUAL benutzt (siehe 5.2.4). + + #on("b")#PROC lex sort (TEXT CONST datei, INT CONST position) #off("b")# + Lexikalische Sortierung durch Vergleich ab Position 'position'. + +#page# + +5.4.8 Prozeduren auf Datenräumen + +Neben den Textdateien gibt es im EUMEL-System den Typ Datenraum, der Objekte +jeglichen Typs aufnehmen kann und direkten Zugriff auf die Objekte gewährt (siehe +2.9.2). + +Für Objekte von Type Datenraum (nicht für die in Datenräumen enthaltenen Objekte!) +existieren folgende Standardprozeduren: + + +':=' + #on("b")#OP := ( DATASPACE VAR ds1, DATASPACE CONST ds2)#off("b")# + Der Datenraum 'ds1' wird als Kopie von 'ds2' angelegt. Es handelt sich zunächst + um eine logische Kopie, eine physische Kopie wird erst nach einem Schreibzugriff + auf 'ds1' oder 'ds2' nötig. + + +'new' + #on("b")#DATASPACE PROC new (TEXT CONST dsname) #off("b")# + Liefert einen neuen Datenraum namens 'dsname'. + +____________________________________________________________________________ + + DATASPACE VAR ds := new ("datenraum") + (* ergibt zwei Datenräume 'ds' und 'datenraum'! *) + +____________________________________________________________________________ + + + +'nilspace' + #on("b")#DATASPACE PROC nilspace#off("b")# + Der 'nilspace' ist ein leerer Datenraum, der ausschließlich als Quelle zum Kopie­ + ren bei der Initialisierung Verwendung finden darf. + + +'old' + #on("b")#DATASPACE PROC old (TEXT CONST dsname) #off("b")# + Liefert einen bereits existierenden Datenraum (oder auch eine Datei) mit dem + Namen 'dsname'. + + FEHLER : "dsname" gibt es nicht + + +'type' + #on("b")#PROC type (DATASPACE CONST ds, INT CONST typ)#off("b")# + Der Datenraum 'ds' erhält den frei wählbaren Schlüssel 'typ'. Es muß eine positive + Zahl gewählt werden. Der Datenraum muß zum Zeitpunkt der Typzuweisung an + ein BOUND Objekt gekoppelt (gewesen) sein. + + #on("b")#INT PROC type (DATASPACE CONST ds)#off("b")# + Liefert den Schlüssel des Datenraums 'ds'. Falls 'ds' nie an ein BOUND Objekt + gekoppelt war, liefert die Prozedur einen Wert < 0, sonst 0 (keine Zuweisung + erfolgt) oder die zugewiesene Typnummer. + + +'dataspaces' + #on("b")#INT PROC dataspaces (TASK CONST task) #off("b")# + Liefert die Anzahl der Datenräume der Task 'task'. + + #on("b")#INT PROC dataspaces #off("b")# + Anzahl der Datenräume von 'myself'. + + +'ds pages' + #on("b")#INT PROC ds pages (DATASPACE CONST ds)#off("b")# + Liefert die Anzahl der durch 'ds' belegten Seiten (je 512 Byte). + + +'storage' + #on("b")#INT PROC storage (DATASPACE CONST ds)#off("b")# + Liefert den von 'ds' belegten Speicherplatz in KB. + +#page# +'copy' + #on("b")#PROC copy (DATASPACE CONST ds, TEXT CONST datei) #off("b")# + Eine neue Datei mit dem Namen 'datei' wird angelegt. Der Inhalt der Datei ist eine + Kopie des Inhalts des Datenraumes 'ds'. + + +'forget' + #on("b")#PROC forget (DATASPACE CONST ds)#off("b")# + Der Datenraum 'ds' wird gelöscht#u#1)#e#. + +#foot# + + 1) Durch diese Prozedur steht nicht unmittelbar mehr freier Speicherplatz zur + Verfügung. Die physische Räumung von Speicherplatz erfolgt durch die + 'Müllabfuhr' bei einem Fixpunkt. +#end# + +'fetch' + #on("b")#PROC fetch (DATASPACE CONST ziel, TEXT CONST datei, + TASK CONST manager) #off("b")# + Aus der Task 'manager' wird der Datenraum der Datei 'datei' in den eigenen + Datenraum 'ziel' kopiert. + + +'save' + #on("b")#PROC save (DATASPACE CONST quelle, TEXT CONST datei, + TASK CONST manager) #off("b")# + Der eigene Datenraum 'quelle' wird in die Datei 'datei' in der Task 'manager' + kopiert. +#page# + +5.5 Eingabe/Ausgabe + +- Eingabesteuerzeichen : HOP , � � � � , TAB , RUBIN , RUBOUT + CR , MARK , ESC + +- Ausgabesteuerzeichen : HOME , � � � � , CL EOP , CL EOL + CPOS , BELL , CR , ENDMARK , BEGINMARK + +- Positionierung : cursor , get cursor , line , page + +- Eingabe : get , getline , inchar , incharety + +- Ausgabe : cout , out , out subtext , put , putline , + TIMESOUT , write + +- Kontrolle : online , pause , sysin , sysout + +- Zeitmessung : clock , date , day , hour , pause , time + time of day + +#page# + +5.5.1 E/A auf Bildschirm + +Steuerzeichen und Standardprozeduren zur Ein- Ausgabe am Bildschirm werden +zur Steuerung des Dialogverhaltens von Prozeduren benutzt. + + +5.5.1.1 Eingabesteuerzeichen +Eingabesteuerzeichen werden durch die Funktionstasten (s. 3.2) erzeugt. Die Wirkung +der Tasten ist ebenfalls an dieser Stelle beschrieben. + +Durch die Tasten werden folgende Codes an Programme gegeben: + +Codierung I Bezeichnung +-----------+-------------- +HOP I 1 +RECHTS I 2 +OBEN I 3 +LINKS I 8 +TAB I 9 +UNTEN I 10 +RUBIN I 11 +RUBOUT I 12 +CR I 13 +MARK I 16 +ESC I 27 + + +#page# + +5.5.1.2 Ausgabesteuerzeichen + +Die Ausgabe dieser Zeichen bewirkt folgendes Verhalten der Bildschirmausgabe. + +Code I Name I Wirkung +-----+-------------+------------------------------------------------------- + 0 I NUL I keine Wirkung + 1 I HOME I Cursor in die linke obere Ecke setzen (Position 0,0!) + 2 I RECHTS I Cursor eine Stelle nach rechts setzen + 3 I OBEN I Cursor eine Zeile höher setzen + 4 I CL EOP I Rest der Seite löschen + 5 I CL EOL I Rest der Zeile löschen + 6 I CPOS I Cursor setzen, nächstes Ausgabezeichen bestimmt die + I I y-Position, das darauf folgende die x-Position. + 7 I BELL I akustisches Signal + 8 I LINKS I Cursor eine Stelle nach links setzen +10 I UNTEN I Cursor eine Stelle nach unten setzen +13 I CR I Cursor an den Anfang der nächsten Zeile setzen +14 I ENDMARK I Ende des markierten Bereichs +15 I BEGINMARK I Anfang des markierten Bereichs + + + + +____________________________________________________________________________ + + ........................... Beispiel .......................... + TEXT VAR ausgabe := (""7""15"V O R S I C H T"14"7""); + out(ausgabe); + +____________________________________________________________________________ + +#page# + +5.5.1.3 Positionierung + +'cursor' + #on("b")#PROC cursor (INT CONST column, row) #off("b")# + Positioniert den Cursor auf dem Bildschirm, wobei 'column' die Spalte und 'row' + die Zeile angibt. Die zulässigen Bereiche von 'column' und 'row' sind geräteab­ + hängig. + + + +'get cursor' + #on("b")#PROC get cursor (INT VAR x, y) #off("b")# + Erfragung der aktuellen Cursor-Position. Die Koordinaten des Cursors werden in + 'x' und 'y' geliefert. Die aktuelle Cursor-Position ist nach Ausgabe von 'HOME' + (Code = 1) oder einer Positionierung des Cursors mit der Prozedur 'cursor' stets + definiert. Die Prozedur 'get cursor' liefert jedoch undefinierte Werte, wenn über + den rechten Rand einer Zeile hinausgeschrieben wurde (die Wirkung einer solchen + Operation hängt von der Hardware eines Terminals ab). + + +'line' + #on("b")#PROC line #off("b")# + Es wird zum Anfang einer neuen Zeile positioniert. + + #on("b")#PROC line (INT CONST number) #off("b")# + Es werden 'number' Zeilenwechsel vorgenommen. + + +'page' + #on("b")#PROC page #off("b")# + Es wird zum Anfang einer neuen Seite positioniert (hier: linke obere Ecke (Position + 1,1 !) des Bildschirms, wobei der Bildschirm gelöscht wird). + +#page# + +5.5.1.4 Eingabe + + +Grundlegende Prozeduren +Die folgenden Prozeduren dienen ausschließlich der Eingabe vom Terminal. + +'editget' + Siehe 5.4.6 + + +'getchar' + #on("b")#PROC getchar (TEXT VAR zeichen)#off("b")# + Liest genau ein Zeichen von der Tastatur und schreibt es in die Variable 'zeichen'. + + +'inchar' + #on("b")#PROC inchar (TEXT VAR character) #off("b")# + Wartet solange, bis ein Zeichen von der Tastatur eingegeben wird, und schreibt + dieses Zeichen in die Variable 'character'. + + +'incharety' + #on("b")#TEXT PROC incharety #off("b")# + Versucht, ein Zeichen von der Tastatur zu lesen. Wurde kein Zeichen eingegeben, + wird niltext geliefert. + + #on("b")#TEXT PROC incharety (INT CONST time limit) #off("b")# + Versucht, ein Zeichen vom Bildschirm zu lesen. Dabei wird maximal eine 'time + limit' lange Zeit auf das Zeichen gewartet (gemessen in Zehntel-Sekunden). + +#page# + +Umleitbare Eingabeprozeduren +Die folgenden Eingabeprozeduren lesen ebenfalls vom Terminal, die Eingabequelle +kann jedoch durch die Prozedur 'sysin' umgestellt werden. Falls in 'sysin' eine Datei +angegeben wird wird die Eingabe statt vom Terminal aus dieser Datei gelesen. + + +'sysin' + #on("b")#PROC sysin (TEXT CONST file name) #off("b")# + Eingabe-Routinen lesen nicht mehr vom Benutzer-Terminal, sondern aus der + Datei 'file name'. + + #on("b")#TEXT PROC sysin #off("b")# + Liefert den Namen der eingestellten 'sysin'-Datei. "" bezeichnet das Benutzer- + Terminal. + + +'get' + #on("b")#PROC get (INT VAR number) #off("b")# + Einlesen eines INT-Wertes vom Bildschirm. Der einzulesende INT-Wert kann + bei der Eingabe vom Terminal editiert werden. + + #on("b")#PROC get (REAL VAR value) #off("b")# + Einlesen eines REAL-Wertes vom Bildschirm. Der einzulesende REAL-Wert + kann bei der Eingabe vom Terminal editiert werden. + + #on("b")#PROC get (TEXT VAR word) #off("b")# + Liest einen Text in die Variable 'word' mit maximal 255 Zeichen. Es werden + solange Zeichen vom Terminal gelesen, bis ein Leerzeichen oder #schl("CR")# eingegeben + wird. Dabei werden führende Leerzeichen übergeben. Der einzulesende Text + kann bei der Eingabe editiert werden. Eine leere Eingabe ist nicht erlaubt. + + #on("b")#PROC get (TEXT VAR word, INT CONST laenge) #off("b")# + Liest einen Text vom Bildschirm mit der Länge 'laenge' oder bis #schl("CR")# eingegeben + wird. Der einzulesende Wert kann bei der Eingabe editiert werden. + + #on("b")#PROC get (TEXT VAR word, TEXT CONST separator) #off("b")# + Liest einen Text vom Bildschirm, bis ein Zeichen 'separator' angetroffen oder #schl("CR")# + eingegeben wird. Der einzulesende Text kann bei der Eingabe editiert werden. + + +'getline' + #on("b")#PROC get line (TEXT VAR line) #off("b")# + Das System wartet auf eine Zeile vom Bildschirm (max. 255 Zeichen). #schl("CR")# been­ + det die Eingabe. + +#page# + +5.5.1.5 Ausgabe + + +Grundlegende Prozeduren +Die folgenden Prozeduren dienen ausschließlich der Ausgabe auf das Terminal. + + +'cout' + #on("b")#PROC cout (INT CONST number) #off("b")# + Schreibt 'number' an die aktuelle Cursor-Position auf den Bildschirm. Anschlie­ + ßend wird an diese Position wieder zurück positioniert. 'number' muß > 0 sein. + Paßt 'number' nicht mehr auf die Zeile, so ist die Wirkung von 'cout' nicht de­ + finiert. 'cout' gibt den Wert von 'number' nur aus, wenn genügend freie Kanal- + Kapazität für diese Ausgabe vorhanden ist. Das hat zur Folge, daß Programme + nicht auf die Beendigung einer Ausgabe von 'number' warten müssen und ggf. + Ausgaben überschlagen werden. + + +'out' + #on("b")#PROC out (TEXT CONST text) #off("b")# + Ausgabe eines Textes auf dem Bildschirm. Im Unterschied zu 'put' wird kein + Blank an den ausgegebenen Text angefügt. + + + +'out subtext' + #on("b")#PROC out subtext (TEXT CONST source, INT CONST from) #off("b")# + Ausgabe eines Teiltextes von 'source' von der Position 'from' bis Textende. Es + wird keine Aktion vorgenommen für + + + from > LENGTH source + + + #on("b")#PROC out subtext (TEXT CONST source, INT CONST from, to)#off("b")# + Ausgabe eines Teiltextes von 'source' von der Position 'from' bis zur Position 'to'. + Für + + + to > LENGTH source + + + wird out subtext (source, from) ausgeführt. + + #on("b")#PROC out text (TEXT CONST source, INT CONST from, to) #off("b")# + Ausgabe eines Teiltextes von 'source' von der Position 'from' bis zur Position 'to'. + Für + + + to > LENGTH source + + + wird für die fehlenden Zeichen Blanks ausgegeben. + + + +'TIMESOUT' + #on("b")#OP TIMESOUT (INT CONST times, TEXT CONST text) #off("b")# + Ausgabe eines TEXTes 'text' 'times'mal. An die Ausgabe wird im Gegensatz zu + 'put' kein Leerzeichen angefügt. Es wird kein Text ausgegeben für + + + times < 1 + + +#page# + +Umleitbare Ausgabeprozeduren +Die folgenden Ausgabeprozeduren schreiben ebenfalls auf das Terminal, die Ausgabe +kann jedoch durch die Prozedur 'sysout' umgeleitet werden. Falls in 'sysout' eine +Datei angegeben wird wird die Ausgabe statt zum +Terminal in die angegebene Datei geleitet. + + +'sysout' + #on("b")#PROC sysout (TEXT CONST file name) #off("b")# + Ausgabe-Routinen gehen nicht mehr zum Benutzer-Terminal, sondern in die + Datei 'file name'. + + #on("b")#TEXT PROC sysout #off("b")# + Liefert den Namen der eingestellten 'sysout'-Datei. "" bezeichnet das Benut­ + zer-Terminal. + + +'line' + #on("b")#line#off("b")# + Positionierung auf den Anfang einer neuen Ausgabezeile. + + #on("b")#line (INT CONST faktor)#off("b")# + Nächste Ausgabezeile um 'faktor' Zeilen weiter positionieren. + + +'put' + #on("b")#PROC put (INT CONST number) #off("b")# + Ausgabe eines INT-Wertes auf dem Bildschirm. Anschließend wird ein Leer­ + zeichen ausgegeben. + + #on("b")#PROC put (REAL CONST real) #off("b")# + Ausgabe eines REAL-Wertes auf dem Bildschirm. Anschließend wird ein Leer­ + zeichen ausgegeben. + + #on("b")#PROC put (TEXT CONST text) #off("b")# + Ausgabe eines Textes auf dem Bildschirm. Nach der Ausgabe von 'text' wird ein + Blank ausgegeben, um nachfolgenden Ausgaben auf der gleichen Zeile voneinan­ + der zu trennen. Hardwareabhängig sind die Aktionen, wenn eine Ausgabe über + eine Zeilengrenze (hier: Bildschirmzeile) vorgenommen wird. Meist wird die Ausga­ + be auf der nächsten Zeile fortgesetzt. + + +'putline' + #on("b")#PROC putline (TEXT CONST text) #off("b")# + Ausgabe von 'text' auf dem Bildschirm. Nach der Ausgabe wird auf den Anfang + der nächsten Zeile positioniert. Gibt man TEXTe nur mit 'putline' aus, so ist + gesichert, daß jede Ausgabe auf einer neuen Zeile beginnt. Hardwareabhängig + sind die Aktionen, wenn eine Ausgabe über eine Zeilengrenze (hier: Bildschirm­ + zeile) vorgenommen wird. Meist wird die Ausgabe auf der nächsten Zeile fort­ + gesetzt. + + +'write' + #on("b")#PROC write (TEXT CONST text) #off("b")# + Gibt 'text' ohne Trennblank aus ('put' mit Trennblank). + +#page# + +5.5.1.6 Kontrolle + +'online' + #on("b")#BOOL PROC online #off("b")# + Liefert TRUE, wenn die Task mit einem Terminal gekoppelt ist. + + +'pause' + #on("b")#PROC pause (INT CONST time limit) #off("b")# + Wartet 'time limit' in Zehntel-Sekunden. Bei negativen Werten ist die Wirkung + nicht definiert. Die Wartezeit wird nicht nur durch das Erreichen der Grenze ab­ + gebrochen, sondern auch durch die Eingabe eines beliebigen Zeichens. + + #on("b")#PROC pause#off("b")# + Wartet bis zur Eingabe eines beliebigen Zeichens. + + +#page# + +5.5.2 Zeitmessung + +'clock' + #on("b")#REAL PROC clock (INT CONST index) #off("b")# + Datum und Uhrzeit werden vom EUMEL-System für alle Tasks geführt. Neben + einer Uhr ('Realzeituhr'), die das Datum und die aktuelle Uhrzeit enthält, wird eine + Uhr für die von der Task verbrauchte CPU-Zeit geführt ('CPU-Zeituhr'). Beide + Zeiten werden vom System als REALs realisiert. Die Prozedur 'clock' liefert die + aktuellen Werte dieser Uhren. Bei 'index = 0' wird die akkumulierte CPU-Zeit + der Task, bei 'index = 1' der Wert der Realzeituhr geliefert. + + Mit den REAL-Werten der Uhren kann ohne weiteres gerechnet werden, jedoch + sind nur Werte > 0 definiert. Die REAL-Werte der Realzeituhr beginnen beim + 1.1.1900 um 0 Uhr. Es sind nur Werte für dieses Jahrhundert zugelassen. Werte + der Realzeituhr in lesbarer Form kann man durch die Konvertierungsprozeduren + 'date' (vergl. 5- #topage("date")# ) (für den aktuellen Tag) und 'time of day' (Uhrzeit, vergl. + 5-#topage("time")#) erhalten. + + Um die benötigte CPU-Zeit eines Programms zu berechnen, muß man die + CPU-Zeituhr zweimal abfragen. Um solche Zeiten in lesbarer Form zu erhalten, + kann man die Konvertierungsprozedur 'time' (vergl. 5- #topage("time")#) verwenden. Beispiel: + +____________________________________________________________________________ + + ........................... Beispiel .......................... + REAL CONST anfang :: clock (0); + berechnungen; + REAL CONST ende :: clock (0); + put ("benoetigte CPU-Zeit in Sek:"); + put (time (ende - anfang)) + +____________________________________________________________________________ +#page# +'date' +#goalpage("date")# + #on("b")#TEXT PROC date (REAL CONST time) #off("b")# + Konvertierungsprozedur für das Datum, welches sich aus dem Aufruf der Prozedur + 'clock (1)' ergibt. Das Datum wird in der Form 'tt.mm.jj' geliefert. Beispiel: + +____________________________________________________________________________ + + put (date (clock (1))) (* z.B.: 24.12.87 *) + +____________________________________________________________________________ + + + #on("b")#REAL PROC date (TEXT CONST datum) #off("b")# + Konvertierungsprozedur für ein Datum in der Form 'tt.mm.jj'. Liefert einen + REAL-Wert, wie ihn die Prozedur 'clock (1)' liefern würde. Beispiel: + +____________________________________________________________________________ + + put (date ("24.12.87")) (* 6.273539e10 *) + +____________________________________________________________________________ + + + #on("b")#TEXT PROC date#off("b")# + Liefert das Tagesdatum. Wirkt wie 'date (clock (1))', ist jedoch erheblich schneller. + + + +'day' + #on("b")#REAL CONST day #off("b")# + Liefert die Anzahl der Sekunden eines Tages (86 400.0). + + + +'hour' + #on("b")#REAL CONST hour #off("b")# + Liefert die Anzahl der Sekunden einer Stunde (3600.0). + + + +'pause' + #on("b")#PROC pause (INT CONST time limit) #off("b")# + Wartet 'time limit' in Zehntel-Sekunden. Bei negativen Werten ist die Wirkung + nicht definiert. Die Wartezeit wird nicht nur durch das Erreichen der Grenze ab­ + gebrochen, sondern auch durch die Eingabe eines beliebigen Zeichens. + + + +'time' +#goalpage("time")# + #on("b")#TEXT PROC time (REAL CONST time) #off("b")# + Konvertierungsprozedur für die Zeiten der CPU-Zeituhr. Liefert die Zeiten in der + Form 'hh:mm:ss.s'. Vergl. dazu 'clock'. + + #on("b")#TEXT PROC time (REAL CONST value, INT CONST laenge) #off("b")# + Konvertiert die Zeit in externe Darstellung. Für die 'laenge'-Werte ergibt sich: + + + laenge = 10 (* hh:mm:ss.s *) + laenge = 12 (* hhhh:mm:ss.s *) + + + + #on("b")#REAL PROC time (TEXT CONST time) #off("b")# + Konvertierungsprozedur für Texte der CPU-Zeituhr in REAL-Werte. + + + +'time of day' + #on("b")#TEXT PROC time of day (REAL CONST time) #off("b")# + Konvertierungsprozedur für REALs, wie sie die Realzeituhr + liefert. Es wird die Tageszeit in der Form 'hh:mm' geliefert. Beispiel: + +____________________________________________________________________________ + + put (time of day (clock (1))) (* z.B.: 17:25 *) + +____________________________________________________________________________ + + + #on("b")#TEXT PROC time of day #off("b")# + Liefert die aktuelle Tageszeit. Entspricht + +____________________________________________________________________________ + + time of day (clock (1)) + +____________________________________________________________________________ +#page# + +5.6 Scanner + +Der Scanner kann benutzt werden, um festzustellen, welche Art von Symbolen in +einem TEXT enthalten sind. Die Repräsentation der Symbole müssen dabei der +ELAN-Syntax entsprechen. Folgende #ib#Symbole#ie# kann der Scanner erkennen: + + - "tags", d.h. Namen, + - "bolds", d.h. Schlüsselworte, + - "number", d.h. INT oder REAL Zahlen, + - Operatoren, + - "delimiter", d.h. Begrenzer wie z.B. ";", + - und das Ende des Scan-Textes. + + +Der Scanner überliest Kommentare und Leerzeichen zwischen den Symbolen. Der +(erste) zu verarbeitende Text muß mit der Prozedur + + + #ib#scan#ie# + + +in den Scanner "hineingesteckt" werden. Mit der Prozedur + + + #ib#next symbol#ie# + + +wird das jeweils nächste Symbol des TEXTes geholt. Am Ende wird "end of scan" +und als Symbol 'niltext' geliefert. Falls innerhalb eines TEXT-Denoters oder eines +Kommentars "end of scan" auftritt, wird "within text" bzw. "within comment" gemel­ +det. Der Scan-Prozeß kann dann mit dem nächsten zu scannenden TEXT (der +nächsten Zeile) fortgesetzt werden. Dafür wird nicht die Prozedur 'scan', sondern + + + #ib#continue scan#ie# + + +verwandt. Sie setzt im letzten Scan-Zustand (z.B. Kommentar oder TEXT-Deno­ +ter) wieder auf, so daß auch Folgen von TEXTen (Zeilen) wie z.B. Dateien leicht +gescannt werden können. + +Mit den Prozeduren + + + scan (* meldet eine Datei zum scannen an *) + next symbol (* holt die Symbole *) + + +kann man auch eine Datei nach ELAN-Symbolen untersuchen. + +____________________________________________________________________________ + + FILE VAR f :: ... + ... + scan (f); (* beginnt das Scanning in + der nächsten Zeile *) + TEXT VAR symbol; + INT VAR type; + REP + next symbol (f, symbol, type); + verarbeite symbol + UNTIL type >= 7 END REP. + +____________________________________________________________________________ + +#page# + +Scanner-Kommandos + + +'continue scan' + #on("b")#PROC continue scan (TEXT CONST scan text) #off("b")# + Das Scanning soll mit 'scan text' fortgesetzt werden. Falls der Scan-Vorgang + beim vorigen 'scan text' innerhalb eines TEXT-Denoters oder eines Kommentars + abgebrochen wurde, wird er jetzt entsprechend mit dem nächsten 'next symbol' + fortgesetzt. Der erste Teil-Scan einer Folge muß aber stets mit 'scan' eingeleitet + werden! + +'next symbol' + #on("b")#PROC next symbol (TEXT VAR symbol, INT VAR type) #off("b")# + Holt das nächste Symbol. In "symbol" steht der TEXT des Symbols, so z.B. die + Ziffern eines INT-Denoters. Bei TEXT-Denotern werden die führenden und + abschließenden Anführungsstriche abgeschnitten. Leerzeichen oder Kommentare + spielen in "tags" oder "numbers" keine Rolle. Zwischen Symbolen spielen Leer­ + zeichen oder Kommentare keine Rolle. In "type" steht eine Kennzeichung für den + Typ des Symbols: + + tag = 1 , + bold = 2 , + number = 3 , + text = 4 , + operator = 5 , + delimiter = 6 , + end of file = 7 , + within comment = 8 , + within text = 9 . + + Wird Scan-Ende innerhalb eines Kommentars gefunden, so wird 'niltext' und + 'within comment' geliefert. Wird Scan-Ende innerhalb eines TEXT-Denoters + gefunden, so wird der schon analysierte Teil des Denoters und 'within text' gelie­ + fert. + + #on("b")#PROC next symbol (TEXT VAR symbol) #off("b")# + s.o. Es wird aber nur der Text des Symbols (ohne Typ) geliefert. + + #on("b")#PROC next symbol (FILE VAR f, TEXT CONST symbol) #off("b")# + Arbeitet wie obige Prozeduren, jedoch auf einen FILE. + + #on("b")#PROC next symbol (FILE VAR f, TEXT CONST symbol, INT VAR type)#off("b")# + Arbeitet wie obige Prozeduren, jedoch auf einen FILE. + + +'scan' + #on("b")#PROC scan (TEXT CONST scan text) #off("b")# + Meldet einen 'scan text' für den Scanner zur Verarbeitung an. Die Prozedur 'scan' + muß vor dem ersten Aufruf von 'next symbol' gegeben werden. Im Gegensatz zu + 'continue scan' normiert 'scan' den inneren Zustand des Scanners, d.h. vorherige + Scan-Vorgänge haben keinen Einfluß mehr auf das Scanning. + + #on("b")#PROC scan (FILE VAR f) #off("b")# + Wie obige Prozedur, jedoch auf einen FILE. Die zu scannende Zeile ist die näch­ + ste Zeile im FILE 'f' ('scan' macht zuerst ein 'getline'). + diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.6 b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.6 new file mode 100644 index 0000000..ce11f6f --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.6 @@ -0,0 +1,1441 @@ +#pagenr("%",1)##setcount(1)##block##pageblock# +#headeven# +#center#EUMEL-Benutzerhandbuch +#center#____________________________________________________________ + +#end# +#headodd# +#center#TEIL 6 : Das Archiv 'std.zusatz' +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +6 - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#6 - % +#end# + +TEIL 6: Das Archiv 'std.zusatz' + +Das Archiv 'std.zusatz' enthält Pakete, die nur bei Bedarf insertiert werden sollen. +Eine Einbindung in das EUMEL Grundsystem würde dieses ungebührlich unfangreich +machen. + +Das Archiv enthält zusätzliche Software für: + +- mathematische Operationen : complex , longint , vector , matrix + +- Analyse : reporter , referencer + +- Taschenrechnerfunktion + zur Editor-Erweiterung : TeCal , TeCal Auskunft + + +#page# + +6.1. Erweiterungen um + Mathematische Operationen + + +6.1.1 COMPLEX + +Das Packet COMPLEX erweitert das System um den Datentyp COMPLEX (komplexe +Zahlen) und Operationen auf komplexen Zahlen. Folgende Operationen stehen für +COMPLEX zur Verfügung: + +- Einfache Operatoren : := , = , <> , + ,- , * + +- Eingabe/Ausgabe : get , put + +- Denotierungsprozedur : complex , complex i , complex one , com­ + plex zero + +- Komponenten : real part , imag part + +- bes. Funktionen : ABS , CONJ , phi , dphi , sqrt + +#page# + +COMPLEX Operationen + + +'TYPE COMPLEX' + Komplexe Zahl, bestehend aud Realteil 're' und Imaginärteil 'im'. + + +':=' + #on("b")#OP := (COMPLEX VAR a, COMPLEX CONST b) #off("b")# + Zuweisung. + + +'=' + #on("b")#BOOL OP = (COMPLEX CONST a, b) #off("b")# + Vergleich von 'a' und 'b' auf Gleichheit. + + +'<>' + #on("b")#BOOL OP <> (COMPLEX CONST a, b) #off("b")# + Vergleich von 'a' und 'b' auf Ungleichheit. + + +'+' + #on("b")#COMPLEX OP + (COMPLEX CONST a, b) #off("b")# + Summe von 'a' und 'b'. + + +'-' + #on("b")#COMPLEX OP - (COMPLEX CONST a, b) #off("b")# + Differenz von 'a' und 'b'. + + +'*' + #on("b")#COMPLEX OP * (COMPLEX CONST a, b) #off("b")# + Multiplikation von 'a' mit 'b'. + + +'/' + #on("b")#COMPLEX OP / (COMPLEX CONST a, b) #off("b")# + Division von 'a' mit 'b'. + +#page# +'get' + #on("b")#PROC get (COMPLEX VAR a) #off("b")# + Einlesen eines komplexen Wertes vom Bildschirm in der Form zweier REAL-De­ + noter. Die Eingabe kann editiert werden. + + +'put' + #on("b")#PROC put (COMPLEX CONST a) #off("b")# + Ausgabe eines komplexen Wertes auf dem Bildschirm in Form zweier REAL- + Werte. Hinter jedem REAL-Wert wird ein Leerzeichen angefügt. + + +'complex' + #on("b")#COMPLEX PROC complex (REAL CONST re, im) #off("b")# + Denotierungsprozedur. Angabe in kartesischen Koordinaten. + + +'complex i' + #on("b")#COMPLEX PROC complex i #off("b")# + Denotierungsprozedur für den komplexen Wert '0.0 + i 1.0'. + + +'complex one' + #on("b")#COMPLEX PROC complex one #off("b")# + Denotierungsprozedur für den komplexen Wert '1.0 + i 0.0'. + + +'complex zero' + #on("b")#COMPLEX PROC complex zero #off("b")# + Denotierungsprozedur für den komplexen Wert '0.0 + i 0.0'. + + +'imag part' + #on("b")#REAL PROC imag part (COMPLEX CONST number) #off("b")# + Liefert den Imaginärteil des komplexen Wertes 'number'. + + +'real part' + #on("b")#REAL PROC real part (COMPLEX CONST number) #off("b")# + Liefert den Real-Teil des komplexen Wertes 'number'. + + +'ABS' + #on("b")#REAL OP ABS (COMPLEX CONST x) #off("b")# + REAL-Betrag von 'x'. + + +'CONJ' + #on("b")#COMPLEX OP CONJ (COMPLEX CONST number) #off("b")# + Liefert den konjugiert komplexen Wert von 'number'. + + +'dphi' + #on("b")#REAL PROC dphi (COMPLEX CONST x) #off("b")# + Winkel von 'x' (Polardarstellung). + + +'phi' + #on("b")#REAL PROC phi (COMPLEX CONST x) #off("b")# + Winkel von 'x' (Polardarstellung) in Radiant. + + +'sqrt' + #on("b")#COMPLEX PROC sqrt (COMPLEX CONST x) #off("b")# + Wurzelfunktion für komplexe Werte. + +#page# + +6.1.2 LONGINT + +LONGINT ist ein Datentyp, für den (fast) alle Prozeduren und Operatoren des Daten­ +typs INT implementiert wurden. LONGINT unterscheidet sich von INT dadurch, daß +erheblich größere Werte darstellbar sind. + +Für den Datentyp LONGINT stehen folgende Operationen zur Verfügung: + +- Operatoren : := , = , <> , < , <= ,> , >= , + , - , * , + ** , + ABS , DECR , DIV , INCR , MOD , SIGN + +- Eingabe/Ausgabe : get , put + + +- Math. Prozeduren : abs , int , longint , max , max logint , min , + random , sign , text , zero + + + +LONGINT-Operationen + + +'TYPE LONGINT' + Datentyp + + +':=' + #on("b")#OP := (LONGINT VAR links, LONGINT CONST rechts) : #off("b")# + Zuweisungsoperator + + +'= ' + #on("b")#BOOL OP = (LONGINT CONST links, rechts) #off("b")# + Vergleichen zweier LONGINTs auf Gleichheit. + + +'<>' + #on("b")#BOOL OP <> (LONGINT CONST links, rechts) #off("b")# + Vergleichen zweier LONGINTs auf Ungleichheit. + + +'< ' + #on("b")#BOOL OP < (LONGINT CONST links, rechts) #off("b")# + Vergleichen zweier LONGINTs auf kleiner. + + +'<=' + #on("b")#BOOL OP <= (LONGINT CONST links, rechts) #off("b")# + Vergleichen zweier LONGINTs auf kleiner gleich. + + +'> ' + #on("b")#BOOL OP > (LONGINT CONST links, rechts) #off("b")# + Vergleichen zweier LONGINTs auf größer. + + +'>=' + #on("b")#BOOL OP >= (LONGINT CONST links, rechts) #off("b")# + Vergleichen zweier LONGINTs auf größer gleich. + + +'+ ' + #on("b")#LONGINT OP + (LONGINT CONST argument) #off("b")# + Monadischer Operator. Ohne Wirkung. + + #on("b")#LONGINT OP + (LONGINT CONST links, rechts) #off("b")# + Addition zweier LONGINTs. + + +'- ' + #on("b")#LONGINT OP - (LONGINT CONST argument) #off("b")# + Vorzeichenumkehrung. + + #on("b")#LONGINT OP - (LONGINT CONST links, rechts) #off("b")# + Subtraktion zweier LONGINTs. + + +'* ' + #on("b")#LONGINT OP * (LONGINT CONST links, rechts) #off("b")# + Multiplikation von zwei LONGINTs. + + +'**' + #on("b")#LONGINT OP ** (LONGINT CONST argument, exponent) #off("b")# + Exponentiation zweier LONGINTs mit positivem Exponenten. + + FEHLER : + LONGINT OP ** : negative exponent + Der 'exponent' muß >= 0 sein. + 0 ** 0 is not defined + 'argument' und 'exponent' dürfen nicht gleich 0 sein. + + + #on("b")#LONGINT OP ** (LONGINT CONST argument, INT CONST exponent)#off("b")# + Exponentiation eines LONGINT mit positiven INT Exponenten. + + FEHLER : + LONGINT OP ** : negative exponent + Der 'exponent' muß >= 0 sein. + 0 ** 0 is not defined + 'argument' und 'exponent' dürfen nicht gleich 0 sein. + +'ABS' + #on("b")#LONGINT OP ABS (LONGINT CONST argument) #off("b")# + Absolutbetrag eines LONGINT. + + +'DECR' + #on("b")#OP DECR (LONGINT VAR resultat, LONGINT CONST ab) #off("b")# + resultat := resultat - ab + + +'DIV' + #on("b")#LONGINT OP DIV (LONGINT CONST links, rechts) #off("b")# + Division zweier LONGINTs. + + FEHLER : + Division durch 0 + 'rechts' muß <> 0 sein. + + +'INCR' + #on("b")#LONGINT OP INCR (LONGINT VAR resultat, LONGINT CONST dazu)#off("b")# + resultat := resultat + dazu + + + +'MOD' + #on("b")#LONGINT OP MOD (LONGINT CONST links, rechts) #off("b")# + Modulo-Funktion für LONGINTs. Der Rest einer LONGINT-Division wird ermit­ + telt. + + FEHLER : + text (links) + 'MOD 0' + 'rechts' muß ungleich null sein. + + +'SIGN' + #on("b")#INT OP SIGN (LONGINT CONST longint) #off("b")# + Feststellen des Vorzeichens von 'longint'. Liefert: + + + 0 wenn 'longint' = 0, + 1 wenn 'longint' > 0, + -1 wenn 'longint' < 0. + + +#page# +'get' + #on("b")#PROC get (LONGINT VAR zahl) #off("b")# + Eingabe eines LONGINTs vom Terminal. + + #on("b")#PROC get (FILE VAR file, LONGINT VAR zahl) #off("b")# + Einlesen von 'zahl' aus der sequentiellen Datei 'file'. Die Datei muß mit 'input' + assoziiert sein (vergl. 'sequential file'). + + FEHLER : + Datei zu + Leseversuch nach Daateiende + Leseversuch auf output-FILE + + +'put' + #on("b")#PROC put (LONGINT CONST longint) #off("b")# + Ausgabe eines LONGINTs auf dem Bildschirm. Anschließend wird ein Leerzeichen + ausgegeben. Hardwareabhängig sind die Aktionen, wenn eine Ausgabe über die + Bildschirmzeilengrenze vorgenommen wird. Meist wird jedoch die Ausgabe auf der + nächsten Zeile fortgesetzt. + + #on("b")#PROC put (FILE VAR file, LONGINT CONST zahl) #off("b")# + Ausgabe von 'zahl' in die sequentielle Datei 'file'. 'file' muß mit 'output' assoziiert + sein. + + FEHLER : + Datei zu + Schreibversuch auf input-FILE +#page# +'abs' + #on("b")#LONGINT PROC abs (LONGINT CONST argument) #off("b")# + Absolutbetrag eines LONGINT. + + +'int' + #on("b")#INT PROC int (LONGINT CONST longint) #off("b")# + Konvertierung von LONGINT nach INT. + + FEHLER : + integer overflow + 'longint' ist größer als 'maxint'. + + +'longint' + #on("b")#LONGINT PROC longint (INT CONST int) #off("b")# + Konvertierung von 'int' nach LONGINT. + + #on("b")#LONGINT PROC longint (TEXT CONST text) #off("b")# + Konvertierung von 'text' nach LONGINT. + + +'max' + #on("b")#LONGINT PROC max (LONGINT CONST links, rechts) #off("b")# + Liefert das Maximum zweier LONGINTs. + + +'maxlongint' + #on("b")#LONGINT PROC max longint #off("b")# + Liefert größten LONGINT Wert. + + +'min' + #on("b")#LONGINT PROC min (LONGINT CONST links, rechts) #off("b")# + Liefert das Minimum zweier LONGINTs. + + +'random' + #on("b")#LONGINT PROC random (LONGINT CONST lower bound, upper bound)#off("b")# + Pseudo-Zufallszahlen-Generator im Intervall 'lower bound' und 'upper bound' + einschließlich. Es handelt sich hier um den 'LONGINT Random Generator'. + + +'sign' + #on("b")#INT PROC sign (LONGINT CONST longint) #off("b")# + Feststellen des Vorzeichens von 'longint'. Liefert: + + + 0 wenn 'longint' = 0, + 1 wenn 'longint' > 0, + -1 wenn 'longint' < 0. + + + +'text' + #on("b")#TEXT PROC text (LONGINT CONST longint) #off("b")# + Konvertierung von 'longint' nach TEXT. + + #on("b")#TEXT PROC text (LONGINT CONST longint, INT CONST laenge) #off("b")# + Konvertierung von 'longint' nach TEXT. Die Anzahl der Zeichen soll 'laenge' + betragen. Für + + + LENGTH (text (longint)) < laenge + + + werden die Zeichen rechtsbündig in einen Text mit der Länge 'laenge' eingetra­ + gen. Ist der daraus entstehende TEXT kleiner als 'laenge', werden die an 'laenge' + fehlenden Zeichen im TEXT mit Leerzeichen aufgefüllt. Für + + + LENGTH (text (longint)) > laenge + + + wird ein Text mit der Länge 'laenge' geliefert, der mit '*'-Zeichen gefüllt ist. + + +'zero' + #on("b")#LONGINT PROC zero #off("b")# + Liefert LONGINT Wert Null. + + +#page# + +6.1.3 VECTOR + +Der Datentyp VECTOR erlaubt Operationen auf Vektoren aus Elementen vom Typ +REAL. Im Gegensatz zur Struktur 'ROW m REAL' muß die Anzahl der Elemente nicht +zur Übersetzungszeit deklariert werden, sondern kann zur Laufzeit festgelegt werden. +Somit kann eine zur Übersetzungszeit unbekannte Anzahl von REALs bearbeitet +werden, wobei nur soviel Speicherplatz wie nötig verwendet wird. Die maximale Größe +eines VECTOR beträgt 4000 Elemente. + +Der in den Operationen ':=', 'idn' und 'vector' benutzte Datentyp INITVECTOR wird +nur intern gehalten. Er dient der Speicherplatzersparnis bei der Initialisierung. + + +- Operatoren : := , = , <> , + , - , * , / + LENGTH , SUB + +- Eingabe/Ausgabe : get , put + +- Besondere Vector- : length , nilvector , norm , vector , replace + Operationen + +#page# +':=' + #on("b")#OP := (VECTOR VAR ziel, VECTOR CONST quelle) #off("b")# + Zuweisung. Nach der Zuweisung gilt auch + + + length (quelle) = length (ziel) + + + d.h. der linke Operand besitzt nach der Zuweisung genauso viele Elemente wie + 'quelle', unabhängig davon, ob 'ziel' vor der Zuweisung mehr oder weniger Ele­ + mente als 'quelle' besaß. Beispiel: + + + VECTOR VAR y :: vector (10, 1.0), + z :: vector (15, 2.0); + ... + y := z; (* length (y) liefert nun 15 ! *) + + + #on("b")#OP := (VECTOR VAR ziel, INITVECTOR CONST quelle) #off("b")# + Dient zur Initialisierung eines VECTORs. Beispiel: + + + VECTOR VAR x :: vector (17); + + + 'vector' erzeugt ein Objekt vom Datentyp INITVECTOR. Dieses Objekt braucht + nicht soviel Speicherplatz wie ein VECTOR-Objekt. Dadurch wird vermieden, daß + nach erfolgter Zuweisung nicht ein durch 'vector' erzeugtes Objekt auf dem Heap + unnötig Speicherplatz verbraucht. + + +'=' + #on("b")#BOOL OP = (VECTOR CONST a, b) #off("b")# + Vergleich zweier Vektoren. Der Operator liefert FALSE, wenn die Anzahl der + Elemente von 'a' und 'b' ungleich ist oder wenn zwei Elemente mit gleichem + Index ungleich sind. Beispiel: + + + VECTOR VAR x :: vector (10, 1.0), + y :: vector (15, 2.0), + z :: vector (10, 1.0); + ... x = y ... (* FALSE *) + ... x = z ... (* TRUE *) + + +'<>' + #on("b")#BOOL OP <> (VECTOR CONST a, b) #off("b")# + Vergleich zweier Vektoren auf Ungleichheit (NOT (a = b)). + + +'+' + #on("b")#VECTOR OP + (VECTOR CONST a) #off("b")# + Monadisches '+' für VECTOR. Keine Auswirkung. + + #on("b")#VECTOR OP + (VECTOR CONST a, b) #off("b")# + Elementweise Addition der Vektoren 'a' und 'b'. Beispiel: + + + VECTOR VAR x, (* 'x' hat undefinierte Länge *) + a :: vector (10, 1.0), + b :: vector (10, 2.0); + ... + x := a + b; (* 'x' hat nun 10 Elemente mit Werten'3.0' + *) + + FEHLER : + VECTOR OP + : LENGTH a <> LENGTH b + 'a' und 'b' haben nicht die gleiche Anzahl von Elementen. + + +'-' + #on("b")#VECTOR OP - (VECTOR CONST a) #off("b")# + Monadisches '-'. + + #on("b")#VECTOR OP - (VECTOR CONST a, b) #off("b")# + Elementweise Subtraktion der Vektoren 'a' und 'b'. + + FEHLER : + VECTOR OP - : LENGTH a <> LENGTH b + 'a' und 'b' haben nicht die gleiche Anzahl von Elementen. + +'*' + #on("b")#REAL OP * (VECTOR CONST a, b) #off("b")# + Skalarprodukt zweier Vektoren. Liefert die Summe der elementweisen Multiplika­ + tion der Vektoren 'a' und 'b'. Beachte eventuelle Rundungsfehler! Beispiel: + + + REAL VAR a; + VECTOR VAR b :: vector (10, 2.0), + c :: vector (10, 2.0); + ... + a := b * c; (* 40.0 *) + + FEHLER : + REAL OP * : LENGTH a <> LENGTH b + 'a' und 'b' haben nicht die gleiche Anzahl von Elementen. + + #on("b")#VECTOR OP * (VECTOR CONST a, REAL CONST s) #off("b")# + Multiplikation des Vektors 'a' mit dem Skalar 's'. + + #on("b")#VECTOR OP * (REAL CONST s, VECTOR CONST a) #off("b")# + Multiplikation des Skalars 's' mit dem Vektor 'a'. + + +'/' + #on("b")#VECTOR OP / (VECTOR CONST a, REAL CONST s) #off("b")# + Division des Vektors 'a' durch den Skalar 's'. Beispiel: + + + VECTOR VAR a, (* 'a' hat undefinierte Laenge *) + b :: vector (10, 4.0); + ... + a := b / 2.0; + (* 'a' hat nun 10 Elemente mit Werten '2.0' *) + + + +'LENGTH' + #on("b")#INT OP LENGTH (VECTOR CONST a) #off("b")# + Liefert die Anzahl der Elemente von 'a'. + + +'SUB' + #on("b")#REAL OP SUB (VECTOR CONST v, INT CONST i) #off("b")# + Liefert das 'i'-te Element von 'v'. + + FEHLER : + OP SUB : subscript overflow + Der Index 'i' liegt außerhalb des Vektors (i > LENGTH v). + OP SUB : subscript underflow + Der Index 'i' liegt außerhalb des Vektors (i < 1). + +#page# +'get' + #on("b")#PROC get (VECTOR VAR a, INT CONST l) #off("b")# + Einlesen der Elemente von 'a' vom Terminal, wobei 'l' die Anzahl der Elemente + angibt. + + FEHLER : + PROC get : size <= 0 + Die angeforderte Elementanzahl 'l' muß > 0 sein. + + +'put' + #on("b")#PROC put (VECTOR CONST v) #off("b")# + Ausgabe der Werte der Elemente von 'v' auf dem Terminal. + + +#page# +'length' + #on("b")#INT PROC length (VECTOR CONST a) #off("b")# + Liefert die Anzahl der Elemente von 'a'. Beispiel: + + + VECTOR VAR a :: vector (10, 1.0), + b :: vector (15, 2.0); + ... + ... length (a) ... (* 10 *) + ... length (b) ... (* 15 *) + + + +'nilvector' + #on("b")#INITVECTOR PROC nilvector #off("b")# + Erzeugen eines Vektors mit einem Element mit dem Wert '0.0'. + + +'norm' + #on("b")#REAL PROC norm (VECTOR CONST v) #off("b")# + Euklidische Norm (Wurzel aus der Summe der Quadrate der Elemente). + + + +'replace' + #on("b")#PROC replace (VECTOR VAR v, INT CONST i, REAL CONST r)#off("b")# + Zuweisung des i-ten Elementes von 'v' mit dem Wert von 'r'. Beispiel: + + + VECTOR VAR v :: ...; + ... + replace (v, 13, 3.14); + (* Das 13. Element von 'v' bekommt den Wert '3.14' *) + + FEHLER : + PROC replace : subscript overflow + Der Index 'i' liegt außerhalb des Vektors (i > LENGTH v). + PROC replace : subscript underflow + Der Index 'i' liegt außerhalb des Vektors (i < 1). + + +'vector' + #on("b")#INITVECTOR PROC vector (INT CONST l) #off("b")# + Erzeugen eines Vektors mit 'l' Elementen. Ein INITVECTOR-Objekt benötigt nicht + soviel Speicherplatz wie ein VECTOR-Objekt. Die Elemente werden mit dem + Wert '0.0' initialisiert. + + FEHLER : + PROC vector : size <= 0 + Die angeforderte Elementanzahl 'l' muß > 0 sein. + + #on("b")#INITVECTOR PROC vector (INT CONST l, REAL CONST value)#off("b")# + Erzeugen eines Vektors mit 'l' Elementen. Ein INITVECTOR-Objekt benötigt nicht + soviel Speicherplatz wie ein VECTOR-Objekt. Die Elemente werden mit dem + Wert 'value' initialisiert. Beispiel: + + + VECTOR VAR v := vector (17, 3.14159); + (* 'v' hat 17 Elemente mit den Wert '3.14159' *) + + FEHLER : + PROC vector : size <= 0 + Die angeforderte Elementanzahl 'l' muß > 0 sein. + +#page# + +6.1.4 MATRIX + +Der Datentyp MATRIX erlaubt Operationen auf m x n Matrizen. Im Gegensatz zur +Struktur 'ROW m ROW n REAL' muß die Anzahl der Elemente nicht zur Überset­ +zungszeit deklariert werden, sondern kann zur Laufzeit festgelegt werden. Somit kann +eine zur Übersetzungszeit unbekannte Anzahl von REALs bearbeitet werden, wobei +nur soviel Speicherplatz wie nötig verwendet wird. Die maximale Größe einer MATRIX +beträgt 4000 Elemente. + +Der in den Operationen ':=', 'idn' und 'matrix' benutzte Datentyp INITMATRIX wird +nur intern gehalten. Er dient der Speicherplatzersparnis bei der Initialisierung. + + +- Operatoren : := , = , <> , + , - , * + COLUMNS , DET , INV , ROWS , TRANSP , + +- Eingabe/Ausgabe : get , put + +- Besondere Matrix- : column , idn , matrix , row , sub + Operationen transp , + replace column , replace element , + replace row + + + +#page# +':=' + #on("b")#OP := (MATRIX VAR l, MATRIX CONST r) #off("b")# + Zuweisung von 'r' auf 'l'. Die MATRIX 'l' bekommt u.U. eine neue Anzahl von + Elementen. Beispiel: + + + MATRIX VAR a :: matrix (3, 4, 0.0), + b :: matrix (5, 5, 3.0); + ... + a := b; (* 'a' hat jetzt 5 x 5 Elemente *) + + + #on("b")#OP := (MATRIX VAR l, INITMATRIX CONST r) #off("b")# + Dient zur Initialisierung einer Matrix. Beispiel: + + + MATRIX VAR x :: matrix (17, 4); + + + 'matrix' erzeugt ein Objekt vom Datentyp INITMATRIX. Dieses Objekt braucht + nicht soviel Speicherplatz wie ein MATRIX-Objekt. Dadurch wird vermieden, daß + nach erfolgter Zuweisung nicht ein durch 'matrix' erzeugtes Objekt auf dem Heap + unnötig Speicherplatz verbraucht. + +'=' + #on("b")#BOOL OP = (MATRIX CONST l, r) #off("b")# + Vergleich zweier Matrizen. Der Operator '=' liefert FALSE, wenn die Anzahl + Spalten oder Reihen der Matrizen 'l' und 'r' ungleich ist und wenn mindestens ein + Element mit gleichen Indizes der zwei Matrizen ungleiche Werte haben. Beispiel: + + + MATRIX VAR a :: matrix (3, 3), + b :: matrix (3, 3, 1.0), + c :: matrix (4, 4); + ... a = b ... + (* FALSE wegen ungleicher Werte *) + ... a = c ... + (* FALSE wegen ungleicher Groesse *) + ... b = c ... + (* FALSE wegen ungleicher Groesse *) + + + +'<>' + #on("b")#BOOL OP <> (MATRIX CONST l, r) #off("b")# + Vergleich der Matrizen 'l' und 'r' auf Ungleichheit. + + +'+' + #on("b")#MATRIX OP + (MATRIX CONST m) #off("b")# + Monadisches '+'. Keine Auswirkungen. + + #on("b")#MATRIX OP + (MATRIX CONST l, r) #off("b")# + Addition zweier Matrizen. Die Anzahl der Reihen und der Spalten muß gleich sein. + Beispiel: + + MATRIX VAR a :: matrix (3, 43, 1.0), + b :: matrix (3, 43, 2.0), + summe; + summe := a + b; + (* Alle Elemente haben den Wert '3.0' *) + + + FEHLER: + MATRIX OP + : COLUMNS l <> COLUMNS r + Die Anzahl der Spalten von 'l' und 'r' sind nicht gleich. + MATRIX OP + : ROWS l <> ROWS r + Die Anzahl der Zeilen von 'l' und 'r' sind nicht gleich. + + +'-' + #on("b")#MATRIX OP - (MATRIX CONST m) #off("b")# + Monadisches Minus. Beispiel: + + + MATRIX VAR a :: matrix (3, 4, 10.0) + a := - a; (* Alle Elemente haben den Wert '- 10.0' *) + + + #on("b")#MATRIX OP - (MATRIX CONST l, r) #off("b")# + Subtraktion zweier Matrizen. Die Anzahl der Reihen und Spalten muß gleich sein. + + FEHLER: + MATRIX OP - : COLUMNS l <> COLUMNS r + Die Anzahl der Spalten von 'l' und 'r' sind nicht gleich. + MATRIX OP - : ROWS l <> ROWS r + Die Anzahl der Zeilen von 'l' und 'r' sind nicht gleich. + +'*' + #on("b")#MATRIX OP * (REAL CONST r, MATRIX CONST m) #off("b")# + Multiplikation einer Matrix 'm' mit einem Skalar 'r'. Beispiel: + + + MATRIX VAR a :: matrix (3, 4, 2.0); + ... + a := 3 * a; (* Alle Elemente haben den Wert '6.0' *) + + + #on("b")#MATRIX OP * (MATRIX CONST m, REAL CONST r) #off("b")# + Multiplikation einer Matrix 'm' mit einem Skalar 'r'. + + #on("b")#MATRIX OP * (MATRIX CONST l, r) #off("b")# + Multiplikation zweier Matrizen. Die Anzahl der Spalten von 'l' und die Anzahl der + Zeilen von 'r' müssen gleich sein. Beispiel: + + + MATRIX VAR a :: matrix (3, 4, 2.0), + b :: matrix (4, 2, 3.0), + produkt; + produkt := a * b; + (* Alle Elemente haben den Wert '24.0' *) + + + FEHLER : + MATRIX OP * : COLUMNS l <> ROWS r + Die Anzahl der Spalten von 'l' muß mit der Anzahl der Zeilen von 'r' + übereinstimmen. + + #on("b")#VECTOR OP * (VECTOR CONST v, MATRIX CONST m) #off("b")# + Multiplikation des Vektors 'v' mit der Matrix 'm'. + + FEHLER : + VECTOR OP * : LENGTH v <> ROWS m + Die Anzahl der Elemente von 'v' stimmt nicht mit den Anzahl der Zeilen + von 'm' überein. + + #on("b")#VECTOR OP * (MATRIX CONST m, VECTOR CONST v) #off("b")# + Multiplikation der Matrix 'm' mit dem Vektor 'v'. + + FEHLER : + VECTOR OP * : COLUMNS m <> LENGTH v + Die Anzahl der Spalten von 'm' stimmt nicht mit der Anzahl der Ele­ + menten von 'v' überein. + + +'COLUMNS' + #on("b")#INT OP COLUMNS (MATRIX CONST m) #off("b")# + Liefert die Anzahl der Spalten von 'm'. Beispiel: + + + MATRIX VAR a :: matrix (3, 4), + b :: matrix (7, 10); + put (COLUMNS a); (* 4 *) + put (COLUMNS b); (* 10 *) + + + +'DET' + #on("b")#REAL OP DET (MATRIX CONST m) #off("b")# + Es wird der Wert der Determinanten von 'm' geliefert. + + FEHLER : + OP DET : no square matrix + Die Matrix ist nicht quadratisch, d.h. ROWS m <> COLUMNS m + + +'INV' + #on("b")#MATRIX OP INV (MATRIX CONST m) #off("b")# + Liefert als Ergebnis die Inverse von 'm' (Achtung: starke Rundungsfehler möglich). + + FEHLER: + OP INV : no square matrix + Die Matrix 'm' ist nicht quadratisch, + d.h. ROWS m <> COLUMNS m + OP INV : singular matrix + Die Matrix ist singulär. + + +'ROWS' + #on("b")#INT OP ROWS (MATRIX CONST m) #off("b")# + Liefert die Anzahl der Zeilen von 'm'. Beispiel: + + + MATRIX VAR a :: matrix (3, 4), + b :: matrix (7, 10); + ... + put (ROWS a); (* 3 *) + put (ROWS b); (* 7 *) + + + +'TRANSP' + #on("b")#MATRIX OP TRANSP (MATRIX CONST m) #off("b")# + Liefert als Ergebnis die transponierte Matrix 'm'. + +#page# +'get' + #on("b")#PROC get (MATRIX VAR m, INT CONST rows, columns) #off("b")# + Einlesen von Werten für die Matrix 'm' vom Terminal mit 'rows'-Zeilen und + 'columns'-Spalten. + + +'put' + #on("b")#PROC put (MATRIX CONST m) #off("b")# + Ausgabe der Werte einer Matrix auf dem Terminal. +#page# +'column' + #on("b")#VECTOR PROC column (MATRIX CONST m, INT CONST i) #off("b")# + Die 'i'-te Spalte von 'm' wird als VECTOR mit 'ROWS m' Elementen geliefert. + Beispiel: + + + MATRIX CONST a :: matrix (3, 4); + VECTOR VAR b :: column (a, 1); + (* 'b' hat drei Elemente mit den Werten '0.0' *) + + FEHLER: + PROC column : subscript overflow + Der Index 'i' liegt außerhalb der Matrix 'm' (i > COLUMNS m). + PROC column : subscript underflow + Der Index 'i' liegt außerhalb der Matrix 'm' (i < 1). + +'idn' + #on("b")#INITMATRIX PROC idn (INT CONST size) #off("b")# + Erzeugen einer Einheitsmatrix vom Datentyp INITMATRIX. Beispiel: + + + MATRIX VAR a :: idn (10); + (* Erzeugt eine Matrix mit 10 x 10 Elementen, deren + Werte '0.0' sind, mit der Ausnahme der Diagonalele­ + mente, die den Wert '1.0' haben.*) + + FEHLER : + PROC idn : size <= 0 + Die angeforderte 'size' Anzahl Spalten oder Zeilen muß > 0 sein. + + +'matrix' + #on("b")#INITMATRIX PROC matrix (INT CONST rows, columns) #off("b")# + Erzeugen eines Datenobjekts vom Datentyp INITMATRIX mit 'rows' Zeilen und + 'columns' Spalten. Alle Elemente werden mit dem Wert '0.0' initialisiert. Beispiel: + + + MATRIX CONST :: matrix (3, 3); + + FEHLER: + PROC matrix : rows <= 0 + Die angeforderte Zeilenanzahl 'rows' muß > 0 sein. + PROC matrix : columns <= 0 + Die angeforderte Spaltenanzahl 'columns' muß > 0 sein. + + #on("b")#INITMATRIX PROC matrix (INT CONST rows, columns, REAL CONST value)#off("b")# + Erzeugen eines Datenobjekts vom Datentyp MATRIX mit 'rows' Zeilen und 'co­ + lumns' Spalten. Alle Elemente der erzeugten MATRIX werden mit dem Wert + 'value' initialisiert. Beispiel: + + + MATRIX CONST :: matrix (3, 3, 3.14); + + FEHLER: + PROC matrix : rows <= 0 + Die angeforderte Zeilenanzahl 'rows' muß > 0 sein. + PROC matrix : columns <= 0 + Die angeforderte Spaltenanzahl 'columns' muß > 0 sein. + + +'row' + #on("b")#VECTOR PROC row (MATRIX CONST m, INT CONST i) #off("b")# + Die 'i'-te Reihe von 'm' wird als VECTOR mit 'COLUMNS m' Elementen gelie­ + fert. Beispiel: + + + MATRIX CONST a :: matrix (3, 4); + VECTOR VAR b :: row (a, 1); + (* 'b' hat vier Elemente mit den Werten '0.0'*) + + FEHLER: + PROC row : subscript overflow + Der Index 'i' liegt außerhalb der Matrix 'm' (i > ROWS m). + PROC row : subscript underflow + Der Index 'i' liegt außerhalb der Matrix 'm' (i < 1). + + +'sub' + #on("b")#REAL PROC sub (MATRIX CONST m, INT CONST row, column) #off("b")# + Liefert den Wert eines Elementes von 'm', welches durch die Indizes 'row' und + 'column' bestimmt wird. Beispiel: + + + MATRIX VAR m :: matrix (5, 10, 1.0); + put (sub (m, 3, 7)); + + FEHLER: + PROC sub : row subscript overflow + Der Index 'row' liegt außerhalb von 'm' (row > ROWS m). + PROC sub : row subscript underflow + Der Index 'row' liegt außerhalb von 'm' (row < 1). + PROC sub : column subscript overflow + Der Index 'column' liegt außerhalb von 'm' (column > ROWS m). + PROC sub : row subscript underflow + Der Index 'column' liegt außerhalb von 'm' (column < 1). + + +'transp' + #on("b")#PROC transp (MATRIX VAR m) #off("b")# + Transponieren der Matrix 'm', wobei kaum zusätzlicher Speicherplatz benötigt + wird. + +#page# +'replace column' + #on("b")#PROC replace column (MATRIX VAR m, INT CONST column index, VECTOR + CONST column value) #off("b")# + Ersetzung der durch 'column index' definierten Spalte in der MATRIX 'm' durch + den VECTOR 'column value'. Beispiel: + + + MATRIX VAR a :: matrix (3, 5, 1.0); + VECTOR VAR b :: vector (3, 2.0); + ... + replace column (a, 2, b); + (* Die zweite Spalte von 'a' wird durch die Werte von + 'b' ersetzt *) + + FEHLER: + PROC replace column : LENGTH columnvalue <> ROWS m + Die Anzahl der Zeilen der MATRIX 'm' stimmt nicht mit der Anzahl der + Elemente von 'columnvalue' überein. + PROC replace column : column subscript overflow + Der Index 'columnindex' liegt außerhalb von 'm' + (columnindex > COLUMNS m). + PROC sub : column subscript underflow + Der Index 'columnindex' liegt außerhalb von 'm' (columnindex < 1). + + +'replace element' + #on("b")#PROC replace element (MATRIX VAR m , INT CONST row, column, + REAL CONST value) #off("b")# + Ersetzung eines Elementes von 'm' in der 'row'-ten Zeile und 'column'-ten + Spalte durch den Wert 'value'. Beispiel: + + + MATRIX VAR a :: matrix (5, 5); + ... + replace element (1, 1, 3.14159); + + FEHLER: + PROC replace element : row subscript overflow + Der Index 'row' liegt außerhalb von 'm' (row > ROWS m). + PROC replace element : row subscript underflow + Der Index 'row' liegt außerhalb von 'm' (row < 1). + PROC replace element : column subscript overflow + Der Index 'column' liegt außerhalb von 'm' (column > COLUMNS m). + PROC replace element : row subscript underflow + Der Index 'column' liegt außerhalb von 'm' (column < 1). + + +'replace row' + #on("b")#PROC replace row (MATRIX VAR m, INT CONST rowindex, + VECTOR CONST rowvalue) #off("b")# + Ersetzung der Reihe 'rowindex' in der MATRIX 'm' durch den VECTOR 'rowvalue'. + Beispiel: + + + MATRIX VAR a :: matrix (3, 5, 1.0); + VECTOR VAR b :: vector (5, 2.0); + ... + replace row (a, 2, b); + (* Die 2. Reihe von 'a' wird durch Werte von 'b'ersetzt *) + + FEHLER: + PROC replace row : LENGTH rowvalue <> COLUMNS m + Die Anzahl der Spalten der MATRIX 'm' stimmt nicht mit der Anzahl der + Elemente von 'rowvalue' überein. + PROC replace row : row subscript overflow + Der Index 'rowindex' liegt außerhalb von 'm' + (rowindex > ROWS m). + PROC sub : row subscript underflow + Der Index 'rowindex' liegt außerhalb von 'm' (rowindex < 1). + +6.2 Programmanalyse + +Das Packet 'reporter' ermöglicht: + +a) Ablaufinformationen ("trace"); +b) #ib#Häufigkeitszählung#ie# ("frequency count"); +c) Programmunterbrechung bei Nichterfüllung einer Bedingung ("#ib#assertion#ie#"). + + +'Installation' +Das Programm befindet sich in der Datei 'reporter' und kann wie üblich insertiert +werden. Jedoch muß es mit 'check off' übersetzt werden, damit keine Zeilennummern +für 'reporter' generiert werden. Dies ist notwendig, damit die Zeilennummern des zu +testenden Programms nicht mit den Zeilennummern des Programms 'reporter' ver­ +wechselt werden können. Beispiel: + + + check off; insert ("reporter"); check on + + +Mit dem Kommando + + + #ib#generate reports#ie# ("testdatei") + + +werden die oben erwähnten Prozeduraufrufe ('#ib#report#ie#') in das zu testende Programm, +welches in der Datei 'testdatei' steht, geschrieben. Die Prozeduraufrufe werden nach +jedem Prozedur-, Operator- oder Refinement-Kopf eingefügt und erhalten den +entsprechenden Namen als Parameter. Diese Prozeduraufrufe werden gekennzeichnet, +damit sie von der Prozedur + + + eliminate reports ("testdatei") + + +automatisch wieder entfernt werden können. Beispiel (für die eingefügten Prozedurauf­ +rufe): + + + ... + PROC beispiel (INT CONST mist): + \#\#report ("PROC beispiel");\#\# + ... + + + +'Automatische Ablaufinformation' +Ist ein Programm mit 'generate reports' mit 'report'-Aufrufen versehen worden, kann +es wie gewohnt übersetzt werden. Wird das Programm vom ELAN-Compiler kor­ +rekt übersetzt und dann gestartet, wird bei jedem Antreffen eines 'report'-Aufrufs der +Parameter (Name der Prozedur, Operator oder Refinement) in eine Datei, die +TRACE-Datei geschrieben. Die TRACE-Datei wird beim Programmlauf automatisch +von 'reporter' unter dem Namen 'TRACE' eingerichtet. + +Mit Hilfe dieser Datei kann der Programmablauf verfolgt werden. Es ist damit auch +möglich festzustellen, wo eine "Endlos-Rekursion" auftritt. Die Ablaufinformationen +bestehen nur aus den Namen der angetroffenen Prozeduren und Refinements. Trotz­ +dem können die Anzahl der Informationen sehr umfangreich werden. Deshalb gibt es +die Möglichkeit, die Erzeugung der Ablaufinformationen ab- bzw. wieder anzuschal­ +ten. Dazu gibt es die Möglichkeit, in das zu testende Programm die Prozeduren + + + #ib#report on#ie# + #ib#report off#ie# + + +einzufügen und das zu testende Programm mit diesen Prozeduraufrufen (erneut) zu +übersetzen. + + +'Benutzereigene Ablaufinformation' +Zusätzlich zu den von 'generate reports' eingefügten 'report'-Aufrufen kann ein +Benutzer eigene Aufrufe an geeigneten Stellen in ein Programm schreiben. Dafür +werden weitere 'report'-Prozeduren zur Verfügung gestellt, die als ersten Parameter +ein TEXT-Objekt (meist Name des Objekts oder der Ausdruck selbst) und als zwei­ +ten ein INT/REAL/TEXT/ BOOL-Objekt (der zu überprüfende Wert oder Ausdruck) +enthalten. Beispiel: + + + ... + PROC beispiel (INT CONST mist): + \#\#report ("beispiel");\#\# (* automatisch eingefuegte *) + INT VAR mist :: ...; ... + \#\#report ("mist:", mist);\#\# (* vom Benutzer per Hand einge­ + fuegt *) + ... + + +Folgende 'report'-Routinen stehen zur Verfügung, damit man sie "von Hand" in ein +zu testendes Programm einfügen kann: + + + PROC report on + PROC report off + PROC report (TEXT CONST message) + PROC report (TEXT CONST message, INT CONST value) + PROC report (TEXT CONST message, REAL CONST value) + PROC report (TEXT CONST message, TEXT CONST value) + PROC report (TEXT CONST message, BOOL CONST value) + + +Wichtig: Hier - wie bei allen anderen "von Hand eingefügten" Aufrufen - sollte +ein Nutzer sich an die Konvention halten, diese in "\#\#" einzuklammern. Mit 'eliminate +reports' werden diese Einfügungen automatisch entfernt. Sollen diese Aufrufe aber +immer im Programm erhalten bleiben (jedoch nicht wirksam sein), sollten sie + +a) vor 'generate reports'-Aufruf mit jeweils '\#\#\#' eingefaßt werden. Beispiel: + \#\#\# report ("...") \#\#\# + So steht das 'report'-Statement in einem Kommentar. 'generate reports' wandelt + '\#\#\#' --> '\#\#\#\#' um, so daß ein solches Statement wirksam wird. 'eliminate + reports' wandelt ein '\#\#\#\#' --> '\#\#\#' zurück. + +b) nach 'generate reports' in '\#\#\#\#' eingefaßt werden. + + +'Häufigkeitszählung' +Eine Häufigkeitszählung erhält man, in dem man in das zu testende Programm die +Aufrufe + + + count on + count off + + +einfügt. Ist die Häufigkeitszählung eingeschaltet, merkt sich 'reporter' die Anzahl der +Durchläufe für jede Prozedur bzw. Refinement. Mit der Prozedur + + + #ib#generate counts#ie# ("zu testende datei") + + +werden die vermerkten Häufigkeiten in das zu testende Programm direkt eingefügt. +Die Häufigkeiten werden wie oben beschrieben gekennzeichnet, so daß sie mit 'elimi­ +nate reports' entfernt werden können. + + +'Assertions' +Zusätzlich zu den oben erwähnten Möglichkeiten bietet 'reporter' noch die Prozedur + + + #ib#assert#ie# + + +an. Diese Prozedur kann von einem Programmierer an einer Stelle in das zu testende +Programm eingefügt werden, an der bestimmte Bedingungen erfüllt sein müssen. Die +Prozedur 'assert' steht in zwei Formen zur Verfügung: + + + PROC #ib#assert#ie# (BOOL CONST zusicherung) + PROC assert (TEXT CONST message, BOOL CONST zusicherung) + + +Ist der Wert von 'zusicherung' nicht TRUE, wird der Programmlauf abgebrochen. + + + +reporter - Kommandos + + +'count on' + #on("b")#PROC count on #off("b")# + Schaltet die Häufigkeitszählung ein. + +'count off' + #on("b")#PROC count off #off("b")# + Schaltet die Häufigkeitszählung aus. + +'eliminate reports' + #on("b")#PROC eliminate reports (TEXT CONST datei) #off("b")# + Entfernt gekennzeichnete 'report'-Aufrufe aus der Datei 'datei'. + +'generate reports' + #on("b")#PROC generate reports (TEXT CONST datei) #off("b")# + Fügt 'report'-Aufrufe in die Datei 'datei' ein und kennzeichnet diese mit '\#\#'. + +'report on' + #on("b")#PROC report on #off("b")# + Schaltet die Ablaufinformationen in die Datei 'TRACE' ein. + +'report off' + #on("b")#PROC report off #off("b")# + Schaltet die Ablaufinformationen wieder aus. + +'generate counts' + #on("b")#PROC generate counts (TEXT CONST datei) #off("b")# + Bringt die Häufigkeitszählung (wie oft eine Prozedur oder Refinement durchlaufen + wurde) in die Programmdatei 'datei'. Mit 'eliminate reports' werden diese wieder + automatisch entfernt. + +'assert' + #on("b")#PROC assert (TEXT CONST message, BOOL CONST value) #off("b")# + Schreibt 'message' und den Wert von 'value' in die TRACE-Datei. Ist 'value' + FALSE, wird angefragt, ob das Programm fortgesetzt werden soll. +#page# + +Referencer + + +'referencer' wird durch + + + referencer ("ref datei", "referenz liste") + + +aufgerufen, wobei die Datei 'referenz liste' nicht existieren darf. 'referenz liste' enthält +nach Ablauf des Programms die gewünschte Liste, die sogenannte #ib# Referenzliste#ie#. + +#ub#Achtung#ue#: 'referencer' arbeitet ausschließlich mit Namen und verarbeitet nur wenige +syntaktische Konstrukte. Darum ist es nur erlaubt, ein PACKET auf einmal von 'refe­ +rencer' verarbeiten zu lassen. Verarbeitet man mehrere PACKETs auf einmal, kann es +geschehen, daß gleichnamige Objekte in unterschiedlichen Paketen zu Warnungen +(vergl. die unten beschriebenen Überprüfungen) führen. + +In der Referenzliste sind + +- alle Objekte mit ihrem Namen (in der Reihenfolge ihres Auftretens im Programm) + +- alle Zeilennummern, in der das Objekt angesprochen wird + +- die Zeilennummern, in der das Objekt deklariert wurde ('L' für ein lokales und 'G' + für ein globales Objekt, 'R' für ein Refinement) + +verzeichnet. + +Die Referenzliste kann u.a. dazu dienen, zu kontrollieren, ob und wie (bzw. wo) ein +Objekt angesprochen wird. Dies lohnt sich selbstverständlich nur bei etwas umfan­ +greicheren Programmen (bei "Mini"-Programmen kann man dies sofort sehen). + +Bei der Erstellung der Referenzliste nimmt das Programm 'referencer' gleichzeitig +einige Überprüfungen vor, die helfen können, ein Programm zu verbessern: + +1. Warnung bei mehrzeiligen Kommentaren. + +2. Überdeckungsfehler. Wird ein Objekt global (auf PACKET-Ebene) und nochmals + lokal in einer Prozedur deklariert, ist das globale Objekt nicht mehr ansprechbar. + Überdeckungen sind nach der gültigen Sprachdefinition z.Zt. noch erlaubt, werden + aber bei einer Revision des Sprachstandards verboten sein. + +3. Mehrmaliges Einsetzen von Refinements. Wird ein Refinement mehrmals einge­ + setzt (das ist völlig legal), sollte man überlegen, ob sich dieses Refinement nicht + zu einer Prozedur umgestalten läßt. + +4. Nicht angewandte Refinements. Wird ein Refinement zwar deklariert, aber nicht + "aufgerufen", erfolgt eine Warnung. + +5. Nicht angesprochene Daten-Objekte. Werden Daten-Objekte zwar deklariert, + aber im folgenden nicht angesprochen, wird eine Warnung ausgegeben. Hinweis: + Alle Objekte, die nur wenig angesprochen werden, also nur wenige Zeilennum­ + mern in der Referenzliste besitzen, sind verdächtig (Ausnahmen: importierte + Prozeduren, LET-Objekte u.a.m.). + + + +referencer - Kommandos + + +'referencer' + #on("b")#PROC referencer (TEXT CONST check file, dump file) #off("b")# + Überprüft 'check file'. In 'dump file' steht nach Abschluß die Referenzliste. + +#page# + +6.3 Rechnen im Editor + +Das Programm TeCal ermöglicht einfache Rechnungen (ähnlich wie mit einem Ta­ +schenrechner) unter der Benutzung des Editors. Gleichzeitig stehen dem Benutzer +aber alle Fähigkeiten des Editors zur Verfügung. TeCal ermöglicht Rechnungen auf +einfache Weise zu erstellen oder Tabellenspalten zu berechnen. Zur Benutzung +müssen 'TeCal' und 'TeCal Auskunft' insertiert werden. + +TeCal wird aus dem Editor heraus durch 'ESC t' oder durch das Editor-Kommando + + + tecal + + +aktiviert. Dadurch wird in der untersten Zeile des Bildschirms eine Informationszeile +aufgebaut, in der die (Zwischen-) Ergebnisse einer Rechnung zur Kontrolle fest­ +gehalten werden. + + + +Arbeitsweise + + +Wenn TeCal insertiert ist, kann die Taschenrechnerfunktion jederzeit durch +aufgerufen werden. Aus der editierten Datei werden Werte mit gelesen, +durch <+> (bzw. -,*,/) verknüpft und mit an die aktuelle Cursor­ +position geschrieben werden. + +Der von TeCal errechnete Wert wird durch derart ausgegeben, daß an der +Stelle an der der Cursor steht die letzte Stelle vor dem Dezimalpunkt geschrieben +wird. + +Die Eingabe von Klammern geschieht durch <(> <)>. + +Durch die Hilfsfunktion lassen sich die TeCal Funktionen auflisten. + +Der Prozentoperator <%> erlaubt einfache Rechnungen der Form: 'zahl' <+> + <%> <=> . + +Derartige Folgen können natürlich mit der bekannten Editor-Lernfunktion auch ge­ +lernt werden, so daß sich z.B. die Mehrwertsteuerberechnung auf wenige Tasten +reduziert. + +Spalten können summiert werden, indem auf der #on("u")#untersten#off("u")# Zahl einer Spalte +eingegeben wird. Daraufhin werden alle darüberliegende Zahlen addiert, bis ein +Zeichen auftritt, das nicht in einer Zahl auftritt (Leerzeichen stören nicht!). + +____________________________________________________________________________ + ............ + 55.00 + 66.99 + 123.45 + + 99.99 + + 9876.54 + ........... + + Anzeige: 0.00 14.00% Memory: 0.00 + +____________________________________________________________________________ + + +TeCal Prozeduren + + +'evaluate' + #on("b")#evaluate (TEXT CONST zeile, INT CONST von) #off("b")# + Ausdruck 'zeile' ab der Stelle 'von' berechnen. + + #on("b")#evaluate (TEXT CONST zeile) #off("b")# + Ausdruck 'zeile' ab Stelle 1 berechnen. + + +'kommastellen' + #on("b")#kommastellen (INT CONST stellen) #off("b")# + Berechnungen auf 'stellen' Zahlen hinter dem Komma einstellen. + + +'merke' + #on("b")#PROC merke (INT CONST zahl)#off("b")# + Integer 'zahl' im Merkregister abspeichern. + + #on("b")#PROC merke (REAL CONST zahl)#off("b")# + Real 'zahl' im Merkregister abspeichern. + +'prozentsatz' + #on("b")#PROC prozentsatz (INT CONST zahl) #off("b")# + Prozentsatz von 'zahl' Prozent einstellen. Der Wert wird automatisch konvertiert. + + #on("b")#PROC prozentsatz (REAL CONST zahl) #off("b")# + Prozentsatz von 'zahl' Prozent einstellen. + + +'tecal' + #on("b")#PROC tecal (FILE VAR f) #off("b")# + Datei 'f', die mit 'sequential file' assoziiert ist, mit TeCal editieren. + + #on("b")#PROC tecal (TEXT VAR datei) #off("b")# + 'datei' mit TeCal editieren. + + #on("b")#PROC tecal #off("b")# + Zuletzt editierte Datei mit TeCal editieren. + + +'tecalauskunft' + #on("b")#PROC tecalauskunft #off("b")# + Auskunft zeigen. + + #on("b")#PROC tecalauskunft (TEXT CONST zeichen) #off("b")# + Auskunft zu 'zeichen' zeigen. + diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.index b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.index new file mode 100644 index 0000000..f3f4ede --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.index @@ -0,0 +1,449 @@ +#pagenr("%",1)##block##pageblock# +#headandbottom("1","EUMEL-Benutzerhandbuch","INDEX","Index")# +#headeven# +#center#EUMEL-Benutzerhandbuch +#center#____________________________________________________________ + +#end# +#headodd# +#center#INDEX +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +Index - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#Index - % +#end# +#lpos(0.2)##lpos(6.2)# + +INDEX + +#table# +* 5-11, 5-18, 5-32, 6-19, 6-27, 6-4, 6-9 +** 5-11, 5-19, 5-60, 6-10 ++ 4-20, 5-11, 5-18, 5-32, 5-54, 6-18, 6-26, 6-3, 6-9 +- 4-20, 5-11, 5-18, 5-54, 6-18, 6-26, 6-3, 6-9 +/ 4-20, 4-22, 5-18, 6-19, 6-4 +:= 2-91, 5-10, 5-17, 5-30, 5-65, 6-17, 6-25, 6-3, 6-8 +< 5-10, 5-17, 5-30, 6-8 +<= 5-10, 5-17, 5-30, 6-8 +<> 5-10, 5-17, 5-30, 6-18, 6-26, 6-3, 6-8 += 5-10, 5-17, 5-30, 6-17, 6-25, 6-3, 6-8 +> 5-10, 5-17, 5-30, 6-9 +>= 5-10, 5-17, 5-30, 6-9 + +Abfragekette 2-25 +ABS 6-10, 6-6 +abs 5-13, 5-20, 6-13 +Abweisende Schleife 2-29 +ALL 4-17 +all 4-17 +AND 5-7 +any 5-54 +Archiv 4-44 +Archivdiskette 4-47 +archive 1-9, 4-24, 4-45 +arctan 5-20 +arctand 5-20 +assert 6-39 +assertion 6-36 +Assertions 6-39 +Ausgabesteuerzeichen 5-70 +Ausschalten des Geräts 1-17 +Automatische Ablaufinformation 6-37 + +begin 2-78, 4-3 +begin password 4-40 +Benutzereigene Ablaufinformation 6-37 +BOOL-Denoter: 2-9 +BOUND 2-83 +bound 5-56 +break 4-4 +brother 4-23 +bulletin 4-8 + +CAND 5-7 +CAT 5-32 +change 5-33 +change 5-61 +change all 5-33 +check 4-49, 5-4 +clear 4-46 +clear removed 5-51 +clock 5-80 +code 5-34 +col 5-48 +column 6-31 +COLUMNS 6-28 +COMPILER ERROR 5-5 +complex 6-5 +complex i 6-5 +complex one 6-5 +complex zero 6-5 +compress 5-34 +configurator 1-9 +CONJ 6-6 +Container 5-26 +continue 4-3 +continue scan 5-83 +copy 4-26, 5-67 +COR 5-7 +cos 5-20 +cosd 5-20 +count off 6-39 +count on 6-39 +cout 5-75 +cursor 5-71 + +dataspaces 5-66 +date 5-81 +Datenraum 1-3 +Datensicherheit 1-8 +day 5-81 +decimal exponent 5-20 +DECR 5-12, 5-19, 6-10 +delete char 5-34 +delete record 5-50 +Der EUMEL-Zeichensatz 5-29 +Der Lernmodus 3-17 +DET 6-28 +DIRFILE 2-73 +DIV 5-12, 6-11 +do 5-2 +down 5-48, 5-57 +downety 5-57 +dphi 6-6 +ds pages 5-66 + +e 5-21 +edit 3-1, 4-29, 5-62 +editget 4-30, 5-63, 5-72 +editor 1-9 +Editor verlassen 3-2 +Ein- bzw. Ausschalten der Markierung 3-9 +Ein- bzw. Ausschalten des Einfügemodus 3-10 +Einfügen von Textpassagen 3-6 +Eingabesteuerzeichen 5-69 +Eingabetaste / Absatztaste 3-4 +eliminate reports 6-39 +Endlosschleife 2-28 +enter password 4-41 +eof 5-43 +erase 4-37 +Erweiterbarkeit 1-6 + +ESC ) 3-16 +ESC ( 3-16 +ESC > 3-16 +ESC < 3-16 +ESC 9 3-14 +ESC 1 3-14 +ESC a 3-16 +ESC A 3-16 +ESC b 3-14 +ESC blank 3-16 +ESC d 3-15 +ESC e 3-14 +ESC ESC 3-16 +ESC f 3-14 +ESC g 3-15 +ESC HOP 3-17 +ESC HOP HOP 3-17 +ESC HOP taste 3-17 +ESC k 3-16 +ESC n 3-14 +ESC O 3-16 +ESC o 3-16 +ESC p 3-15 +ESC q 3-14 +ESC RUBIN 3-15 +ESC RUBOUT 3-15 +ESC s 3-16 +ESC ? taste 3-16 +ESC ! taste 3-16 +ESC U 3-16 +ESC u 3-16 +ESC v 3-14 +ESC w 3-14 +ESC k 3-16 +ESC ­ 3-16 + +EUMEL-Editor 3-1 +evaluate 6-44 +exp 5-21 + +false 5-7 +family password 4-42 +father 4-23 +Fehlermeldungen des Archivs 4-52 +fetch 4-33, 5-67 +fetchall 4-34 +FILE 2-73 +Fixpunkt 1-8 +floor 5-21 +forget 4-26, 4-47, 5-67 +frac 5-21 + +Garbage Collection 5-26 +Gelerntes vergessen 3-17 +generate counts 6-40 +generate reports 6-40 +get 2-80, 5-44, 5-73, 6-5, 6-12, 6-21, 6-30 +getchar 5-72 +get cursor 5-71 +getline 5-45, 5-74 + +Häufige Fehler bei der Benutzung von Datenräumen 2-85 +Häufigkeitszählung 6-36 +halt 4-4 +headline 5-43 +heap size 5-27 +help 4-5, 4-9 +hour 5-81 + +idn 6-31 +imag part 6-6 +inchar 5-72 +incharety 5-72 +INCR 5-12, 5-19, 6-11 +INITFLAG 2-91 +initialized 2-91 +initialize random 5-13, 5-21 +input 2-75, 5-42 +insert 5-2 +insert char 5-35 +insert record 5-50 +Installation 6-36 +int 5-21 +int 6-13 +INT-Denoter: 2-7 +INV 6-28 + +Kommando 1-9 +kommando auf taste 4-31 +kommando auf taste legen 4-31 +Kommando auf Taste legen 3-16 +Kommandotaste 3-11 +kommastellen 6-44 +Konfiguration 1-9 + +length 5-35, 6-22 +LENGTH 5-35, 6-19 +Lernen ausschalten 3-17 +Lernen einschalten 3-17 +lernsequenz auf taste 4-32 +lernsequenz auf taste legen 4-32 +Lese-Fehler (Archiv) 4-52 +LEXEQUAL 5-31 +LEXGREATER 5-31 +LEXGREATEREQUAL 5-31 +lex sort 5-64 +LIKE 4-19, 5-59 +line 5-47, 5-71, 5-77 +line no 5-43 +lines 5-43 +list 4-27 +ln 5-22 +Löschtaste 3-10 +log10 5-22 +log2 5-22 +longint 6-13 + +manager task 1-9 +Mantisse 5-16 +Markierzustand 3-9 +match 5-60 +matchpos 5-60 +matrix 6-32 +max 5-13, 5-22, 6-13 +maxint 5-13 +maxlongint 6-13 +maxreal 5-22 +max text length 5-35 +merke 6-45 +min 5-13, 5-23, 6-14 +minint 5-14 +MOD 5-14, 5-23, 6-11 +modify 2-75, 5-42 +Monitor 1-9 +Multi-Tasking-/Multi-User-Betrieb 1-5 +myself 4-23 + +name 4-25 +Namensverzeichnis 4-16 +Netzwerkfähigkeit 1-6 +new 5-65 +next symbol 5-83 +next symbol 5-85 +Nicht abweisende Schleife 2-29 +nilspace 5-65 +niltask 4-22 +nilvector 6-22 +norm 6-22 +NOT 5-8 +notion 5-56 + +old 5-66 +online 5-79 +Operationen auf Markierungen 3-15 +Operatoren 2-14 +OR 5-8 +OR 5-54 +out 5-75 +output 2-75, 5-42 +out subtext 5-76 + +packets 4-8 +page 5-71 +Paketkonzept 2-1 +pause 5-79, 5-82 +phi 6-6 +pi 5-23 +pos 5-36 +Positionierung 5-71 +Positionierung des Cursors 3-4 +print 4-38 +PRINTER 4-24 +printer 4-24 +Priorität von generischen Operatoren 2-49 +Priorität von Operatoren 2-16 +prot 5-4 +Prozeduren als Parameter 2-39 +Prozeduren mit Parametern 2-38 +prozentsatz 6-45 +Prozeßkommunikation 1-6 +PUBLIC 4-24 +public 4-24 +put 5-46, 5-78, 6-12, 6-21, 6-30, 6-5 +putline 5-46, 5-78 + +random 5-14, 5-23, 6-14 +read record 5-50 +real 5-14, 5-37 +REAL-Denoter: 2-8 +Realisierung von abstrakten Datentypen 2-47 +real part 6-6 +referencer 6-42 +Referenzliste 6-41 +Refinements 2-1 +reinsert 5-51 +release 4-45 +remainder 4-18 +remove 5-51 +rename 4-28 +rename myself 4-25 +reorganize 5-52 +replace 5-37, 6-22 +replace column 6-34 +replace element 6-34 +replace row 6-35 +report 6-36 +report off 6-40 +report on 6-40 +reserve 4-25 +REST 3-6 +round 5-23 +row 6-32 +ROWS 6-29 +run 5-3 +runagain 5-3 + +save 4-35, 5-67 +saveall 4-36 +scan 5-86 +Schreibarbeit beenden 3-2 +Schutz vor fehlerhaftem Zugriff auf Datenobjekte 2-45 +Scratch-Datei 3-13 +segments 5-52 +sequential file 5-41 +SHard 1-5 +show 4-30 +shutup 1-17 +sign 5-15, 5-24, 6-14 +SIGN 6-11 +sin 5-24 +sind 5-24 +smallreal 5-24 +SOME 2-80, 4-17 +son 4-23 +sort 5-64 +Spracherweiterung 2-44 +sqrt 5-24, 6-6 +Standard-Datenraum 1-9 +std tastenbelegung 4-32 +STOP-Taste 3-20 +storage 4-11, 5-66 +storage info 4-5, 4-11 +sub 6-33 +SUB 5-37, 6-20 +subtext 5-38 +supervisor 4-24 +Supervisor 1-9 +SUPERVISOR-Taste 3-18 +Symbole 5-83 +sysin 5-73 +sysout 5-77 + +Tabulatortaste 3-8 +tan 5-25 +tand 5-25 +task 4-22 +Task 1-9 +task info 4-5, 4-12 +Task-Organisation 1-2 +task password 4-43 +task status 4-15 +taste enthaelt kommando 4-31 +tecal 6-45 +tecalauskunft 6-45 +text 5-15, 5-25, 5-39, 6-15 +TEXT-Denoter: 2-9 +Thesaurus 4-16 +time 5-82 +time of day 5-82 +TIMESOUT 5-76 +Titelzeile 3-2 +to line 5-48 +transp 6-33 +TRANSP 6-29 +true 5-8 +type 5-66 +TYPE COMPLEX 6-3 +TYPE LONGINT 6-8 + +Überschrift in die Kopfzeile 5-43 +Umschalttaste 3-4 +UNLIKE 5-59 +Unterbrechen einer Ausgabe 3-20 +up 5-49 +up 5-58 +uppety 5-58 + +vector 6-23 +Vereinbarung eines dyadischen Operators 2-42 +Vereinbarung eines monadischen Operators 2-42 +Verstärkertaste 3-5 +Verwendung von Prozeduren 2-35 +Virtuelle Speicherverwaltung 1-7 +Vorbelegte Tasten 3-17 + +warnings 5-4 +WEITER-Taste 3-20 +Wertliefernde Prozeduren 2-40 +Wertliefernde Refinements 2-34 +word wrap 4-32 +write 5-78 +write 5-47 +write record 5-50 + +XOR 5-8 + +Zählschleife 2-30 +Zeichen schreiben 3-16 +zero 6-15 +#tableend# + diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.inhalt b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.inhalt new file mode 100644 index 0000000..45b3f1f --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.inhalt @@ -0,0 +1,249 @@ +#setcount (1)# +#block##pageblock# +#pagenr ("%", 1)# +#headeven# +#center#EUMEL-Benutzerhandbuch +#center#____________________________________________________________ + +#end# +#headodd# +#center#Inhalt +#center#____________________________________________________________ + +#end# +#bottomeven# + +#center#____________________________________________________________ +I - % #right#GMD +#end# +#bottomodd# + +#center#____________________________________________________________ +GMD #right# I - % +#end# + +#lpos(0.2)##lpos(1.8)##lpos(9.0)# + +TEIL 1 : Einleitung +#table# +1.1 Allgemeines über EUMEL 1 +1.2 Struktur des Betriebssystems EUMEL 2 +1.3 Eigenschaften des Betriebssystems 4 + Multi-Tasking-/Multi-User-Betrieb 5 + Prozeßkommunikation und Netzwerkfähigkeit 6 + Erweiterbarkeit 6 + Virtuelle Speicherverwaltung 7 + Datensicherheit 8 +1.4 Wichtige Begriffe 9 +1.5 Die Notation in diesem Buch 10 +1.6 Die Funktionstasten des EUMEL-Systems 11 +1.7 Eine Beispielsitzung 12 +#tableend# + + + + +TEIL 2 : ELAN +#table# +2.1 Besondere Eigenschaften von ELAN 1 +2.2 Lexikalische Elemente 2 +2.2.1 Schlüsselwörter 2 +2.2.2 Bezeichner 3 +2.2.3 Sonderzeichen 4 +2.2.4 Kommentare 5 +2.3 Datenobjekte 6 +2.3.1 Elementare Datentypen 6 +2.3.1.1 Denoter für elementare Datentypen 7 + INT-Denoter: 7 + REAL-Denoter: 8 + TEXT-Denoter: 9 + BOOL-Denoter: 9 +2.3.1.2 LET-Konstrukt für Denoter 10 +2.3.2 Zugriffsrecht 11 +2.3.3 Deklaration 11 +2.3.4 Initialisierung 12 +2.4 Programmeinheiten 13 +2.4.1 Elementare Programmeinheiten 14 +2.4.1.1 Ausdruck 14 + Operatoren 14 + Priorität von Operatoren 16 +2.4.1.2 Zuweisung 18 +2.4.1.3 Refinementanwendung 19 +2.4.1.4 Prozeduraufruf 20 +2.4.2 Zusammengesetzte Programmeinheiten 22 +2.4.2.1 Folge 22 +2.4.2.2 Abfrage 23 +2.4.2.3 Auswahl 26 +2.4.2.4 Wertliefernde Abfrage + und wertliefernde Auswahl 27 +2.4.2.5 Wiederholung 27 + Abfragekette 25 + Endlosschleife 28 + Abweisende Schleife 29 + Nicht abweisende Schleife 29 + Zählschleife 30 +2.4.3 Abstrahierende Programmeinheiten 32 +2.4.3.1 Refinementvereinbarung 32 + Vorteile der Refinementanwendung 33 + Wertliefernde Refinements 34 +2.4.3.2 Prozedurvereinbarung 35 +2.4.3.3 Operatorvereinbarung 41 + Verwendung von Prozeduren 35 + Prozeduren mit Parametern 38 + Prozeduren als Parameter 39 + Wertliefernde Prozeduren 40 + Vereinbarung eines monadischen Operators 42 + Vereinbarung eines dyadischen Operators 42 +2.4.3.4 Paketvereinbarung 43 + Spracherweiterung 44 + Schutz vor fehlerhaftem Zugriff + auf Datenobjekte 45 + Realisierung von abstrakten Datentypen 47 +2.4.4 Terminatoren für Refinements, + Prozeduren und Operatoren 48 +2.4.5 Generizität von Prozeduren und Operatoren 49 + Priorität von generischen Operatoren 49 +2.4.6 Rekursive Prozeduren und Operatoren 50 +2.5 Programmstruktur 52 +2.6 Zusammengesetzte Datentypen 56 +2.6.1 Reihung 56 +2.6.2 Struktur 61 +2.6.3 LET-Konstrukt für + zusammengesetzte Datentypen 64 +2.6.4 Denoter für zusammengesetzte + Datentypen (Konstruktor) 65 +2.7 Abstrakte Datentypen 67 +2.7.1 Definition neuer Datentypen 67 +2.7.2 Konkretisierung 69 +2.7.3 Denoter für abstrakte Datentypen (Konstruktor) 70 +2.8 Dateien 73 +2.8.1 Datentypen FILE und DIRFILE 73 + FILE: 73 + DIRFILE: 73 +2.8.2 Deklaration und Assoziierung 74 + input: 75 + output: 75 + modify: 75 +2.9 Abstrakte Datentypen im EUMEL-System 77 +2.9.1 Datentyp TASK 77 +2.9.2 Datentyp THESAURUS 79 +2.9.3 Datenräume 81 +2.9.3.1 Datentyp DATASPACE 82 +2.9.3.2 BOUND-Objekte 83 + Häufige Fehler bei der Benutzung von Datenräume 85 +2.9.3.3 Definition neuer Dateitypen 88 +2.9.4 Datentyp INITFLAG 91 +#tableend# + + + + +TEIL 3 : Der Editor +#table# +3.1 Ein- und Ausschalten des Editors 1 +3.2 Die Funktionstasten 3 +3.3 Die Wirkung der Funktionstasten 4 +3.4 ESC Kommandos 11 + Operationen auf Markierungen 15 + Zeichen schreiben 16 + Kommando auf Taste legen 16 + Vorbelegte Tasten 17 + Der Lernmodus 17 +3.5 Positionieren, Suchen, Ersetzen + im Kommandodialog 21 + Weitere Hilfen 23 +#tableend# + + + + +TEIL 4 : Kommandosprache +#table# +4.1 Supervisor 2 +4.2 Monitor 6 +4.2.1 Hilfsprozeduren 8 + Informationsprozeduren 11 +4.2.2 Thesaurus 16 +4.2.3 Tasks 21 +4.2.4 Handhabung von Dateien 26 +4.2.5 Editor-Prozeduren 29 +4.2.6 Dateitransfer 33 +4.2.7 Passwortschutz 39 +4.2.8 Das Archiv 44 + Fehlermeldungen des Archivs 52 +#tableend# + + + + +TEIL 5 : Programmierung +#table# +5.1 Der ELAN-Compiler 1 +5.1.1 Fehlermeldungen des ELAN-Compilers 5 +5.2 Standardtypen 7 +5.2.1 Bool 7 +5.2.2 Integer-Arithmetik 9 +5.2.3 Real-Arithmetik 16 +5.2.4 Text 26 + Der EUMEL-Zeichensatz 29 +5.3.1 Assoziierung 41 +5.3.2 Informationsprozeduren 43 +5.3.3 Betriebsrichtung INPUT 44 +5.3.4 Betriebsrichtung OUTPUT 46 +5.3.5 Betriebsrichtung MODIFY 48 +5.3.6 FILE -Ausschnitte 51 +5.4 Suchen und Ersetzen in Textdateien 53 +5.4.1 Aufbau von Textmustern 54 +5.4.2 Suche nach Textmustern 57 +5.4.3 Treffer registrieren 59 +5.4.4 Treffer herausnehmen 60 +5.4.5 Ändern in Dateien 61 +5.4.6 Editor-Prozeduren 62 +5.4.7 Sortierung von Textdateien 64 +5.4.8 Prozeduren auf Datenräumen 65 +5.5 Eingabe/Ausgabe 68 +5.5.1 E/A auf Bildschirm 69 +5.5.1.1 Eingabesteuerzeichen 69 +5.5.1.2 Ausgabesteuerzeichen 70 +5.5.1.3 Positionierung 71 + Grundlegende Prozeduren 72 + Umleitbare Eingabeprozeduren 73 + Grundlegende Prozeduren 75 + Umleitbare Ausgabeprozeduren 77 +5.5.1.4 Eingabe 72 +5.5.1.5 Ausgabe 75 +5.5.1.6 Kontrolle 79 +5.5.2 Zeitmessung 80 +5.6 Scanner 83 + Scanner-Kommandos 85 +#tableend# + + + + +TEIL 6 : Das Archiv 'std zusatz' +#table# +6.1 Erweiterungen um Mathematische Operationen 2 +6.1.1 COMPLEX 2 +6.1.2 LONGINT 7 +6.1.3 VECTOR 16 +6.1.4 MATRIX 24 +6.2 Programmanalyse 36 + reporter - Kommandos 39 + Referencer 41 + referencer - Kommandos 42 +6.3 Rechnen im Editor 43 + Arbeitsweise 43 + TeCal Prozeduren 44 +#tableend# + + + + +Anhang : ELAN-Syntaxdiagramme + + + + +INDEX + diff --git a/doc/programmer-manual/1.8.7/doc/programmierhandbuch.titel b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.titel new file mode 100644 index 0000000..79b09b0 --- /dev/null +++ b/doc/programmer-manual/1.8.7/doc/programmierhandbuch.titel @@ -0,0 +1,52 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#Programmierhandbuch + + + + +#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# +#block##pageblock# +#start(5.0,1.5)# + +#lpos(3.0)# +#table# + + + + + + +Benutzerhandbuch + +Programmierung + + + +Stand: 1.7.87 + +#tableend##page# + + diff --git a/doc/programmer-manual/1.8.7/source-disk b/doc/programmer-manual/1.8.7/source-disk new file mode 100644 index 0000000..13e2021 --- /dev/null +++ b/doc/programmer-manual/1.8.7/source-disk @@ -0,0 +1 @@ +grundpaket/10_handbuecher.2.img diff --git a/doc/system-manual/1.8.7/doc/systemhandbuch.1 b/doc/system-manual/1.8.7/doc/systemhandbuch.1 new file mode 100644 index 0000000..a8f53bb --- /dev/null +++ b/doc/system-manual/1.8.7/doc/systemhandbuch.1 @@ -0,0 +1,1685 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#Systemhandbuch + + + + +#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# +#start(5.1,1.5)# +#free(4.0)# +#center#EUMEL + + +#center#Systemhandbuch + + + + + + + + + +#center#copyright ERGOS GmbH, 1990 + + +#page# +#block# + +Copyright: ERGOS GmbH April 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. + + + +-----------------------------------------------------+ + + + + + + + +Autoren : Jochen Liedtke + Dietmar Heinrichs + Rainer Hahn + Christian Szymanski + Thomas Müller + +Texterstellung : Dieser Text wurde mit der ERGOS-EUMEL Textverarbeitung erstellt + und aufbereitet und auf einem Kyocera Laserdrucker ge­ + druckt. +#page# + + + + + + + + +----------------------------------------------+ + + + + +#page# + +#start(2.5,1.5)# +#pageblock# +#block# +#headeven# + +%#center#EUMEL-Systemhandbuch + + +#end# +#headodd# + +#center#Einführung#right#% + + +#end# + +#ib(9)#Einführung#ie(9)# + +Der größte Teil dieses Systemhandbuchs ist für Anwender geschrieben, die tiefer in +das EUMEL-System einsteigen und evtl. Systemergänzungen oder Systemänderun­ +gen programmieren wollen. Der erste Teil ist allerdings für alle interessant, die ein +EUMEL-System verwenden, selbst für Anfänger, die ihr System zum ersten Mal in +Betrieb nehmen wollen. Entsprechend der verschiedenen Adressatenkreise unter­ +scheiden sich die einzelnen Kapitel stark in der Beschreibungsart. Deshalb: + +#on("b")##on("i")#Sind Sie EUMEL-Neuling?#off("b")##off("i")# + + Dann sollten Sie #on("b")##on("i")#vor#off("b")##off("i")# dem Einschalten Ihres Systems die Einführung des Kapi­ + tels "System einrichten" lesen. Dort werden keine weiteren Kenntnisse voraus­ + gesetzt. Danach sollten Sie erst einmal durch praktisches Arbeiten mit Hilfe des + Benutzerhandbuchs etwas mit dem System vertraut werden. + + +#on("b")##on("i")#Haben Sie schon einige Zeit mit dem EUMEL gearbeitet?#off("b")##off("i")# +#on("b")##on("i")#Sind Sie mit dem System einigermaßen vertraut?#off("b")##off("i")# + + Dann lesen Sie den kompletten Teil 1 ("System einrichten") dieses Systemhand­ + buchs. + Das Lesen der folgenden Kapitel ist für den einfachen Betrieb des EUMEL- + Systems nicht erforderlich. Sie setzen auch intime Kenntnis des Systems auf + dem Niveau des Benutzerhandbuchs voraus und würden Anfänger leicht verwir­ + ren. + + +#on("b")##on("i")#Haben Sie Probleme mit Ihrer Hardware?#off("b")##off("i")# + + #on("i")#Wenn Sie nichts von Hardware verstehen, wenden Sie sich an einen Fachmann!#off("i")# + + Wenn Sie ein gewisses Grundwissen über Hardware haben, dann lesen Sie Teil 2 + ("Hardware und ihre Steuerung"). In diesem Kapitel sollten Sie "3. Kanä­ + le und Konfigurierung" erst einmal auslassen. + + +#on("b")##on("i")#Wollen Sie tiefer in das Betriebssystem einsteigen?#off("b")##off("i")# +#on("b")##on("i")#Haben Sie EUMEL-Erfahrung?#off("b")##off("i")# +#on("b")##on("i")#Haben Sie Programmiererfahrung?#off("b")##off("i")# + + Dann lesen Sie im Systemhandbuch alles, was Ihnen interessant erscheint. +#page# +#headeven# + +%#center#EUMEL-Systemhandbuch + + +#end# +#headodd# + +#center#1. System einrichten#right#% + + +#end# + +#ib(9)#1. #ib#System einrichten#ie##ie(9)# + +#ib(9)#1.1. Einführung#ie(9)# + +#ib(9)#Wie Ihr System aufgebaut ist#ie(9)# + +Der kleinstmögliche EUMEL-Rechner besteht aus einem #ib#Rechnerkern#ie# und einem Ter­ +minal: + + + Rechnerkern Terminal 1 + + + #on("i")#Anmerkung: In manchen Fällen ist das Terminal hardwaremäßig in den Rechner + integriert. Trotzdem fassen wir diese physische Einheit dann als + zwei logisch getrennte Komponenten auf, nämlich Rechnerkern + und Terminal!#off("i")# + +Wie man sieht, hat das #ib#Terminal#ie# die Nummer 1. Das bedeutet, daß es über Kanal 1 mit +dem Rechnerkern verbunden ist. Das EUMEL-System kennt 16 solche #ib#Kanäle#ie#, wobei es +von der konkreten Hardware abhängt, welche Kanäle wirklich vorhanden sind und +welche Geräte man daran anschließen kann. (Allerdings ist der Kanal 1 als Verbindung +zum Terminal 1 immer vorhanden.) + +In den meisten Fällen wird auch ein #ib#Drucker#ie# angeschlossen sein. Die genaue An­ +schlußart ist wieder von der konkret verwendeten Hardware abhängig. Nehmen wir an, +er sei an Kanal 4 angeschlossen: + + + + Rechnerkern Terminal 1 + + Drucker (Kanal 4) + + + +Man sieht also, daß Lücken bei der Verwendung der Kanäle auftreten dürfen. Bei +Multi-User-Systemen können, sofern die entsprechenden Schnittstellen vorhanden +sind, weitere Terminals und andere Geräte (z.B. #ib#Plotter#ie#) angeschlossen werden: + + + + Rechnerkern Terminal 1 + + Terminal 2 + + Plotter (Kanal 3) + + Drucker (Kanal 4) + + Terminal 5 + + Terminal 6 + + + + + +#ib(9)#1.2. Wie Sie die EUMEL-Software erhalten und + installieren#ie(9)# + + + +Betriebssystem : EUMEL (Version 1.8) +Hardware : IBM-PC/AT, IBM-PC/XT und Kompatible +SHard-Version : 4.9 und 5.0 + +Erforderliche Disketten + + - EUMEL-Generierungsdiskette : "SETUP-EUMEL AT" (bzw. "SETUP- + EUMEL XT") + - EUMEL-Systemdisketten : "HG0" und "HG1" (EUMEL0-Maschine + und Hintergrund) evtl. auch nur eine 1,2 + MB Hintergrunddiskette + +Die Diskette "SETUP-EUMEL" ist ein kleines EUMEL-System zur Installation des Be­ +triebssystems EUMEL auf einem AT/XT kompatiblen Rechner. Auf diesem System +laufen Programme ab, die im Dialog mit dem Benutzer das Einrichten einer oder +mehrerer EUMEL-Partitionen ermöglichen. +#on("b")#Diese Diskette darf nicht schreibgeschützt sein!#off("b")# + +Beim Einrichten einer EUMEL-Partition wird nach Prüfung der Festplatte durch +"SETUP-EUMEL" der hardwarenahe Teil des EUMEL-Systems, 'SHard' (Software/ +Hardware-Interface), auf die Festplatte geschrieben. + +Die Hintergrunddisketten beinhalten das eigentliche Betriebssystem EUMEL (den +Systemkern (EUMEL-0-Maschine)) und die darauf aufbauenden Systemteile (Hinter­ +grund)). + + +Leistungen des SETUP EUMEL + +Wenn Sie bereits ein Betriebssystem auf Ihrer Festplatte installiert haben, müssen Sie +darauf achten, daß noch ausreichend Platz für ein EUMEL-System übrig ist. Die Min­ +destgröße einer Partition für ein EUMEL-System beträgt ca. 1MB, die maximale Größe +ist vom benutzten Systemkern abhängig: der in der Version 1.8.6 M+ verwendete +Systemkern u186+ \#1523 erlaubt eine maximale Größe von 128 MB. Andere, ältere +EUMEL Versionen erlauben nur eine Partitionsgröße von 16 MB. Aus Kompatibilitäts­ +gründen stellt das Installationsprogramm eine Kontrollfrage bei Überschreiten der 16 +MB Grenze. + +Soll neben EUMEL auch eine MS-DOS Partition auf der Festplatte sein, muß, da +MS-DOS standardmäßig die gesamte Festplatte belegt, dieses System gesichert, mit +dem MS-DOS-Kommando 'fdisk' (o.ä.) die Partition gelöscht und entsprechend kleiner +neu eingerichtet werden. Sie können auch bei der EUMEL-Installation alle bereits +bestehenden Systeme löschen; dazu bietet Ihnen der SETUP-EUMEL die Option +'Löschen der gesamten Partitionstabelle' an. Dabei gehen jedoch alle Daten auf der +Festplatte verloren. Achten Sie also darauf, daß sie alle Daten vorher gesichert haben! + +Um nun die Partitionierung für Ihr EUMEL-System vorzunehmen, legen Sie die Diskette +"SETUP-EUMEL" ohne Schreibschutzmarke in das Start-Laufwerk. Sollten Sie ein Gerät +mit zwei Laufwerken besitzen, dann ist es das Laufwerk A:. (Bei Unklarheiten im Benut­ +zerhandbuch des Herstellers nachsehen.) + +Schalten Sie nun den Rechner ein bzw. betätigen Sie den Tastatur-RESET, wenn Ihr +Gerät bereits eingeschaltet ist (meistens mit dem gleichzeitigen Druck der Tasten +CTRL, ALT und DEL). + +Der SETUP-EUMEL gibt zunächst folgende SHard-Meldung aus: + ++--------------------------------------------+ +i i +i Setup-SHard für EUMEL auf IBM PC/AT, V 4.8 i +i Copyright (C) 1989 ERGOS GmbH, Siegburg i +i i ++--------------------------------------------+ + +Warten Sie beim Hochfahren des SETUP-EUMELs, bis Ihnen nach einem Zwischen­ +bildschirm ("SETUP-EUMEL für Modul-SHard") eine Partitionstabelle angezeigt wird. +Dieser können Sie entnehmen, ob bereits Partitionen auf der Festplatte eingerichtet +und wie diese spezifiziert sind. + +Angezeigt werden neben Größe, Start- und Endspur der einzelnen Partitionen auch +eine Typ-Nummer. Für EUMEL-Partitionen werden in aufsteigender Reihenfolge die +Typ-Nummern 69 bis 72, für MS-DOS je nach Größe der eingerichteten Partition die +Nummern 1 oder 4 vergeben. Außerdem wird die gerade aktive Partition durch einen +entsprechenden Eintrag in der Tabelle kenntlich gemacht. "Aktiv" ist die Partition, die +nach dem nächsten Einschalten des Rechners bzw. nach dem nächsten Tastatur- +RESET gestartet würde. + + +Sie sehen zusätzlich ein Menü mit folgenden zur Auswahl stehenden Funktionen: + ++------------------------------------------------------------+ +i i +i - EUMEL-Partition einrichten 1 i +i - erneuern (Neuer SHard) 2 i +i - aktivieren 3 i +i - löschen 4 i +i - Partitionstabelle löschen 5 i +i - SHard-Konfiguration anzeigen 6 i +i - SHard konfigurieren 7 i +i - SHardmodule laden oder löschen 8 i +i - SETUP-EUMEL beenden 0 i +i i ++------------------------------------------------------------+ + +#on("i")##on("u")#EUMEL - Partition einrichten #off("u")##off("i")# + +Eine neue EUMEL-Partition wird gemäß den im weiteren erfragten Angaben eingerich­ +tet. In die Partition wird ein SHard geschrieben, dessen Konfiguration die gelieferte +Grundkonfiguration oder die von Ihnen eingestellte ist (s. Partitionieren der Festplatte, +Seite 3). + + +#on("i")##on("u")#EUMEL - Partition erneuern (Neuer SHARD)#off("u")##off("i")# + +In eine bereits vorhandene Partition wird ein SHard in der eingestellten Konfiguration +geschrieben. Der bis dahin vorhandene SHard wird überschrieben. Die Möglichkeit +besteht jedoch nur, wenn die Partition mit einem SETUP-EUMEL eingerichtet worden +ist. + +Erneuern bedeutet, nur den SHard #on("u")#auszutauschen#off("u")# auf einer Partition, die schon einen +fertigen EUMEL enthält, ohne daß man dabei den EUMEL löscht. Das ist dann sinnvoll, +wenn man eine neue Version des SHard benutzen möchte oder den SHard aus ir­ +gendwelchen Gründen (z.B. Streamer gekauft) um einen oder mehrere Module erwei­ +tern will. + +Diese Aktion kann nur durchgeführt werden, wenn bereits ein SHard mit der Versions­ +nummer 4.x in dieser Partion vorhanden ist. Ältere (Version 2.7, 2.8 etc.) können #on("u")#nicht#off("u")# +ersetzt werden. + + +#on("i")##on("u")#EUMEL - Partition aktivieren#off("u")##off("i")# + +Eine Partition wird ausgewählt und aktiv gesetzt, d.h. beim nächsten Start des Re­ +chners wird das System, das auf dieser Partition steht, hochgefahren. + + +#on("i")##on("u")#EUMEL - Partition löschen #off("u")##off("i")# + +Hierbei wird ein Eintrag aus der Partitionstabelle entfernt. Die EUMEL-Partition wird +nicht wirklich gelöscht, d.h. wenn man nach dem Löschen den Plattenbereich noch +nicht anderweitig verwendet hat, kann das EUMEL-System auf dieser Partition durch +ein "EUMEL-Partition einrichten" auf genau demselben Plattenbereich (Start-/Endzy­ +linder) wieder hergestellt werden. + + +#on("i")##on("u")#Partitionstabelle löschen#off("u")##off("i")# + +Dies ist eine sehr gefährliche Option ! +Es werden hiermit #on("u")##on("b")#alle#off("b")##off("u")# Partitionen auf der Platte gelöscht (nicht nur die von EUMEL). +Auch hier gilt zwar, daß die Partitionen selbst an sich unangetastet bleiben und wie­ +derhergestellt werden könnten, aber dies ist bei anderen Betriebssystemen oft nicht +möglich. Also #on("u")#VORSICHT#off("u")#. + + +#on("i")##on("u")#SHard-Konfiguration anzeigen #off("u")##off("i")# + +Die Module des SHard, der bereitgestellt ist, um auf die Platte geschrieben zu werden, +werden angezeigt. Es werden alle definierten Kanäle angezeigt und zu jeder Kanal­ +nummer der assoziierte Modulname. Aufgelistet ist die zuletzt mit dem SETUP-EUMEL +zusammengestellte Konfiguration. + + +#on("i")##on("u")#SHard konfigurieren #off("i")##off("u")# + +Zusammenstellen von einer SHardbasis und SHardmodulen zu einem neuen SHard, +um eine neue Partition einzurichten oder den SHard einer bestehenden Partition zu +ersetzen. +ACHTUNG: Bitte diesen Menuepunkt nicht experimentell benutzen! Eine Anleitung + zum Thema Module etc. wird separat erscheinen. +#page# +#on("i")##on("u")#SHardmodule laden oder löschen #off("u")##off("i")# + +Hiermit können neue Module oder neue Versionen von Modulen in den SETUP-EUMEL +geladen werden oder nicht mehr benötigte Module gelöscht werden. Die neuen Modu­ +le werden von einer EUMEL-Archivdiskette gelesen, deren Name zuvor eingegeben +werden muß. +ACHTUNG: Bitte diesen Menüpunkt nicht experimentell benutzen! Eine Anleitung + zum Thema Module etc. wird separat erscheinen. + + +#on("i")##on("u")#SETUP-EUMEL beenden #off("u")##off("i")# + +SETUP-Programm ordnungsgemäß beenden. +ENDE-Meldung abwarten! + + + + +Die eigentliche Partitionierung beginnt nun, indem Sie Menü-Punkt 1 "EUMEL-Partition +einrichten" anwählen. (Punkt 1 wird Ihnen nur dann #on("b")#nicht#off("b")# angeboten, wenn die Fest­ +platte bereits vollständig belegt ist. Sichern Sie dann das alte System und löschen eine +oder alle Partitionen.) Die Kontrollabfrage "Neue EUMEL-Partition einrichten? (j/n)" +beantworten Sie entsprechend mit "j". + +Beim Generieren einer EUMEL-Partition werden Angaben zu Größe und Startzylinder +abgefragt. Dafür werden Vorgaben gemacht, die Sie bestätigen, indem Sie die +-Taste betätigen, oder die Sie überschreiben können. Die abschließende +Abfrage "Sind die Partitionsangaben korrekt?" fordert Sie zur Überprüfung Ihrer Einga­ +ben auf. + +Nach der Eingabe und der Überprüfung der Sektoren erscheint eine Meldung wie z.B.: + ++--------------------------------------------------+ +i i +i Ich habe keine schlechten Sektoren gefunden i +i SHard wird auf die Partition geschrieben i +i Bitte betätigen Sie eine Taste! i +i i ++--------------------------------------------------+ + +oder + ++--------------------------------------------------+ +i i +i Ich habe 2 schlechte Sektoren gefunden i +i SHard wird auf die Partition geschrieben i +i Bitte betätigen Sie eine Taste! i +i i ++--------------------------------------------------+ + +Danach gelangen Sie wieder in das Generierungsmenü. Wählen Sie "0" für "SETUP- +EUMEL beenden". Über eine Sicherheitsfrage verlassen Sie nun den ersten Teil der +Installation. Warten Sie #on("b")#unbedingt#off("b")#, bis auf dem Bildschirm die Meldung "ENDE" er­ +scheint, bevor Sie die Diskette "SETUP EUMEL" aus dem Laufwerk nehmen. + + + +Installieren eines EUMEL-Hintergrundes + +Im nächsten Schritt wird auf ihrer Festplatte das vollständige EUMEL-System instal­ +liert. + +Bitte betätigen Sie den Tastatur-Reset an Ihrem Rechner (oder die Tasten CTRL, ALT +und DEL oder den AUS-/EIN-Schalter). + +Auf dem Bildschirm erscheint die folgende Meldung: + ++--------------------------------------------------------------------------+ +i i +i SHard für EUMEL auf IBM PC,AT,XT, V 4.7 i +i Copyright (c) 1985, 86, 87, 88, 89 Martin Schönbeck Beratungen GmbH, i +i Spenge i +i Ladevorgang kann durch Tastendruck unterbrochen werden i +i Habe leider keine EUMEL-0-Maschine gefunden i +i Ladevorgang unterbrochen, drücken Sie eine Taste um fortzufahren. i +i i ++--------------------------------------------------------------------------+ + +Legen Sie nun die erste Hintergrunddiskette (HG0) in das Laufwerk ein und betätigen +Sie eine Taste. Der Systemkern wird geladen und es erscheinen Angaben zu HG-, +RAM-, und Pufferkapazität sowie zu den angeschlossenen Kanälen, diesmal jedoch +bezogen auf die Festplatten-Partition. Warten Sie nun, bis die Meldung "HG ungültig" +kommt. Drücken Sie anschließend eine beliebige Taste. +Falls Sie in ein bereits bestehendes EUMEL-System einen neuen Urlader einspielen +wollen, lesen Sie bitte den Abschnitt "Installation eines neuen Urladers". + +#page# +#free(1.0)# +Ein Menü bietet Ihnen dann folgende Auswahl: + ++-----------------------------------------+ +i i +i (1) Systemstart i +i (2) Hintergrund vom Archiv laden i +i (3) Hardwaretest i +i (4) neuen Urlader vom Archiv laden i +i i ++-----------------------------------------+ + +Wählen Sie Menü-Punkt (2) "Hintergrund vom Archiv laden" und bestätigen Sie die +Abfrage "Alten HG überschreiben?" mit "j". + +Das Laden des Hintergrundes kann einige Minuten in Anspruch nehmen. Sie werden +mit der Meldung "Nächstes HG-Archiv eingelegt? (j/n)" zum Einlegen der Folgedisket­ +te(n) aufgefordert, was Sie anschließend mit der Eingabe von "j" quittieren. + +Es können bei beschädigten Disketten Lesefehler auftreten; dann gibt das System eine +der Meldungen 'Harter Lesefehler' bzw. 'Softerror' aus. Bei letzterem könnte der ent­ +sprechende Sektor nach mehrmaligem Versuch noch gelesen werden. Bei einem +harten Lesefehler können Sie die Diskette nicht verwenden. Bitte benachrichtigen Sie +die Firma, von der Sie die Disketten erhalten haben. + +Wenn der Hintergrund eingelesen ist, erscheint die Aufforderung 'fertig, bitte RESET'. +#on("b")#Vergessen Sie nicht#off("b")#, vor der Betätigung des Tastatur-RESET die Hintergrunddiskette +aus dem Diskettenlaufwerk zu entfernen. + +Wenn Sie während des Hochfahrens keine Taste drücken, dann startet der Lader durch +und das EUMEL-System meldet sich mit einer Tabelle von Geräteanpassungen: + ++--------------------------------------------------------------------------+ +i i +i psi transparent pc.1.25 pc.2.25 i +i pc.3.25 pc.1.24 pc.2.24 pc.3.24 i +i psi25 tandberg.2244s DEC.VT100.ascii DEC.VT100 i +i DEC.VT220.ascii DEC.VT220.german FT10/20.german FT10/20.ascii i +i ampex210.ascii ampex210.german ampex220.german ampex232 i +i Wyse.WY50.ascii Wyse.WY50.german Wyse.WY60.german i +i Wyse.WY120.german i +i i +i Kanal 1 (j/n) i +i i ++--------------------------------------------------------------------------+ + +Da unterschiedliche Tastaturen auch unterschiedliche Tastenbelegungen haben, ist es +notwendig, mit Hilfe der Konfigurationstabelle Ihre Tastatur und Ihren Bildschirm an +das EUMEL-System anzupassen. Dafür bietet Ihnen das System "Kanäle" an. #on("u")#Kanal 1#off("u")# +entspricht dem Haupt-Terminal des Rechners, #on("u")#muß also auf jeden Fall konfiguriert +werden#off("u")#. Beantworten Sie also die Frage "Kanal 1 (j/n)" mit "j". +Das EUMEL-System funktioniert auch, wenn Sie zunächst nur Kanal 1 mit der Anpas­ +sung konfigurieren, die Ihrem Gerätetyp entspricht. Wenn Ihr Rechner eine AT-Tastatur +hat, ist die korrekte Konfiguration "pc.1"; die Konfigurationen "pc.2" und "pc.3" decken +die meisten der Rechner ab, deren Tastenbelegung von der Standard-AT Tastatur +geringfügig abweicht. Die Erweiterung ".24" bzw. ".25" gibt die Anzahl der Bildschirm­ +zeilen wieder. Standardmäßig sind im SHard 24 Zeilen eingestellt. + +Weitere Kanäle zum Anschluß von Druckern oder weiteren Terminals können jederzeit +bei Bedarf vorgenommen werden (EUMEL Systemhandbuch Teil 1). +Die Anfrage nach der Konfiguration weiterer Kanäle kann deshalb verneint werden. Die +Abfrage 'koennen unbenutzte Geraetetypen geloescht werden (j/n)' beantworten Sie +einstweilen mit 'n'. Anschließend werden noch Datum und Uhrzeit abgefragt. Damit ist +das Erstinstallationsprogramm abgeschlossen und es erscheint die Meldung 'mainten­ +ance :'. Geben Sie an dieser Stelle (nacheinander) ein. Sie haben damit +die Task 'configurator' ordnungsgemäß verlassen. Erst damit ist sichergestellt, daß die +eingestellte Konfiguration wirksam wird. + + +Installation eines neuen Urladers + +Wenn Sie den alten Urlader mit einem neuen (z.B. protected mode) überschreiben +wollen, starten Sie das EUMEL-System zunächst neu. Sobald die Meldung + + #on("b")#Ladevorgang kann durch Tastendruck unterbrochen werden#off("b")# + +erscheint, drücken Sie eine beliebige Taste (z.B. ENTER). Auf dem Bildschirm er­ +scheint nun zusätzlich die Meldung + + #on("b")#Ladevorgang unterbrochen, drücken Sie eine Taste um fortzufahren#off("b")# +#page# +Legen Sie nun die Diskette mit dem neuen Urlader in das Bootlaufwerk und drücken +Sie wieder eine beliebige Taste. Danach werden folgende Meldungen auf dem Bild­ +schirm ausgegeben: + ++-----------------------------------------------------+ +i i +i EUMEL wird von Diskette geladen i +i i +i i +i E U M E L - Vortest i +i i +i Terminals: 1 .... i +i RAM-Groesse (gesamt): .... kB i +i Pufferbereich: .... kB i +i Hintergrund-Speicher .... kB i +i i +i Speichertest: ********** i +i i ++-----------------------------------------------------+ + +In der Zeit, in der die Sternchen des Speichertests erscheinen, drücken Sie bitte wieder +die ENTER-Taste. Nach dem Speichertest erscheint dann folgendes Menü: + ++-----------------------------------------------------+ +i i +i (1) Systemstart i +i (2) neuen Hintergrund vom Archiv laden i +i (3) Hardwaretest i +i (4) neuen Urlader vom Archiv laden i +i i ++-----------------------------------------------------+ + +Wählen Sie Menüpunkt 4 und auf dem Bildschirm erscheinen die folgenden Zeilen: + +#box("-0.1","0.0","8.0","1.0")# + \# xxx + fertig, bitte RESET + +wobei hinter dem \#-Zeichen die übertragenen Blöcke des neuen Urladers gezählt +werden. + +Anschließend entfernen Sie bitte die Urladerdiskette aus dem Laufwerk und drücken +den RESET-Schalter Ihres Rechners. Das EUMEL-Betriebssystem wird nun mit dem +neuen Urlader gestartet. + + +Tastenbelegung: + +EUMEL-Zeichen: Taste auf dem IBM-PC/AT + + MARK : +--------+ + i bild i (oder Pfeil nach oben) + +--------+ + + RUBIN : +--------+ + i Einfüg i + +--------+ + + RUBOUT : +--------+ + i Lösch i + +--------+ + + TAB : +--------+ + i <= => i + +--------+ + + HOP : +--------+ + i Pos 1 i + +--------+ + + ESC : +------------+ + i Eing Lösch i + +------------+ + + SV : +------------+ +-------+ + i CTRL g i oder i F1 i + +------------+ +-------+ + +Bemerkung: Die CTRL-Taste kann auch mit STRG bezeichnet sein. + +Sollte die Tastaturbelegung noch nicht die EUMEL-spezifischen Tasten (HOP, MARK, +SV, RUBIN, RUBOUT) an den entsprechenden Orten anbieten, können Sie durch +Ankoppeln der Task "configurator" und Absetzen des Befehls "configurate" die Tastatu­ +ren (auch für zusätzlich angeschlossene Terminals) kanalweise umkonfigurieren. Nähe­ +res entnehmen Sie bitte dem Systemhandbuch, S.6ff. + + +Zusatzprogramme + +Nachdem das System vollständig installiert ist, kann noch typspezifische Software +eingespielt werden. Diese befindet sich auf der Diskette 'EUMEL-Archiv "AT" (bzw. +"XT")'. Der folgende Ablauf skizziert schon das Prinzip jeder Arbeit in einem EUMEL- +System: Task ankoppeln mit 'continue("taskname")' bzw. 'begin("taskname")', Eingabe +von Kommandos wie 'edit', 'run' oder 'generate shutup dialog manager', abschließend +Task abkoppeln durch . Eine ausführliche Beschreibung finden Sie in +den EUMEL-Handbüchern. +#page# +Wenn Sie nach Einstellen des Kanals 1 die Task 'configurator' verlassen haben, befin­ +den Sie Sich auf Supervisor-Ebene. Um die auf der Diskette befindlichen Programme +an der richtigen Stelle zu übersetzen, sind folgende Schritte notwendig: + +Drücken Sie die -Taste (F1). Damit landen Sie im Supervisor-Menü, dem +Systemverteiler. Mit und Eingabe des Tasknamens 'SYSUR' (auf Groß­ +schreibung achten!) holen Sie die Task 'SYSUR' an das Terminal. Diese Task meldet +sich mit 'maintenance:'. Da Sie mit einem Mehrbenutzersystem arbeiten, müssen Sie +das Diskettenlaufwerk zunächst für sich reservieren: 'archive("AT")'. Erst dann können +Sie Dateien von der Diskette holen: 'fetch("AT install",archive)' und das Installations­ +programm ausführen: 'run'. Der weitere Ablauf erfordert keine Eingriffe. + +Nach Ablauf der Programme sollten Sie schließlich eine besondere Task zum Abschal­ +ten einrichten. Dazu müssen Sie nocheinmal die Task 'SYSUR' an den Bildschirm +holen und dort das durch die Zusatzsoftware (u.a.) neu hinzugewonnene Kommando +'generate shutup dialog manager' geben. Nach Absetzen des Kommandos können Sie +'SYSUR' durch wieder verlassen. + +Um menügesteuert das Betriebssystem abzuschalten oder einen Partitionswechsel +vorzunehmen, steht Ihnen die Task 'shutup dialog' zur Verfügung. Bei Ausführung des +Supervisor-Kommandos 'continue("shutup dialog")' wird Ihnen die aktuelle Partitions­ +tabelle angezeigt, so wie Sie diese bereits bei der Generierung kennengelernt haben, +d.h. mit Angabe von Größe, Start- und Endzylinder der eingerichteten Partitionen. Sie +können dann eine beliebige Partition menugesteuert auswählen und starten oder das +Betriebssystem kontrolliert abschalten (sog. 'shutup'). Dabei wird der aktuelle System­ +zustand automatisch gesichert. + + +Archivformate bei ATs und Kompatiblen mit zwei Diskettenlauf­ +werken: + +Standardmäßig ist der Archivkanal 31 an das Laufwerk 'A:' gebunden, das eine Kapazi­ +tät von 1,2 Megabyte besitzt. Ist jedoch bei Ihrem Gerät ein zweites Diskettenlaufwerk, +z.B. mit einer Kapazität von 360 Kilobyte eingebaut, dann können Sie auf dieses Lauf­ +werk über den Kanal 30 zugreifen. + +Dazu richten Sie unter 'SYSUR' eine Task ein, die Sie z.B. 'ARCHIVE 360' benennen. +Geben Sie in dieser Task das Kommando 'archive manager (30)'; dann können Sie von +jeder Benutzertask das Archiv mit dem Kommando 'archive ("Archivname",/ "ARCHIVE +360")' anmelden. Der Zugriff auf eine Diskette in diesem Laufwerk geschieht z.B. über +'list(/"ARCHIVE 360")' oder 'save ("Dateiname",/"ARCHIVE 360")'. Eine andere Möglich­ +keit ist ein 3,5" Laufwerk. + + + +Die einzelnen Schritte der Installation im Überblick: + + + 1. Die Diskette 'SETUP-EUMEL' in das Laufwerk stecken. + + 2. Rechner einschalten oder Tastatur-RESET + + 3. EUMEL-Partition einrichten. + + 4. Generierung beenden und auf 'ENDE'-Meldung warten. + + 5. Diskette 'SETUP-EUMEL AT (XT)' entnehmen. + + 6. Tastatur-RESET. + + 7. Die Meldung 'Leider keine EUMEL-0-Maschine gefunden' abwarten. + + 8. Hintergrunddiskette ('HG0') einlegen und Taste drücken. + + 9. Nach der Meldung 'HG-ungültig' eine Taste betätigen, um in den Startdialog zu + gelangen. + + 10. Menupunkt 2 anwählen: Neuen Hintergrund vom Archiv laden. Hintergrunddis­ + kette einlegen und 'Alten HG überschreiben?' mit "j" quittieren. Folgedisketten + einlegen, sobald entsprechende Meldung ("weiterer Archivträger eingelegt?") + erscheint, und "j" eingeben. + + 11. Hintergrunddiskette entnehmen und anschließend Tastatur-RESET ausführen. + + 12. Kanal 1 konfigurieren. + + + +#ib(9)#1.3. Ausführliche Beschreibung#ie(9)# + + +#ib##ib(9)#System laden#ie##ie(9)# + + +Wie Sie in der Installationsanleitung lesen konnten, geht man beim Systemstart durch +Eingabe eines Zeichens während des Vortests in das Startmenü und wählt dort "Hin­ +tergrund vom Archiv laden" an. Falls der zu ladende Hintergrund sich über mehrere +Archiv-Disketten erstreckt, werden die folgenden sukzessive angefordert. + + + + +#ib##ib(9)#System sichern#ie##ie(9)# + + +Der aktuelle eigene Hintergrund läßt sich (mit allen Tasks und allen Dateien) durch das +Kommando + + #ib#save system#ie# + +auf Archivdisketten sichern. Dabei wird der Systemzustand zunächst über einen Fix­ +punkt gesichert. Anschließend werden #on("b")##on("i")#formatierte#off("i")##off("b")# Disketten angefordert. Der Hinter­ +grund wird komprimiert gesichert, d.h. nur die belegten Blöcke werden auf das Archiv +geschrieben. + +#on("i")#Anmerkung: Diese Prozedur kann nur von privilegierten Tasks (Nachfahren von + "SYSUR"), wie dem OPERATOR, aufgerufen werden. + Vor dem Aufruf von 'save system' sollten Sie genügend Disketten for­ + matiert haben (Überprüfen Sie mit 'storage info', wieviele Disketten Sie + benötigen, um den gesammten Hintergrund darauf zu schreiben). #off("i")# + + + + +#ib(9)#System gegen Unbefugte schützen#ie(9)# + + +Falls der Benutzerkreis eines Multi-User-Systems nicht "gutartig" ist, sollte man verhin­ +dern, daß jeder Benutzer des Systems Zugang zu #ib#privilegierten Operationen#ie# hat, wie +Löschen anderer Tasks, Konfiguration ändern und System sichern. + +Dies erreichen Sie dadurch, daß Sie #on("b")#alle#off("b")# privilegierten Tasks, das sind 'SYSUR' und alle +Söhne, Enkel usw. von 'SYSUR', durch #ib#Paßworte#ie# schützen. Damit wird der Zugang zu +diesen Tasks nur möglich, wenn man das entsprechende Paßwort eingibt. Man de­ +finiert solche #on("i")##on("b")##ib#Task-Paßworte#ie##off("i")##off("b")#, indem man die zu schützende Task mit Hilfe des Super­ +visor-Kommandos "continue" an ein Terminal holt und dann das Kommando + + #ib#task password#ie# ("simsalabim") + +gibt. Dabei ist "simsalabim" nur ein Beispiel. Bitte verwenden Sie ein anderes Paß­ +wort! Da die Eigenschaft, privilegiert zu sein, nur davon abhängt, im "SYSUR"-Zweig +(und nicht im normalen "UR"-Zweig) des Systems zu sein, könnte sich ein gewitzter +Anwender die Privilegierung einfach erschleichen, indem er eine neue Sohntask von +"SYSUR" einrichtet. Um auch diese Möglichkeit zu unterbinden, sollte man in #on("b")#jeder#off("b")# +Task des SYSUR-Zweiges ebenfalls ein #on("i")##on("b")#"begin"-Paßwort#off("i")##off("b")# definieren. Das geschieht mit +dem Kommando + + #ib#begin password#ie# ("simsalabim") + +Bei der Wahl der Paßworte sollte man folgendes bedenken: + + - Ein zu kurzes oder offensichtliches Paßwort (beispielsweise der Name des + Systemverwalters) wird von "Hackern" schnell herausgefunden. + + - Oft werden Paßworte bekannt, weil irgendwo ein Zettel mit den Paßworten + herumliegt. + + - Der Paßwortschutz ist hart. Wenn man sein Paßwort vergessen hat, gibt es + keinen Zugang mehr zu der geschützten Task. + + + +Beschreibung der Paßwortprozeduren: + +#ib#task password#ie# + PROC task password (TEXT CONST password) + Zweck: Einstellen eines Paßwortes für eine Task im Monitor. + +#ib#begin password#ie# + PROC begin password (TEXT CONST password) + Zweck: Verhindert das unberechtigte Einrichten einer Sohn-Task. + Anmerkung: Das 'begin password' vererbt sich auf die später erzeugten Sohn- + Tasks. + +#ib#family password#ie# + PROC family password (TEXT CONST password) + Zweck: Setzt oder ändert das Paßwort derjenigen Familienmitglieder, die kein + Paßwort oder das gleiche Paßwort wie die aufrufende Task haben. + Zu einer Familie gehören die Task in der man sich befindet und die ihr + untergeordneten Tasks. + Bsp.: Das Kommando 'family password ("EUMEL")' wird in SYSUR + gegeben. Dadurch wird das SYSUR-Paßwort und die Paßworte + der entsprechenden Tasks unter SYSUR auf "EUMEL" gesetzt. + + + +#ib##ib(9)#Konfiguration#ie##ie(9)# + +Die #ib#Konfiguration#ie# läuft über die Task "#ib#configurator#ie#" ab. Diese Task müssen Sie also für +die hier aufgeführten Operationen durch das Supervisor-Kommando "continue" an­ +koppeln (Dabei wird das Paßwort überprüft, falls die Task geschützt wurde). + +#on("i")#Anmerkung: Man kann die Task "configurator" löschen und dann neu (als Sohn, En­ + kel,... von SYSUR) wieder einrichten. Danach holt man die Konfigura­ + tionsdatei (z.B. von std.devices) und gibt das Kommando "#ib#configuration + manager#ie#".#off("i")# + + +Der in der Einführung unter "Wie Sie die Konfiguration einstellen" beschriebene Konfi­ +gurationsdialog läßt sich vermittels des Kommandos + + #ib#configurate#ie# + +aufrufen. Dabei wird für jeden angewählten Kanal die bis jetzt gültige Einstellung als +Vorschlag mit ausgegeben. Die Einstellung aller Kanäle, die nicht angesprochen wer­ +den, bleibt unverändert. + +Im Menü werden die Namen aller Dateien mit #ib#Gerätetabellen#ie# aufgeführt, die in der +Task enthalten sind. Daraus folgt, daß nur noch die bei der letzten Konfigurierung +benutzten Typen aufgeführt werden, wenn vorher auf die Frage "Koennen unbenutzte +Geraetetypen geloescht werden (j/n)?" mit "j" geantwortet wurde. Löschen Sie also +nicht alle unbenutzten Gerätetypen, wenn Sie sie später evtl. nochmal bruachen (siehe +auch "Teil 2, 3. Kanäle und Konfigurierung"). + +Im Konfigurationsdialog kann folgendes eingestellt werden: + + #ib#Typ#ie# Es werden alle vorhandenen Gerätetabellen durchgegangen, bis + eine davon ausgewählt wurde. Diese manchmal etwas langwierige + Arbeit kann man durch Eingabe des Zeichens ESC abkürzen: + Danach kann man den Typnamen direkt eingeben. #on("i")#Das funktioniert + aber nur vernünftig, wenn das eigene Arbeitsterminal bereits richtig + konfiguriert worden ist!#off("i")# + + #ib#Baudrate#ie# (nur für V.24-Kanäle von Bedeutung) Es werden alle einstellbaren + Baudraten durchgegangen, bis eine davon ausgewählt wurde. Das + sind die Werte 50, 75, 110, 134.5, 150, 300, 600, 1200, 1800, 2400, + 3600, 4800, 7200, 9600, 19200, 38400 Baud. + + #ib#Bits#ie# (nur für V.24-Kanäle von Bedeutung) Es werden die einstellbaren + Zeichengrößen durchgegangen, d.h. 7 oder 8 Bit pro Zeichen. + + #ib#Parität#ie# (nur für V.24-Kanäle von Bedeutung) Möglich sind die Einstellun­ + gen 'no', 'even' und 'odd'. + + #ib#Stopbits#ie# (nur für V.24-Kanäle von Bedeutung) Stopbits geben die Pause + zwischen zwei aufeinanderfolgenden Zeichen an. Möglich sind 1 + oder 2 Stopbits. + + + #ib#Protokoll#ie# Terminals u.ä. werden üblicherweise ohne Protokoll angeschlossen. + Bei langsamen Geräten wie Druckern bzw. Plottern oder aber bei + Rechnerkopplungen bzw. Netzen kann der Empfänger nicht immer + so schnell Zeichen annehmen wie sie von der Gegenstation gesen­ + det werden. In diesem Fall kann man das #ib#XON/XOFF-#ie# oder das + #ib#RTS/CTS-Protokoll#ie# einstellen. + #on("b")#BEACHTE: Sender und Empfänger müssen auf das gleiche Proto­ + koll eingestellt sein.#off("b")# + + Manchmal müssen auch Terminals mit Protokoll angeschlossen + werden. Üblicherweise wählt man dann aber ein rein ausgabe­ + seitiges Protokoll, damit SV den EUMEL auf jeden Fall erreicht. + Es gibt folgende Protokolle: + + #ib#XON/XOFF-Protokoll#ie#: + Rechner und Gerät steuern die Sendungen jeweils über + XON/XOFF-Zeichen. + #ib#RTS/CTS-Protokoll#ie#: + Rechner und Gerät steuern ihre Sendungen jeweils über + RTS/CTS- Leitungen. + #ib#XON/XOFF-ausgabeseitig#ie#: + Das angeschlossene Gerät steuert die Ausgabe über + XON/XOFF.Eingaben zum Rechner unterliegen keinem + Protokoll. + #ib#RTS/CTS-ausgabeseitig#ie#: + Das angeschlossene Gerät steuert die Ausgabe über + RTS/CTS. Eingaben zum Rechner unterliegen keinem + Protokoll. + #ib#XON/XOFF-eingabeseitig#ie#: + Der EUMEL-Rechner steuert die angeschlossenen + Geräte durch XON/XOFF. Die Ausgaben zum Gerät + unterliegen keinem Protokoll. + #ib#RTS/CTS-eingabeseitig#ie#: + Der EUMEL-Rechner steuert die angeschlossenen + Geräte durch RTS/CTS. Die Ausgaben zum Gerät unter­ + liegen keinem Protokoll. + + #ib#Puffer#ie# Terminals und alle Ausgabegeräte (Drucker u.ä.) haben standard­ + mäßig die normalen "kleinen" Eingabepuffer im System zugeord­ + net. Bei Rechner-Rechner-Kopplungen, DFÜ oder Netzen kann ein + "großer" #ib#Eingabepuffer#ie# von 512 Byte notwendig werden. Dement­ + sprechend sind #ib#Großpuffer#ie# nur beim Schnittstellentyp 'transparent' + möglich. + +Im #ib#Konfigurationsdialog#ie# werden bei jedem Kanal nur die dort vorhandenen Möglich­ +keiten angeboten. Dabei wird die vorherige Einstellung immer als erste angeboten. So +kann man sich verhältnismäßig einfach "durchtasten". + +Die Fragen des #ib#Konfigurationsdialog#ie#s werden nach folgendem Schema gestellt: + +#linefeed(1.18)# + erfrage ("Kanal") ; + erfrage ("Typ") ; + IF dieses ist ein v24 kanal + THEN IF baudrate einstellbar + THEN erfrage ("Baudrate") + FI ; + IF zeichengroesse einstellbar + THEN erfrage ("Bits") + FI ; + IF parität einstellbar + THEN erfrage ("Parität") + FI ; + IF stopbits einstellbar + THEN erfrage ("Stopbits") + FI ; + FI ; + erfrage ("Protokoll") ; + IF typ ist tranparent + THEN erfrage ("Puffer") + FI. + +#linefeed(1.0)# +Will man seine eingestellte #ib#Konfiguration sichern#ie#, reicht es, alle Dateien der Task +"#ib#configurator#ie#" auf ein Archiv zu schreiben. Diese Konfiguration kann man dann bei +einem neuen Hintergrund einfach vom Archiv laden. Um die Konfigurierung dann auch +auszuführen, gibt man das Kommando "setup". + + + + +#ib##ib(9)#Druckersoftware einrichten#ie##ie(9)# + + + +Das Standardarchive "std.printer" enthält einige Druckeranpassungen für die Ansteu­ +erung diverser Druckertypen. Soll einer dieser Druckertypen an das EUMEL-System +angeschlossen werden, so muß zuerst eine Task "#ib#PRINTER#ie#" (als Sohntask von +"SYSUR" mit dem Supervisorkommando) vorhanden sein bzw. durch + + + begin ("PRINTER", "SYSUR") + + +eingerichtet werden. In dieser Task müssen dann die folgenden Schritte vollzogen +werden: + +- Anmelden des Archivs: + + archive ("std.printer") + + +- Holen der Druckeranpassung vom Archiv: + + fetch ("druckertyp.inserter", archive) + + +- Insertieren der Druckeranpassung: + + insert ("druckertyp.inserter") + + + +Beispiel: + archive ("std.printer") + fetch ("laser.inserter", archive); + check off; + insert ("laser.inserter") + + +Nach Beendigung der Kompilierung finden Sie sich in einem Menü wieder, daß Ihnen +die Auswahl Ihres Drucker-Herstellers durch die Eingabe der vor dem Firmennamen +stehenden Zahl erlaubt. Diese Eingabe schicken Sie mit RETURN ab. Da Hersteller +mitunter verschiedene Modelle mit verschiedenen Funktionen anbieten, ist es nötig, +daß Sie Ihr Modell auswählen. Auch diese Eingabe wird durch RETURN abgeschickt. +Nachdem Sie die Nummer des gewünschten Druckers eingegeben haben, erfolgt noch +einmal eine Sicherheitsabfrage, ob dieser Drucker installiert werden soll. + +Neben den speziell zu dem gewählten Drucker passenden Fragen (z.B. NLQ-Modus +standardmäßig) ist es erforderlich, den Kanal einzugeben, an dem der Drucker ange­ +schlossen ist (z.B. Kanal 15 für eine parallele Schnittstelle). + +Wenn die Generierung beendet ist, muß in allen bestehenden Tasks - insbesondere in +der Task 'PUBLIC' - die Fonttabelle mit dem fonttable-Kommando eingestellt werden. +Mit dem Kommando + + + print ("dateiname") + + +wird dann eine Datei ausgedruckt. + +Befindet sich keine passende Druckeranpassung für den anzuschließenden Drucker­ +typ auf dem Standardarchiv "std.printer", so sollte die Druckeranpassung "printer.std" +benutzt werden. Diese Druckeranpassung ist eine universelle Druckeranpassung für +alle Drucker, die mit ASCII-Code 13 ein 'Carriage Return' (d.h. Bewegung des Druck­ +kopfes an den linken Rand) und mit ASCII-Code 10 eine Zeilenschaltung von 1/6 Zoll +vornehmen. Mit ihr kann dann in einem Schrifttyp (entweder 10 oder 12 Zeichen pro +Zoll, je nachdem welche Fonttabelle eingestellt ist) gedruckt werden. So erhält man +wenigstens eine Minimalansteuerung des Druckers. Für eine bessere Ansteuerung des +Drucker muß ein Programm geschrieben werden, das das Druckertreiber-Interface +erfüllt (siehe Teil 6 "Der EUMEL-Drucker") und eine Fonttabelle erstellt (siehe Teil 7 "Der +Fontspeicher") werden. +#page# +#headeven# + +%#center#EUMEL-Systemhandbuch + + +#end# +#headodd# + +#center#2. Hardware und ihre Steuerung#right#% + + +#end# + + +#ib(9)#2. Hardware und ihre Steuerung#ie(9)# + + + + +#ib(9)#2.1. Vorwort#ie(9)# + + +Die #ib#Hardware#ie# eines jeden EUMEL-Systems läßt sich in #ib#Rechnerkern#ie# und Peripherie +einteilen. + + +a) Der #ib#Rechnerkern#ie# + + +In der Regel wird der Rechnerkern aus folgenden Komponenten bestehen: + + - #ib#CPU#ie# + - #ib#Vordergrundspeicher#ie# (oft als RAM bezeichnet) + - #ib#Hintergrundspeicher#ie# (Floppy, Harddisk, oder auch RAM/ROM) + +Alle Daten, Dateien und Programme werden auf dem Hintergrundspeicher abgelegt. +Der benötigte Platz wird dabei dynamisch nach Bedarf zugewiesen. Jeder Zugriff auf +Daten, die sich auf dem Hintergrundspeicher befinden, muß über den Vordergrund­ +speicher erfolgen. Zu diesem Zweck verlagert das EUMEL-System automatisch alle +aktuell benötigten Daten in den Vordergrundspeicher. Das erfolgt nach dem Prinzip +des #ib#Demand-Paging#ie# (s. Benutzerhandbuch Kap. 1). Die CPU führt die aktiven Pro­ +gramme (unter Benutzung des Speichers) aus. Dabei bearbeitet sie reihum alle re­ +chenwilligen Prozesse. +Die drei Komponenten des Rechnerkerns werden vollständig vom EUMEL-Betriebs­ +system verwaltet und miteinander verknüpft, so daß der Anwender sich in der Regel +darum weder kümmern muß noch kann. Ausgenommen davon sind allerdings die +Diagnose von Hardwarefehlern und Überlegungen zur Systemleistung. + + +b) Die #ib#Peripherie#ie# + + +Alle anderen Geräte oder Gerätekomponenten gehören aus der Sicht des EUMEL- +Systems zur Peripherie. Wesentliches Kennzeichen ist, daß sie über Kanäle mit dem +Rechnerkern verbunden sind und von dort aus durch System- und Anwender­ +programm gesteuert werden können. Angeschlossen werden können u.a. + + - #ib#Terminal#ie#s + - #ib#Drucker#ie# und #ib#Plotter#ie# + - andere #ib#Rechner#ie# bzw. #ib#Rechnernetze#ie# + - #ib#Archivgerät#ie#e (z.B. Floppy-Laufwerke) + +In der Regel hat jedes EUMEL-System mindestens ein #ib#Terminal#ie# und #ib#Archivlaufwerk#ie#. +Auch wenn dieses "Terminal 1" und das Floppy-Laufwerk baulich in den Rechner +integiert sind, gehören sie logisch zur Peripherie. Die entsprechenden Kanäle sind +dann allerdings Teil des Rechners und brauchen den Anwender nicht zu interessie­ +ren. Die beiden wesentlichen anderen Kanaltypen sind: + + - #ib#serielle Schnittstelle#ie#n (#ib#V.24#ie#) + - #ib#Parallelschnittstellen#ie# + +Beide führen "echt" aus dem Rechner heraus und sind u.U. hardwaremäßig für den +Anwender von Bedeutung. Normalerweise sollte zwar der Lieferant der EUMEL- +Hardware für die Verkabelung und den Anschluß peripherer Geräte sorgen, aber +Kenntnisse können in Fehlersituationen (z.B. Kabelbruch), bei Umkonfigurierungen +und bei Kombinationen verschiedener Geräte helfen. + + + + +#ib(9)#2.2. #ib#Hardware-Test#ie##ie(9)# + + + +Der EUMEL-Hardware-Test ist ein rechnerunabhängiger Test und kann demzufolge +nicht so viel überprüfen wie Testprogramme, die genau auf eine entsprechende Hard­ +ware zugeschnitten sind. Trotzdem sollten die meisten Hardware-Fehler schon mit +dem EUMEL-#ib#Hardware-Test#ie# gefunden werden. + +Bei jedem Systemstart wird der "#ib#Vortest#ie#" durchgeführt. Nachdem er Terminals, Spei­ +cher und Hintergrund angezeigt hat, testet er einmal den Hauptspeicher. Danach wird +das eigentliche EUMEL-System gestartet. + + +Durch Eingabe eines beliebigen Zeichens während des Vortests (Speichertest: +*********) kommt man in den ausführlichen #ib#Start-Dialog#ie#. Dort wird u.a. auch die +Möglichkeit "Hardware-Test" angeboten. Wählt man diese an, werden die verfügbaren +Tests als Menü aufgelistet. Bei jedem EUMEL-System stehen folgende Testmöglichkei­ +ten zur Verfügung: + + (1) #ib#Speichertest#ie# + (2) #ib#Kanaltest#ie# + (3) #ib#Hintergrundtest#ie# + (4) #ib#Archivtest#ie# + +Alle Tests sind dabei Dauertests, d.h. sie beginnen nach jedem Durchlauf von neu­ +em, können aber durch abgebrochen werden. + + + + + +#ib##ib(9)#Speichertest#ie##ie(9)# + + +Der #ib#Speichertest#ie# soll den Vordergrundspeicher (#ib#RAM#ie#) des Rechners untersuchen. +Gerade #ib#Speicherfehler#ie# tendieren aber dazu, nur sporadisch aufzutreten oder wär­ +meabhängig zu sein. Deshalb sollte der Test bei Verdacht auf Speicherfehler längere +Zeit (einige Stunden) laufen. Leider können auch dann nicht alle Fehler aufgedeckt +werden, z.B. nicht solche, die nur in ganz speziellen Situationen entstehen, wie Spei­ +cherzugriff mit gleichzeitig anlaufendem Floppymotor und Zeichenausgabe. Generell +gilt hier (wie für jeden Test), daß das Nichtvorhandensein von Fehlern nie Vollkommen +sicher nachgewiesen werden kann. + +Der Speichertest teilt den Speicher in drei verschiedene Bereiche auf: + + 0 : adresse MOD 3 = 0 + 1 : adresse MOD 3 = 1 + 2 : adresse MOD 3 = 2 + +Der freie Speicher wird nach folgendem Algorithmus geprüft: + + schreibe (1, OLOLOLOL) ; out ("*") ; + schreibe (2, OLOLOLOL) ; out ("*") ; + schreibe (0, LOLOLOLO) ; out ("*") ; + pruefe (1, OLOLOLOL) ; out ("*") ; + schreibe (1, LOLOLOLO) ; out ("*") ; + pruefe (2, OLOLOLOL) ; out ("*") ; + pruefe (0, LOLOLOLO) ; out ("*") ; + pruefe (1, LOLOLOLO) ; out ("*") ; + schreibe (0, OLOLOLOL) ; out ("*") ; + pruefe (0, OLOLOLOL) ; out ("*") ; + schreibe (2, LOLOLOLO) ; out ("*") ; + pruefe (2, LOLOLOLO) ; out ("*") . + + +Dabei werden durch 'PROC schreibe (INT CONST bereich, BYTE CONST muster)' alle +Bytes des entsprechenden Bereichs mit dem angegebenen Muster geladen. 'PROC +pruefe (INT CONST bereich, BYTE CONST soll)' überprüft entsprechend alle Bytes des +Bereichs darauf, ob sie das Sollmuster enthalten. + +Findet der Speichertest Fehler, können u.a. folgende Ursachen vorliegen: + + - Ein Speicherchip ist defekt. + + - Die Versorgungsspannung für den Speicher (meistens +5V) ist zu niedrig, + d.h. das Netzteil ist nicht richtig eingestellt bzw. defekt. (Das kann insbeson­ + dere dann entstehen, wenn ein Rechner so "hochgerüstet" wurde, daß das + Netzteil nachgeregelt werden müßte.) + + - Die Kontakte der Speicherkarten sind locker oder oxidiert. + + - Die Speicheransteuerung ist defekt. + + + + + +#ib##ib(9)#Kanaltest#ie##ie(9)# + + +Beim #ib#Kanaltest#ie# werden fortlaufend auf allen #ib#Terminalkanälen#ie# (außer auf Terminal 1) +die jeweiligen Kanalnummern in der Form "Kanal: n" ausgegeben. Jedes Eingabe­ +zeichen wird in dezimaler Verschlüssung unter Angabe der Kanalnummer auf dem +Terminal 1 gemeldet. + +Mit Hilfe dieses Tests können u.a. Kabel und Geräteeinstellungen überprüft werden. +Mögliche Fehlerursachen: + + - falsche #ib#Baudrate#ie# eingestellt + + Symptome: Bei Aus- und Eingabe werden vollkommen unsinnige Zeichen + angeliefert. + Abhilfe: Baudrate am Endgerät oder am Rechner richtig einstellen. + + - falsche #ib#Parität#ie# eingestellt + + Symptome: Einige Zeichen werden richtig übertragen, andere verfälscht. In + einigen Fällen können auch alle Zeichen falsch übertragen wer­ + den. + Abhilfe: Parität am Endgerät oder am Rechner richtig einstellen. + + - falsches #ib#Kabel#ie# (z.B. Sende- und Empfangsleitungen fälschlich gekreuzt bzw. + nicht gekreuzt, Kabel ohne Flußkontrolle an Schnittstelle mit + Flußkontrolle, V.24-Kabel an Parallelschnittstelle oder umge­ + kehrt): + + Symptome: Keine Ausgabe, keine Eingabe oder andauernder Strom von + "Schrottzeichen". + Abhilfe: richtiges Kabel nehmen oder Kabel korrigieren. + + - defektes Kabel (Kabelbruch, defekter Stecker o.ä.) + + Symptome: beliebig. + Testmöglichkeit: Kabel wechseln. + + - defektes #ib#Endgerät#ie# + + Symptome: beliebig. + Testmöglichkeit: Anderes Gerät mit gleicher Einstellung (Baudrate, Parität + usw.) anschließen. + + - defekte #ib#Schnittstelle#ie# im Rechner + + Symptome: beliebig + Testmöglichkeit: Endgerät mit gleichem Kabel an eine andere Schnittstelle + am Rechner anschließen (dazu evtl. die Geräteparameter + wie Baudrate anpassen). + + + + + +#ib##ib(9)#Hintergrundtest#ie(9)##ie# + + +Zur Überprüfung des #ib#Hintergrund#ie#es werden drei Tests angeboten: + + (1) #ib#Lesetest#ie# + (2) #ib#Lese-/Schreibtest#ie# + (3) #ib#Positioniertest#ie# + + +Der #ib##on("i")##on("b")#Lesetest#off("i")##off("b")##ie# prüft, ob alle für EUMEL verfügbaren Blöcke auf der Platte bzw. Floppy +lesbar sind. Dabei wird der Blockinhalt nicht inspiziert. Sowohl behebbare (soft) als +auch harte #ib#Lesefehler#ie# werden gemeldet. Der Bediener kann einen Korrekturversuch +durch Rückschreiben veranlassen. Bei einem #ib#Soft-Error#ie# (Block konnte nach mehreren +Versuchen doch gelesen werden) wird der gelesene Block neu geschrieben. Der Fehler +kann jetzt ohne negative Folgen behoben sein, bei defekter Hardware aber auch zu +Folgefehlern führen. +Als Korrekturversuch bei harten Fehlern wird ein mit 'FFFD' gefüllter Block geschrie­ +ben. Wird ein solcher Block später vom EUMEL gelesen und als Code angesehen, führt +das zur Fehlermeldung "#ib#code block unreadable#ie#". Wird FFFD als INT angesehen, liefert +es den Wert -3, bei REAL oder TEXT können keine Vorhersagen gemacht werden. + + +Bei dem #ib##on("i")##on("b")#Schreib-/Lesetest#off("i")##off("b")##ie# wird jeder Block mit mehreren Bitmustern beschrieben und +zur Kontrolle wieder gelesen. Der alte Inhalt wird vor dem Test gesichert und nachher +wieder in den Block geschrieben. + + #on("b")#Achtung: Normalerweise zerstört der Test den EUMEL-Hintergrund nicht. Bei + defekter Platte können allerdings Blöcke durch mißlungenes Rück­ + schreiben zerstört werden. #off("b")# + + +Der #ib##on("i")##on("b")#Positioniertest#off("i")##off("b")##ie# arbeitet ähnlich wie die Leseprüfung. Allerdings wird in der Reihen­ +folge 0, 1, 0, 2, 0, 3, ... gelesen, so daß die Platte für jeden Lesevorgang positionieren +muß. + + #on("b")#Achtung: Wegen der harten Plattenbelastung sollte dieser Test nicht zu lange + laufen.#off("b")# + + + + + +#ib##ib(9)#Archivtest#ie##ie(9)# + + +Der Archivtest arbeitet ähnlich wie der Hintergrundtest - allerdings auf dem Archiv. Er +kann sowohl zur Überprüfung von Archiv-Datenträgern (#ib#Lesetest#ie#) als auch zum Test +des #ib#Archivlaufwerks#ie# benutzt werden. + + + + + +#ib(9)#2.3. #ib#Serielle Geräteschnittstelle#ie##ie(9)# + + +#ib##ib(9)#Pinbelegung und Kabel#ie(9)##ie# + + +#on("b")##on("i")#Anmerkung: Dieses Kapitel ist nur für solche Anwender von Bedeutung, die sich selbst + mit der Verkabelung ihrer Geräte befassen.#off("i")##off("b")# + +Im folgenden werden die wichtigsten Leitungen der offiziellen #ib#V.24-Schnittstelle#ie# (#ib#seriel­ +le Schnittstelle#ie# zum Anschluß von Terminals, Druckern, Fremdrechnern u.ä.) beschrie­ +ben: + + Pin Betriebsrichtung Bedeutung + + 2 out Sendedaten + 3 in Empfangsdaten + + 4 out Sendeaufforderung (RTS) + 5 in Empfangsbereitschaft (CTS) + + 7 Signalerde + + 8 in Gegenstation bereit (DCD) + + 20 out eigene Station bereit (DTR) + + +Dabei dient das Paar (2,3) zur Übertragung der Daten, mit Hilfe von (4,5) ist #ib#Flußkon­ +trolle#ie# möglich (z.B. kann ein Drucker damit Sendungen vom Rechner "verlangsamen"). +Das Paar (8,20) wird bei manchen Geräten und Rechnern benutzt, um festzustellen, ob +die Gegenstation eingeschaltet ist. + + +Die meisten Rechner haben die gleiche #ib#Pinbelegung#ie# wie oben aufgeführt. Die Kabel +müssen dann die folgenden #ib#Pin#ie#s verbinden: + + +Rechner 2 3 4 5 7 8 20 Vollständige Verbindung mit Flußkontrolle. + +Gerät 2 3 4 5 7 8 20 + + +Rechner 2 3 4 5 7 Reicht für die meisten Anschlüsse mit Flußkontrol­ + le, z.B. Rechnerkopplung. +Gerät 2 3 4 5 7 + + +Rechner 2 3 5 7 Reicht für die meisten Drucker, Flußkontrolle nur + einseitig vom Drucker zum Rechner. +Gerät 2 3 4 7 + + +Rechner 2 3 7 Reicht meistens für Terminals, Flußkontrolle ist + dabei überflüssig. +Gerät 2 3 7 + + +Rechner 2 3 4 5 7 Manchmal für Terminals. Rechnerseitig wird Fluß­ + kontrolle durch die Brücke 4-5 simuliert. +Gerät 2 3 7 + + +Bei manchen Rechnern werden die notwendigen paarweisen Vertauschungen schon +im Rechner durchgeführt. Es ergibt sich entsprechend: + + +Rechner 2 3 4 5 7 8 20 Vollständige Verbindung mit Flußkontrolle. + +Gerät 2 3 4 5 7 8 20 + + +Rechner 2 3 4 5 7 Einfacher Anschluß mit Flußkontrolle. + +Gerät 2 3 4 5 7 + + +Rechner 2 3 4 7 Drucker, einseitige Flußkontrolle. + +Gerät 2 3 4 7 + + +Rechner 2 3 7 Terminal. + +Gerät 2 3 7 + + +Rechner 2 3 4 5 7 Terminal mit simulierter Flußkontrolle. + +Gerät 2 3 7 + + + + + + + +#ib(9)#2.4. #ib#Kanäle#ie# und #ib#Konfigurierung#ie##ie(9)# + + + +Im EUMEL-System dienen #ib#Kanäle#ie# zur Kommunikation mit der Außenwelt, d.h. Kanäle +sind Verbindungen vom Rechner zu peripheren Geräten wie Terminals, Drucker, Plotter +und Archiv. Kanäle können für zeichen- und #ib#blockorientierte Ein-/Ausgabe#ie# verwendet +werden. Ein Kanal heißt #ub##ib#privilegiert#ie(1,"er Kanal")##ue#, wenn er nur von privilegierten Systemtasks (Nach­ +kommen des Supervisors) benutzt werden kann. + +#ib#Kanalaufteilung#ie#: + + Kanal Bedeutung + + 1 zeichenorientiert, blockorientiert + Dieser Kanal muß mit einem Terminal verbunden sein, da + über ihn der Systemstart erfolgt. + 2-16 zeichenorientiert, blockorientiert + Diese Kanäle werden für weitere Terminals, Drucker, Plot­ + ter, Rechnerkopplung usw. verwandt. + + 15-23 blockorientiert + + 24-30 blockorientiert, privilegiert + + 31 blockorientiert, privilegiert + Dieser Kanal ist der #ib#Standardkanal des Archivsystems#ie#, d.h. + üblicherweise wird darüber die Archivfloppy angesprochen. + + 32 blockorientiert, privilegiert + Dieses ist ein #ib#interner Kanal#ie#, an den kein externes Gerät + angeschlossen werden kann. Er wird zur Konfigurierung + der anderen Kanäle benutzt. + +Der Supervisor des EUMEL-Systems verwaltet die Kanäle. Jeder Task ist dabei kein +oder genau ein Kanal zugeordnet. Entsprechend ist jedem Kanal keine oder genau +eine Task zugeordnet. Solche Zuordnungen können von außen durch den Benutzer +(nur bei interaktiven Kanälen) über die SV-Kommandos bzw. Prozeduraufrufe 'conti­ +nue' und 'break' (s. Kap. 5) verändert werden. In jedem Fall überprüft der Supervisor +die Zugriffsberechtigung. + + + + + +#ib##ib(9)#Zeichenorientierte Ein-/Ausgabe#ie##ie(9)# + + +Zeichenorientierte Ein-/Ausgabe kann auf den Kanälen 1 bis 16 benutzt werden. Dafür +stehen die Basisoperationen + + PROC #ib#out#ie# (TEXT CONST text) + PROC #ib#outsubtext#ie# (TEXT CONST source, + INT CNST from) + PROC outsubtext (TEXT CONST source, + INT CONST from, to)9 + PROC #ib#cursor#ie# (INT CONST x, y) + PROC #ib#inchar#ie# (TEXT VAR char) + TEXT PROC #ib#incharety#ie# + TEXT PROC incharety (INT CONST time limit) + PROC #ib#get cursor#ie# (INT VAR x, y) + +und alle darauf aufbauenden Operationen (wie 'put', 'get', 'putline', 'getline' usw.) zur +Verfügung. Diese Kanäle sind 'konfigurierbar' (s.u.) und erlauben den Anruf des +Systems durch den Benutzer von außen (SV-Taste). In der Regel werden die Kanäle 1 +bis 16 für Terminals, Drucker, Plotter und andere zeichenorientierte Anschlüsse be­ +nutzt. +Wenn ein Kanal zum Anschluß eines Terminals verwendet wird, müssen die #ib#Standard- +Steuerzeichen#ie# des EUMEL-Systems (s. Benutzerhandbuch Programmierung, Kap. 3 +"Der Editor", "5.2.4. Der EUMEL-Zeichensatz") auf jedem Terminal die gleiche Semantik +haben. Das heißt beispielsweise, daß der Code ""2"" auf jedem Terminal bei Ausgabe +den Cursor um eine Stelle nach rechts verschiebt. Da Datenendgeräte in dieser Hin­ +sicht aber faktisch keiner Norm gehorchen, müssen die EUMEL-Codes in der Regel in +#ib#terminalspezifische Codes#ie# umgesetzt werden. Diese Umsetzregeln kann man bei der +Konfigurierung (s.u.) festlegen. Für die meisten Terminaltypen werden allerdings +fertige Konfigurationssätze mit dem EUMEL-System zusammen ausgeliefert, die man +bei der Einrichtung des Systems (s. Kap. 1 Installationsanleitung) interaktiv anwählen +kann. + + + + +#ib##ib(9)#Blockorientierte Ein-/Ausgabe#ie##ie(9)# + + +Blockorientiere Ein-/Ausgabe kann auf den Kanälen 1 bis 32 benutzt werden. Dafür +stehen die Operationen + + PROC #ib#control#ie# (INT CONST code1, code2, code3, + INT VAR return code) + PROC #ib#blockout#ie# (DATASPACE CONST ds, + INT CONST page nr, code1, code2, INT VAR return code) + PROC #ib#blockout#ie# (ROW 256 INT CONST block, + INT CONST code1, code2, INT VAR return code) + PROC #ib#blockin#ie# (DATASPACE VAR ds, + INT CONST page nr, code1, code2, INT VAR return code) + PROC #ib#blockin#ie# (ROW 256 INT VAR block, + INT CONST code1, code2, INT VAR return code) + +zur Verfügung. Näheres findet man in Kap. 4.5 dieses Systemhandbuchs. + + + + + +#ib##ib(9)#Konfigurierung von Kanal 1 bis 15#ie(9)##ie# + + + +Alle #ib#zeichenorientierten Kanäle#ie# können (mittels Block I/O auf Kanal 32) konfiguriert +werden. Dabei werden im wesentlichen #ib#Umsetzregeln#ie# für Ein- und Ausgabe definiert, +die den Zweck haben, + + - bei der Ausgabe den EUMEL Zeichensatz auf den Zeichensatz des ange­ + schlossenen Geräts abzubilden und + + - bei der Eingabe die gerätespezifischen Zeichen auf den EUMEL Zeichensatz + abzubilden. + +So ist eine geräteunabhängige Programmierung möglich. + +Mit Hilfe der Prozedur '#ib#link#ie#' kann man einen der Kanäle 1 bis 16 auf einen bestimm­ +ten Typ setzen. Immer vorhanden sind die Typen: + +"#ib#transparent#ie#": Keine Codeumsetzungen (für Drucker usw.) und +"#ib#psi#ie#" : Keine Codeumsetzungen, jedoch folgende Sonderfunktionen: +#free(1.0)# + Code Funktion + 7 (CTLg) SV + 17 (CTLq) Stop + 23 (CTLw) Weiter + +Weitere Typen müssen in Form eines DATASPACE, die nach den Gerätetypen benannt +sind, in der Task vorliegen, in der das Kommando 'link' gegeben wird. + +Neue Terminaltypen können mit den Prozeduren 'new type', 'enter outcode', 'enter +incode' usw. definiert werden. Im einzelnen stehen folgende Prozeduren zur Verfü­ +gung: + + +#ib#link#ie# + PROC link (INT CONST channel, TEXT CONST type) + Zweck: Der angegebene Kanal (1 bis 16) wird auf den angegebenen Typ konfi­ + guriert. + Hinweis: Die Prozedur 'link' hat die angegebene Wirkung nur, wenn + die Task an Kanal 32 hängt, der nur für Söhne des + SUPERVISOR zugänglich ist ('continue (32)'). + +#ib#y size#ie# + PROC y size (INT CONST channel, new size, INT VAR old size) + Zweck: Einstellmöglichkeiten für verschiedene Bildschirmgrößen. Diese Proze­ + dur wirkt nur auf Kanal 32. 'channel' gibt dabei den zu konfigurierenden + Kanal an. + +#ib#new type#ie# + PROC new type (TEXT CONST typ) + Zweck: Eröffnet einen neuen Kanaltyp mit dem Namen 'typ'. Die folgenden + Aufrufe von 'enter outcode', 'enter incode' usw. beziehen sich dann auf + diesen Typ. + +#ib#enter outcode#ie# + PROC enter outcode (INT CONST eumelcode, zielcode) + Zweck: Legt fest, daß der Code 'eumelcode' bei Ausgabe auf dem Terminaltyp + in 'zielcode' gewandelt werden soll. + + PROC enter outcode (INT CONST eumelcode, TEXT CONST zeichen) + Zweck: Wirkt wie 'enter outcode (eumelcode, code (zeichen))'. + + PROC enter outcode (INT CONST eumelcode, zeit, TEXT CONST seq) + Zweck: Hiermit wird festgelegt, daß der Code 'eumelcode' als Mehrzeichenfolge + 'seq' ausgegeben werden soll. Jedesmal, wenn diese Folge ausgegeben + wurde, verzögert das System die Ausgabe des nächsten Zeichens um + mindestens 'zeit' Millisekunden. Dies wird z.B. von den meisten Termi­ + nals gefordert, wenn sie die Funktion 'Löschen Bildschirm' ausführen + sollen. + +#ib#enter incode#ie# + PROC enter incode (INT CONST eumelcode, TEXT CONST seq) + Zweck: Es wird festgelegt, daß eine Eingabezeichenfolge 'seq' an das System + als ein (!) Zeichen mit dem Code 'eumelcode' weitergegeben werden + soll. Die ganze Sequenz muß dabei innerhalb von ca. 40 Millisekunden + eintreffen, andernfalls werden die Zeichen einzeln gemeldet. Diese + Logik ist erforderlich, um auch Terminals anzuschließen, die z.B. Cursor­ + tasten als ESC-Sequenzen melden. Ohne die Zeitüberwachung würde + das Betätigen der ESC-Taste sonst die Eingabe blockieren, bis die Folge + 'seq' vollständig ist. + Folgende Eumelcodes sind für die Sondertasten (SV usw.) anzugeben: + + 17 : STOP + 23 : WEITER + 7 : SV + + Weitere Codes ('HOP',...) sind im Benutzerhandbuch Programmierung + (5 - 29, Der EUMEL-Zeichensatz) angegeben. + + #on("i")#Hinweis: Liefert die SV-Taste eines Terminals von sich aus schon Code + 7, so ist dennoch 'enter incode (7, ""7"")' anzugeben. Entspre­ + chendes gilt für die zwei anderen "Ereignistasten" STOP und + WEITER. Bei allen anderen Tasten brauchen jedoch nur echte + Umcodierungen vermerkt zu werden.#off("i")# + + +#ib#cursor logic#ie# + PROC cursor logic (INT CONST offset, modus, TEXT CONST pre, mid, post) + Zweck: Es wird festgelegt, daß der EUMEL-Code 6 (Cursorposition) mit den + folgenden beiden Zeichen, deren Codes y und x seien, + + bei modus = 255 als + pre + code (offset+y) + mid + code (offset+x) + post + und bei modus = 1 als + pre + text (offset+y) + mid + text (offset+x) + post + + ausgegeben wird. + Hinweis: 'offset' ist üblicherweise 32 (manchmal 0) und + mid = post = "". + +#ib#cursor logic#ie# + PROC cursor logic (INT CONST dist, TEXT CONST pre, mid, post) + Zweck: Diese Prozedur wird von den Konfigurationsdateien alter Versionen + benutzt. + +#ib#ansi cursor#ie# + PROC ansi cursor (TEXT CONST pre, mid, post) + Zweck: Diese Prozedur ist anstelle von 'cursor logic' zu verwenden, wenn die + Cursor-Positionierungen bei dem Terminal so erfolgt, wie im Ansi- + Standard definiert wird. + +#ib#elbit cursor#ie# + PROC elbit cursor + Zweck: Diese Prozedur ist bei Elbit-Terminals anstelle von 'cursor logic' zu + verwenden. + + + + + + +#ib##ib(9)#Konfigurations-Manager#ie##ie(9)# + + +Wenn das System gestartet wird, weiß der Urlader noch nicht, welche #ib#Terminaltypen#ie# +an welchen Kanälen hängen. (Der Vortest kann deshalb auch nicht bildschirmorien­ +tiert arbeiten). + +Falls eine Task 'configurator' im System ist, schickt der SUPERVISOR dieser eine Start­ +sendung zu. Diese Task kann daraufhin die nötigen Konfigurierkommandos ('link',...) +ausführen. + +Ansonsten ist 'configurator' ein normaler Fontmanager, der die Fonttabellen verwaltet +(siehe Kap. 7). Deshalb sollte im System immer eine Task 'configurator' existieren und +nach Möglichkeit immer im 'wait' stehen. Man kann ihn also auch mit 'continue' an ein +Terminal holen und dann wie üblich Kommandos geben. + +#ib#configurate#ie# + PROC configurate + Zweck: Führt den Konfigurationsdialog und anschließendes 'setup' durch. + +#ib#setup#ie# + PROC setup + Zweck: Alle Kanäle werden gemäß der im letzten Konfigurationsdialog bestimm­ + ten Werte konfiguriert (wird automatisch bei jedem Systemstart durch­ + geführt). + +#ib#configuration manager#ie# + PROC configuration manager + Zweck: Durch Aufruf dieser Prozedur wird die Task zu einem Konfigurations­ + manager. Man kann also die Task "configurator" löschen, neu als + Systemtask einrichten und mit diesem Kommando wieder etablieren. + BEACHTE: - Die Task muß 'configurator' heißen. + - Alle Terminalanpassungen gehen beim Löschen verloren, d.h. + man sollte sie vorher sichern! + + +#on("i")#Hinweis: Es passieren, daß eine Task schon Ausgaben macht, bevor der Kanal + konfiguriert ist (z.B. wenn ein 'shutup' bei aktiver Netz-Kommunikation + durchgeführt wurde).#off("i")# + diff --git a/doc/system-manual/1.8.7/doc/systemhandbuch.2 b/doc/system-manual/1.8.7/doc/systemhandbuch.2 new file mode 100644 index 0000000..c4772f0 --- /dev/null +++ b/doc/system-manual/1.8.7/doc/systemhandbuch.2 @@ -0,0 +1,1351 @@ +#start(2.5,1.5)# +#pageblock# +#block# +#page (35)# +#headeven# + +%#center#EUMEL-Systemhandbuch + + +#end# +#headodd# + +#center#3. ELAN-Programme#right#% + + +#end# + + +#ib(9)#3. #ib#ELAN-Programme#ie##ie(9)# + + + + +#ib(9)#3.1. #ib#Wertebereich#ie#e und #ib#Speicherbedarf#ie##ie(9)# + + +#ib#INT-Objekte#ie# + + +Jedes #ib#Datenobjekt#ie# vom Typ INT belegt im Speicher 2 Bytes. Mögliche INT-Werte sind +die ganzen Zahlen von -32768 bis +32767 einschließlich. + + + + +#ib#REAL-Objekte#ie# + + +Jedes Datenobjekt vom Typ REAL belegt im Speicher 8 Bytes. + +REALs haben eine 13-stellige #ib#Mantisse#ie#, die im Rechner dezimal geführt wird. (Das +heißt, bei Konversionen zwischen interner und TEXT-Darstellung treten keine Run­ +dungsfehler auf.) Der Wertebereich wird durch folgende Eckwerte abgelegt: + + 9.999999999999e+126 größter REAL-Wert + 0.000000000001 kleinster positiver REAL-Wert mit x + 1.0 > 1.0 + 9.999999999999e-126 kleinster positiver REAL-Wert > 0.0 + -9.999999999999e-126 größter negativer REAL-Wert + -9.999999999999e+126 kleinster REAL-Wert + + + + + +#ib#BOOL-Objekte#ie# + + +Jedes Datenobjekt vom Typ BOOL belegt im Speicher 2 Bytes. + + + + + +#ib#TEXT-Objekte#ie# + + +Jedes Datenobjekt vom Typ TEXT besteht aus einem festen Teil von 16 Bytes und +möglicherweise aus einem flexiblen Teil auf dem #on("i")##on("b")##ib#Heap#ie##off("i")##off("b")#. Im festen Teil werden #ib#Texte bis +zur Länge von 13 Zeichen#ie# untergebracht. Wenn eine TEXT-Variable einen Wert mit +mehr als 13 Zeichen Länge annimmt, werden alle Zeichen auf dem Heap unterge­ +bracht. Genauer ergibt sich folgendes Bild: + + kurzer Text (LENGTH <= 13): + + Heap-Link 2 Bytes + Textlänge 1 Byte + Text 13 Bytes + + langer Text (LENGTH > 13): + + Heap-Link 2 Bytes + 255 1 Byte + Länge 2 Bytes + ungenutzt 11 Bytes + +Wenn eine Variable einmal Platz auf dem Heap bekommen hat, behält sie diesen +vorbeugend auch dann, wenn sie wieder einen kurzen Text als Wert erhält. So muß +wahrscheinlich kein neuer Platz auf dem Heap zugewiesen werden, wenn sie wieder +länger wird. Das gilt allerdings nur bis zur nächsten #ib#Garbage Collection#ie# auf den +TEXT-Heap, denn dabei werden alle Heap-Container minimal gemacht bzw. gelöscht, +wenn sie nicht mehr benötigt werden. Der Platz auf dem Heap wird in Vielfachen von +16 Bytes vergeben. In Fremddatenräumen wird in jedem #ib#Container#ie# neben dem eigent­ +lichen Text auch die Containerlänge untergebracht. + +Beispiele: TEXT-Länge Speicherbedarf (Byte) + + 0 16 + 13 16 + 14 32 + 15 48 + 30 48 + 31 64 + 46 64 + 47 80 + 62 80 + + +Die Heapgröße eines Fremddatenraums berechnet sich als: + + 1024 * 1024 - 520 = 1048056 - stat Bytes + +'stat' ist dabei die statistische Größe der Datenstruktur, die dem Datenraum aufgeprägt +wurde. Bei einem BOUND ROW 1000 TEXT ergibt sich also eine Heapgröße von + + 1048056 - (1000 * 16) = 1032056 Bytes. + + + + + + +#ib#ROW- und STRUCT-Objekte#ie# + + +Bei der Berechnung des Speicherbedarfs von #ib#STRUCT#ie#s und #ib#ROW#ie#s muß man beden­ +ken, daß längere Datenobjekte ausgerichtet werden. Und zwar werden alle Objekte, die +mindestens die Länge eines REAL-Objektes haben, auf durch 8 teilbare Speichera­ +dressen ausgerichtet. Man bedenke, daß bei ROWs alle Elemente entsprechend ihres +Elementtyps ausgerichtet sind. + +Beispiele: Länge (Byte) + + ROW 2 BOOL 4 + ROW 4 INT 8 + ROW 5 INT 16 + ROW 2 STRUCT (INT, BOOL) 4 + ROW 100 STRUCT (INT,INT) 400 + ROW 100 STRUCT (INT,REAL) 1600 + ROW 100 STRUCT (INT,INT,INT,INT,REAL) 1600 + ROW 100 STRUCT (REAL, REAL) 1600 + ROW 100 STRUCT (INT,TEXT) 2400 + ROW 100 STRUCT (INT,INT,INT,INT,TEXT) 2400 + ROW 100 STRUCT (INT,TEXT,INT,TEXT) 4800 + ROW 100 STRUCT (INT,INT,TEXT,TEXT) 4000 + ROW 100 ROW 3 INT 600 + ROW 100 ROW 4 INT 800 + ROW 100 ROW 5 INT 1600 +aber: + ROW 500 INT 1000 + +#on("i")#Anmerkung: Bei der #ib#Speichervergabe#ie# der einfachen Variablen und Konstanten eines + Programms spielen Verluste aufgrund von Ausrichtungen in der Regel + keine Rolle. Der ELAN-Compiler optimiert dabei soweit möglich.#off("i")# +#page# +#headeven# + +%#center#EUMEL-Systemhandbuch + + +#end# +#headodd# + +#center#4. Standardpakete für Systemprogrammierer#right#% + + +#end# + + +#ib(9)#4. #ib#Standardpakete für + Systemprogrammierer#ie(9)##ie# + + +#ib(9)#4.1. #ib#Fehlerbehandlung#ie##ie(9)# + + +Übersicht + + +#on("italics")# + Fehler treten auf, wenn ein Programm eine gewünschte Leistung + nicht erbringen kann. Solche Situationen müssen von System- + Programmen kontrolliert behandelt werden. Die folgenden Aus­ + führungen sind somit nur für diejenigen interessant, die "Sy­ + stem"-Programme schreiben wollen.#off("italics")# + +#ib#Fehler#ie# treten in Operationen auf, wenn diese eine geforderte Leistung nicht erbringen +können (z.B. das Drucken einer nicht vorhandenen Datei). Da folgende Anweisungen +aber davon ausgehen, daß die gewünschten Leistungen erbracht wurden, ist es nicht +sinnvoll, die Operation weiter auszuführen. Wir sprechen vom #ib#Abbruch einer Operation#ie#, +wenn nach einem Fehler keine Anweisungen mehr ausgeführt werden, sondern die +Operation verlassen wird. Im EUMEL-System kann durch folgende drei Maßnahmen +ein Abbruch verursacht werden: + +- Aufruf der Prozedur '#ib#errorstop#ie#': + Die Operation wird mit einer Fehlermeldung abgebrochen, die man dem Aufruf von + 'errorstop' als Parameter beifügt werden kann. + +- Aufruf der Prozedur '#ib#stop#ie#': + Die Operation wird abgebrochen. Wirkt wie 'errorstop' mit der Meldung "stop". + +- Umschalten in den Supervisor: + Durch Betätigen der Taste SV und Eingabe des Kommandos '#ib#halt#ie#'. Die laufende + Operation wird abgebrochen. Wirkt wie ein 'errorstop', der von "außen" in das + Programm induziert wird. + +Da alle drei Maßnahmen zum Abbruch führen können und somit eine anormale (vor­ +zeitige) Beendigung eines Programms bewirken, werden sie im folgenden zusammen­ +fassend als #ib#Fehler#ie# bezeichnet. + +Für solche Fehler bietet das EUMEL-System die Möglichkeit, den Abbruch zu unter­ +drücken. Dies kann notwendig werden, wenn + +a) bestimmte Fehlerfälle vom aufrufenden Programm selbst behandelt werden sollen. + Beispiel: + + Der EUMEL-Editor wird aufgerufen, um eine Datei zu bearbeiten. Er versucht als + erstes, die Datei zu assoziieren. Existiert die Datei nicht, wird die Prozedur + (z.B. 'old'), mit der die Datei angemeldet werden soll, normalerweise mit der Feh­ + lermeldung ' "datei" gibt es nicht' abgebrochen. Diesen Fehlerzustand fängt der + Editor jedoch ab und versucht, eine neue Datei einzurichten (Anmerkung: In Wirk­ + lichkeit fragt der Editor natürlich vor der Assoziierung mit 'exists' ab, ob die Datei + existiert). + +b) eine Operation die Kontrolle auf jeden Fall behalten soll. + + Dies ist z.B. beim Monitor notwendig. Gleich welche Fehler vom Monitor gerufene + Programme produzieren, der Monitor muß in der Lage sein, die weitere Bearbei­ + tung zu ermöglichen. + +c) eine Operation nicht unterbrechbar sein darf. + + Beispielsweise dürfen Programm(teil)e, die Daten transportieren, nicht unterbro­ + chen werden, da sonst ein Verlust dieser Daten eintreten könnte. + + + +#ib(9)##ib#Fehlerbehandlung#ie# und #ib#Fängerebenen#ie##ie(9)# + + +Der Aufruf einer der Prozeduren + + #ib#errorstop#ie# + #ib#stop#ie# + #ib#halt#ie# + +(wobei letztere vom Supervisor gegeben werden muß) werden zusammenfassend als +#ib#Fehler#ie# bezeichnet. Bei einem Fehler wird ein #ib#Fehlerzustand#ie# gesetzt. Im Fehlerzustand +merkt sich das EUMEL-System, daß ein Fehler vorliegt. Die Prozeduren + + #ib#enable stop#ie# + #ib#disable stop#ie# + +bestimmen, ob Operationen im Fehlerzustand weiter bearbeitet oder abgebrochen +werden. Beispiel: + + + INT VAR x; + get (x); + ... + disable stop; + x := x * x; + ... + + +Hier wird mit 'disable stop' verhindert, daß ein Abbruch beispielsweise durch 'INT- +Ueberlauf' auftreten kann. Die Anweisungen nach 'x * x' werden also weiter bearbei­ +tet. + +Welchen Wert hat aber nun die Variable 'x', nachdem der Fehler auftrat? Offensicht­ +lich war die den Fehler auslösende Operation '*' nicht in der Lage, den richtigen Wert +zu errechnen. #ib#Abgebrochene Operationen#ie# liefern in der Regel keinen Wert. Dadurch ist +der Wert von 'x' in unserem Beispiel nach einem Fehler bei '*' undefiniert. Es ist nun +ersichtlich, daß mit der Anwendung der 'disable stop'-Prozedur äußerst vorsichtig zu +verfahren ist, weil u.U. Werte verloren gehen können bzw. mit unerwarteten Werten +weitergerechnet wird. + +Damit Programmierer erfahren können, ob ein Fehler aufgetreten ist, gibt es die Infor­ +mations-Prozedur + + #ib#is error#ie# + +über den Fehlerzustand. Die Prozedur liefert den Wert TRUE, wenn ein Fehler vorliegt, +andernfalls FALSE. Die Prozedur + + #ib#clear error#ie# + +"löscht" den Fehlerzustand, d.h. anschließende Abfragen mit 'is error' liefern FALSE. +(Die "richtige" Reaktion auf den Fehler muß ein Programmierer natürlich selbst be­ +stimmen). + +Beispiel: + + + INT VAR x; + get (x); + ... + disable stop; + x := x * x; + IF is error + THEN put ("'x'-Wert zu groß"); + x := 0; + clear error + FI; + ... + + +Leider würden jetzt aber auch alle folgenden Anweisungen bei eventuellen Fehlern +nicht abgebrochen, also auch in Situationen, in denen ein Abbruch erwünscht ist, um +#ib#Programmierfehler#ie# zu erkennen. Deshalb können durch + + #ib#enable stop#ie# + +Abbrüche wieder zugelassen werden. Wenn wir jetzt also schreiben: + + + INT VAR x; + get (x); + ... + disable stop; + x := x * x; + IF is error + THEN put ("'x'-wert zu gross"); + x := 0; + clear error + FI; + enable stop; + ... + + +dann würden - wie gewünscht - eventuelle Fehler in den Anweisungen nach 'enable +stop' zu einem Abbruch führen. + +Nicht mit '#ib#clear error#ie#' gelöschte Fehler führen bei '#ib#enable stop#ie#' ebenfalls zu einem +Abbruch. In dem Programmteil + + + ... + disable stop; + x := x * x; + enable stop; + ... + + +würde der eventuell auftretender Fehler 'INT Ueberlauf' nicht abgefangen, sondern nur +verzögert wirksam, weil er nicht mit 'clear error' gelöscht wurde. + +Für die Behandlung von Fehlern durch Benutzer gibt es Prozeduren, die eine adäquate +Reaktion auf den Fehler erlauben. Mit + + #ib#error message#ie# + +können Sie auf die erste Fehlermeldung (eines 'error stop') nach dem letzen 'clear +error' zugreifen (d.h. Folgefehler verändern nicht die Originalmeldung). Die Prozedur + + #ib#error code#ie# + +liefert den #ib#Fehlercode#ie#, der bei der Prozedur 'errorstop' zusätzlich zum #ib#Fehlertext#ie# +angegeben werden kann. + + #ib#error line#ie# + +liefert die Zeilennummer des zuletzt aufgetretenen Fehlers. Mit + + #ib#put error#ie# + +kann eine noch anstehende Fehlermeldung ausgegeben werden. Beispiel: + + + INT VAR x; + get (x); + ... + disable stop; + x := x * x; + IF is error + THEN IF error message = "INT-Ueberlauf" + THEN put ("'x'-wert zu gross"); + ELSE put error + FI; + clear error + FI; + enable stop; + ... + + +Tritt ein Fehler auf, so wird die den Fehler auslösende Operation entweder abgebro­ +chen oder "normal" weiter bearbeitet, je nachdem, ob 'enable stop' oder 'disable stop' +gesetzt ist. Auf jeden Fall wird der #ib#Fehlerzustand#ie# an die aufrufende Operation weiter­ +gemeldet, die wiederum abgebrochen oder weiterbearbeitet werden kann usw. Die +#ib#Weitermeldung#ie# eines Fehlers kann auch über mehrere Stufen erfolgen, solange bis der +Fehler gelöscht wird. Andererseits gilt 'enable/ disable stop' nicht nur für die aktuelle +Operation, sondern auch für gerufene Operationen ("Vererbung"). Die gerufenen Ope­ +rationen können allerdings 'enable/disable stop' neu festlegen. Beispiel: + + + PROC a: PROC b: PROC c: + ... ... ROW 10 INT VAR x; + disable stop; enable stop; ... + b; ... INT VAR i :: 4711; + IF is error c; x [i] := ...; + THEN ... ... ... + clear error END PROC b END PROC c + FI; + enable stop + END PROC a; + + +In der Prozedur 'a' wird die Prozedur 'b' aufgerufen. Diese ruft wiederum eine Prozedur +'c' auf. Für die Prozedur 'c' gilt nun der Zustand 'enable stop' der Prozedur 'b' (#ib#Verer­ +bung von 'enable stop'#ie#). Tritt jetzt in 'c' der Subskriptions-Fehler auf, wird 'c' abgebro­ +chen. Die Wirkung der fehlerauslösenden Operation ist nicht definiert. + +Da aber auch die Prozedur 'b' im 'enable stop' Zustand ist, wird auch die Prozedur 'b' +abgebrochen. Der Fehler bleibt jedoch erhalten, wird also weitergemeldet. Dies wirkt +sich so aus, daß die Anweisung 'c' nicht ausgeführt wird. Da die Prozedur 'a' 'disable +stop' gesetzt hat, werden die auf den Aufruf von 'b' folgenden Anweisungen durchlau­ +fen und somit durch 'clear error' der Fehler gelöscht. In diesem Beispiel "fängt" die +Prozedur 'a' Fehler auf, die in den Prozeduren 'b' und 'c' entstehen können. + +Ein solcher #ib#Fänger#ie# wird durch zwei Prozeduren konstruiert. Der eigentliche Fänger +(hier: Prozedur 'a') ruft eine ausführende Prozedur (hier: 'b') im 'disable stop'-Zustand +auf. Die gerufene Prozedur setzt sofort 'enable stop' und führt dann die eigentlichen +Aktionen aus. So wird die gerufene Prozedur abgebrochen (kann also im Fehlerfall +nicht zuviel Schaden anrichten). Der Abbruch führt bis zur Fängerprozedur ('a') hinter +den Aufruf der gerufenen Prozedur ('b'). Nach Löschung eventuell auftretender Fehler +ist somit sichergestellt, daß der Fänger immer weiterarbeiten kann. + + + +#ib(9)#Wichtiger Hinweis#ie(9)# + + + + 1. #on("italics")##on("bold")#Da im 'disable stop'-Zustand kein Fehler zum Abbruch führt, kann + eine Operation in diesem Zustand auch nicht durch 'halt' abge­ + brochen werden. Einerseits ist das für manche Systemteile wün­ + schenswert, andererseits können Operationen, die auf Grund von + Programmierfehlern nicht terminieren (Endlosschleifen), nicht + unter Kontrolle gebracht werden. Also Vorsicht! (Letztes Mittel: + Task löschen)#off("italics")##off("bold")# + + 2. #on("i")##on("b")#Es ist nicht (!) garantiert, daß im Fehlerzustand aufgerufene + Prozeduren ihre normale Wirkung haben. Garantiert ist dies je­ + doch für alle Prozeduren und Operatoren, die in diesem Kapi­ + tel aufgeführt werden.#off("i")##off("b")# + +#on("italics")##on("bold")#Merke: Fehler sind im EUMEL-System Aufrufe der Prozeduren 'errorstop', + 'stop' oder das Betätigen der SV Taste und dem Supervisor- + Kommando 'halt'. Ein Fehler gilt solange, bis er mit Hilfe der + Prozedur 'clear error' gelöscht wurde. Die Prozeduren 'enable/ + disable stop' steuern die Abarbeitung der Operationen im Fehler­ + fall. Gilt für eine Operation 'enable stop', wird die Operation + abgebrochen, d.h. die restlichen Anweisungen der Operation + nach der Fehler auslösenden Anweisung werden nicht durchlau­ + fen. Ist 'disable stop' gesetzt, werden die restlichen Operationen + weiterhin abgearbeitet. 'enable/disable stop' gilt für alle - auch + indirekt - aufgerufenen Operationen ("Vererbung"), es sei denn, in + den gerufenen Operationen wird ein erneutes 'enable/disable + stop' gesetzt. Über die Aufrufkette werden ggf. auch die Fehler + zurück gemeldet.#off("italics")##off("bold")# + + + #on("italics")##on("bold")#Eine Fänger-Ebene ist eine Prozedur, die 'disable stop' setzt und + dann andere Operationen aufruft. Nach jedem dieser Aufrufe + kann eine Fehlerbehandlung mit 'clear error' durchgeführt wer­ + den. Damit ist gewährleistet, daß Fehler immer von der Fänger- + Ebene "aufgefangen" und entsprechend behandelt werden.#off("italics")##off("bold")# + + + +#ib(9)##ib#Prozeduren zur Fehlerbehandlung#ie##ie(9)# + + +#ib#clear error#ie# + PROC clear error + Zweck: Löscht den Fehlerzustand. 'is error' liefert anschließend wieder FALSE. + 'error message', 'error code' und 'error line' werden nicht gelöscht. + +#ib#disable stop#ie# + PROC disable stop + Zweck: Unterbindet den Abbruch in aufgerufenen Operationen. 'disable stop' + gilt für die Prozedur, in der sie aufgerufen wird und in allen folgenden + gerufenen Prozeduren, es sei denn, sie wird durch 'enable stop' außer + Kraft gesetzt. Wird die Operation verlassen, in der 'disable stop' aufge­ + rufen wurde, wird der "alte" Zustand wiederhergestellt, der vor dem + Aufruf der Operation galt. 'disable stop' kann weiterhin in einer aufge­ + rufenen Operation durch den Aufruf von 'enable stop' in dieser und den + folgenden Operationen außer Kraft gesetzt werden. + +#ib#enable stop#ie# + PROC enable stop + Zweck: Setzt die Wirkung eines Aufrufs von 'disable stop' zurück. Fehler ('error­ + stop', 'stop' oder 'halt') in der aktuellen Operation oder den folgenden + aufgerufenen Operationen führen zum Abbruch. Bisher nicht gelöschte + Fehler (siehe 'clear error') führen sofort zum Abbruch. + +#ib#error code#ie##--goalpage ("fehlercodes")# + INT PROC error code + Zweck: Liefert den durch 'errorstop' gesetzten #ib#Fehlercode#ie#. Beispiel: + + PROC test: + enable stop; + error stop (110, "Dies ist mein Abbruch!"); + END PROC test; + + ... + disable stop; + test; + put (error code); (* liefert 110 *) + clear error; + enable stop + + +#ib#error line#ie# + INT PROC error line + Zweck: Liefert die Zeilennummmer des Fehlers (Voraussetzung : Die Überset­ + zung erfolgt im 'checkon-Modus). + +#ib#error message#ie# + TEXT PROC error message + Zweck: Liefert die Fehlermeldung als Text. Anhand dieser Meldung kann ent­ + schieden werden, welcher Fehler vorliegt. + Hinweis: Eine Fehlermeldung "" (also: 'error stop ("")') führt zum Fehlerabbruch + mit der Bedeutung "Fehlermeldung wurde bereits ausgegeben". Dem­ + entsprechend erfolgt bei der Fehlermeldung 'niltext' keine Reaktion bei + 'put error'. + +#ib#errorstop#ie# + PROC error stop (TEXT CONST message) + Zweck: Bricht ab und setzt die Zeilennummer (wenn man sich im 'checkon'- + Modus befindet), in der der Fehler aufgetreten ist, sowie den Text 'mes­ + sage'. Der Abbruch kann mit 'disable stop' unterbunden werden. 'error­ + stop' hat keine Wirkung, wenn ein noch nicht gelöschter Fehler vorliegt. + Zu einer Fehlermeldung "" siehe auch die Prozedur 'error message'. Als + 'error-code' wird 0 gesetzt. + + + PROC error stop (INT CONST code, TEXT CONST message) + Zweck: Analog obiger 'errorstop'-Prozedur, aber mit Angabe des Fehlercodes, + der durch die Prozedur 'error code' in einer Fängerebene erfragt wer­ + den kann. + +#ib#is error#ie# + BOOL PROC is error + Zweck: Informationsprozedur auf das Vorhandensein eines Fehlers. + +#ib#put error#ie# + PROC put error + Zweck: Gibt die durch 'errorstop' gesetzte Fehlermeldung aus, falls ein Fehler + noch nicht gelöscht ist (siehe auch: 'error message'). + + + + +#ib##ib(9)#Fehlercode#ie#s#ie(9)# + + +Einige Fehlercodes sind bereits belegt: + + 0 kein Fehlercode spezifiziert (Standardwert) + 1 'halt' vom Terminal + 2 Stack-Ueberlauf + 3 Heap-Ueberlauf + 4 INT-Ueberlauf + 5 DIV durch 0 + 6 REAL-Ueberlauf + 7 TEXT-Ueberlauf + 8 zu viele DATASPACEs + 9 Ueberlauf bei Subskription + 10 Unterlauf bei Subskription + 11 falscher DATASPACE-Zugriff + 12 INT nicht initialisiert + 13 REAL nicht initialisiert + 14 TEXT nicht initialisiert + 15 nicht implementiert + 16 Block unlesbar + 17 Codefehler + 100 Syntax-Fehler beim Übersetzen + + + + + +#ib(9)#4.2. #ib#THESAURUS#ie##ie(9)# + + + +Ein #ib#Thesaurus#ie# ist ein #ib#Namensverzeichnis#ie#, das bis zu 200 Namen beinhalten kann. +Dabei muß jeder Namen mindestens ein Zeichen und darf höchstens 100 Zeichen lang +sein. Steuerzeichen (code < 32) sind in Namen nicht erlaubt. + +Ein Thesaurus ordnet jedem eingetragenen Namen einen Index zwischen 1 und 200 +(einschließlich) zu. Diese Indizes bieten dem Anwender die Möglichkeit, Thesauri zur +Verwaltung benannter Objekte zu verwenden. (Der Zugriff erfolgt dann über den Index +eines Namens in einem Thesaurus). So werden Thesauri u.a. von der Dateiverwaltung +benutzt. Sie bilden die Grundlage der ALL- und SOME-Operatoren. + + + + +#ib(9)#Grundoperationen#ie(9)# + + +#ib#CONTAINS#ie# + BOOL OP CONTAINS (THESAURUS CONST t, TEXT CONST name) + Zweck: Liefert genau dann TRUE, wenn 't' den Namen 'name' enthält. Falls + 'name=""' oder 'LENGTH name > 100', wird FALSE geliefert. + +#ib#delete#ie# + PROC delete (THESAURUS VAR t, TEXT CONST name, INT VAR index) + Zweck: Falls der Name 'name' im Thesaurus 't' enthalten ist, wird er dort ge­ + löscht. In 'index' wird dann sein alter Index geliefert, unter dem er im + Thesaurus eingetragen war. Ist der Name nicht im Thesaurus enthalten, + wird 0 als Index geliefert. + + PROC delete (THESAURUS VAR t, INT CONST index) + Zweck: Der Eintrag mit dem angegebenen Index wird aus dem Thesaurus 't' + gelöscht. + +#ib#empty thesaurus#ie# + THESAURUS PROC empty thesaurus + Zweck: Für Initialisierungszwecke wird ein leerer Thesaurus geliefert. + +#ib#get#ie# + PROC get (THESAURUS CONST t, TEXT VAR name, INT VAR index) + Zweck: Liefert den "nächsten" Eintrag aus dem Thesaurus 't'. "Nächster" heißt + hier, der kleinste vorhandene mit einem Index größer als 'index'. Dabei + wird in 'name' der Name und in 'index' der Index des Eintrags geliefert. + D.h. 'index' wird automatisch weitergeschaltet. Den ersten Eintrag erhält + man entsprechend durch Aufruf mit 'index=0'. Nach dem letzten Ein­ + trag wird 'name=""' und 'index=0' geliefert. Beispiel: + + + TEXT VAR name; + INT VAR index := 0 ; + get (thesaurus, name, index) ; + WHILE index > 0 REP + putline (name) ; + get (thesaurus, name, index) + PER + + +#ib#highest entry#ie# + INT PROC highest entry (THESAURUS CONST t) + Zweck: Liefert den höchsten belegten Index des Thesaurus 't'. + Achtung: Das ist nicht die Anzahl der vorhandenen Namen, da durch + Löschungen Lücken entstanden sein können. + +#ib#insert#ie# + PROC insert (THESAURUS VAR t, TEXT CONST name, INT VAR index) + Zweck: Der Name 'name' wird als zusätzlicher Eintrag in den Thesaurus 't' + eingetragen und der dafür vergebene Index geliefert. Falls der Thesau­ + rus schon voll ist und der Name nicht mehr eingetragen werden kann, + wird 0 als Index geliefert. + Achtung: Mehrfacheintragungen sind möglich. Wenn man diese verhin­ + dern will, muß man entsprechend vermittels + + + IF NOT t CONTAINS name + THEN insert (t, name, index) + FI + + + eintragen. + Fehlerfall: + * Name unzulaessig + + PROC insert (THESAURUS VAR t, TEXT CONST name) + Zweck: s.o. Allerdings wird der Index des Namens nicht geliefert. Ein Thesau­ + rusüberlauf wird entsprechend als 'errorstop' gemeldet. + Fehlerfälle: + * Name unzulaessig + * THESAURUS-Ueberlauf + +#ib#link#ie# + INT PROC link (THESAURUS CONST t, TEXT CONST name) + Zweck: Liefert den Index des Namens 'name' im Thesaurus 't'. Falls der Name + nicht enthalten ist, wird 0 geliefert. Ist der Name mehrfach im Thesau­ + rus enthalten, ist nicht definiert, welcher der möglichen Indizes geliefert + wird. + +#ib#name#ie# + TEXT PROC name (THESAURUS CONST t, INT CONST index) + Zweck: Liefert den Namen des Eintrags mit dem Index 'index' aus dem The­ + saurus 't'. Falls kein solcher Eintrag im Thesaurus enthalten ist, wird + Niltext geliefert. + +#ib#rename#ie# + PROC rename (THESAURUS VAR t, TEXT CONST old, new) + Zweck: Ändert im Thesaurus 't' einen Eintrag mit dem alten Namen 'old' in 'new' + um. Falls 'old' nicht im Thesaurus enthalten ist, wird keine Leistung + erbracht. Falls 'old' mehrfach in 't' enthalten ist, ist nicht definiert, wel­ + cher der möglichen Einträge geändert wird. + Fehlerfall: + * Name unzulaessig + + PROC rename (THESAURUS VAR t, INT CONST index, TEXT CONST new) + Zweck: Ändert im Thesaurus 't' den Namen des durch 'index' identifizierten + Eintrags in 'new'. + Fehlerfall: + * Name unzulaessig + +#ib#THESAURUS#ie# + TYPE THESAURUS + Zweck: Bezeichnet Thesaurus-Datenobjekte + +:= + OP := (THESAURUS VAR dest, THESAURUS CONST source) + Zweck: Zuweisung + + + + + + +#ib(9)#Verknüpfungsoperationen#ie(9)# + +Das Paket '#ib#nameset#ie#' bietet die Möglichkeit, Operationen nicht nur auf einzelnen Datei­ +en, sondern auf (geordneten) Mengen ablaufen zu lassen: + +#ib#ALL#ie# + THESAURUS OP ALL (TASK CONST task) + Zweck: Liefert einen Thesaurus, der alle Dateinamen der angegebenen Task + enthält. + + THESAURUS OP ALL (TEXT CONST file name) + Zweck: Liefert einen Thesaurus, der die in der angegebenen Datei vorhande­ + nen Namen (jede Zeile ein Name) enthält. + +#ib#all#ie# + THESAURUS PROC all + Zweck: Liefert einen Thesaurus, der alle Dateinamen der eigenen Task enthält. + Entspricht 'ALL myself'. + +#ib#LIKE#ie# + THESAURUS OP LIKE (THESAURUS CONST thesaurus, TEXT CONST muster) + Zweck: Alle im Thesaurus enthaltenen Dateien, die dem 'muster' entsprechen + sind im Ergebnisthesaurus enthalten. + (Die Syntax von 'muster' findet man bei der Beschreibung des Pattern- + Matching) + +#ib#SOME#ie# + THESAURUS OP SOME (THESAURUS CONST thesaurus) + Zweck: Bietet den angegebenen Thesaurus im EUMEL-Editor zum Ändern an. + Es können nicht erwünschte Namen gestrichen werden. + + THESAURUS OP SOME (TASK CONST task) + Zweck: Aufruf von: SOME ALL task. + + THESAURUS OP SOME (TEXT CONST file name) + Zweck: Aufruf von: SOME ALL filename. + +#ib#FILLBY#ie# + OP FILLBY (THESAURUS VAR thesaurus, FILE VAR file) + Zweck: Schreibt 'file' in den Thesaurus. Dabei werden Zeilen, die schon im + Thesaurus sind, nicht mehr in den Thesaurus geschrieben. Jede Zeile + kommt im Thesaurus also nur einmal vor. + + OP FILLBY (FILE VAR file, THESAURUS CONST thesaurus) + Zweck: Schreibt den Thesaurus in die Datei 'file'. + + OP FILLBY (TEXT CONST filename, + THESAURUS CONST thesaurus) + Zweck: Richtet eine Datei mit dem Namen 'filename' ein und schreibt den The­ + saurus in die Datei. + ++ + THESAURUS OP + (THESAURUS CONST left, right) + Zweck: Liefert die Vereinigungsmenge von 'left' und 'right'. + Achtung: Die Vereinigungsmenge enthält keine Namen mehrfach. + + THESAURUS OP + (THESAURUS CONST left, TEXT CONST right) + Zweck: Fügt dem Thesaurus 'right' zu, wenn 'right' noch nicht im Thesaurus + enthalten ist. + +- + THESAURUS OP - (THESAURUS CONST left, right) + Zweck: Liefert die Differenzmenge. Achtung: Die Differenzmenge enthält keine + Namen mehrfach. + + THESAURUS OP - (THESAURUS CONST left, TEXT CONST right) + Zweck: Nimmt den Namen 'right' aus dem Thesaurus. + +/ + THESAURUS OP / (THESAURUS CONST left, right) + Zweck: Liefert die Schnittmenge + Achtung: Die Schnittmenge enthält keine Namen mehrfach. + +#ib#do#ie# + PROC do (PROC (TEXT CONST) operate, THESAURUS CONST thesaurus) + Zweck: Ruft 'operate' nacheinander mit allen im Thesaurus enthaltenen Namen + auf. + + PROC do (PROC (TEXT CONST, TASK CONST) operate, + THESAURUS CONST thesaurus, TASK CONST task) + Zweck: s.o. + +#ib#erase#ie# + PROC erase (THESAURUS CONST thesaurus) + Zweck: Löscht alle aufgeführten Dateien in der Vater-Task. + + PROC erase (THESAURUS CONST thesaurus, TASK CONST manager) + Zweck: Löscht alle aufgeführten Dateien in der Task 'manager'. + +#ib#fetch#ie# + PROC fetch (THESAURUS CONST thesaurus) + Zweck: Holt alle aufgeführten Dateien vom Vater. + + PROC fetch (THESAURUS CONST thesaurus, TASK CONST manager) + Zweck: Holt alle aufgeführten Dateien vom 'manager'. + +#ib#fetch all#ie# + PROC fetch all (TASK CONST manager) + Zweck: Holt alle Dateien vom 'manager'. Diese Prozedur entspricht dem Aufruf + der Prozedur 'fetch (ALL manager, manager)'. + + PROC fetch all + Zweck: Aufruf der Prozedur 'fetch all (father)'. + +#ib#forget#ie# + PROC forget (THESAURUS CONST thesaurus) + Zweck: Löscht alle aufgeführten Dateien in der Benutzer-Task. + +#ib#insert#ie# + PROC insert (THESAURUS CONST thesaurus) + Zweck: Insertiert alle aufgeführten Dateien in der Benutzer-Task. + +#ib#remainder#ie# + PROC remainder + Zweck: Liefert nach einem 'errorstop' die noch nicht bearbeiteten Dateien. + Beispiel: + 'save all (archive)' + kann dazu führen, daß nicht alle Dateien auf das Archiv geschrie­ + ben werden können. Fehlermeldung: + '"....." kann nicht geschrieben werden (Archiv voll)' + Nachdem man eine neue Floppy ins Archivlaufwerk gelegt hat, + kann man mit + 'save (remainder, archive)' + den Rest der Dateien auf der Floppy sichern. + +#ib#save#ie# + PROC save (THESAURUS CONST thesaurus) + Zweck: Schickt alle aufgeführten Dateien zur Vater-Task. + + PROC save (THESAURUS CONST thesaurus, TASK CONST manager) + Zweck: s.o. + +#ib#save all#ie# + PROC save all (TASK CONST manager) + Zweck: Schickt alle eigenen Dateien zum 'manager'. Diese Prozedur entspricht + dem Aufruf der Prozedur 'save (ALL myself, manager)'. + + PROC save all + Zweck: Aufruf der Prozedur 'save all (father)'. + + +Beispiele: + + save (ALL myself) + forget (ALL myself) + forget (all) + fetch (SOME father) + fetch (ALL father - ALL myself) + insert (ALL "gen datei") + save (ALL myself - ALL archive, archive) + + + + +#ib(9)#4.3. #ib#Kommandos und Dialog#ie(9)##ie# + + + +#ib##ib(9)#Kommandodialog#ie##ie(9)# + + +Das Paket "#ib#command dialogue#ie#" dient zur zentralen Steuerung und einfachen Durch­ +führung von #ib#Kommando-Dialog#ie#en wie + + "datei" loeschen (j/n)? + +Er wird von allen Systemteilen verwandt, die einen Kommandodialog mit dem Benut­ +zer aufnehmen. Anwenderprozeduren mit ähnlichen Problemen sollten genauso damit +arbeiten. + +Der Kommandodialog kann zentral aus- und eingeschaltet werden. + + + +#ib#command dialogue#ie# + BOOL PROC command dialogue + Zweck: Liefert den aktuellen Zustand des Kommandodialogs: + TRUE - Dialog soll geführt werden! + FALSE - Dialog soll nicht geführt werden! + + PROC command dialogue (BOOL CONST status) + Zweck: Schaltet den Kommandodialog ein ('status' = TRUE) oder aus ('status' + = FALSE). Der alte Zustand wird überschrieben. Soll später wieder in + den alten Zustand zurückgeschaltet werden, muß er vorher erfragt und + gesichert werden. + +#ib#yes#ie# + BOOL PROC yes (TEXT CONST question) + Zweck: a) Kommandodialog soll geführt werden (command dialogue = TRUE) + Der übergebene Fragetext wird durch " (j/n)?" ergänzt auf dem Ter­ + minal ausgegeben. Als Antwort wird eine der Tasten , , + , , , akzeptiert; jede andere Eingabe führt zu + einem akustischen Signal und der Fragewiederholung. Das Resultat + der Prozedur ist + TRUE bei bejahender Antwort (j,J,y,Y) + FALSE bei verneinender Antwort (n,N) + b) Kommandodialog soll nicht geführt werden (command dialogue = + FALSE) + Keine Aktion, das Resultat ist TRUE. + +#ib#no#ie# + BOOL PROC no (TEXT CONST question) + Zweck: a) Kommandodialog soll geführt werden (command dialogue = TRUE) + Frage und Antwort wie bei 'yes'. Das Resultat ist + TRUE bei verneinender Antwort (n,N) + FALSE bei bejahender Antwort (j,J,y,Y) + b) Kommandodialog soll nicht geführt werden (command dialogue = + FALSE) + Keine Aktion, das Resultat ist FALSE. + +#ib#say#ie# + PROC say (TEXT CONST message) + Zweck: IF command dialogue THEN out (text) FI + +#ib#last param#ie# + TEXT PROC last param + Zweck: Liefert den zuletzt gesetzten Parameter-Text (siehe folgende Proze­ + dur). Falls 'command dialogue' = TRUE und die 'param position' > 0 + ist, wird der Parametertext als Standardparameter an der angegebenen + x-Position eine Zeile höher in der Form ("...") ausgegeben. Diese Proze­ + dur wird von den parameterlosen Kommandos bzw. Prozeduren wie + 'edit', 'run' usw. verwandt, um mit dem Standardparameter weiterzuar­ + beiten. + + PROC last param (TEXT CONST new) + Zweck: Setzt 'last param' auf 'new'. (Das Setzen muß explizit durchgeführt + werden und geschieht nicht implizit durch den 'command handler'. 'Last + param' wird beispielsweise von den einparametrigen Prozeduren 'edit' + und 'run' gesetzt. + +#ib#param position#ie# + PROC param position (INT CONST x) + Zweck: Setzt die Echoposition für 'last param'. Bei x=0 wird ein Echo unter­ + drückt. + +#ib#std#ie# + TEXT PROC std + Zweck: Liefert wie 'last param' den zuletzt gesetzten Parameter. Im Gegensatz + dazu wird der Parameter aber nicht ausgegeben. + + + + + +#ib##ib(9)#Kommandoverarbeitung#ie##ie(9)# + + +Das Paket '#ib#command handler#ie#' stellt Prozeduren zur #ib#Kommandoanalyse#ie# und zum +Führen des kompletten Kommandodialogs zur Verfügung. + + +#ib#get command#ie# + PROC get command (TEXT CONST dialogue text, TEXT VAR command line) + Zweck: Falls eine Fehlermeldung aussteht, ('is error' liefert TRUE), wird sie über + 'put error' ausgegeben und der Fehlerzustand zurückgesetzt. Der 'dialo­ + gue text' wird als Dialogaufforderung ausgegeben und der Benutzer + kann eine Kommandozeile eingeben. Die letzte Kommandozeile wird + ihm dabei automatisch (zum Ändern) angeboten, wenn vorher eine + Fehlermeldung anstand. Der Benutzer kann dies ebenfalls erreichen, + wenn er zu Beginn gibt. Die Kommandozeile wird dem Auf­ + rufer in der Variablen 'command line' geliefert. + + PROC get command (TEXT CONST dialogue text) + Zweck: s.o. Allerdings wird eine interne Kommandozeile des Pakets 'command + handler' als 'command line' verwandt. Dadurch wird es möglich, alle + Spuren einer Kommandoeingabe durch 'cover tracks' zu beseitigen. + +#ib#analyze command#ie# + PROC analyze command (TEXT CONST command list, command line, + INT CONST permitted type, + INT VAR command index, number of params, + TEXT VAR param 1, param 2) + Zweck: Die übergebene Kommandozeile ('command line') wird anhand der + übergebenen 'command list' analysiert. Sie ist ein TEXT, der aus einer + Folge von Kommandospezifikationen besteht. Jede hat die Form + K:I.P + + K Kommandotext, Prozedurname nach ELAN-Syntax + I Hauptindex, Form eines INT-Denoters + P Parameterspezifikation, eine Folge der Ziffern 0, 1 und 2. + + Beispiele: + - 'edit:15.012' + Das Kommando 'edit' wird in drei verschieden parametrisierten + Formen spezifiziert: + edit mit 0 Parameter erhält Index 15 + edit mit 1 Parameter erhält Index 16 + edit mit 2 Parametern erhält Index 17 + + - 'fetch:18.1' + Das Kommando 'fetch' wird in einer Form spezifiert: + fetch mit 1 Parameter erhält Index 18 + + Die Analyse erfolgt gemäß ELAN-Syntaxregeln. Dabei sind als Para­ + meter Denoter vom Typ TEXT und vom übergebenen ' permitted type' + zugelassen. Diese Typen werden wie beim Scanner (s. Benutzerhand­ + buch Programmierung Kap. 5.6) angegeben: + + 1 tag + 2 bold + 3 number + 4 text + 5 operator + 6 delimiter + + Falls das Kommando in der Kommandoliste gefunden wird (und die + Syntax in Ordnung ist), wird der entsprechende 'command index' zu­ + rückgemeldet. Die Parameter werden (falls vorhanden) in 'param 1' und + 'param 2' abgelegt. Undefinierte oder nicht vorhandene Parameter + werden als Niltext geliefert. Wenn ein Kommando vorhanden ist, die + Anzahl der Parameter aber nicht stimmt, wird der negative Hauptindex + geliefert. Ist es vollkommen unbekannt oder ist die Eingabe zu komplex + (mehrere Kommandos, Ausdrücke oder komplexere ELAN-Statements), + wird 0 geliefert. Der Anwender kann in solchen Fällen die Analyse mit + einer anderen Kommandoliste fortsetzen, das Kommando dem ELAN- + Compiler übergeben oder eine Fehlermeldung auslösen (s. 'command + error'). + + PROC analyze command (TEXT CONST command list, + INT CONST permitted type, + INT VAR command index, number of params, + TEXT VAR param 1, param 2) + Zweck: s.o. Allerdings wird die interne Kommandozeile des Pakets 'command + handler' als 'command line' verwandt. + +#ib#command error#ie# + PROC command error + Zweck: Falls bei der Kommandoanalyse ein Fehler gefunden wurde, führt er + nicht zum 'errorstop', sondern wird nur hinterlegt. (Soll das Kommando + dem Compiler übergeben werden, liegt ja evt. überhaupt kein Fehler + vor.) Diese hinterlegte Meldung kann mit 'command error' als 'errorstop' + gegeben werden. Mögliche Meldungen: + "ungueltiger name" + ") fehlt" + "( fehlt" + "Parameter ist kein TEXT ("fehlt)" + "Kommando zu schwierig" + +#ib#cover tracks#ie# + PROC cover tracks + Zweck: Die Spuren der letzten Kommandoanalyse werden gelöscht. Das dient + u.a. dazu, daß später eingerichtete Sohntasks keine Relikte des Kom­ + mandos mehr auf dem Textheap vorfinden und evtl. mittels nicht initiali­ + sierter TEXT VARs herausfinden können. Vollständig können die Spuren + aber nur dann gelöscht werden, wenn für die Kommandoanalyse die + 'get command'- und 'analyze command'-Prozeduren benutzt wurden, + die auf der internen Kommandozeile des Pakets 'command handler' + arbeiten. + +#ib#do command#ie# + PROC do command + Zweck: Die interne Kommandozeile des Pakets 'command handler' wird dem + ELAN-Compiler zur Ausführung übergeben. + + + + + +#ib(9)#Beispiele zur Kommandoverarbeitung#ie(9)# + + +#ib##ub#Kleiner Monitor#ue##ie# + + +LET command list = "otto:1.12emil:3.012hugo:6.0" ; + +LET number = 3 , + text = 4 ; + +INT VAR command index, params ; +TEXT VAR param 1, param 2 ; + +PROC monitor : + + disable stop ; + command dialogue (TRUE) ; + REP get command ("gib kleines kommando:") ; + analyze command (command list, text, + command index, params, + param 1, param 2) ; + execute command + PER + +ENDPROC monitor ; + +PROC execute command : + + enable stop ; + SELECT command index OF + CASE 1 : otto (param 1) + CASE 2 : otto (param 1, param 2) + CASE 3 : emil + CASE 4 : emil (param 1) + CASE 5 : emil (param 1, param 2) + CASE 6 : hugo + OTHERWISE do command line + END SELECT + +ENDPROC execute command ; + + + +#ib(9)##ub#Steuerkommando-Analyse#ue##ie(9)# + + +PROC command (TEXT CONST command text) : + + disable stop ; + command dialoge (FALSE) ; + analyze command (command list, command text, number, + command index, params, param 1, param 2) ; + execute command ; + IF is error + THEN put error ; + clear error + FI + +ENDPROC command ; + +PROC execute command : + + enable stop ; + SELECT command index OF + CASE .... + OTHERWISE IF command index = 0 + THEN errorstop ("unbekanntes Kommando") ELSE command error + FI + END SELECT + +ENDPROC execute command ; + + + + + +#ib(9)#4.4. Verschiedenes#ie(9)# + + +#ib(9)##ib#SESSION#ie(9)##ie# + + +Mit Hilfe von 'session' kann man feststellen, ob das System neu gestartet wurde. Dabei +spielt es keine Rolle, ob es korrekt ('shutup') abgeschaltet wurde, oder ob es sich um +einen "RERUN" handelt. + +#ib#session#ie# + INT PROC session + Zweck: Liefert eine "Sitzungsnummer". Diese wird automatisch bei jedem + Systemstart erhöht. + +Beispiel: + + + REP + INT VAR old session := session ; + WHILE session = old session REP pause (100) PER ; + putline ("Neuer Systemstart") + PER. + + + + +#ib(9)##ib#INITFLAG#ie##ie(9)# + + +Im Multi-User-System ist es oft notwendig, Pakete beim Einrichten einer neuen Task in +dieser neu zu initialisieren. Das muß z.B. bei der Dateiverwaltung gemacht werden, da +die neue Task ja nicht die Dateien des Vaters erbt. Mit Hilfe von INITFLAG-Objekten +kann man zu diesem Zweck feststellen, ob ein Paket #on("b")##on("i")#in dieser Task#off("b")##off("i")# schon initialisiert +wurde. + + +#ib#INITFLAG#ie# + TYPE INITFLAG + Zweck: Erlaubt die Deklaration entsprechender Flaggen. + +:= + OP := (INITFLAG VAR flag, BOOL CONST flagtrue) + Zweck: Erlaubt die Initialisierung von INITFLAGs + +#ib#initialized#ie# + BOOL PROC initialized (INITFLAG VAR flag) + Zweck: Wenn die Flagge in der Task A auf TRUE oder FALSE gesetzt wurde, + dann liefert sie beim ersten Aufruf den entsprechenden Wert, danach + immer TRUE (in der Task A!). + Beim Einrichten von Söhnen wird die Flagge in den Sohntasks automa­ + tisch auf FALSE gesetzt. So wird erreicht, daß diese Prozedur in den neu + eingerichteten Söhnen und Enkeltasks genau beim ersten Aufruf FALSE + liefert. + + +Beispiel: + + PACKET stack DEFINES push, pop: + + INITFLAG VAR in this task := FALSE ; + INT VAR stack pointer ; + ROW 1000 INT VAR stack ; + + PROC push (INT CONST value) : + + initialize stack if necessary ; + .... + + ENDPROC push ; + + PROC pop (INT VAR value) : + + initialize stack if necessary ; + .... + + ENDPROC pop ;. + + initialize stack if necessary : + IF NOT initialized (in this task) + THEN stack pointer := 1 + FI . + + ENDPACKET stack + + + + + +#ib(9)##ib#Bit-Handling#ie##ie(9)# + + +Die #ib#Bit-Operationen#ie# arbeiten auf INT-Objekten. Sie können z.B. für die Systempro­ +grammierung benutzt werden, wenn es um Bitmasken u.ä. geht. + +Ein INT besteht aus 16 Bits. Dabei hat das niederwertigste die Nummer 0, das höch­ +stwertige die Nummer 15. + + +#ib#AND#ie# + INT OP AND (INT CONST left, right) + Zweck: Bitweise UND-Verknüpfung von 'left' mit 'right'. + +#ib#OR#ie# + INT OP OR (INT CONST left, right) + Zweck: Bitweise ODER-Verknüpfung von 'left' mit 'right'. + +#ib#XOR#ie# + INT OP XOR (INT CONST left, right) + Zweck: Bitweise EXCLUSIV-ODER-Verknüpfung von 'left' mit 'right'. + +#ib#bit#ie# + BOOL PROC bit (INT CONST bits, bit no) + Zweck: Liefert TRUE genau dann, wenn das Bit mit der Nummer 'bit no' in dem + INT 'bits' gesetzt ist. + +#ib#set bit#ie# + PROC set bit (INT VAR bits, INT CONST bit no) + Zweck: Das Bit mit der Nummer 'bit no' wird in 'bits' auf 1 gesetzt. + +#ib#reset bit#ie# + PROC reset bit (INT VAR bits, INT CONST bit no) + Zweck: Das Bit mit der Nummer 'bit no' wird in 'bits' auf 0 gesetzt. + +#ib#rotate#ie# + PROC rotate (INT VAR bits, INT CONST number of bits) + Zweck: Bits können mit dieser Prozedur zyklisch geschiftet werden. + Bsp.: rotate (1,1) ---> 2 + rotate (1,2) ---> 4 + rotate (1,-3) ---> 16384 + rotate (16384,3) ---> 1 + +#ib#lowest set#ie# + INT PROC lowest set (INT CONST bits) + Zweck: Liefert die Nummer des niederwertigsten 1-Bits in 'bits'. Ist kein Bit auf 1 + gesetzt, wird -1 geliefert. + +#ib#lowest reset#ie# + INT PROC lowest reset (INT CONST bits) + Zweck: Liefert die Nummer des niederwertigsten 0-Bits in 'bits'. Ist kein Bit auf 0 + gesetzt, wird -1 geliefert. + + + + + +#ib(9)#4.5. #ib#Blockorientierte Ein-/Ausgabe#ie##ie(9)# + + + +Die blockorientierte Ein-/Ausgabe dient dazu, Datenraumseiten (#ib#Blöcke#ie#) oder Teile +davon über die #ib#Kanäle#ie# zu transferieren. Sie wird vom System u.a. beim Archivzugriff +und bei der Konfigurierung der Kanäle eingesetzt. + +Die Wirkung der blockorientierten Ein-/Ausgabeoperationen kann dabei kanal- und +rechnerspezifisch unterschiedlich sein. +Auf dem Archivkanal (31) und allen anderen Block-IO-Kanälen werden bei +'code 1 = 0' die normalen Blocklese- bzw. -schreiboperationen durchgeführt. 'code 2' +gibt dabei die Blocknummer an. Andere (positive) Werte von 'code 1' sind zur Zeit +nicht offiziell definiert. Negative Werte können vom SHard für Spezialaufgaben verge­ +ben werden. + + + +#ib#blockin#ie# + PROC blockin (DATASPACE VAR ds, INT CONST page nr, code1, code2, + INT VAR return code) + Zweck: Die Seite 'page nr' des Datenraums 'ds' wird "eingelesen". Die Opera­ + tion kann durch 'code1' und 'code2' näher gesteuert werden. + + PROC blockin (ROW 256 INT VAR block, INT CONST code1, code2, + INT VAR return code) + Zweck: Wie oben, nur wird der Block direkt als Datenstruktur übergeben. + +#ib#blockout#ie# + PROC blockout (DATASPACE CONST ds, INT CONST page nr, + code1, code2, INT VAR return code) + Zweck: Die Seite 'page nr' des Datenraums 'ds' wird "ausgegeben". Die Opera­ + tion kann durch 'code1' und 'code2' näher gesteuert werden. + + PROC blockout (ROW 256 INT CONST block, INT CONST code1, code2, + INT VAR return code) + Zweck: Wie oben, nur wird der Block als Datenstruktur übergeben. + +#ib#control#ie# + PROC control (INT CONST code1, code2, code3, INT VAR return code) + Zweck: Diese Prozedur dient zur Kanalsteuerung. + +#ib#ds pages#ie# + INT PROC ds pages (DATASPACE CONST ds) + Zweck: Liefert die Anzahl der belegten Seiten eines Datenraums. (Jede Seite ist + 512 Byte groß.) + +#ib#next ds page#ie# + INT PROC next ds page (DATASPACE CONST ds, INT CONST page nr) + Zweck: Liefert die Nummer der nächsten (von 'page nr' an gerechneten) Seite + des Datenraums. Die erste belegte Seite erhält man durch + + next ds page (ds, -1) + + #on ("b")#Achtung: Die Seitennummern müssen nicht lückenlos sein.#off ("b")# + diff --git a/doc/system-manual/1.8.7/doc/systemhandbuch.3 b/doc/system-manual/1.8.7/doc/systemhandbuch.3 new file mode 100644 index 0000000..3c0a482 --- /dev/null +++ b/doc/system-manual/1.8.7/doc/systemhandbuch.3 @@ -0,0 +1,1366 @@ +#start(2.5,1.5)# +#pageblock# +#block# +#page (63)# +#headeven# + +%#center#EUMEL-Systemhandbuch + + +#end# +#headodd# + +#center#5. Supervisor, Tasks und Systemsteuerung#right#% + + +#end# + +#ib(9)#5. #ib#Supervisor#ie#, #ib#Tasks#ie# und + #ib#Systemsteuerung#ie##ie(9)# + + + +#ib(9)#5.1. #ib#Tasks#ie##ie(9)# + + + +#ib(9)#Der Datentyp #ib#TASK#ie##ie(9)# + + +Benannte Tasks werden innerhalb eines Rechners vollständig und eindeutig über ihren +Namen identifiziert. Eine weitere Möglichkeit der Identifikation besteht in der Verwen­ +dung von Datenobjekten vom Typ TASK. Beispiel: + + TASK VAR plotter := task ("PLOTTER 1") + +Die Taskvariable 'plotter' bezeichnet jetzt die Task im System, die augenblicklich den +Namen "PLOTTER 1" hat. Nun sind #ib#Taskvariablen#ie# auch unter Berücksichtigung der Zeit +und nicht nur im aktuellen Systemzustand eindeutig. Der Programmierer braucht sich +also keine Sorgen darüber zu machen, daß seine Taskvariable irgendwann einmal eine +"falsche" Task (nach Löschen von "PLOTTER 1" neu eingerichtete gleichen oder ande­ +ren Namens) identifiziert. Wenn die Task "PLOTTER 1" gelöscht worden ist, bezeichnet +'plotter' keine gültige Task mehr. + +#ib#Unbenannte Tasks#ie# haben alle den Pseudonamen "-". Sie können nur über Taskvari­ +ablen angesprochen werden. + +Der #ib#Task-Katalog#ie# wird vom Supervisor geführt; andere Tasks können sich Kopien +dieses Katalogs besorgen. Einige Prozeduren arbeiten auf dieser taskeigenen Kopie, +ohne diese automatisch auf den neuesten Stand zu bringen (Effizienzgründe). Das +muß bei Bedarf explizit geschehen. + + +#ib#TASK#ie# + TYPE TASK + Zweck: Interner Taskbezeichner + +:= + OP := (TASK VAR dest, TASK CONST source) + Zweck: Zuweisung von internen Taskbezeichnern + += + BOOL OP = (TASK CONST left, right) + Zweck: Gleichheitsabfrage + +< + BOOL OP < (TASK CONST left, right) + Zweck: Überprüft, ob die Task 'left' ein Sohn, Enkel, Urenkel, ... der Task 'right' + ist. + +/ + TASK OP / (TEXT CONST task name) + Zweck: Liefert die Task des angegebenen Namens, falls sie existiert. Der eigene + Katalog wird automatisch aktualisiert (identisch mit der + PROC task (TEXT CONST task name). + Fehlerfall: + * ... gibt es nicht + + TASK OP / (INT CONST station number, TEXT CONST name) + Zweck: Liefert die Task des angegebenen Namen von der Station mit der ange­ + gebenen Nummer. + +#ib#access#ie# + PROC access (TASK CONST task) + Zweck: Aktualisiert den eigenen Taskkatalog, falls 'task' nicht darin enthalten ist. + +#ib#access catalogue#ie# + PROC access catalogue + Zweck: Aktualisiert den eigenen Taskkatalog, indem die neueste Fassung vom + Supervisor geholt wird. Die Prozeduren 'father', 'son', 'brother' arbeiten + dann auf dieser neuen Fassung. + +#ib#archive#ie# + TASK PROC archive + Zweck: Liefert den internen Taskbezeichner der aktuellen Task mit Namen + "ARCHIVE". Diese Prozedur dient zum schnellen und bequemen An­ + sprechen der Archivtask. + +#ib#brother#ie# + TASK PROC brother (TASK CONST task) + Zweck: Liefert den nächsten Bruder von 'task'. Falls kein Bruder existiert, wird + 'niltask' geliefert. Aktualisiert den eigenen Katalog nicht automatisch! + +#ib#canal#ie# + TASK PROC canal (INT CONST channel number) + Zweck: Diese Prozedur zeigt an, welche Command-Analyser-Task an einem + bestimmten Kanal hängt. + +#ib#exists#ie# + BOOL PROC exists (TASK CONST task) + Zweck: Falls 'task' auf der eigenen Station liegt, informiert diese Prozedur, ob + die angegebene 'task' noch existiert. Der eigene Taskkatalog wird dabei + aktualisiert. + Wenn abgefragt werden soll, ob 'task' auf einer anderen Station liegt, + muß die Prozedur 'name (task) <> "" ' verwendet werden. + Achtung: Diese Prozedur taugt nicht dazu, zu erfragen, ob eine Task + mit bestimmtem Namen im System exisiert. + + exists (task ("hugo")) + + Falls die Task "hugo" nicht existiert, führt schon der Aufruf + 'task ("hugo")' zum 'errorstop (""hugo" gibt es nicht")'. + +#ib#exists task#ie# + BOOL PROC exists task (TEXT CONST name) + Zweck: Wenn auf der eigenen Station eine Task mit dem Namen 'name' exi­ + stiert, liefert diese Prozedur 'TRUE'. + +#ib#father#ie# + TASK PROC father + Zweck: Liefert die eigene Vatertask. + + TASK PROC father (TASK CONST task) + Zweck: Liefert den Vater von 'task'. Existiert kein Vater (z.B. bei UR), wird niltask + geliefert. Aktualisiert den eigenen Katalog nicht automatisch! + +#ib#index#ie# + INT PROC index (TASK CONST task) + Zweck: Liefert einen INT-Wert von 1 bis 125, der 'task' unter allen gleichzeitig (!) + existierenden Tasks eindeutig identifiziert. + +#ib#is niltask#ie# + BOOL PROC is niltask (TASK CONST task) + Zweck: task = niltask + +#ib#myself#ie# + TASK PROC myself + Zweck: Liefert eigenen Task-Bezeichner. + +#ib#name#ie# + TEXT PROC name (TASK CONST task) + Zweck: Liefert den Namen von 'task'. Die Task muß noch im System existieren, + sonst ist der Name nicht mehr bekannt. Falls die 'task' noch nicht im + eigenen Katalog enthalten ist, wird er aktualisiert. + +#ib#niltask#ie# + TASK CONST niltask + Zweck: Bezeichner für "keine Task". So liefern die Prozeduren 'son', 'brother' + und 'father' als Resultat 'niltask', wenn keine Sohn-, Bruder- oder Vater­ + task existiert. + +#ib#printer#ie# + TASK PROC printer + Zweck: Liefert den internen Taskbezeichner der aktuellen Task mit Namen + #ib#PRINTER#ie#. Diese Prozedur dient zum schnellen und bequemen Anspre­ + chen des Druckspoolers. + +#ib#public#ie# + TASK PROC public + Zweck: Liefert den internen Taskbezeichner der Task #ib#PUBLIC#ie#. + +#ib#reserve#ie# + PROC reserve (TASK CONST task) + Zweck: Reservieren einer Task für den ausschließlichen Dialog mit der Task, in + der das Kommando gegeben wurde. + PROC reserve (TEXT CONST message, TASK CONST task) + Zweck: Wie 'reserve (TASK CONST task)' mit Übergabe einer 'message'. + +#ib#son#ie# + TASK PROC son (TASK CONST task) + Zweck: Liefert den ersten Sohn von 'task'. Falls keiner im Katalog vermerkt ist, + wird 'niltask' geliefert. Aktualisiert den eigenen Katalog nicht automa­ + tisch! + +#ib#supervisor#ie# + TASK PROC supervisor + Zweck: Liefert den internen Taskbezeichner des Supervisors. + +#ib#task#ie# + TASK PROC task (TEXT CONST task name) + Zweck: Liefert die Task des angegebenen Namens, falls sie existiert. Der eigene + Katalog wird automatisch aktualisiert. + Fehlerfall: + * ... gibt es nicht + + TASK PROC task (INT CONST channel number) + Zweck: Liefert den Namen der Task, die an dem angegebenen Kanal hängt. + + + +#ib##ib(9)#Inter-Task-Kommunikation#ie##ie(9)# + + +Die #ib#Task-Kommunikation#ie# im EUMEL System ist strikt botschaftsorientiert. Eine #ib#Bot­ +schaft#ie# bzw. "#ib#Sendung#ie#" besteht immer aus einem #ib#Sendungscode#ie# (INT) und einem +Datenraum (DATASPACE). Damit kann eine Botschaft bis zu 1 Mbyte umfassen! + +Kommunikation zwischen zwei Tasks ist nur dann möglich, wenn #ib#Sender#ie# und #ib#Empfän­ +ger#ie# dazu bereit sind. Eine Sendung kann also nur dann korrekt transferiert werden, +wenn der Empfänger existiert und empfangsbereit ist. Diese Art der Kommunikation +wurde gewählt, um + + - eine möglichst einfache und effiziente Implementation zu ermöglichen und + - mit den vorhandenen Primitiva möglichst flexibel bei der Implementation + "höherer" Kommunikationsmethoden (z.B. Warteschlangen) zu sein. + + +#ib#call#ie# + PROC call (TASK CONST destination, INT CONST send code, + DATASPACE VAR message ds, INT VAR reply code) + Zweck: Die eigene Task wartet, bis die Zieltask 'destination' empfangsbereit ist. + Dann wird die Sendung ('send code' und 'message ds') transferiert. + Anschließend wartet die Sendertask auf eine Antwort von 'destination'. + Für Sendungen anderer Tasks ist sie dabei nicht (!) empfangsbereit, nur + die Zieltask kann eine Antwortsendung schicken. Nachdem eine solche + Antwort eingetroffen ist, wird sie in 'message ds' und 'reply code' gelie­ + fert und die eigene Task fortgesetzt. Wenn die angesprochene Zieltask + nicht existiert, wird -1 als 'reply code' geliefert. 'message ds' ist in + diesem Fall unverändert. + 'call' hat Ähnlichkeiten mit einem Prozeduraufruf, nur ist es hier der + Aufruf einer anderen Task. Störungen können hierbei nicht auftreten, da + der Zustand der Zieltask keine Rolle spielt (es wird auf Empfangsbereit­ + schaft gewartet) und beim Warten auf Antwort auch keine "Querschlä­ + gersendungen" von anderen Tasks dazwischenfunken können. + +#ib#pingpong#ie# + PROC pingpong (TASK CONST destination, INT CONST send code, + DATASPACE VAR message ds, INT VAR reply code) + Zweck: Diese Prozedur wirkt wie die entsprechende 'call'-Prozedur, wartet aber + nicht (!), bis die Zieltask empfangsbereit ist. Wenn die Zieltask existiert, + aber nicht empfangsbereit ist, wird -2 als 'reply code' geliefert. Der + 'message ds' ist dann nicht verändert. + +#ib#send#ie# + PROC send (TASK VAR destination, INT CONST send code, + DATASPACE VAR message ds, INT VAR receipt) + Zweck: Wenn die Zieltask existiert und empfangsbereit ist, wird die Sendung + ('send code' und 'message ds') transferiert und die Zieltask aktiviert. Als + 'receipt' wird 0 (=ack) gemeldet. Diese positive Quittung kommt nicht + von der Zieltask, sondern bestätigt nur, daß die Sendung ordnungsge­ + mäß übertragen wurde. Der Datenraum gehört dann nicht mehr der + Sender-, sondern der Zieltask, d.h. die Variable 'message ds' bezeichnet + keinen gültigen Datenraum mehr. + Im Gegensatz zu 'call' und 'pingpong' läuft die Sendertask ohne Halt + weiter und wartet nicht auf eine Antwort von der Zieltask. + Falls die Zieltask nicht existiert, wird -1, falls sie nicht empfangsbereit ist, + -2 als 'receipt' geliefert. Bei diesen negativen Quittungen bleibt der + Datenraum Eigentum der Absendertask, d.h. die Variable 'message ds' + bezeichnet immer noch einen gültigen Datenraum. + + PROC send (TASK VAR destination, INT CONST send code, + DATASPACE VAR message ds) + Zweck: s.o. Negative Quittungen (-1 oder -2) werden jedoch ignoriert. Der Da­ + tenraum wird entweder transferiert oder gelöscht ('forget'), steht also in + keinem Fall mehr zur Verfügung. Die Prozedur sollte nur verwendet + werden, wenn der Sender sicher ist, daß die Sendung transferiert wer­ + den kann, bzw. daß sie im Fehlerfall nicht transferiert zu werden braucht. + +#ib#wait#ie# + PROC wait (DATASPACE VAR message ds, INT VAR message code, + TASK VAR source task) + Zweck: Die eigene Task geht in den #ub##ib#offenen Wartezustand#ie##ue# über. Sie ist jetzt + gegenüber allen anderen Tasks empfangsbereit. Sie wird erst fortge­ + setzt, wenn eine Sendung eintrifft. Diese wird in 'message ds' und 'mes­ + sage code', die Absendertask in 'source task' geliefert. + +Der #ub##ib#Sendungscode#ue##ie# muß zwischen den Beteiligten abgesprochen sein und ist also frei +wählbar. Allerdings sind negative Werte nicht erlaubt, sondern für bestimmte "Pseudo­ +antworten" vom Betriebssystem reserviert: + + -1 "Zieltask existiert nicht" + + -2 "Zieltask ist nicht empfangsbereit" + + -4 "Eingabe vom Kanal" Diese Meldung kann nur (!) beim offenen War­ + ten ('wait') auftreten, und auch dann nur, wenn die Task gleichzeitig + an einen Kanal angekoppelt ist. Auf diese Weise wird mitgeteilt, daß + mindestens ein Zeichen vorliegt. Dieses kann im folgenden mit 'in­ + char', 'incharety', 'blockin' oder darauf aufbauenden Prozeduren + gelesen werden. + +Weitere Codes werden in Systemroutinen standardmäßig verwandt und sollten auch +von Anwenderroutinen genauso interpretiert werden: + + 0 "#ib#ack#ie#" positive Quittung + + 1 "#ib#nak#ie#" negative Quittung + + 2 "#ib#error nak#ie#" negative Quittung mit Fehlermeldung. + Der gelieferte Datenraum sollte die Struktur eines + BOUND TEXTs haben und die Fehlermeldung in + diesem TEXT beinhalten. + + +Beispiel: #ub#Kommunikation mit einem Manager#ue# + + + Auftraggeber Manager + + + call (....) REP + wait (ds, order, order task) ; + execute order ; + send (order task, reply, ds) + PER + +Da der Auftraggeber 'call' verwendet, wartet er automatisch so lange, bis der Manager +für ihn empfangsbereit wird. Dann schickt er die Sendung und geht gleichzeitig (!) in +den geschlossenen "auf Antwort warten" - Zustand über. Der Manager kann daher +unbesorgt mit dem "unsicheren" 'send' antworten, da die Empfangsbereitschaft des +Auftraggebers nur durch Katastrophen wie Löschung der Task oder "halt from terminal" +gestört werden kann. (In diesen Fällen kann die Antwort ruhig ins Leere gehen.) + +Hier sieht man auch den Unterschied zwischen + + call (...) und send (....); wait (....) . + +Bei der zweiten Alternative können drei Störfälle eintreten: + + + a) Der Manager ist nicht empfangsbereit. 'send' versagt, 'wait' wartet ewig. + + b) Da über die zeitlichen Rahmenbedingungen nichts ausgesagt werden kann, + ist es möglich, daß der Manager die Antwort schickt, bevor die 'wait'-Opera­ + tion beim Auftraggeber ausgeführt werden konnte. In unserem Beispiel + würde das den Verlust der Rückmeldung und ewiges Warten seitens des + Auftraggebers auslösen. + + c) Beim 'wait' kann eine Störsendung einer anderen Task eintreffen. + + + + + + + +#ib(9)#5.2. #ib#Supervisor#ie##ie(9)# + + + +#ib(9)##ib#Verbindung zum Supervisor#ie##ie(9)# + + +#ib#begin#ie# + PROC begin (PROC start, TASK VAR new task) + Zweck: Es wird eine #ib#unbenannte Task#ie# (Pseudoname "-") als neuer Sohn der + aufrufenden eingerichtet und mit der Prozedur 'start' gestartet. Namens­ + kollision ist nicht möglich, die erzeugte Task kann aber auch nicht na­ + mensmäßig angesprochen werden. 'new task' identifiziert den neuen + Sohn, falls kein Fehler auftrat. + Fehlerfälle : + * zu viele Tasks + + PROC begin (TEXT CONST son name, PROC start, TASK VAR new task) + Zweck: Es wird eine Task mit Namen 'son name' als Sohn der aufgerufenen + eingerichtet und mit der Prozedur 'start' gestartet. 'new task' identifi­ + ziert den neuen Sohn, falls kein Fehler auftrat. + Fehlerfälle : + * zu viele Tasks + * Name unzulaessig (* "" oder LENGTH > 100 *) + * ... existiert bereits + +#ib#begin password#ie# + PROC begin password (TEXT CONST password) + Zweck: Bei normalen 'global manager'-Tasks kann man mit dieser Operation + das weitere Kreieren von Sohntasks unter Paßwortkontrolle stellen. + Wenn dieses Kommando in der Manager-Task gegeben worden ist, wird + bei folgenden SV-begin-Kommandos interaktiv das Paßwort verlangt. + Dabei gelten die üblichen Paßwort-Konventionen: + + a) "" (Niltext) bedeutet #on("i")#kein Paßwort#off("i")#. Damit kann man durch + 'begin password ("")' das Paßwort wieder ausschalten. + b) "-" bedeutet #on("i")#jedes eingegebene Paßwort ist ungültig#off("i")#. Damit + kann man durch 'begin password ("-")' das Einrichten von + Sohntasks von außen (durch SV-Kommando) abschalten. + +#ib#break#ie# + PROC break + Zweck: Die Task koppelt sich von einem evtl. angekoppelten Terminal ab. Bei + der Abkopplung wird auf dem Terminal die "Tapete" ("Terminal n... + EUMEL Version ..../M...") ausgegeben. + + PROC break (QUIET CONST quiet) + Zweck: Die Task koppelt sich von einem evtl. angekoppelten Terminal ab. Dabei + wird aber keine "Tapete" ausgegeben. + +#ib#channel#ie# + INT PROC channel + Zweck: Liefert die #ib#Kanalnummer#ie# der eigenen Task. Falls kein Kanal (Terminal) + zugeordnet ist, wird 0 geliefert. + + INT PROC channel (TASK CONST task) + Zweck: Liefert die Kanalnummer der angegebenen Task. Ist kein Kanal zuge­ + ordnet, wird 0 geliefert. + +#ib#clock#ie# + REAL PROC clock (INT CONST index) + Zweck: Liefert die über Index spezifizierte #ib#Systemuhr#ie#. Die Zeiteinheit ist 1 sec, + die Meßgenauigkeit 0.1 sec. + clock (0) : CPU-Zeit der eigenen Task + clock (1) : Realzeit des Systems + + REAL PROC clock (TASK CONST task) + Zweck: Liefert die CPU-Zeit der angegebenen Task. + + Hinweis: Die CPU-Zeit beginnt mit der Taskkreation zu laufen. Sie gibt also + jeweils die gesamte bisher verbrauchte CPU-Zeit an. Die Zeitdauer + bestimmter Operationen kann als Differenz zweier 'clock'-Aufrufe + gemessen werden. Beim Ende einer Task wird ihr CPU-Zeitverbrauch + dem Vater zugeschlagen, um Abrechnungen zu ermöglichen. + +#ib#continue#ie# + PROC continue (INT CONST channel nr) + Zweck: Die Task versucht, sich an den vorgegebenen Kanal anzukoppeln. Falls + sie vorher schon an ein Terminal gekoppelt war, wird implizit 'break' + durchgeführt, falls die Aktion erfolgreich durchgeführt werden konnte. + Ein erfolgreiches 'continue' beinhaltet implizit 'reset autonom'. + Anmerkung: Normale Tasks können auf die Kanäle 1-24 zugreifen, + Systemtasks dürfen sich auch an die privilegierten Kanäle + 25-32 ankoppeln. + Fehlerfälle: + * ungueltiger Kanal + * Kanal belegt + +#ib#end#ie# + PROC end + Zweck: Löscht die eigene Task und alle Söhne. Wenn die Task an ein Terminal + angekoppelt ist, wird vorher angefragt, ob wirklich gelöscht werden soll. + Anschließend wird die Standard-"Tapete" auf dem Bildschirm ausge­ + geben. + + PROC end (TASK CONST task) + Zweck: Löscht die angegebene 'task'. 'task' muß allerdings die eigene oder eine + Sohn- bzw. Enkel-Task der eigenen sein (siehe auch: 'Privilegierte Ope­ + rationen'). Im Unterschied zur oben aufgeführten parameterlosen Proze­ + dur 'end' wird nicht angefragt und auch keine "Tapete" ausgegeben. + Wenn also die eigene Task ohne Reaktion auf dem Terminal beendet + werden soll, kann dies mit 'end (myself)' geschehen. + Fehlerfall: + * 'end' unzulaessig + +#ib#family password#ie# + PROC family password (TEXT CONST password) + Zweck: Diese Prozedur setzt oder ändert das Paßwort derjenigen Familien­ + mitglieder, die kein Paßwort oder das gleiche Paßwort wie die aufrufen­ + de Task haben. + Zu einer Familie gehören die Task, in der man sich befindet, und die ihr + untergeordneten Tasks. + Natürlich gelten auch hier die allgemeinen Paßwortbedingungen (siehe + dazu: 'task password'). + Beispiel: Das Kommando 'family password ("EUMEL")' wird in SYSUR + gegeben. Dadurch wird das SYSUR­Paßwort und die Paß­ + worte der entsprechenden Tasks unter SYSUR auf "EUMEL" + gesetzt. + + +#ib#next active#ie# + PROC next active (TASK VAR task) + Zweck: 'task' wird auf die nächste aktive Task gesetzt. Aktiv sind alle Tasks, die + sich im Zustand 'busy' befinden oder auf Ein/Ausgabe warten (i/o) und + an einen Kanal angekoppelt sind. Beispiel: + + + TASK VAR actual task := myself; + REP + ... ; + next active (actual task) + UNTIL actual task = myself PER. + + + Hier werden alle aktiven Tasks durchgemustert (z.B. für Scheduling- + Anwendungen). Dieses Verfahren ist sehr viel weniger aufwendig als + eine Durchmusterung des ganzen Taskbaumes, liefert aber nur die + gerade aktiven Tasks. + +#ib#rename myself#ie# + PROC rename myself (TEXT CONST new task name) + Zweck: Die eigene Task erhält als neuen Tasknamen 'new task name'. Damit + kann auch aus einer benannten eine unbenannte Task mit dem Pseu­ + donamen "-" werden. Umbenennung in die andere Richtung ist eben­ + falls möglich. + Achtung: Durch das Umbenennen der Task werden alle Taskvariablen, + die sich auf diese Task beziehen, ungültig (als wäre die Task + gelöscht und dann neu eingerichtet). + Fehlerfälle: + * ... existiert bereits + * Name unzulaessig + +#ib#reset autonom#ie# + PROC reset autonom + Zweck: Die eigene Task deklariert sich beim Supervisor als nicht autonom + (Normalzustand). Das bedeutet, 'continue'-Aufforderungen über ein + 'Supervisor-Kommando' vom Terminal werden vom System ohne Be­ + nachrichtigung der Task durchgeführt. + +#ib#set autonom#ie# + PROC set autonom + Zweck: Die eigene Task deklariert sich beim Supervisor als #ib#autonom#ie# (üblich für + Manager-Tasks). Wenn jetzt ein 'continue'-Supervisor-Kommando auf + diese Task von einem Terminal aus gegeben wird, wird der Task über + 'send' eine Nachricht zugestellt. + Achtung: Im autonomen Zustand ist der Programmierer selbst für die + Reaktion der Task verantwortlich. Man kann sie von außen auf + keine Weise gewaltsam an ein Terminal koppeln (ermög­ + licht Paßalgorithmen / Datenschutz). + Um die Programmierung etwas zu entschärfen, wird eine + Task automatisch aus dem autonomen in den Normalzustand + überführt, wenn sie selbst ein 'continue' gibt. + +#ib#status#ie# + INT PROC status (TASK CONST task) + Zweck: Liefert den Status der angegebenen Task: + + 0 -busy- Task ist aktiv. + 1 i/o Task wartet auf Beendigung des Outputs oder + auf Eingabe. + 2 wait Task wartet auf Sendung von einer anderen Task. + 4 busy-blocked Task ist rechenwillig, ist aber blockiert. + 5 i/o -blocked Task wartet auf I/O, ist aber blockiert. + 6 wait-blocked Task wartet auf Sendung, ist aber blockiert. + Achtung: Die Task wird beim Eintreffen einer + Sendung automatisch entblockiert. + +#ib#storage#ie# + PROC storage (INT VAR size, used) + Zweck: Informiert über den physisch verfügbaren ('size') und belegten ('used') + Speicher des Gesamtsystems. Die Einheit ist KByte. + Achtung: 'size' gibt den Speicher an, der benutzt werden kann, ohne in + eine Engpaßsituation zu kommen. Tatsächlich wird auf dem + Hintergrundmedium noch eine gewisse Reserve freigehalten. + Wenn diese angebrochen wird, befindet sich das System im + #ib#Speicherengpaß#ie#. Dieser Zustand kann mit 'used > size' + abgefragt werden. + + INT PROC storage (TASK CONST task) + Zweck: Liefert die Größe des Speicherbereichs in KByte, den die angegebene + Task augenblicklich belegt. + Dabei werden durch Sharing mögliche Optimierungen nicht berücksich­ + tigt. D.h. eine Task kann physisch erheblich weniger Speicher als logisch + belegen. Entsprechend kann die Speichersumme aller Tasks den phy­ + sisch belegten Speicherbereich des Gesamtsystems beträchtlich über­ + schreiten. + +#ib#task password#ie# + PROC task password (TEXT CONST password) + Zweck: Das angegebene Paßwort wird beim Supervisor hinterlegt. Bei folgen­ + den SV-Kommandos 'continue...' auf diese Task wird interaktiv das + Paßwort abgefragt. Dabei gelten die üblichen Paßwort-Konventionen: + + a) "" (Niltext) bedeutet #on("i")#kein Paßwort#off("i")#. Damit kann man durch + 'task password ("")' das Paßwort wieder ausschalten. + + b) "-" bedeutet #on("i")#jedes eingegebene Paßwort ist ungültig#off("i")#. Damit + kann man durch 'task password ("-")' das Ankoppeln an ein + Terminal von außen (durch SV-Kommando) unterbinden. + + + + +#ib##ib(9)#Privilegierte Operationen#ie(9)##ie# + + +Die im folgenden aufgeführten privilegierten Operationen können #ub#nur#ue# von #ib#System­ +tasks#ie# - das sind direkte oder indirekte Söhne des Supervisors - ausgeführt werden. Um +Mißbrauch unmöglich zu machen, sollte der Supervisor nach der Einrichtung der +gewünschten Systemtasks bzgl. der Einrichtung neuer Söhne gesperrt und alle Sy­ +stemtasks durch Paßworte geschützt werden. + + +#ib#block#ie# + PROC block (TASK CONST task) + Zweck: Die angegebene #ib#Task wird blockiert#ie#, d.h. so lange von der Verarbeitung + suspendiert, bis die Blockade durch 'unblock' wieder aufgehoben wird. + Diese Operation wird vom Scheduler benutzt. Falls das Packet 'schedu­ + ler' insertiert ist, sollten andere Tasks die Prozedur 'block' nicht anwen­ + den, um dem Scheduling nicht entgegenzuwirken. + +#ib#collect garbage blocks#ie# + PROC collect garbage blocks + Zweck: Es wird eine außerplanmäßige Gesamtmüllabfuhr durchgeführt. Plan­ + mäßig (d.h. ohne Aufruf dieser Prozedur) wird sie alle 15 Minuten und in + Engpaßsituationen durchgeführt. Nach Aufruf dieser Prozedur wird der + automatische Fixpunkt/ Müllabfuhr-Rhythmus ca. 1 Stunde lang ge­ + sperrt. Somit kann man z.B. in der Task "scheduler" einen eigenen + Fixpunkt/Müllabfuhr-Rhythmus implementieren. + Achtung: Diese Operation erfordert starkes Paging und dauert dement­ + sprechend lange. + +#ib#end#ie# + PROC end (TASK CONST task) + Zweck: Die angegebene Task und alle Söhne, Enkel etc. werden gelöscht. + Systemtasks (direkte und indirekte Nachkommen des SUPERVISORs) + können beliebige andere Tasks (nicht nur eigene Söhne) löschen. + +#ib#fixpoint#ie# + PROC fixpoint + Zweck: Für das Gesamtsystem wird ein außerplanmäßiger #ib#Fixpunkt#ie# geschrie­ + ben. Planmäßige Fixpunkte (d.h. ohne Aufruf dieser Prozedur) werden + alle 15 Minuten geschrieben. Nach Aufruf dieser Prozedur wird der + automatische Fixpunkt/Müllabfuhr-Rhythmus ca. 1 Stunde lang ge­ + sperrt. Somit kann man z.B. in der Task "scheduler" einen eigenen + Fixpunkt/Müllabfuhr-Rhythmus implementieren. + Achtung: Diese Operation verursacht starkes Paging (Rückschreiben + aller veränderten Seiten auf das Hintergrundmedium) und + dauert dementsprechend lange. + +#ib#prio#ie# + INT PROC prio (TASK CONST task) + Zweck: Liefert die augenblickliche #ib#Priorität#ie# der angegebenen Task. + + PROC prio (TASK CONST task, INT CONST new prio) + Zweck: Setzt die Priorität der Task. + + Hinweis: 0 ist die höchste, 15 die niedrigste Priorität. Die Prioritäten 0 bis 2 + werden von EUMEL 0 (fine scheduling) verwaltet. Die restlichen Priori­ + täten können für 'rough scheduling' (siehe auch im Kapitel Scheduler) + eingesetzt werden. + Durch 'continue ("name")' wird die Priorität wieder auf 0 gesetzet. + +#ib#set date#ie# + PROC set date + Zweck: #ib#Datum#ie# und #ib#Uhrzeit#ie# können im Dialog gesetzt werden (Form wie beim + Start des Systems). Dabei wird gegebenenfalls die Hardware­Uhr gele­ + sen. + Sollte der SHard ein falsches Datum liefern, so muß das Datum mit + set clock (date("tt.mm.jj") + time ("hh:mm:ss")) + gesetzt werden. + +#ib#save system#ie# + PROC save system + Zweck: Der gesamte Systemhintergrund wird auf Archivdisketten gesichert. Zu + diesem Zweck wird das System wie bei 'shutup' heruntergefahren. + +#ib#shutup#ie# + PROC shutup + Zweck: #ib#Kontrolliertes Herunterfahren des Systems#ie#. Beim nächsten Systemstart + wird automatisch Datum und Uhrzeit erfragt, wenn der Kommandodial­ + og eingeschaltet ('command dialogue (TRUE)') und keine Hardwareuhr + vorhanden ist. Falls diese Prozedur nicht vor dem Abschalten aufgerufen + wurde, findet beim Neustart ein Aufsetzen auf dem letzten Fixpunkt statt + (RERUN). + +#ib#unblock#ie# + PROC unblock (TASK CONST task) + Zweck: Eine vorherige Blockierung der Task wird aufgehoben. Ist die Task nicht + blockiert, bewirkt 'unblock' nichts. Diese Operation wird vom Scheduler + benutzt. Andere Tasks sollten sie normalerweise nicht anwenden, um + dem Scheduling nicht entgegenzuwirken. + + + + + +#ib(9)#5.3. #ib#ID ­ Konstanten#ie##ie(9)# + + +Die Informationsprozedur + + INT PROC id (INT CONST no) + +liefert folgende Informationen über die Soft­ und Hardware des Rechners: + + Von EUMEL 0 werden geliefert: + id (0) --> EUMEL­Version + id (1) --> Prozessortyp (1: Z80, + 2: Z8001, + 3: 8086 und kompatible, + 4: 68000 + 5: 80286) + id (2) --> Urlader­Version + id (3) --> reserviert + + Vom SHard werden geliefert: + id (4) --> Lizenznummer des SHards + id (5) --> Installationsnummer des EUMEL­Anwenders + id (6) --> SHard­spezifisch + id (7) --> SHard­spezifisch + + + + + +#ib(9)#5.4. #ib#Systemverwaltung#ie##ie(9)# + + +#on("i")#Achtung#off("i")#: Dieser Teil des Systemhandbuchs ist nur für solche Multi-User-Installationen + von Bedeutung, die erweiterte Systemverwaltungsfunktionen generieren + bzw. modifizieren wollen. + + #on("i")#Das EUMEL-System ist in der ausgelieferten minimalen Standardform (ohne + die Features) ohne weiteres benutzbar#off("i")#. + + + + + +#ib(9)#Der Systemmanager #ib#SYSUR#ie##ie(9)# + + +Der Systemmanager verhält sich im wesentlichen wie ein normaler Manager, allerdings +mit folgender Erweiterung: + + - Die Operationen 'list' und 'fetch' können von allen Tasks des Systems und + nicht nur von Söhnen durchgeführt werden. Damit kann man Systemverwal­ + tungsdateien (z.B. "#ib#logbuch#ie#") von allen Tasks aus lesen. 'erase' und 'save' sind + jedoch nur von Söhnen bzw. Enkeln - d.h. von privilegierten Systemtasks - aus + zulässig. + +Das Paket stellt folgende Operationen zusätzlich zur Verfügung: + +#ib#generate shutup manager#ie# + PROC generate shutup manager + Zweck: Es wird eine Sohntask mit Namen "shutup" kreiert. Diese Task ist nicht­ + (!) paßwortgeschützt, läßt aber keine normalen Kommandos zu, son­ + dern fragt nur + + shutup (j/n) ? + + So kann jeder das System kontrolliert abschalten und die privilegierten + Operationen des OPERATORs wie 'end' sind dennoch geschützt. + +#ib#put log#ie# + PROC put log (TEXT CONST log record) + Zweck: Der angegebene 'log record' wird mit vorangestelltem Tasknamen des + Absenders, Datums- und Uhrzeitangabe in die Logbuchdatei "logbuch" + in der Task "SYSUR" geschrieben. Der neue Satz wird an die Datei ange­ + fügt. ("logbuch" wird z.B. vom EUMELmeter verwandt.) + + Hinweis: Bei Verwendung des Logbuchs darf die zwar große, aber doch end­ + liche Dateikapazität nicht vergessen werden. Nachdem das Logbuch + mit 4073 Sätzen voll ist, werden weitere 'put log' Operationen igno­ + riert. Die Datei "logbuch" sollte deshalb - wenn sie beispielsweise vom + EUMELmeter verwandt wird - von Zeit zu Zeit gelöscht werden ('erase' + bzw. 'forget')! + + + + +#ib(9)##ib#Scheduler#ie##ie(9)# + + +Der Scheduler dient zur Verwaltung der rechenwilligen #ib#Hintergrundtask#ie#s. Will man den +Scheduler (eventuell abgeändert) insertieren, muß man die Task "scheduler" als Sohn +von SYSUR einrichten. Dann holt man die Datei "scheduler" vom Archiv und insertiert +sie. "scheduler" beinhaltet "#ib#eumelmeter#ie#". Es wird beim Start erfragt, ob die Meßrouti­ +nen aktiviert werden sollen oder nicht. + + + + +#ib##ib(9)#Funktionsweise des Schedulers#ie(9)##ie# + + +Der Scheduler sammelt in bestimmten Zeitintervallen alle aktiven (rechnenden) Tasks +ab, die an kein Terminal angekoppelt sind und auch keine Manager sind. Diese Tasks +werden blockiert und in die Warteschlange der #ib#Standardklasse#ie# eingefügt. + +Die Klassen des Schedulers werden durch die #ib#Taskpriorität#ie#en 5 bis 9 definiert. Die +Standardklasse entspricht der Priorität 7. Die Klassenzugehörigkeit einer Task kann von +einer Systemtask aus (z.B. von "OPERATOR") mit der Prozedur '#ib#prio#ie#' verändert werden. + +Der Scheduler geht nach folgender Strategie vor: + + Anhand der Vordergrund/Hintergrundlast des Systems wird entschieden, ob + überhaupt Hintergrundtasks aktiv sein dürfen, welche Klassen aktiv sein dürfen + und wieviel #ib#Hintergrundtask#ie#s gleichzeitig rechnen dürfen. + + Die wartenden #ib#Hintergrundtask#ie#s werden im #ib#Round-Robin-Verfahren#ie# aktiviert. + Dabei kommt die Klasse n+1 erst dann zum Zug, wenn die Warteschlange der + Klasse n leer ist oder weniger Tasks enthält, als gleichzeitig aktiviert werden + sollen. + +Die implementierte Standardstrategie hat als oberste Maxime, den Vordergrund auf +keinen Fall zu stören. Dementsprechend wird der Hintergrund nur aktiviert, wenn eine +der folgenden Bedingungen erfüllt ist: + + - Die Vordergrundlast des Systems liegt unter 3% . + + - Es ist keine normale #ib#Vordergrundtask#ie# (Nachfahre von "UR") an einen Kanal + angekoppelt. Man beachte, daß Systemtasks hierbei nicht berücksichtigt + werden. Ein aktiver Drucker blockiert die Hintergrundtasks also nicht. + + + + +EUMELmeter (Systemstatistik) + + +Die #ib#Meßsoftware#ie# zum #ib#Protokollieren der Systembelastung#ie# befindet sich auf dem Archiv +'std.zusatz'. + +Falls das System keinen #ib#Scheduler#ie# benutzt, muß eine Meßtask als Sohn von "SYSUR" +eingerichtet werden. In diese Task muß dann die Datei "#ib#eumelmeter#ie#" vom Archiv geholt +und übersetzt werden. + +Falls das System einen Scheduler beinhalten soll, muß bei der Generierung des Sche­ +dulers lediglich auf die Frage "mit eumelmeter (j/n) ?" mit "j" geantwortet werden. + + + +#ib##ib(9)#EUMELmeter#ie(9)##ie# + + +Das EUMELmeter protokolliert die #ib#Systemlast#ie# in ca. 10 minütigen Abständen in der +Datei "#ib#logbuch#ie#" in "SYSUR". Für jedes Meßintervall wird eine Zeile angefügt. Die Zeilen +sind folgendermaßen aufgebaut: + +tt.mm.jj hh:mm hg uf ub pw pb cpuf cpub cpus last nutz + + +tt.mm.jj hh:mm Datum und Uhrzeit des Eintrags + +hg Größe des aktuell belegten Hintergrundspeichers + (in KB) + +uf Anzahl der aktiven Vordergrundtasks + +ub Anzahl der aktiven Hintergrundtasks + +pw #ib#Paginglast#ie# bei wartender CPU (#ib#Paging/Wait#ie#) + +pb Paginglast bei aktiver CPU (#ib#Paging/Busy#ie#) + +cpuf #ib#CPU-Auslastung#ie# durch Vordergrundtasks + +cpub CPU-Auslastung durch Hintergrundtasks + +cpus #ib#CPU-Systemlast#ie# + +last #ib#Gesamtlast des Systems#ie#: + pw + pb + cpuf + cpub+ cpus + (Achtung: kann 100% übersteigen, da Platte und CPU über­ + lappt arbeiten können.) + +nutz #ib#Nutzgüte#ie# im Meßintervall: 100% - pw - cpus + Die Nutzgüte gibt an, welcher Anteil der Systemarbeit für echte + Nutzarbeit verfügbar war. Sie ist die Summe aus der echten + Nutzlast 'cpuf+cpub' und der Leerzeit, die ja theoretisch auch + für Nutzarbeit hätte verwandt werden können. Sie läßt sich, wie + oben angegeben, auch berechnen, indem man den idealerweise + überflüssigen Overhead 'cpus' und 'pw' von 100% abzieht. +#page# + +#count per page# +#headeven# +%#center#EUMEL-Systemhandbuch + + +#end# +#headodd# +#center#6. Der EUMEL-Drucker#right#% + + +#end# + +#ib(9)#6. Der #ib#EUMEL-Drucker#ie##ie(9)# + + + +#ib(9)#6.1. Allgemeine Einführung#ie(9)# + + +Die Ansteuerung eines #ib#Druckers#ie# durch das EUMEL-System geschieht durch zwei +aufeinanderbauende Komponenten. Die eine Komponete ist der hardwareunabhängi­ +ge #ib#EUMEL-Drucker#ie#, der die #ib#Textverarbeitungsanweisungen#ie# umsetzt und die Druck­ +seite entsprechend aufbereitet, so daß sie im Blocksatz, in Tabellenform oder in Spal­ +ten gedruckt werden kann. Die andere Komponente ist der hardwareabhängige #ib#Druk­ +kertreiber#ie#, der durch ein einfaches Interface zum EUMEL-Drucker, wie z.B. Textausge­ +ben, Positionieren oder Schrifttypen und Modifikationen an- und ausschalten, den +eigentlichen Druck vornimmt. +Die hardwareunabhängige Komponente, der EUMEL-Drucker, befindet sich bei den +ausgelieferten Systemen im priviligierten Ast des Taskbaums, so daß beim Anschluß +eines Druckers nur noch der hardwareabhängige Druckertreiber insertiert werden muß. +Auf dem PRINTER-Archiv befinden sich schon einige Druckeranpassungen für diverse +Druckertypen. + +- Implementierung des Druckertreiber-Interface + Das Paket mit dem Druckertreiber muß in einer Task "PRINTER" insertiert und + ein Spool eingerichtet werden. + +- Erstellen einer Fonttabelle für den anzuschießenden Drucker + Eine vorhandene Fonttabelle wird dabei in die Task "configurator" gebracht + werden. Die Fonttabelle sollte in allen bestehenden Tasks - insbesondere in + der Task "PUBLIC" und der Task "PRINTER" - mit dem #on("i")##on("b")#fonttable#off("i")##off("b")#-Kommando + eingestellt werden. + + + + +#ib(9)#6.2. Das #ib#Druckertreiber-Interface#ie##ie(9)# + + +Da der EUMEL-Drucker vor dem Druckertreiber insertiert ist, aber auf dem Drucker­ +treiber aufbaut, müssen beim Aufruf der 'print'-Prozedur des EUMEL-Druckers die +Prozeduren des Druckertreibers mit übergeben werden. Aus progammtechnischen +Gründen sollte ihre Anzahl möglichst gering gehalten werden. Deshalb gibt es die +folgende drei Prozeduren, die mit einem 'op code' parametrisiert werden. Die Bedeu­ +tung der weiteren Parameter der Interfaceprozeduren hängen von diesem 'op code' ab. +Die folgende Beschreibung der Prozeduren gibt einen Programmrahmen vor, in dem +die Parameter durch Refinements entsprechend ihrer Bedeutung umdefiniert sind. + + + +PROC open (INT CONST op code, INT VAR param 1, param 2) : + + LET document code = 1 , + page code = 2 ; + + SELECT op code OF + CASE document code : open document + CASE page code : open page + END SELECT. + + + x steps : param1 . + y steps : param2 . + + #ib#open document#ie# : + + Zweck: Die Prozedur wird vom EUMEL-Drucker zur Einleitung jedes Ausdrucks + aufgerufen. Hier können notwendige Initialisierungen der Hardware + durchgeführt werden. In 'x steps' und 'y steps' muß die Breite bzw. + Höhe der bedruckbaren Fläche des Papieres in Mikroschritten des + Druckers angegeben werden.#u##count#)#e# +#foot# + +#value#) Zur Definition der Mikroschritte siehe Bemerkung 2. +#end# + + + + x start : param1 . + y start : param2 . + + #ib#open page#ie# : + + Zweck: Hiermit wird dem Hardware-Interface der Beginn einer neuen Seite + mitgeteilt. Die Parameter 'x start' und 'y start' liefern die gewünschte + Position der linken oberen Ecke des Schreibfeldes. Das Hardware-In­ + terface muß in diesen Parametern seine augenblickliche Position auf + dem Papier zurückmelden, wobei die Position (0,0) die linke obere + Ecke des Papieres ist. + Vor der Rückmeldung kann aber auch auf die angegebene Startpo­ + sition positioniert und diese zurückgemeldet werden. Es ist jedoch + darauf zu achten, daß die zurückgemeldete Position den internen + Nullpunkt für die Absolutkoordinaten im EUMEL-Drucker definiert. + Deswegen muß das Hardware-Interface sicherstellen, daß bei einem + "Zeilenrücklauf" die zurückgemeldete Position 'x start' erreicht wird. + (Siehe 'carriage return' in der Prozedur 'execute'). Auch gibt es Fälle, + bei denen links von der gemeldeten 'x start'-Position positioniert wird. + Bei #ib#Druckern mit Einzelblatteinzug#ie#, bei denen das Papier gleich auf die + zweite oder dritte Zeile positioniert wird, sollte, um ein korrektes Druck­ + bild zu erreichen, diese Postion in 'y start' zurückgemeldet werden. + + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param 1) : + + LET document code = 1 , + page code = 2 ; + + SELECT op code OF + CASE document code : close document + CASE page code : close page + END SELECT. + + + #ib#close document#ie# : + + Zweck: Hiermit wird dem Hardware-Interface das Ende eines Druckvorgangs + mitgeteilt. + + + + remaining y steps : param 1 . + + #ib#close page#ie# : + + Zweck: Hiermit wird dem Hardware-Interface mitgeteilt, daß der Druck der + aktuellen Seite abgeschlossen ist. + 'remaining y steps' gibt an, wieviel Mikroschritte das vertikale Papier­ + ende noch von der aktuellen Druckposition entfernt ist. Die x-Position + des Druckers ist bei Aufruf dieser Prozedur immer der linke Rand + 'x start'. + + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, + INT CONST param1, param2) : + + LET write text code = 1 , + write cmd code = 2 , + carriage return code = 3 , + move code = 4 , + draw code = 5 , + on code = 6 , + off code = 7 , + type code = 8 ; + + SELECT op code OF + CASE write text code : write text + CASE write cmd code : write cmd + CASE carriage return code : carriage return + CASE move code : move + CASE draw code : draw + CASE on code : on + CASE off code : off + CASE type code : type + END SELECT . + + + from : param1 . + to : param2 . + + #ib#write text#ie# : + + Zweck: Der übergebene Text 'string' muß von der Zeichenposition 'from' bis + 'to' (einschließlich) auf dem Drucker ausgegeben werden. Die Über­ + schreitung der Papierbreite braucht nicht überprüft zu werden. + + + + #ib#write cmd#ie# : + + Zweck: Der übergebene Text 'string' enthält zwischen den Positionen 'from' + und 'to' ein direkt angegebenes #ib#Druckerkommando#ie# (\#"..."\#). Wenn + direkte Druckerkommandos erlaubt sein sollen, müssen sie ausgege­ + ben werden. + + + + x steps to left margin : param 1 . + + #ib#carriage return#ie# : + + Zweck: Der Druckkopf muß (ohne Zeilenvorschub) an den linken Rand be­ + wegt werden, d.h. an die bei 'open page' vom Druckertreiber gemel­ + dete Position 'x start'. 'x steps to left margin' gibt an, wieviel Minimal­ + schritte die augenblickliche Position vom linken Rand entfernt ist. + + + + x steps : param 1 . + y steps : param 2 . + + #ib#move#ie# : + + Zweck: Die Schreibposition muß um 'x steps' Mikroschritte nach rechts und um + 'y steps' Mikroschritte nach unten verschoben werden. Negative + Schrittwerte bedeuten dabei die jeweils andere Richtung. Das Über­ + schreiten des Papiers braucht nicht überprüft zu werden. Bei einer + horizontalen Bewegung nach rechts ('x steps' > 0) müssen die einge­ + schalteten Modifikationen beachtet werden. Wenn z.B. 'underline' + eingeschaltet ist, muß die Strecke unterstrichen werden. + Kann eine Leistung (z.B. Bewegung nach links) nicht erbracht wer­ + den, muß ein 'errorstop' ausgelöst werden. Im Fehlerfall bei einer + Horizontalbewegung versucht der EUMEL-Drucker nach einem Zei­ + lenrücklauf nochmals die angestrebte x-Position zu erreichen. Somit + brauchen horizontale Bewegungen nach links ('x steps' < 0) nicht + unbedingt implementiert zu werden, sondern können mit einem 'error­ + stop' beantwortet werden. Im Fehlerfall bei einer vertikalen Bewegung + wird an der alten Position weitergeschrieben. + + + + #ib#draw#ie# : + Zweck: Von der aktuellen Schreibposition an (linke untere Ecke der Zeichenposition) + soll eine gerade Linie zum Zielpunkt ('x steps' weiter rechts, 'y steps' weiter + unten) gezogen werden. Kann eine Leistung (z.B. schräge Linie, Linie nach + oben o.ä.) nicht erbracht werden, muß ein 'errorstop' ausgelöst werden. + Dieser Fehlerfall wird vom EUMEL-Drucker ignoriert. Das Überschreiten + des Schreibfeldes braucht nicht überprüft zu werden. + + + + modification : param 1 . + + #ib#on#ie# : + + Zweck: Die #ib#Modifikation#ie# der Nummer 'modification' soll eingeschaltet wer­ + den, sofern die Hardware es erlaubt. Augenblicklich gibt es folgende + Modifikationen: + + 1 underline + 2 bold + 4 italics + 8 reverse + + Die in der Fonttabelle spezifizierte Befehlssequenz, um die entspre­ + chende Modifikation anzuschalten, kann mit der Prozedur #on("i")#on string + (modification)#off("i")# abgefragt werden. + Kann eine Leistung nicht erbracht werden, muß ein 'errorstop' aus­ + gelöst werden. Im Fehlerfall der Modifikation 'underline' versucht der + neue EUMEL-Drucker die Zeile mit Hilfe von 'draw' zu unterstreichen. + Im Fehlerfall der Modifikation 'bold' wird die Zeile nochmals, um den in + der Fonttabelle spezifizierten 'bold offset' verschoben, ausgegeben. + Bei den restlichen beiden Modifkationen wird der Fehlerfall ignoriert. + + + + #ib#off#ie# : + + Zweck: Die angegebene #ib#Modifikation#ie# 'modification' soll ausgeschaltet wer­ + den. Die in der Fonttabelle spezifizierte Befehlssequenz, um die ent­ + sprechende Modifikation auszuschalten, kann mit der Prozedur #on("i")#off + string (modification)#off("i")# abgefragt werden. Ein Fehlerfall wird hier igno­ + riert. + + + + font nr : param 1 . + + #ibie# : + + Zweck: Die Druckausgabe soll auf den #ib#Schrifttyp#ie# mit der angegebenen Font­ + nummer 'font nr' umgeschaltet werden. Diese Nummer bezieht sich auf + die eingestellte Fonttabelle. Mit den Prozeduren des Fontspeichers + können anhand dieser Nummer die nötigen Informationen beschafft + werden. So liefert z.B. die Prozedur #on("i")#font string (font nr)#off("i")# die in der Font­ + tabelle spezifizierte Befehlssequenz oder die Prozedur #on("i")#font (font nr)#off("i")# + den Namen des Fonts. Die Breite des Leerzeichens kann mit #on("i")#char pitch + (font nr, " ")#off("i")# bestimmt werden. + + +END PROC execute; + + + + + +#ib(9)#6.3. Prozedur-Schnittstelle des EUMEL- + Druckers#ie(9)# + + + +#ib#print#ie# + PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, + INT CONST, INT CONST) execute, + BOOL CONST elan listing, TEXT CONST file name) + Zweck: Solange die Prozedur 'eof' FALSE liefert wird mit der Prozedur 'next + line' eine Zeile eingelesen. Dieser Eingabestrom wird für den Druck + aufbereitet. Ist die Konstante 'elan listing' auf FALSE gesetzt, so wird + der Eingabestrom als Textdatei mit Textkosmetik-Anweisungen aus­ + gedruckt. Andernfalls wird der Eingabestrom wie ein ELAN-Listing + behandelt. In der Textkonstanten 'file name' muß dann der Dateiname + der Programmdatei enthalten sein. + + + PROC print (FILE VAR file, + PROC (INT CONST, INT VAR, INT VAR) open + PROC (INT CONST, INT CONST) close + PROC (INT CONST, TEXT CONST, + INT CONST, INT CONST) execute) + Zweck: Der Eingabestrom kommt aus der angegebenen Datei. Anhand vorge­ + gebener Kriterien wird entschieden, ob diese Datei als Textdatei oder + als ELAN-Listing ausgedruckt wird. + +#ib#with elan listings#ie# + PROC with elan listings (BOOL CONST flag) + Zweck: Mit dieser Prozedur kann bei der vorangegangenen 'print'-Prozedur + gesteuert werden, ob überhaupt irgendwelche Dateien als ELAN-Lis­ + tings gedruckt werden sollen. Wird damit FALSE eingestellt, so wer­ + den alle Dateien als Textdateien gedruckt. + + BOOL PROC with elan listings + Zweck: Liefert die aktuelle Einstellung. + + +#ib#is elan source#ie# + PROC is elan source (FILE VAR file) + Zweck: Entscheidet nach vorgebenen Kriterien, ob die angegebene Datei ein + ELAN-Listing ist. + + +#ib#bottom label for elan listings#ie# + PROC bottom label for elan listings (TEXT CONST label) + Zweck: Bei ELAN-Listings wird in der Fußzeile ein Text eingestellt, der durch + Schägstrich getrennt vor die Seitennummer geschrieben wird. (z.B. zur + Durchnumerierung der Pakete im Quellcode) + + TEXT PROC bottom label for elan listings + Zweck: Liefert die aktuelle Einstellung. + + +#ib#material#ie# + TEXT PROC material + Zweck: Hier kann das Hardware-Interface jeder Zeit den aktuellen Material­ + wert abfragen, der vom Benutzer mit der 'material'-Anweisung einge­ + stellt ist. + + +#ib#x pos#ie# + INT PROC x pos + Zweck: Wird in der Prozedur 'execute' die Funktion 'move' oder 'draw' ange­ + steuert, so liefert diese Prozedur die absolute Zielposition in x-Rich­ + tung, wo bei der Nullpunkt durch das zurückgelieferte 'x start' bei 'open + page' definiert ist. Diese Prozedur dient zur Unterstützung von Druk­ + kern, die eine absolute Positionierung in horizontaler Richtung benöti­ + gen. + + +#ib#y pos#ie# + INT PROC y pos + Zweck: Wird in der Prozedur 'execute' die Funktion 'move' oder 'draw' an­ + gesteuert, so liefert diese Prozedur die absolute Zielposition in y-Rich­ + tung, wo bei der Nullpunkt durch das zurückgelieferte 'y start' bei 'open + page' definiert ist. Diese Prozedur dient zur Unterstützung von Druk­ + kern, die eine absolute Positionierung in vertikaler Richtung benötigen. + + +#ibie# + INT PROC linetype + Zweck: Wird in der Prozedur 'execute' die Funktion 'draw' angesteuert, so gibt + diese Prozedur den gewünschten Linientyp an. Bisher ist nur definiert: + 1 underline + + Anmerkung: Bis jetzt benutzt der EUMEL-Druckers die Funktion 'draw' lediglich + zum Unterstreichen in Fehlerfall der Modifikation 'underline', d.h. + zeichnen mit 'y steps = 0' und 'x steps >= 0' mit 'line type = 1' + reicht aus. + + +#ib#y offset index#ie# + INT PROC y offset index + Zweck: Wurde der Font mit 'y offsets' definiert, so kann hiermit in der bei der + Funktion 'write text' in der Prozedur 'execute' der jeweilige Offset-In­ + dex für den auszugebenden Text abgefragt werden. Der Offset-Index + sagt aus, die wievielte Verschiebung nun ausgegeben wird. Dabei + werden die Verschiebungen in der Reihenfolge durchnummeriert, in + der sie in der Fonttabelle angegeben wurden. Anhand dieses Offset-In­ + dex muß das Hardware-Interface entscheiden, welche Bitmuster aus­ + gegeben werden müssen. + + +#ib#pages printed#ie# + INT PROC pages printed + Zweck: Gibt nach dem Ausdruck an, wieviel Seiten gedruckt wurden. + + + + +#ib(9)#6.4. Bemerkungen und Ratschläge#ie(9)# + + + +1) Für ein Paket, das dieses Interface implementiert, sind folgende Punkte wichtig: + + - Man braucht sich keine Zustände (aktuelle Position o.ä.) zu merken. + + - Rückmeldungen über die Leistungsfähigkeit eines Druckers bzw. seiner An­ + passung erfolgen über 'errorstop'. Der #ib#EUMEL-Drucker#ie# stellt fest, ob bestimm­ + te Leistungen (Einschalten der Attribute und Bewegungen des Druckers) + verfügbar sind, indem er sie versuchsweise ausführen läßt. Bei den Prozedu­ + ren 'open', 'close' und den Funktionen 'write text', 'write cmd', 'carriage return' + und 'type' der Prozedur 'execute' führt ein 'errorstop' jedoch zum Abbruch des + Drucks. + +2) Die #on("i")##on("b")##ib#Mikroschritte#ie##off("i")##off("b")# sollten die kleinsten durchführbaren horizontalen bzw. vertikalen + Bewegungen des Druckers sein. Oft gibt aber das Handbuch des Druckers keine + eindeutige Angabe über die Mikroschritte in horizontaler Richtung, sondern sagt + nur, daß es gewisse Schriften mit einer bestimmten Anzahl von Zeichen pro Zoll + gibt.#u##count#)#e# Dann ergibt sich die Anzahl von Mikroschritten pro Zoll aus dem kleinsten#foot# + +#value#) 1 Zoll = 1 Inch = 2.54 cm + +#end# + gemeinsamen Vielfachen der Anzahl Zeichen pro Zoll aller Schriften. + + Beispiel: + Der Olivetti Drucker PR1470 hat drei Schriften mit 10, 12, und 16.6 Zeichen pro + Zoll. Das kleinste gemeinsame Vielfache ist 300. Ein Mikroschritt bei dem Druk­ + ker PR1470 entspricht also einem 300stel Zoll. Die Breite der einzelnen Schrif­ + ten läßt sich nun aus der folgenden Tabelle ablesen. + + Anzahl Zeichen pro Zoll Breite in 1/300 Zoll + 10 30 + 12 25 + 16.6 18 + + Wenn der Drucker in diesen theoretischen Mikroschritten nicht positionieren kann, + so muß er bei einem #on("i")#move#off("i")#-Befehl so genau wie möglich positionieren. Der Rest + sollte abgespeichert und beim nächsten #on("i")#move#off("i")#-Befehl hinzuaddiert werden. + +3) Um ein optimales Druckbild zu bekommen, müssen alle Breiten und Höhenanga­ + ben der Zeichen genau angegeben werden. + +4) Die Fonttabelle bietet eine einfache Möglichkeit, Zeichen mit Hilfe der #ib#Ersatzdar­ + stellung#ie#en umzucodieren. Deshalb sollte der Druckerkanal auch mit der Konfigu­ + rationstabelle 'transparent' konfiguriert werden. + +5) Um den Schrifttyp festzulegen, mit dem #ib#ELAN-Listing#ie#s gedruckt werden sollen, + kann in der Fonttabelle einem Font der Name #on("i")##on("b")#"#ib#elanlist#ie#"#off("i")##off("b")# zugeordnet werden, denn + der ELAN-Lister versucht auf einen Schrifttyp mit diesem Namen zuschalten. Wenn + kein Schrifttyp "elanlist" existiert, dann wird für ELAN-Listings der erste Schrifttyp + der Fonttabelle genommen. + +6) Nach der Installation des #ib#Druckertreiber#ie#s ist darauf zu achten, daß in der Task + "PRINTER" eine Fonttabelle des Druckers eingestellt ist. + +7) Der #ib#Druckertreiber#ie# sollte eventuell noch ein Prozedur bereitstellen, mit der die + Papierbreite bzw. -höhe eingestellt werden kann, die bei 'open document' dem + EUMEL-Drucker gemeldet wird. + + + + +#ib(9)#6.5. Arbeitsweise des EUMEL-Druckers#ie(9)# + + + +Der EUMEL-Drucker arbeitet mit der folgenden Strategie: + +Die Datei wird zeilenweise analysiert. Bei der Analyse werden einzelne #ib#Token#ie# be­ +stimmt. Ein Token ist ein Textteil, der zusammenhängend gedruckt werden kann, ohne +daß es zu Typumschaltungen, Modifkationsänderungen oder Positionierungen in x- +bzw. y-Richtung kommt. So ist bei einfachem Zeilendruck jede Zeile ein Token, wäh­ +rend im Blocksatz jedes Wort ein Token ist. Ein Token hat also immer + + - einen Text, + - die Länge des Textes bei der Ausgabe, + - eine absolute x- und y- Position auf dem Papier, + - einen Schrifttyp, + - Modifikationen für den Text, + - Modifikationen für den Zwischenraum vom letzten Token zu diesem Token. + +Sind alle Token einer Zeile bestimmt, so werden sie in eine Liste aller bisher erzeug­ +ten, aber noch nicht gedruckten Token der absoluten y-Position nach einsortiert. Diese +Tokenliste wird erst dann ausgedruckt, wenn sichergestellt ist, daß im weiteren Verlauf +der Datei kein Token vor das letzte Token der sortierten Liste kommt. Beim Zeilendruck +ist dies nach jeder Zeile der Fall. Bei Spaltendruck kann jedoch erst dann ausgedruckt +werden, wenn sich die Analyse in der letzten Spalte befindet. Spätestens bei einem +Seitenwechsel muß die Tokenliste ausgegeben werden. + +Durch diese Strategie lassen sich Spaltendruck oder Indizes und Exponenten sehr +leicht für alle Drucker implementieren, ohne daß ein Drucker in vertikaler Richtung +rückwärts positionieren muß. + +Bei der Ausgabe der Tokenliste wird jeweils auf die nächst größere y-Position posi­ +tioniert und dort werden alle Token zu dieser y-Position ausgegeben. Die Ausgabe +eines Tokens erfolgt in der folgenden Reihenfolge: + + - der Schrifttyp wird eingeschaltet, + - die Modifikationen für den Zwischenraum werden eingeschaltet, + - der Positionsbefehl für horizontale Bewegungen wird gegeben, + - die Modifikationen für den Text werden eingeschaltet, + - der Text wird ausgegeben. + +Die ersten vier Punkte werden nur dann ausgeführt, wenn sie notwendig sind. Über­ +schreitet der Text die Papierbreite, so zeigen Punkte am Ende der Zeile dies an. + diff --git a/doc/system-manual/1.8.7/doc/systemhandbuch.4 b/doc/system-manual/1.8.7/doc/systemhandbuch.4 new file mode 100644 index 0000000..e511eb5 --- /dev/null +++ b/doc/system-manual/1.8.7/doc/systemhandbuch.4 @@ -0,0 +1,1185 @@ +#start(2.5,1.5)# +#pageblock# +#block# +#page (91)# +#headeven# +%#center#EUMEL-Systemhandbuch + + +#end# +#headodd# +#center#7. Der Fontspeicher#right#% + + +#end# + +#ib(9)#7. Der #ib#Fontspeicher#ie##ie(9)# + + + +#ib(9)#7.1. #ib#Fonttabellen#ie##ie(9)# + + +Damit die Textverarbeitung Dokumente formatieren kann, muß sie über Breiten und +Höhen der einzelnen Schrifttypen (auch "#ib#Fonts#ie#" genannt) des Druckers, auf dem das +Dokument gedruckt wird, Bescheid wissen. Auch bei dem Ausdruck des Dokuments +wird diese Information benötigt. Im EUMEL-System stellt der #ib#Fontspeicher#ie# diese Infor­ +mation den #ib#Formatierprogramm#ie#en (#on("i")#lineform#off("i")# und #on("i")#pageform#off("i")#) und dem #ib#EUMEL-Drucker#ie# +zur Verfügung. + +Da nun der Drucker Angaben zur Positionierung in seinen #ib#Mikroschritten#ie# (kleinste +Schrittweite in horizontaler oder vertikalter Richtung) benötigt, liefert die Fonttabelle +die Breiten- und Höhenangaben in Mikroschritten und eine Umrechnungseinheit von +Schritten in Zentimeter oder umgekehrt. So braucht der EUMEL-Drucker bei Positionie­ +rungen keine Umrechnung vorzunehmen. Allerdings müssen die Formatierprogramme +auch in Mikroschritten des jeweiligen Druckers rechnen. Dadurch werden jedoch +Unterschiede durch Rundungsfehler zwischen dem EUMEL-Drucker und den Forma­ +tierprogrammen vermieden. + +Bei diesem Konzept können Fonts von verschiedenen Druckern nicht in einer Fontta­ +belle verwaltet werden, denn unterschiedliche Drucker haben meist verschiedene +Mikroschritte. Somit muß es für jeden Drucker mindestens eine Fonttabelle geben. + +Es gibt aber auch Fälle, in denen Fonts auf einem Drucker nicht mit anderen Fonts des +Druckers zusammengedruckt werden können. Solche Fälle liegen z.B. bei Typenrad­ +druckern vor, die immer nur mit einem Typenrad drucken können und dessen Zei­ +chenbreite hardwaremäßig eingestellt werden muß (z.B. beim Olivetti PR320), bei +Druckern, die verschiedene Fonts für Längs- und Querformat haben (z.B. beim Agfa +P400), oder bei Druckern, deren Fonts geladen werden (z.B. beim HP 2686). Eine +#on("b")##ib#Fonttabelle#ie##off("b")# enthält also alle die Fonts eines Druckers, #on("b")#die auf dem Drucker kompati­ +bel sind#off("b")#. Es kann mehrere Fonttabellen zu einem Drucker geben. + +Die verschiedenen Fonttabellen werden von im Multi-User Betrieb von der Task "#ib#confi­ +gurator#ie#" verwaltet. Sie enthält alle Fonttabellen, die auf dem Rechner zur Verfügung +stehen. Mit dem Kommando + + + #ib#fonttable#ie# ("Name der Fonttabelle") + + +wird in einer Task die gewünschte Fonttabelle eingestellt. Danach stehen die Fonts +dieser Tabelle in der Task zur Verfügung. Die Einstellung der Fonttabelle vererbt sich +auf die Sohntasks, d.h. wird eine Sohntask begonnen, so ist dort die Fonttabelle des +Vaters eingestellt. + +Dazu das folgenden Beispiel: + + Für den Agfa-Drucker P400 gibt es die Fonttabellen "agfa" und "agfaquer", in + denen die Fonts für Längsdruck bzw. Querdruck enthalten sind. In der Task + #on("i")#PUBLIC#off("i")# wird mit dem Kommando #on("i")#fonttable ("agfa")#off("i")# die Fonttabelle "agfa" ein­ + gestellt. Alle neuen Sohntasks können sofort ohne weitere Einstellung mit der + Textformatierung im Längsformat beginnen. Will nun jemand im Querformat + drucken, so muß er in seiner Task mit dem Kommando #on("i")#fonttable ("agfaquer")#off("i")# den + Fontspeicher auf die Fonts zum Querdruck umstellen. + +Das Kommando + + + #ib#list fonts#ie# + + +listet die Fonts der eingestellten Fontabelle ins #on("i")#notebook#off("i")# und das Kommando + + + #ib#list fonttables#ie# + + +informiert über die verfügbaren Fonttabellen. + + + + +#ib(9)#7.2. Erstellen einer #ib#Fonttabelle#ie##ie(9)# + + +Die Fonttabelle ist ein Datenraum mit einer eigenen Struktur. Somit kann sie nicht +mehr mit dem Editor, sondern nur mit einem entsprechenden Programm bearbeitet +werden. Solch ein Programm befindet sich in der Datei "#ib#font convertor#ie#" auf dem Stan­ +dardarchiv 'std.zusatz'. Diese Datei sollte in einer Systemtask (Sohntask von "SYSUR") +insertiert werden. Danach stehen entsprechende Kommandos zur Bearbeitung einer +Fonttabelle zur Verfügung. + +Um eine Fonttabelle zu bekommen, muß zuerst eine #on("b")##ib#Fontdatei#ie##off("b")# (d.h. eine editierbare +Datei mit dem unten beschriebenen Aufbau) angelegt werden. Mit dem Kommando + + + #ib#create fonttable#ie# ("Name der Fontdatei") + + +werden alle in der Fontdatei spezifizierten Fonttabellen erstellt. Sie liegen als benannte +Datenräume in der Task vor und können mit dem Kommando #on("i")#save#off("i")# von einer System­ +task an die Task "configurator" gesendet werden. Danach sind diese Fonttabellen in +allen Task auf dem Rechner verfügbar und können mit dem #on("i")#fonttable#off("i")# - Kommando +eingestellt werden. + +Soll dagegen eine bestehende Fonttabelle geändert werden, so erstellt das Komman­ +do + + + #ib#create fontfile#ie# ("Name der Fonttabelle", "Name der Fontdatei") + + +aus der angegebenen Fonttabelle eine Fontdatei. Die Fonttabelle muß dazu in der Task +als benannter Datenraum vorliegen (d.h. sie muß eventuell mit #on("i")#fetch#off("i")# von der Task +"configurator" geholt werden). In der so erstellten Fontdatei können die Änderungen +mit dem Editor vorgenommen, mit #on("i")#create fonttable#off("i")# die geänderte Fonttabelle erstellt +und diese wiederum mit #on("i")#save#off("i")# an die Task "configurator" gesendet werden. Mit dem +#on("i")#fonttable#off("i")#-Kommando kann dann in den bestehenden Tasks die geänderte Fonttabelle +eingestellt werden. Alle neuen Tasks erhalten automatisch die geänderte Fonttabelle. + + + +#ib(9)#Prozedurbeschreibung der Umwand­ +lungs­Kommandos#ie(9)# + + +Nach der Insertierung der Datei "font convertor" stehen die folgenden Kommandos zur +Umwandlung einer Fontdatei in eine Fonttabelle oder umgekehrt zur Verfügung. + +#ib#create fontfile#ie# + PROC create fontfile (TEXT CONST fonttable name, fontfile name) + Zweck: Aus Fonttabelle 'fonttable name' wird eine Fontdatei mit dem ange­ + gebenen Name erstellt. Die Fonttabelle muß dabei in der eigenen Task + als benannter Datenraum vorliegen. + +#ib#create fonttable#ie# + PROC create fonttable (TEXT CONST fontfile name) + Zweck: Es werden alle Fonttabellen erzeugt, die in der Fontdatei 'fontfile name' + angegeben sind. Die Fonttabellen liegen dann als benannte Datenräu­ + me in der Task vor. + + PROC create fonttable + Zweck: Es werden alle Fonttabellen erzeugt, die in der zuletzt bearbeiteten + Datei angegeben sind. + + + + +#ib(9)#7.3. Aufbau der #ib#Fontdatei#ie##ie(9)# + + +In der Fontdatei können drei Strukturen stehen und zwar Kennungen, Identifkationen +und Zeichenspezifikationen.#u##count#)#e# +#foot# + +#value#) Beim formalen Aufbau bedeuten eckige Klammern, daß diese Angaben optional sind. + +#end# + + + +#ib(9)##ib#Kennungen#ie##ie(9)# + + + Formaler Aufbau: <#on("i")#Kennung#off("i")#> : Name 1 [, Name 2] [ ... ] ; + + Eine Kennung leitet eine Definition ein. Für die Namen der Namensliste gelten die + folgenden Konventionen: + + - der Name muß als TEXT-Denoter angegeben werden, + - der Name muß ungleich #on("i")#niltext#off("i")# sein, + - Leerzeichen sind im Namen nicht signifikant (d.h. "agfa quer" wird zu "agfa­ + quer"). + + Eine Kennung kann die folgenden Werte annehmen: + + <#on("i")#Kennung#off("i")#> { FONTTABLE, FONT } + + - #on("b")##ib#FONTTABLE#ie##off("b")# + Hiermit wird eine Definition einer Fonttabelle eingeleitet. Es wird nur der erste + Name der Namensliste ausgewertet, da die Fonttabelle eindeutig identifiziert + sein muß. Alle folgenden Angaben werden dieser Fonttabelle zugeordnet, bis + eine neue Kennung FONTTABLE folgt. + + - #on("b")##ib#FONT#ie##off("b")# + Hiermit wird eine Definition eines Schrifttyps eingeleitet. Ein Schrifttyp kann + mehrere Namen haben. Jedoch darf in einer Fonttabelle jeder Fontname nur + einem Font zugeordnet werden. + + + +#ib(9)##ib#Identifikation#ie#en#ie(9)# + + + Formaler Aufbau: [ <#on("i")#Identifikation#off("i")#> = ; ] + + Mit den Identifikationen werden bestimmte Angaben zu den Kennungen gemacht. + Sie müssen unmittelbar nach der entsprechenden Kennung folgen, brauchen aber + nur angegeben werden, wenn sie von den Standardwerten abweichen. + + + +#ib(9)#Identifikationen nach der Kennung #ib#FONTTABLE#ie##ie(9)# + + + <#on("i")#Identifikation#off("i")#> { x unit, y unit, on string, off string } + + - #on("b")##ib#x unit#ie##off("b")# + Hiermit wird die Anzahl der Mikroschritte des Druckers pro Zentimeter in + horizontaler (x-) Richtung spezifiziert. Die Einheit muß als REAL-Denoter + angegeben werden. Alle weiteren Breitenangaben zu den Fonts dieses Druk­ + kers beziehen sich auf diese Einheit. + + STD-Wert: 10.0 / 2.54 = 3.937008 + + - #on("b")##ib#y unit#ie##off("b")# + Hiermit wird die Anzahl der Mikroschritte des Druckers pro Zentimeter in + vertikaler (y-) Richtung spezifiziert. Die Einheit muß als REAL-Denoter ange­ + geben werden. Alle weiteren Höhenangaben zu den Fonts dieses Druckers + beziehen sich auf diese Einheit. + + STD-Wert: 6.0 / 2.54 = 2.362205 + + - #on("b")##ib#on string#ie##off("b")# + Hier müssen vier Textdenoter, durch Komma getrennt, angegeben werden. + Die Textdenoter enthalten die Befehlssequenzen, um beim Drucker die Mo­ + difikationen anzuschalten. Dabei ist die Reihenfolge der Modifikationen + underline, bold, italics, reverse. + Liegt für eine der Modifikationen keine Befehlssequenz vor, so muß #on("i")#niltext#off("i")# + angegeben werden. Die Befehlssequenzen können vom Druckertreiber ab­ + gefragt werden. + + STD-Wert: #on("i")#niltext#off("i")# für alle Modifikationen + + - #on("b")##ib#off string#ie##off("b")# + Hier müssen vier Textdenoter, durch Komma getrennt, angegeben werden. + Die Textdenoter enthalten die Befehlssequenzen, um beim Drucker die Mo­ + difikationen auszuschalten. Dabei ist die Reihenfolge der Modifikationen + underline, bold, italics, reverse. + Liegt für eine der Modifikationen keine Befehlssequenz vor, so muß #on("i")#niltext#off("i")# + angegeben werden. Die Befehlssequenzen können vom Druckertreiber ab­ + gefragt werden. + + STD-Wert: #on("i")#niltext#off("i")# für alle Modifikationen + + + +#ib(9)#Identifikationen nach der Kennung #ib#FONT#ie##ie(9)# + + + <#on("i")#Identifikation#off("i")#> { font lead, font height, font depth, indentation pitch, + next larger font, next smaller font, + font string, y offsets, bold offset } + + - #on("b")##ib#font lead#ie##off("b")##u##count#)#e# + Der Durchschuß eines Fonts gibt den Zwischenraum in vertikaler Richtung + zwischen den Zeilen bei einfachem Zeilenvorschub an. Er muß in Mikroschrit­ + ten der y-Richtung als INT-Denoter angegeben werden. + + STD-Wert: 0 +#foot# + +#value#) Für spätere Erweiterungen des EUMEL-Druckers wurde die bisherige Fonthöhe in Durchschuß, Fonthöhe + und Fonttiefe aufgespalten. Für alle bis jetzt definierten Leistungen braucht nur wie bisher die Fonthöhe + angegeben zu werden. Der Durchschuß und die Fonttiefe werden dann auf Null gesetzt. +#end# + + - #on("b")##ib#font height#ie##off("b")##u##value#)#e# + Die Fonthöhe ist die Distanz von der Basislinie bis zur Oberkante des höch­ + sten Zeichens. Sie muß in Mikroschritten der y-Richtung als INT-Denoter + angegeben werden. + + STD-Wert: 6 Zeilen pro Inch entsprechend der definierten #on("i")#y unit#off("i")# + + - #on("b")##ib#font depth#ie##off("b")##u##value#)#e# + Die Fonttiefe ist die Distanz von der Basislinie bis zur Unterkante des tief­ + sten Zeichens. Sie muß in Mikroschritten der y-Richtung als INT-Denoter + angegeben werden. + + STD-Wert: 0 + + - #on("b")##ib#indentation pitch#ie##off("b")# + Einrückungen oder Aufzählungen werden äquidistant berechnet, d.h. Anzahl + der Zeichen mal einer festen Breite. Diese Einrückbreite sollte ein Mittel al­ + ler Zeichenbreiten sein und braucht nicht der Breite des Leerzeichens zu + entsprechen. Sie muß in Mikroschritten der x-Richtung als INT-Denoter an­ + gegeben werden. + + STD-Wert: 10 Zeichen pro Inch entsprechend der definierten #on("i")#x unit#off("i")# + + - #on("b")##ib#next larger font#ie##off("b")# + Hier muß der Name des nächst größeren Fonts als TEXT-Denoter aufgeführt + werden. Gibt es keinen nächst größeren Font, so ist #on("i")#niltext#off("i")# anzugeben. + + STD-Wert: #on("i")#niltext#off("i")# + + - #on("b")##ib#next smaller font#ie##off("b")# + Hier muß der Name des nächst kleineren Fonts als TEXT-Denoter aufge­ + führt werden. Gibt es keinen nächst kleineren Font, so ist #on("i")#niltext#off("i")# anzugeben. + Bei Indizes oder Exponenten wird automatisch auf diesen nächst kleineren + Font umgeschaltet. + + STD-Wert: #on("i")#niltext#off("i")# + + + - #on("b")##ib#font string#ie##off("b")# + Hier kann als TEXT-Denoter eine Befehlssequenz angegeben werden, die + den Drucker auf diesen Font umschaltet. Diese Befehlssequenz kann vom + Druckertreiber abgefragt werden. Dadurch ist es nicht nötig, daß er die Na­ + men der Fonts kennt. + + STD-Wert: #on("i")#niltext#off("i")# + + - #on("b")##ib#y offsets#ie##off("b")# + Um bei Matrixdruckern Schriften zu erzeugen, die höher als eine Nadelreihe + sind, müssen entsprechende Bitmuster des Textes an verschiedenen y-Po­ + sitionen ausgegeben werden. Um diese Anforderung durch den EUMEL- + Drucker zu unterstützen, kann hier eine Liste von Verschiebungen von der + Basislinie angegeben werden, an denen der Text ein weiteres Mal ausgege­ + ben wird. Dabei bedeuten negative Werte eine Verschiebung oberhalb und + positive Werte eine Verschiebung unterhalb der Basislinie. Ist der Wert Null, + so wird der Text auf der Basislinie ausgegeben. Die Modifikation #on("i")#underline#off("i")# + wird bei der Ausgabe des Textes nur an der ersten Verschiebung angestellt. + Die Werte für die Verschiebungen müssen in Mikroschritten der y-Richtung + als INT-Denoter angegeben und durch Komma getrennt werden. + + STD-Wert: 0 + + - #on("b")##ib#bold offset#ie##off("b")# + Falls der Drucker die Modifikation #on("i")#bold#off("i")# nicht beherrscht, versucht der + EUMEL-Drucker sie durch Doppeldruck zu simulieren. Der 'bold offset' gibt + an, ob und wieviel der zweite Durchgang in x-Richtung verschoben werden + soll. Dies ergibt insbesondere bei Laserdruckern, die nicht für alle Schriftty­ + pen einen Bold-Typ haben, einen recht guten Fettdruck. Der Wert muß in + Mikroschritten der x-Richtung als INT-Denoter angegeben werden. + + STD-Wert: 0 + + + +#ib(9)##ib#Zeichenspezifikationen#ie##ie(9)# + + + + Formaler Aufbau: [ [, ] + [, ] ; ] + + + Nachdem die Identifikationen zu einer Kennung angegeben wurden, können Zei­ + chenspezifikationen folgen, d.h. zu einem Zeichen kann die Breite und/oder eine + Ersatzdarstellung spezifiziert werden. Dazu muß zuerst das Zeichen selber als + TEXT-Denoter angegeben werden. + + - #on("b")##ib#Breite des Zeichens#ie##off("b")# + Die Zeichenbreite muß als INT-Denoter in Mikroschritten angegeben werden. + Alle Zeichenbreiten werden mit der Einrückbreite vorbesetzt, so daß nur sol­ + che Zeichen angegeben werden müssen, deren Breite von der Einrückbreite + abweichen. Negative Zeichenbreiten sind nicht erlaubt. Die Angabe von Zei­ + chenbreiten nach der Kennung FONTTABLE wird ignoriert. + + - #on("b")##ib#Ersatzdarstellung des Zeichens#ie##off("b")# + Die Ersatzdarstellung wird statt des Zeichens ausgedruckt. Sie muß als + TEXT-Denoter angegeben werden. Werden Ersatzdarstellungen nach der + Kennung FONTTABLE angegeben, so gelten sie global für alle Fonts dieser + Fonttabelle. Sie können jedoch bei der Fontangabe lokal wieder überschrie­ + ben werden. Eine Ersatzdarstellung darf höchsten 255 Zeichen lang sein. Alle + Ersatzdarstellungen eines Fonts dürfen 32767 Zeichen nicht überschreiten. + + + +#ib(9)##ib#Kommentare in der Fontdatei#ie##ie(9)# + + + In der Fontdatei dürfen Kommentare eingefügt werden. Sie müssen den Kommen­ + taren der ELAN-Syntax entsprechen, d.h. mit '(*' beginnen und mit '*)' enden. + + + +#ib(9)##ib#Deutsche Namen#ie##ie(9)# + + + Kennungen und Identifikationen dürfen in der Fontdatei auch mit folgenden deut­ + schen Namen angegeben werden. + + FONTABLE : FONTABELLE + FONT : FONT + +#free (0.15)# + x unit : x einheit + y unit : y einheit + on string : on sequenz + off string : off sequenz + indentation pitch : einrueckbreite + font lead : durchschuss + font height : fonthoehe + font depth : fonttiefe + next larger font : groesserer font + next smaller font : kleinerer font + font string : font sequenz + y offsets : y verschiebungen + bold offset : bold verschiebung + + + + +#ib(9)#7.4. Beispiel für eine Fontdatei#ie(9)# + + +In diesem Beispiel einer Fonttdatei sind drei Fonttabellen enthalten, nämlich "agfa" und +"agfaquer" für den Agfa-Drucker und "epson" für einen Epson-Drucker. + + +FONTTABLE : "agfa" ; + x unit = 160.0 ; #right#(* Anzahl der Mikroschritte pro cm *) + y unit = 160.0 ; + on string = "\UL1;", "\BO1;", "\IT1;", "\CFW;\CBB;" ; + off string = "\UL0;", "\BO0;", "\IT0;", "\CFT;\CBT;" ; + +#right#(* globale Ersatzdarstellungen für alle Agfa-Fonts *) + + ""214"" , "\!298;" ; #right#(* AE *) + ""215"" , "\!299;" ; #right#(* OE *) + ""216"" , "\!300;" ; #right#(* UE *) + ""217"" , "\!451;" ; #right#(* ae *) + ""218"" , "\!452;" ; #right#(* oe *) + ""219"" , "\!453;" ; #right#(* ue *) + . + . + . + + FONT : "trium10" ; + indentation pitch = 30 ; + font lead = 7 ; + font heigth = 54 ; + font depth = 15 ; + next larger font = "trium12" ; + next smaller font = "helvetica8" ; + font string = "\FO5;" ; + + " " , 20 ; "!" , 16 ; + """" , 22 ; "\#" , 31 ; + "$" , 31 ; "%" , 55 ; + . + . + . + ""217"" , 31 ; #right#(* ae *) + +#right#(* lokale Ersatzdarstellungen für Font "trium10" *) + + ""244"" , 43 , "\FO23;\!725;\FO5;" ; #right#(* ungleich *) + ""245"" , 31 , "\FO23;\!405;\FO5;" ; #right#(* mal-Zeichen *) + + FONT : "modern12", "elanlist" ; #right#(* Mehrere Namen für einen Font *) + indentation pitch = 33 ; + font lead = 14; + font heigth = 53; + font depth = 13; + next larger font = "" ; + next smaller font = "micro" ; + font string = "\FO11;" + #right#(* Alle Zeichen haben die gleiche Breite *) + + FONT . . . + + +FONTTABLE : "agfaquer" ; + x unit = 160.0 ; + y unit = 160.0 ; + on string = "\UL1;", "\BO1;", "\IT1;", "\CFW;\CBB;" ; + off string = "\UL0;", "\BO0;", "\IT0;", "\CFT;\CBT;" ; + . + . + . + + +FONTTABLE : "epson" ; + x unit = 47.24409 ; #right#(* 120.0 / 2.54 *) + y unit = 85.03937 ; #right#(* 216.0 / 2.54 *) + on string = ""27"-"1"", "", ""27"4", ""; + off string = ""27"-"0"", "", ""27"5", ""; + + ""214"" , ""27"R"2""091""27"R"0"" ; #right#(* AE *) + ""215"" , ""27"R"2""092""27"R"0"" ; #right#(* OE *) + ""216"" , ""27"R"2""093""27"R"0"" ; #right#(* UE *) + ""217"" , ""27"R"2""123""27"R"0"" ; #right#(* ae *) + ""218"" , ""27"R"2""124""27"R"0"" ; #right#(* oe *) + ""219"" , ""27"R"2""125""27"R"0"" ; #right#(* ue *) + ""220"" , "k" ; #right#(* Trenn-k *) + ""221"" , "-" ; #right#(* Trennstrich *) + ""222"" , "\#" ; #right#(* geschütztes Nummernkreuz *) + ""223"" , " " ; #right#(* geschütztes Leerzeichen *) + ""251"" , ""27"R"2""126""27"R"0"" ; #right#(* ss *) + ""252"" , ""27"R"2""064""27"R"0"" ; #right#(* Paragraph *) + + FONT : "12", "elite", "elite12" ; #right#(* Mehrere Namen für einen Font *) + font height = 36 ; + indentation pitch = 10 ; + next smaller font = "12.klein" ; + font string = ""27"!"1""27"p"0""27"T" ; + bold offset = 2 ; + + FONT : "12.klein", "elite.klein", "elanlist" ; + font height = 20 ; + indentation pitch = 10 ; + next smaller font = "12.klein" ; + font string = ""27"!"1""27"p"0""27"S"1"" ; + bold offset = 1 ; + + FONT : "12.hoch" ; + font height = 96 ; + indentation pitch = 10 ; + next smaller font = "12.klein" ; + font string = "" ; + bold offset = 2 ; + y offsets = 12, -12 ;#right#(* der Text wird jeweils 12 Mikroschritte unter- + #right# und überhalb der Basislinie ausgegeben *) + + FONT : "prop10", "prop" ; + font height = 12 ; + indentation pitch = 24 ; + next smaller font = "" ; + font string = ""27"!"0""27"p"1""27"T" ; + bold offset = 2 ; + + "!" , 10 ; + """" , 16 ; + "(" , 12 ; + . . . + + + + + +#ib(9)#7.5. Schnittstelle des #ib#Fontspeicher#ie#s#ie(9)# + + + +Das Paket #on("i")#font store#off("i")# liefert die folgenden Prozeduren: + +#ib#fonttable#ie# + PROC fonttable (TEXT CONST fonttable name) + Zweck: Stellt die angegebene Fonttabelle in der Task ein. Dabei wird zuerst in + der eigenen Task nach der angegebenen Fonttabelle gesucht. Existiert + die Fonttabelle in der eigenen Task nicht, so wird die Fonttabelle von + der Task "configurator" geholt. + Wenn die Fonttabelle eingestellt ist, sind in der Task nur noch die Fonts + dieser Fonttabelle bekannt. Die Einstellung vererbt sich auf die Sohn­ + tasks. + + TEXT PROC fonttable + Zweck: Liefert den Name der eingestellten Fonttabelle. + +#ib#list fonttables#ie# + PROC list fonttables + Zweck: Zeigt die Liste der verfügbaren Fonttabellen im #on("i")#notebook#off("i")#. + +#ib#list fonts#ie# + PROC list fonts + Zweck: Listet die Fonts der eingestellten Tabelle ins #on("i")#notebook#off("i")#. + + PROC list fonts (TEXT CONST fonttable name) + Zweck: Listet die Fonts der angegebenen Fonttabelle ins #on("i")#notebook#off("i")#. Die vorher + eingestellte Fonttabelle bleibt jedoch weiter eingestellt. + +#ib#x step conversion#ie# + INT PROC x step conversion (REAL CONST cm) + Zweck: Rechnet die in Zentimeter angegebene Länge in Mikroschritte der + x-Richtung um. + + REAL PROC x step conversion (INT CONST steps) + Zweck: Rechnet die in Mikroschritten der x-Richtung angegebene Länge in + Zentimeter um. + +#ib#y step conversion#ie# + INT PROC y step conversion (REAL CONST cm) + Zweck: Rechnet die in Zentimeter angegebene Länge in Mikroschritte der + y-Richtung um. + + REAL PROC y step conversion (INT CONST steps) + Zweck: Rechnet die in Mikroschritten der y-Richtung angegebene Länge in + Zentimeter um. + +#ib#on string#ie# + TEXT PROC on string (INT CONST modification) + Zweck: Liefert die in der Fonttabelle spezifizierte Befehlssequenz, um eine + Modifikation anzuschalten. Es gibt die folgenden Modifikationen + 1 underline + 2 bold + 4 italics + 8 reverse + +#ib#off string#ie# + TEXT PROC off string (INT CONST modification) + Zweck: Liefert die in der Fonttabelle spezifizierte Befehlssequenz, um eine + Modifikation auszuschalten. Es gibt die folgenden Modifikationen + 1 underline + 2 bold + 4 italics + 8 reverse + +#ib#font#ie# + INT PROC font (TEXT CONST font name) + Zweck: Liefert die interne Fontnummer des Fonts. Mit dieser Fontnummer + können die weiteren Informationen über den Font angefordert werden. + Existiert kein Font mit diesem Namen, so wird Null geliefert. + + TEXT PROC font (TEXT CONST font nr) + Zweck: Liefert den Fontnamen des Fonts mit der angegeben Fontnummer. Hat + der Font mehrere Namen, so wird der erste Name der Namensliste aus + der Fontdatei geliefert. Existiert kein Font unter dieser Nummer, so wird + #on("i")#niltext#off("i")# geliefert. + +#ib#font exists#ie# + BOOL PROC font exists (TEXT CONST font name) + Zweck: Informationsprozedur zur Abfrage der Existenz eines Fonts. + +#ib#next smaller font exists#ie# + BOOL PROC next smaller font exists (INT CONST font nr, + INT VAR next smaller font) + Zweck: Informationsprozedur zur Abfrage der Existenz des nächst kleineren + Fonts. Wenn er existiert, wird die Fontnummer dieses Fonts zurück­ + geliefert. + +#ib#next larger font exists#ie# + BOOL PROC next larger font exists (INT CONST font nr, + INT VAR next larger font) + Zweck: Informationsprozedur zur Abfrage der Existenz des nächst größeren + Fonts. Wenn er existiert, wird die Fontnummer dieses Fonts zurück­ + geliefert. + +#ib#indentation pitch#ie# + INT PROC indentation pitch (INT CONST font nr) + Zweck: Liefert die Einrückbreite in Mikroschritten der x-Richtung. Sie sollte eine + mittlere Breite der Zeichen sein, denn mit ihr werden die Einrückungen + und Aufzählungen berechnet. + +#ib#font lead#ie# + INT PROC font lead (INT CONST font nr) + Zweck: Liefert den Durchschuss des Fonts in Mikroschritten der y-Richtung. + Der Druchschuß ist der Zwischenraum zwischen den einzelnen Zeilen + bei einfachem Zeilenvorschub. + +#ib#font height#ie# + INT PROC font height (INT CONST font nr) + Zweck: Liefert die Höhe des Fonts in Mikroschritten der y-Richtung. Die Fon­ + thöhe ist die Distanz von der Basislinie bis zur Oberkante des höchsten + Zeichens. + +#ib#font depth#ie# + INT PROC font depth (INT CONST font nr) + Zweck: Liefert die Tiefe des Fonts in Mikroschritten der y-Richtung. Die Fonttie­ + fe ist die Distanz von der Basislinie bis zur Unterkante des tiefsten + Zeichens. + +#ib#font string#ie# + TEXT PROC font string (INT CONST font nr) + Zweck: Liefert den Fontstring des Fonts. Der Fontstring enthält die Befehls­ + sequenz, um den Drucker auf diesen Font umzuschalten. + +#ib#y offsets#ie# + TEXT PROC y offsets (INT CONST font nr) + Zweck: Liefert einen Text mit den y-Verschiebungen von der Basislinie. Die + einzelnen Verschiebungen können mit dem Operator 'ISUB' abgefragt + werden. + +#ib#bold offsets#ie# + INT PROC bold offsets (INT CONST font nr) + Zweck: Liefert die 'bold'-Verschiebung. + +#ib#char pitch#ie# + INT PROC char pitch (INT CONST font nr, TEXT CONST char) + Zweck: Liefert die Breite des Zeichens in Mikroschritten der x-Richtung. + +#ib#replacement#ie# + TEXT PROC replacement (INT CONST font nr, TEXT CONST char) + Zweck: Falls das Zeichen eine Ersatzdarstellung hat, so wird diese geliefert, + anderfalls das Zeichen selbst. + +#ib#get font#ie# + PROC get font (INT CONST font nr, + INT VAR indentation pitch, font lead, font height, font depth, + ROW 256 INT VAR pitch table) + Zweck: Die Variablen liefern die entsprechenden Informantionen über den + Font. Der Eintrag des Codewerts eines Zeichens plus eins in der Brei­ + tentabelle liefert die Breite dieses Zeichens. + +#ib#get replacements#ie# + PROC get replacements (INT CONST font nr, + TEXT VAR replacements, + ROW 256 INT VAR replacement table) + Zweck: In der Fonttabelle kann für jedes Zeichen eine Ersatzdarstellung an­ + gegeben werden. Diese Ersatzdarstellungen werden mit dieser Proze­ + dur geliefert. Dabei stehen in der Textvariablen 'replacement' die ge­ + samten Ersatzdarstellungen des Fonts. Die Ersatzdarstellungstabelle + enthält Zeiger auf den Text der Ersatzdarstellungen. Die Ersatzdarstel­ + lung eines Zeichnes bestimmt sich wie folgt: + + + ersatzdarstellung : + INT CONST wert := replacement table (code( zeichen ) + 1); + IF wert > 0 + THEN INT CONST ende := wert + code (replacements SUB wert); + subtext (replacements, wert + 1, ende) + ELSE zeichen + FI. + + +Bei den Prozeduren des Packets #on("i")#font store#off("i")# können die folgenden Fehlerfälle auftreten: + + - Fonttabelle noch nicht eingestellt + Es wurde noch keine Fonttabelle in der Task eingestellt. + + - Fonttabelle "fonttable name" gibt es nicht + Die angegebene Fonttabelle wurde weder in der eigenen Task, noch in der + Task 'configurator' gefunden. + + - Font 'font nr' gibt es nicht + Unter der angegebenen Fontnummer gibt es in der eingestellten Font­ + tabelle keinen Font. Speziell ist das für 'font nr' = 0 der Fall, falls ein Font­ + name nicht gefunden wurde. + + - unzulaessige Modifikation + Die angegebene Modifikation ist ungleich 1, 2, 4 oder 8. +#page# + +#headeven# + +%#center#EUMEL-Systemhandbuch + + +#end# +#headodd# + +#center#8. Verschiedenes#right#% + + +#end# + +#ib(9)#8. Verschiedenes#ie(9)# + + + + +#ib(9)#8.1. Der Spoolmanager#ie(9)# + + +Der "#ib#Spoolmanager#ie#" verwaltet eine #ib#Warteschlange von Datenräumen#ie# (Dateien), die von +einem "#ib#Server#ie#" abgearbeitet werden sollen. Dabei puffert der Spoolmanager Dateien, +die von beliebigen Tasks geschickt werden können, in einer Warteschlange und gibt +sie der Reihe nach dem Server zur eigentlichen Verarbeitung. Ein typischer Einsatzfall +(aber nicht der einzige) für ein solches System ist der Druck von Dateien in Multi- +User-Systemen. Unabhängig davon, ob der Drucker gerade aktiv ist und wieviele +Dateien noch auf den Ausdruck warten, kann jeder seine Datei dem Druckerspool (in +der Regel die Task "PRINTER") senden und sofort danach weiterarbeiten. + + + +#ib(9)#Prozeduren des Spoolmanagers#ie(9)# + + +Im privilegierten Ast des Taskbaumes (Söhne von "SYSUR"), stehen die folgenden +Prozeduren zur Einrichtung eines Spoolmanagers zur Verfügung. + +#ib#spool manager#ie# + PROC spool manager (PROC server, BOOL CONST with start) + Zweck: Die Task, in der die Prozedur aufgerufen wird, wird zum Spoolmanager. + Wenn 'with start' auf TRUE gesetzt ist, wird eine Server-Task als unbe­ + nannter Sohn ("-") eingerichtet und mit der übergebenen 'PROC server' + gestartet. Anderfalls muß der Spool durch den Benutzer mit Hilfe der + Spoolkommandos (siehe dort) gestartet werden. + + PROC spool manager (PROC server) + Zweck: Diese Prozedur ruft die Prozedur 'spool manager' mit 'with start' gleich + TRUE auf. + + +Mit Hilfe der folgenden Prozeduren kann der Spool eingestellt werden. + +#ib#station only#ie# + PROC station only (BOOL CONST flag) + Zweck: Wenn flag auf TRUE gesetzt ist, nimmt der Spooler nur Aufträge von + Tasks der eigenen Station entgegen. + Voreinstellung: 'station only (FALSE)'. + + BOOL PROC station only + Zweck: liefert TRUE, wenn der Spooler nur von der eigenen Station benutzt + werden darf. + +#ib#spool duty#ie# + PROC spool duty (TEXT CONST duty) + Zweck: Mit dieser Prozedur kann ein Text im Spooler eingestellt werden, der die + Aufgabe des Spoolers beschreibt. Dieser wird beim 'list' gemeldet. + + TEXT PROC spool duty + Zweck: Liefert die eingestellte Text-Beschreibung der Aufgabe des Spools. + +#ib#spool control task#ie# + PROC spool control task (TASK CONST task) + Zweck: Diese Prozedur gibt der Task 'task' und ihrer Söhne die Berechtigung + Spoolkommandos (z.B. 'stop' oder 'start') an den Spoolmanager zusen­ + den. Dabei muß die Task auf derselben Station wie der Spool sein und + in der Task muß die Datei "spool cmd", die sich auf dem Standardar­ + chiv befindet, insertiert werden. + Wird "SUPERVISOR" als Spoolkontrolltask eingestellt, so können alle + Tasks der Station, in denen die Datei "spool cmd" insertiert ist, die + Spoolkommandos geben. + + TASK PROC spool control task + Zweck: Liefert die Taskidentifikation der Spoolkontrolltask. + +#ib#server channel#ie# + PROC server channel (INT CONST channel) + Zweck: Mit Hilfe dieser Prozedur wird im Spoolmanager eine Kanalnummer + eingestellt, die der Server mit der Prozedur 'server channel' abfragen + kann. + Fehlerfall: + * falsche Kanalangabe + Der angegebene Kanal ist kleiner als 1 oder größerer als 32. + + INT PROC serverchannel + Zweck: Liefert die Nummer des Kanals, der im Spool eingestellt ist. + +#on("b")#Anmerkung:#off("b")# Soll im nicht-privilegierten Ast des Taskbaums (Söhne von "PUBLIC") ein + Spool eingerichtet werden, so muß dort die Datei "spool manager", die + sich auf dem Standardarchiv "std.zusatz" befindet, insertiert werden. + + + + +#ib(9)##ib#Spoolkommandos#ie##ie(9)# + + +Ein Spool kann zur Verwaltung der Warteschlange wie jede andere Task ans Termi­ +nal gekoppelt werden. Danach stehen die folgenden Spoolkommandos zur Verfügung. +Diese Kommandos sind keine Prozeduren, sondern werden nur interpretiert. Sie dürfen +also nur alleine eingegeben werden. Nach Beendigung der Verwaltungsaufgaben muß +der Spool mit dem Kommando 'break' verlassen werden, da sonst keine weiteren +Aufträge an den Spool gesendet werden können und auch die Warteschlange nicht +weiter abgearbeitet wird. + +#ib#stop#ie# + Zweck: Die Server-Task wird gelöscht und dadurch der Spool deaktiviert. Der + Spool empfängt zwar noch weitere Aufträge und sortiert diese in die + Warteschlange ein. Die Warteschlange wird aber nicht weiterabgearbei­ + tet. Ein eventuell von der Server-Task belegter Kanal wird freigegeben. + Ist bei einem 'stop' noch ein Auftrag in Bearbeitung, so wird dieser + Auftrag abrupt abgebrochen. Es wird jedoch angefragt, ob der Auftrag + nochmal neu an die erste Stelle in der Warteschlange eingetragen wer­ + den soll. + Ist ein Spool deaktiviert, so wird dies bei einem 'list' angezeigt, + +#ib#halt#ie# + Zweck: Der Spool deaktiviert sich nach Abarbeitung des Auftrags, der gerade + bearbeitet wird. Bei einem 'list' wird dies vermerkt. + +#ib#start#ie# + Zweck: Der Spool wird aktiviert, indem eine neue Server-Task begonnen wird. Ist + der Spool zuvor nicht gestoppt worden, so wird zuerst ein 'stop' durch­ + geführt. + Wurde mit der Prozedur 'server channel' kein Kanal eingestellt, so wird + die Warnung + WARNUNG : Serverkanal nicht eingestellt + ausgeben. Der Spool wird trotzdem gestartet. + +start (kanal nummer) + Zweck: Vor dem Start des Spools wird zuerst mit der Prozedur 'server channel' + der angegebene Kanal eingestellt. + +#ib#first#ie# + Zweck: Im Dialog kann ein Auftrag in der Warteschlange auf den ersten Platz + vorgezogen werden. + +#ib#killer#ie# + Zweck: Im Dialog werden alle Aufträge der Warteschlange zum Löschen ange­ + boten. + +#ib#list spool#ie# + Zweck: Der aktuelle Zustand des Spools und die Warteschlange werden geli­ + stet. + +Ist nun eine Spoolkontrolltask eingestellt worden (siehe 'spool control task'), so muß in +ihr die Datei "spool cmd" insertiert werden. Danach stehen die folgenden Prozeduren +zur Verfügung. + +#ib#stop#ie# + PROC stop (TASK CONST spool) + Zweck: Dem Spool 'spool' wird ein 'stop' zugestellt, was den Spool deaktiviert. + Wird noch ein Auftrag bearbeitet, so wird angefragt, ob dieser neu + eingetragen werden soll. + +#ib#halt#ie# + PROC halt (TASK CONST spool) + Zweck: Dem Spool 'spool' wird ein 'halt' zugestellt, d.h der Spool deaktiviert + sich nach Beendigung des aktuellen Auftrags. + +#ib#wait for halt#ie# + PROC wait for halt (TASK CONST spool) + Zweck: Dem Spool 'spool' wird ein 'halt' zugestellt. Die Task wartet jedoch auf + eine Rückantwort, die ihr der Spool sendet, wenn er sich nach Been­ + digung des aktuellen Auftrags deaktiviert hat. + Fehlerfall: + * Task "task name" wartet schon auf halt + Die angegebene Task wartet schon auf eine Rückantwort des Spools + 'spool'. + +#ib#start#ie# + PROC start (TASK CONST spool) + Zweck: Dem Spool 'spool' wird ein 'start' zugestellt, wodurch der Spool sich + aktiviert. War der Spool zuvor nicht deaktiviert, so wird er zuerst ge­ + stoppt. + +#ib#first#ie# + PROC first (TASK CONST spool) + Zweck: Im Dialog kann einer der Aufträge in der Warteschlange des Spools + 'spool' auf den ersten Platz vorgezogen werden. + +#ib#killer#ie# + PROC killer (TASK CONST spool) + Zweck: Im Dialog werden die Aufträge der Warteschlange des Spools 'spool' + zum Löschen angeboten. + + + +#ib(9)#Arbeitsweise des #ib#Servers#ie##ie(9)# + + +Der Server wird vom Spoolmanager mit einer Prozedur gestartet, die die Abarbeitung +der Warteschlange vornimmt. Dabei muß diese Prozedur zuerst den Datenraum mit +dem 'fetch code' (= 11) holen. Danach kann der Server sich noch mit dem 'fetch +param code' (= 21) die Dateiparameter (Dateiname, Schreib- und Lesepaßwort, Sen­ +dername und Senderstation) abholen und mit der Bearbeitung des Auftrags beginnen. + +Beispiel: + + +LET fetch code = 11, + param fetch code = 21; +BOUND STRUCT (TEXT name, write pass, read pass, sendername, + INT senderstation ) VAR msg; +DATASPACE VAR ds, param ds; +INT VAR reply; + +spool manager (PROC server); + +PROC server : + disable stop; + continue (server channel); + REP forget (ds); ds := nilspace; + call (father, fetch code, ds, reply); + forget (param ds); param ds := nilspace; + call (father, param fetch code, param ds, reply); + msg := param ds; + execute spool; + IF is error THEN error treatment FI; + PER; +END PROC server; + +PROC execute spool : + enable stop; + ... + + + + + +#ib(9)#Senden eines Auftrags an den Spool#ie(9)# + + +Jede Task kann jedem Spool durch Aufruf von '#ib#save#ie#' eine Datei senden. + +Beispiel: + + + save ("datei name", task ("spool name")) + + +Dieses 'save'-Kommando funktioniert zweiphasig. Dabei wird in der ersten Phase dem +Spool die Dateiparameter zugesendet. In der zweiten Phase folgt dann der Datenraum +selber. Bei Netzübertragung zu einem Spool ist dieses zweiphasige 'save' jedoch +nachteilig. Deshalb können Dateien vom Typ 'FILE' auch mit einem einphasigen 'save' +unter dem 'file save code' (= 22) an den Spool gesendet werden. Die #on("i")#'headline'#off("i")# dieser +Dateien muß jedoch dann auf eine bestimmte Art und Weise aufbereitet werden, so +daß sie die Dateiparameter enthält. Beim Aufbau der #on("i")#'headline'#off("i")# muß eine Information +muß mit dem Code 0 beginnen und dem Code 1 enden. Die Dateiparamter müssen +dann mit der folgenden Reihenfolge in die #on("i")#'headline'#off("i")# eingetragen werden. + + - Dateiname + - Schreibepaßwort + - Lesepaßwort + - Name des Senders + - Station des Senders + +Beispiel: + + +... +LET file save code = 22; +DATASPACE VAR ds := old (file name); +FILE VAR file := sequential file (input, ds); +INT VAR reply; +headline (file, ""0"" + file name + + ""1""0"" + write password + + ""1""0"" + read password + + ""1""0"" + name (myself) + + ""1""0"" + text (station (myself)) + ""1""); +call (spool task, file save code, ds, reply); +... + + +Der Spoolmanager setzt bei Dateien, die mit dem 'file save code' angeliefert werden +die #on("i")#'headline'#off("i")# wieder auf den Dateinamen. + +Den Benutzer stehen neben dem '#ib#save#ie#'-Kommando zur Übertragung einer Datei zum +Spool noch die folgenden Kommandos zur Verfügung. + + + save (ALL myself, task ("spool name")) + save (SOME myself, task ("spool name")) + + übertragung aller bzw. einiger Dateien der eigenen Task zum Spool. + + + #ib#erase#ie# ("datei name", task ("spool name")) + erase (ALL task ("spool name"), task ("spool name")) + + Löschen eines bzw. aller eigenen Aufträge in der Warteschlange des Spools + + + #ib#list#ie# (task ("spool name")) + + Liste des Spools über den aktuellen Zustand und die Warteschlange. + +Existiert ein Spool "PRINTER", so gibt es noch die folgenden Befehle. + + + #ib#print#ie# + print ("datei name") + print (ALL myself) + print (SOME myself) + + Sie entsprechen einem 'save' an die Task "PRINTER" + + + #ib#printer#ie# + + Liefert den internen Taskbezeichner der Task "PRINTER", d.h. diese Proze­ + dur entspricht dem Aufruf von 'task ("PRINTER")'. + + + + + +#ib(9)#8.2. #ib#Freie Kanäle#ie(9)##ie# + + +Das Paket '#ib#free channel#ie#' ermöglicht in Multi-User-Systemen die Einrichtung freier +Kanäle. Freie Kanäle kann man zusätzlich zu dem Terminalkanal, der einem vom +Supervisor zugeordnet wurde, benutzen. Jeder freie Kanal wird durch eine (benannte) +Task - dem #ib#Kanalmanager#ie# - implementiert. Er wird danach mit dem Tasknamen ange­ +sprochen und kann von jeder Task belegt und wieder freigegeben werden. Während +einer Belegung können andere Tasks den Kanal nicht benutzen. Der Kanalmanager +koppelt sich für jede Belegung an den physikalischen Kanal an und gibt ihn danach +auch wieder frei. Ein physischer Kanal kann also im Wechsel von mehreren Kanalma­ +nagern oder einem Kanalmanager und "normalen" Tasks belegt werden. + +Das Paket 'free channel' muß beim Kanalmanager und allen Benutzern des Kanals +bzw. bei einem gemeinsamen Vater insertiert sein. + + +#ib#FCHANNEL#ie# + Zweck: Der Datentyp FCHANNEL spezifiziert einen freien Kanal. Die Assoziie­ + rung mit einem realen freien Kanal erfolgt mit der Prozedur 'free chan­ + nel' und der Zuweisung ':=' (ähnlich wie beim Datentyp FILE). + +:= + OP := (FCHANNEL VAR dest, FCHANNEL CONST source) + Zweck: Zuweisung. Wird insbesondere bei der Assoziation (Assoziation: Verbin­ + dung zwischen FCHANNEL VAR und Kanal) benötigt. + +#ib#close#ie# + PROC close (FCHANNEL VAR f) + Zweck: Der belegte FCHANNEL wird freigeben. + + PROC close (TEXT CONST channel name) + Zweck: Der namentlich spezifizierte Kanal wird freigegeben. + +#ib#dialogue#ie# + PROC dialogue (FCHANNEL CONST f, TEXT CONST end of dialogue char) + Zweck: Der Terminalkanal wird direkt mit dem angegebenen freien Kanal ge­ + koppelt. (Das Benutzerterminal wird "durchgeschaltet".) Eingaben am + Terminal werden auf 'f' ausgegeben, auf 'f' ankommende Daten werden + auf dem Benutzerterminal ausgegeben. Der Datenverkehr erfolgt im + #ib#Vollduplexmodus#ie#, d.h. der Datenverkehr beider Richtungen läuft unab­ + hängig voneinander parallel. Hiermit können Terminals dynamisch an + andere Rechner gekoppelt werden. Der Dialogzustand wird durch Ein­ + gabe des 'end of dialogue char' am Benutzerterminal beendet. + +#ib#fetch#ie# + PROC fetch (FCHANNEL VAR channel, TEXT CONST filename, controlchars) + Zweck: Die angegebene datei wird über den Kanal 'channel' eingelesen. Dabei + besteht 'control chars' aus zwei bis vier Zeichen + (eof + eol + handshake + handshake prompt) + eof: + Dieses Zeichen wird als Dateiabschluß erwartet. + eol: + Dieses Zeichen wird als Zeilenende erwartet. + handshake, handshake prompt: + Falls 'handshake prompt <> "" ' ist, wird bei dem Empfang eines + Prompt­Zeichen eine Quittung (Handshake­Zeichen) ausgegeben. + +#ib#free channel#ie# + FCHANNEL PROC free channel (TEXT CONST channel name) + Zweck: Der namentlich spezifizierte Kanal wird belegt und als FCHANNEL + geliefert. + Fehlerfälle: + * task not existing + * channel not free + + PROC free channel (INT CONST physical channel number) + Zweck: Installiert die eigene Task als Kanalmanager für den angegebenen + physikalischen Kanal. + +#ib#in#ie# + PROC in (FCHANNEL CONST f, TEXT VAR response) + Zweck: Es werden die Daten geliefert, die seit dem letzten 'in'­Aufruf bzw. seit + der Assoziierung eingetroffenen Daten geliefert. Bei 'niltext' liegen keine + Eingabedaten vor. + +#ib#open#ie# + PROC open (FCHANNEL VAR f) + Zweck: Der Kanal wird neu belegt. Die Assoziation erfolgt mit dem gleichen + Kanal wie bei der letzten Assoziation. + Fehlerfälle: + * "task" gibt es nicht + * Kanal ist nicht frei + +#ib#out#ie# + PROC out (FCHANNEL VAR f, TEXT CONST message) + Zweck: Der übergebene Text wird auf dem Kanal 'f' ausgegeben. + +#ib#save#ie# + PROC save (FCHANNEL VAR f, TEXT CONST name, control chars) + Zweck: Die übergebene Datei muß eine Textdatei sein (Struktur eines FILEs + haben). Sie wird komplett auf dem Kanal 'f' ausgegeben. + Dabei bestehen 'control chars' aus bis zu drei Zeichen: + (eof char + eol char + handshake option) + eof char: + Dieses Zeichen wird als Dateiabschluß geschickt. + eol char: + Dieses zeichen wird als Zeilenabschluß geschickt. + handshake option: + Falls die 'control chars' drei Zeichen umfassen, wird nach jeder + Zeile auf das als drittes definierte Handshake­Zeichen gewartet. + +Beispiele: + + + a) FCHANNEL VAR f := free channel ("otto") ; + TEXT VAR antwort ; + out (f, "hallo") ; + in (f, antwort) ; + put (antwort) ; + close (f) ; + + b) open (f) ; + REP + out (f, "hallo ") ; + in (f, antwort) + UNTIL antwort <> "" PER ; + put (antwort) ; + close (f) ; + + c) open (f) ; + dialogue (f, "§") ; + close (f) + diff --git a/doc/system-manual/1.8.7/source-disk b/doc/system-manual/1.8.7/source-disk new file mode 100644 index 0000000..13e2021 --- /dev/null +++ b/doc/system-manual/1.8.7/source-disk @@ -0,0 +1 @@ +grundpaket/10_handbuecher.2.img diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil1 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil1 new file mode 100644 index 0000000..cdeca13 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil1 @@ -0,0 +1,924 @@ + EUMEL-Benutzerhandbuch + + TEIL 1: Einführung + +Vorwort + +Lieber EUMEL-Nutzer! + +Ihnen liegt hier das EUMEL-Benutzerhandbuch zur Public-Domain-Version 1.7.3 +vor. Es gliedert sich in mehrere Teile. Der erste Teil des Benutzerhandbuchs +soll dem zukünftigen Benutzer den "Einstieg" in das EUMEL-System erleichtern. +Dazu werden die wichtigsten Eigenschaften des EUMEL-Systems vorgestellt. +Danach zeigen wir eine Beispielsitzung. Anschließend werden einige +prinzipielle Konzepte des EUMEL-Systems vermittelt. Den Abschluß bildet ein +kleines EUMEL-Wörterbuch. + +Die übrigen Teile des EUMEL-Benutzerhandbuchs dokumentieren jeweils ein oder +mehrere abgeschlossene Einheiten des Systems. Ein EUMEL-Nutzer braucht so nur +die ihn interessierenden Teile zu lesen. Ein Programmierer z.B. sollte + + Einführung, Supervisor/Monitor, Editor, ELAN-Compiler und Dateien + +durcharbeiten. Für Programmierer, die noch keine Erfahrung mit ELAN besitzen, +ist der Teil "Erste Hilfe" gedacht. Weiterhin werden die Teile über Dateien +und Standardpakete oft benötigt. Ein Nutzer, der vorwiegend an der Textbe- +und verarbeitung interessiert ist, braucht dagegen nur + + Einführung, Supervisor/Monitor, Dateien, Editor und Textkosmetik. + +Der OPERATOR/Spooler-Teil ist nur für diejenigen Programmierer gedacht, die +ein EUMEL-System betreuen. Weitere Informationen finden System-Programmierer +im System-Handbuch bzw. in der Veröffentlichung des Quellcodes. + + +1. Eigenschaften des EUMEL-Betriebssystems + +Das EUMEL-Betriebssystem (Extendable multi User Microprocessor ELANsystem) +ist ein Betriebssystem, das z.Z. für den Einsatz auf Mikroprozessoren vorge- +sehen ist. Es weist u.a. folgende Eigenschaften auf: + +- Das EUMEL-System ist ein "Time sharing"-Betriebssystem, d.h. mehrere Be- + nutzer können gleichzeitig an einem Rechensystem arbeiten (z.B. Programme + übersetzen, bearbetten (rechnen) oder erstellen (edieren)). Dabei wird die + verfügbare Rechen- und Speicherkapazität zwischen den Benutzer-Prozessen + dynamisch aufgeteilt. + +- Jeder Benutzer richtet (mindestens) eine Task ein, in der er sich Programme + und/oder Dateien halten kann, auf die andere Nutzer nicht zugreifen können. + Tasks können von einem Terminal "abgekoppelt" und trotzdem - sofern aus- + reichend freie Rechnerkapazität zur Verfügung steht - als Batch-Auftrag im + Hintergrund weiter bearbeitet werden. + +- Das EUMEL-Betriebssystem ist so konzipiert, daß der Sicherheit des Systems + besondere Beachtung geschenkt wurde. Zu diesem Zweck werden in bestimmten + zeitlichen Abständen sogenannte Restart-Punkte auf dem externen Speicher- + medium gesichert. In diesen Sicherungen wird der augenblickliche System- + Zustand konserviert, so daß bei Netzausfall oder eventuellen System-Zu- + sammenbrüchen der Betrieb übergangslos wieder aufgenommen werden kann, mit + der Ausnahme des Verlustes der Daten, die nach dem letzten Restart-Punkt + aufliefen. + +- "Tasks" und/oder Dateien können vor dem unbefugten Zugriff durch "Pass- + words" geschützt werden. Ein weitergehender Schutz wird durch die Möglich- + keit von Password-Algorithmen vom EUMEL-System angeboten, so daß den Be- + langen des Datenschutzes Rechnung getragen werden kann. + +- Das EUMEL-Betriebssystem ist leicht erweiterbar. Da der Kern des Betriebs- + systems in ELAN geschrieben ist, können Anwender selbst leicht Erweiterun- + gen bzw. lokale Modifikationen in das System ein- bzw. anfügen. Dabei kön- + nen bestimmte Erweiterungen nur bestimmten Benutzern oder Benutzergruppen + zur Verfügung gestellt werden. Da die Programmiersprache ELAN selbst er- + weiterbar ist, ist es möglich, verschiedenen Anwendern oder -gruppen unter- + schiedliche Erweiterungen der Sprache anzubieten. + +- In dem EUMEL-Betriebssystem ist eine implizite Dateihierarchie realisiert. + Dies wird erreicht, indem den Tasks Dateien zugeordnet werden. Man kann + Dateien im Taskbaum von "Vater-Tasks" holen oder zu ihnen schicken. Lokale + Dateien werden mit dem Beenden einer Task automatisch gelöscht, während + Dateien, die längerfristig gehalten werden sollen, bei längerlebenden Tasks + gehalten werden müssen. + +- Die Kommandosprache ("job control language") des EUMEL-Systems entspricht + der ELAN-Syntax (Prozeduraufrufe). Das befreit den Anwender von der + Schwierigkeit, zwei verschiedenartige Sprachen zu erlernen. Darüber hinaus + können eine oder mehrere Anweisungen der Kommandosprache in ELAN-Programmen + enthalten sein. Z.B. ist es möglich, Kommandos vom Editor ausführen zu + lassen oder den Editor von einem Programm aus aufzurufen. + +- Die Dienstprogramme des EUMEL-Systems, wie z.B. der EUMEL-Editor, sind + geräteunabhängig und meist erweiterbar konzipiert. Zudem sind sie auch in + ELAN formuliert, so daß Änderungen und Korrekturen leicht vorgenommen + werden können. + +- Das EUMEL-System verwaltet seinen Hauptspeicher nach dem "demand-paging"- + Prinzip. Daten und/oder Programme werden daher in Seiten von 512 Bytes + aufgeteilt. Nur diejenigen Seiten, die zu einem Zeitpunkt wirklich benötigt + werden, befinden sich im Speicher. Dadurch kann sich das EUMEL-System auf + wechselnde Speicherplatz-Anforderungen optimal einstellen. + +- Für alle Programme wird reentranter Code erzeugt. Somit können mehrere + Benutzer Code gleichzeitig benutzen ("sharable code"), wobei der Code nur + einmal vorhanden sein muß. Dies ist insbesondere für Dienstprogramme wie + z.B. Compiler, Editor usw. wichtig. + +- Dateien können ebenfalls (wie Programme) von mehreren Benutzern gemeinsam + verwendet werden, ohne daß mehrere Kopien davon hergestellt werden müssen + Das System sorgt mit seinen Paging-Fähigkeiten automatisch für das "sharen" + von Dateien. Erfolgt jedoch ein Schreibzugriff, so wird nur für den + schreibenden Benutzer eine Kopie angelegt. + +- Das EUMEL-System bietet gute Textbe- und -verarbeitungsmöglichkeiten. + Grundlage dafür ist der bildschirmorientierte Editor (eine Entwicklung der + GMD). Der Editor erlaubt auch ein "multi window editing" und die Ausführung + von beliebigen Kommandos. Zusätzlich gibt es eine Reihe von Programmen zur + "Textkosmetik", die es erlauben, Texte zeilen- und seitenweise zu forma- + tieren. Dabei ist es möglich, unterschiedliche Schriftarten zu verwenden. + + +2. Eine kleine Beispielsitzung mit EUMEL + +Zum ersten Kennenlernen wird hier ein Beispiel einer EUMEL-Sitzung darge- +stellt. Diese Vorlage kann man am Rechner "nachspielen". Da die Reaktion des +Systems hier auf dem Papier nur unvollkommen wiedergegeben werden kann, ist +diese Beispielsitzung durch "trockenes" Lesen (ohne Rechner) sicherlich etwas +schwieriger zu verstehen als durch Nachspielen. + +Alle Ausgaben des EUMEL werden mit + +----> + +gekennzeichnet, alle Benutzereingaben haben + +<---- + +als Kennzeichen. Spezielle Tasten werden groß geschrieben, z.B. + + RETURN + +als Bezeichnung für die RETURN-Taste. + + +Anfang + +Im Multi-User-System können gleichzeitig mehrere Benutzer aktiv sein. Dabei +braucht jeder ein eigenes "Zimmer" im "EUMEL-Haus", in dem er arbeiten kann, +ohne andere zu stören. Diese "Zimmer" heißen hier "Tasks" und haben Namen. +Zu Beginn muß der Benutzer sich an seinem Bildschirm eine Task erzeugen. Dazu +muß er das Betriebssystem aktivieren: + +<---- SV + +EUMEL meldet sich: EUMEL Version 1.7.3/M + +----> gib supervisor kommando: + +Dann muß der Benutzer sich einen Tasknamen ausdenken (z.B. "ottokar") und +ein Kommando zum Einrichten einer neuen Task geben: + +<---- begin ("ottokar") RETURN + +Daraufhin wird eine neue Task erzeugt, sie meldet sich: + +----> gib kommando: + +Jetzt kann die eigentliche Sitzung beginnen. + + +Programm erstellen + +Wir schreiben ein kleines Programm zur Primzahlberechnung: + +<---- edit ("prim") RETURN + +----> neue datei einrichten (j/n) ? + +<---- j + +Es soll eine neue Datei mit dem Namen 'prim' eingerichtet werden, daher ant- +worten wir mit 'j'. Die Datei ist zu Anfang leer. Der Editor zeigt nur die +Überschrift, der restliche Bildschirm ist leer. Wir können jetzt unser Pro- +gramm eingeben: + + INT VAR zahl := 3 ; + WHILE zahl <= 1000 REP + drucke falls primzahl ; + zahl INCR 2 + PER . + + drucke falls primzahl : + INT VAR teiler := 3 ; + WHILE teiler * teiler <= zahl REP + IF teiler gefunden + THEN LEAVE drucke falls primzahl + FI ; + teiler INCR 2 + PER ; + put (zahl) ; + line . + + teiler gefunden : + zahl MOD teiler = 0 . + +Bei der Eingabe des Programms können wir auch die Funktionstasten benutzen. +Die genauen Funktionen sind in den folgenden Teilen des Benutzerhandbuchs +erklärt. Für den Anfang gilt aber: Probieren geht über Studieren! + +Wir verlassen den Editor: + +<---- ESC q + +----> gib kommando: + + +Programm übersetzen und ausführen + +<---- run RETURN + +----> ("prim") + +Der Dateiname ('prim') wird automatisch ergänzt und das Programm wird vom +ELAN-Compiler übersetzt. Dabei erscheinen die Nummern der gerade übersetzten +Zeilen in der linken unteren Bildecke. Wenn keine Fehler gefunden wurden, +wird das Programm anschließend ausgeführt. Dann sollten die Primzahlen von +3 bis 1000 erscheinen. + + +Ein fehlerhaftes Programm korrigieren + +Falls der ELAN-Compiler Fehler findet, wird das Programm nicht ausgeführt. +Das System geht automatisch in den Editor, der jetzt zwei Dateien "parallel" +auf dem Bildschirm zeigt. Die obere enthält die Fehlermeldungen, die untere +das ELAN-Programm, so daß Korrekturen leicht möglich sind. Dabei kann man gut +folgende Editor-Funktionen benutzen (ausprobieren!): + + ESC ESC n RETURN positioniert auf Zeile n + + HOP UNTEN + zum Blättern + HOP OBEN + + ESC w wechselt zur jeweils anderen Datei (z.B. um in der + Fehlermeldungsdatei weiterzublättern) + +Nach Verlassen des Editors (ESC q) kann das Programm wieder gestartet werden. + + +Ändern des Programms + +<---- edit RETURN + +----> ("prim") + +Auch hier wird der Dateiname zum Kommando 'edit' automatisch ergänzt. Jetzt +kann das Programm mit den üblichen Editor-Möglichkeiten verändert werden. +Vorschläge: + + - Man ändere den Bereich (Vorsicht: maxint ist 32767). + - Man teste die Teiler bis zur Zahl selbst hoch. + - Man benutze REALs anstelle von INTs. + - Man suche Zwillinge. + +An Editor-Möglichkeiten könnte man ausprobieren: + + RUBOUT löscht ein Zeichen. + + RUBIN schaltet den Einfügezustand ein. Das nächste RUBIN + schaltet ihn wieder ab. + + HOP UNTEN zum Anfang des Bildschirms oder "blättern nach oben". + + HOP OBEN zum Ende des Bildschirms oder "blättern nach unten". + + HOP RUBOUT am Zeilenanfang löscht die ganze Zeile. + + HOP RUBIN schaltet "Zeilen einfügen" ein. Das nächste HOP RUBIN + schaltet es wieder aus. + + +Datei löschen + +<---- forget RETURN + +----> ("prim") + +----> löschen (j/n) ? + +<---- j + +----> gib kommando: + + +Ende einer Sitzung + +<---- end RETURN + +----> task loeschen (j/n) ? + +<---- j + +----> EUMEL Version 1.7.3 / M + + + +3. Einige Eigenschaften des EUMEL-Systems + +In diesem Abschnitt werden wir einige Eigenschaften des EUMEL-Systems +schildern, die zum korrekten Arbeiten mit dem System wichtig sind. Um das +Verständnis zu erleichtern, verwenden wir für einige System-Eigenschaften +Modelle, die das Verhalten des Systems an typischen Merkmalen widerspiegeln +spiegeln sollen, die aber - wie bei allen Modellen - kein exaktes Abbild +darstellen. + + +Tasks, Supervisor und Monitor + +Zuerst versuchen wir zu erklären, wie sich ein Benutzer im EUMEL-System +anmeldet und den Mechanismus, wie man bestimmte Leistungen vom System +anfordert (Einige Ideen dieses ersten Abschnittes gehen auf W. Ambros, +Rhein-Sieg Gymnasium, St. Augustin, zurück). + +Stellen wir uns das EUMEL-System als ein riesiges Verwaltungsgebäude vor, +wie es in unseren Städten in den letzten Jahren überall gebaut wurde. Ein +Verwaltungsangestellter beginnt frohgemut seinen ersten Arbeitstag. Da das +Gebäude so riesig ist, kann er sein Zimmer nicht finden. Aber er ist pfiffig: +er fragt einfach den freundlichen Pförtner, der ihn in sein Zimmer führt. + +So ist es im EUMEL-System: +Wenn man eine Arbeit neu beginnen will, muß man sich beim Supervisor (das ist +der Pförtner in unserem Modell) anmelden. Dazu muß man erstmal den Supervisor +"wecken" (wie mit einer Klingel): wir drücken die Supervisor-Taste (im +folgenden mit SV abgekürzt). Der Supervisor meldet sich dann mit + + gib supervisor kommando : + +Nun kann man eine Task anmelden. Das ist ein Zimmer im EUMEL-System, in dem +man arbeiten kann, ohne von den anderen Benutzern gestört zu werden. Ist die +Task noch nicht vorhanden, wird sie eingerichtet. Dann leitet uns der Super- +visor in die angegebene Task. + +Der Verwaltungsangestellte ist nun vom Pförtner zu seinem Büro geleitet +worden. Dort empfängt ihn der Bürovorsteher: "Was möchten Sie arbeiten?" +Unser Angestellter kann nun (z.B.) sagen, daß er etwas schreiben möchte. Der +Bürovorsteher führt ihn in einen speziellen Schreibraum, in dem einige +spezielle Einrichtungen und Geräte für komfortables Schreiben stehen. + +So sieht es im EUMEL-System aus: +Nachdem man eine neue Task eingerichtet hat oder eine bereits vorhandene +fortsetzen will, gelangt man zum Monitor (das ist unser Bürovorsteher), der +sich mit + + gib kommando : + +meldet. Nun kann man verschiedene Arbeiten verrichten, wie z.B. den Editor +rufen, um einen Text oder ein Programm zu schreiben: + + edit ("meine datei") + +In diesem Schreibzimmer kann unser Angestellter irgendetwas schreiben, z.B. +ein Programm, einen Liebesbrief, ein Testament oder ganz etwas anderes. Hat +er eine Frage oder will er eine besondere Leistung, dann kann unser Ange- +stellter den Bürovorsteher aus dem Schreibzimmer rufen. Hat er seine Schreib- +arbeit beendet, geht er aus dem Zimmer und trifft dort wiederum auf den auf- +merksamen Vorsteher. Ihm kann er nun sagen, daß er das Schriftstück (z.B.) +drucken oder von einem Dolmetscher übersetzen lassen will. + +Im EUMEL-System: +Im Editor schreibt man Texte oder Programme. Während man im Editor ist, kann +man besondere Leistungen durch Kommandos anfordern, ohne den Editor zu ver- +lassen, z.B. in einer anderen Datei nachschauen oder einen Teiltext in dem +geschriebenen Schriftstück suchen. Nachdem die Arbeit beendet ist, verläßt +man den Editor (ESC q) und gelangt wiederum in den Monitor. Hier kann man +das Schriftstück drucken oder - im Falle eines Programms - übersetzen lassen: + + print ("meine datei") + run ("meine datei") + +Hat das Programm einen Fehler, eröffnet uns der Monitor ein Fenster auf die +Datei und zeigt uns gleichzeitig die Fehlermeldungen, so daß wir bequem +korrigieren können. + +Nachdem unser Angestellter mit seinen Arbeiten fertig ist, kann er dem Vor- +steher (Monitor) sagen: + + Ich kündige! (will nicht mehr weiterarbeiten) ('end') + Bis Morgen! (will später weiterarbeiten) ('break') + +Merke: Der Supervisor des EUMEL-Systems regelt die Einrichtung, Zugang und + Löschung von Tasks. In einer Task kann ein Benutzer arbeiten, ohne + von anderen gestört zu werden. Spezielle Tasks sind für allgemeine + Aufgaben vorgesehen, wie z.B. das Drucken und Sichern von Dateien. + Durch den Monitor kann man Kommandos innerhalb einer Task geben. + + +Demand Paging + +Nun versuchen wir einen zentralen Begriff des EUMEL-Systems zu erklären, das +"demand paging". Diese Eigenschaft moderner Rechensysteme sorgt dafür, daß +bei (normalerweise immer) beschränkten Speicherkapazitäten eines Rechners +Programme bearbeitbar sind, die in ihrer Gesamtgröße nicht in den Speicher +des Rechners passen würden. + +Nehmen wir wieder den Angestellten, der nun in einem Zimmer (Task) auf einem +Tisch das EUMEL-Benutzerhandbuch durcharbeiten will. Stellen wir uns weiter +vor, daß er das Benutzerhandbuch nicht rein "sequentiell" lesen will, sondern +daß er fortwährend "blättern" muß. Eigentlich muß unser Angestellter mehrere +Seiten des Benutzerhandbuchs gleichzeitig lesen. Deshalb kommt er auf die +listige Idee, die Seiten, die er dringend benötigt, zu photokopieren und auf +seinem Tisch nebeneinander auszubreiten, damit er nicht mehr blättern muß. +Leider ist sein Tisch zu klein, um alle photokopierten Seiten darauf auszu- +breiten. Durch die Sparbemühungen der Regierung ist es auch aussichtslos, +sich um einen größeren Tisch zu bemühen. Aber im Titel für Verbrauchsmaterial +ist genügend Geld vorhanden, so daß Papier für den Photokopierer angeschafft +werden kann. Außerdem geht das Photokopieren sehr schnell, weil er den Photo- +kopierer direkt neben seinen Tisch aufbaut. Darum photokopiert er nur die- +jenigen Seiten, die er gerade benötigt und legt diese auf seinen Tisch. +Braucht er eine neue Seite aus dem Buch und hat diese auf dem Schreibtisch +keinen Platz mehr, so muß er eine auf dem Tisch liegende Seite entfernen. +Geschickt wählt sich unser Angestellter eine Seite aus, von der er annimmt, +daß er diese nicht so schnell wieder benötigt. + +Was macht er nun mit der "alten" Seite? Er könnte die kopierte Seite einfach +in das Benutzerhandbuch einordnen. Aber dazu müßte er erstmal in dem Benut- +zerhandbuch suchen, was ihm zuviel Mühe macht. Deshalb wirft er diese Seite +einfach weg, denn er kann sie ja jederzeit wieder aus dem Handbuch kopieren. + +Gerade will er eine Seite wegwerfen, da fällt ihm auf, daß er das "Wegwerf"- +Verfahren vielleicht nicht immer anwenden sollte. Seine Notizen, die er sich +auf einigen Seiten gemacht hat, würden ja mit weggeworfen und damit ver- +nichtet. Deshalb wirft er Seiten mit Notizen nicht weg, sondern tauscht diese +Seiten mit den ursprünglichen Seiten im Benutzerhandbuch aus. + +Fassen wir zusammen: +Jemand arbeitet ein Buch "durch". Er kopiert sich diejenigen Seiten, die er +jeweils benötigt. Da sein Tisch zu klein ist, um alle Seiten gleichzeitig +auszulegen, kann er immer nur einen Ausschnitt aus dem Buch bearbeiten, was +aber ausreicht. Braucht er eine neue Seite, so muß er eine auf dem Tisch +liegende Seite "verdrängen". Hat er diese Seite nicht verändert, also mit +Notizen versehen, so kann er sie einfach wegwerfen. "Veränderte" Seiten +ersetzt er im Buch und bewahrt sie somit auf. + +Ähnliches erfolgt auch im EUMEL-System: +Der Zentralspeicher (der Tisch in unserem Modell) des Rechners ist meist ge- +genüber dem Massenspeicher, der im EUMEL-System auch als "Hintergrund" be- +zeichnet wird (Floppy oder Magnetplatte; in unserem Modell das Buch) zu +klein, als daß alle Informationen gleichzeitig hineinpassen würden. Darum +werden alle Informationen in sogenannte Seiten ("pages") unterteilt, die +jeweils 512 Byte (ein Byte entspricht einem Zeichen) groß sind. Wird eine +Information benötigt, so wird die betreffende Seite in den Speicher geholt +(daher auch der Begriff "demand paging", etwa: Seitenaustausch auf An- +forderung). Das geht so lange gut bis der gesamte Platz im Zentralspeicher +des Rechners belegt ist. Soll nun eine neue Seite vom Massenspeicher geholt +werden, weil die darin enthaltenen Informationen gebraucht werden, muß eine +Seite im Zentralspeicher ersetzt werden (Fachwort: die Seite muß "verdrängt" +werden). Sie kann überschrieben werden (in unserem Modell wurde sie "wegge- +worfen"), wenn keine Veränderungen vorgenommen wurden, d.h. keine Schreibzu- +griffe, sondern nur Lesezugriffe auf die Seite erfolgten. Wurde die Seite +verändert, so muß sie auf den Hintergrund zurückkopiert werden und dort die +ursprüngliche Seite ersetzen. + + +Merke: Die Vorteile eines "demand paging" Systems sind nun offensichtlich: + Es ist möglich, bei weitem größere Informationsmengen (Daten und/oder + Programme) zu bearbeiten als diejenige, die eigentlich in den vor- + handenen Speicher passen würde, weil tatsächlich immer nur ein Aus- + schnitt der gesamten Informationsmenge zu einem Zeitpunkt bearbeitet + werden muß. Bei traditionellen Systemen ist dagegen die maximale Größe + von Programmen und Daten durch die physikalische Größe des Zentral- + speichers beschränkt. + + +Sharing + +Sharing bezeichnet die gemeinsame Nutzung von Seiten ("pages") durch mehr +als einen Benutzer. + +Zurück zu unserem Angestellten: Dieser ist inzwischen fleißiger geworden und +hat das gleiche Verfahren auf mehrere Bücher ausgedehnt, d.h. er kopiert sich +diejenigen Seiten aus den Büchern, die er gerade benötigt. Bei der Ver- +drängung einer Seite behält er sein altes (nicht sehr umweltfreundliches) +Verfahren bei: nur die veränderten Seiten ersetzen die Original-Seiten in den +Büchern (werden zurückgelegt), die anderen (nicht veränderten) weggeworfen. + +Aber auch andere Angestellte seines Büros haben ihn beobachtet, beneiden ihn +um seine "geschickte" Arbeitstechnik und wollen mitarbeiten. Leider steht +ihnen gemeinsam nur der eine Tisch zur Verfügung, der zudem in der Zwischen- +zeit auch nicht größer geworden ist, weil die Sparmaßnahmen der Regierung +noch immer anhalten. Darum müssen sie sich nun den einzigen Tisch teilen, auf +dem sie ihre kopierten Seiten auslegen können. + +Im Laufe der Arbeit ergibt es sich, daß sie unterschiedliche Seiten der +Bücher durcharbeiten müssen, weil sie verschieden schnell arbeiten, aber auch +andere Arbeitsgebiete haben. + +Durch die unterschiedliche Arbeitsgeschwindigkeit ergibt es sich, daß ein +Angestellter z.B. zu einem Zeitpunkt sich intensiv nur mit einer Seite be- +schäftigt, ein anderer aber mehrere Seiten quasi gleichzeitig braucht. Aber +oft brauchen mehrere Angestellte mehrere Seiten, so daß der verfügbare Platz +auf dem Tisch bald etwas zu eng wird. Natürlich "funktioniert" unser Ver- +fahren immer noch, aber es ist doch etwas langsam geworden, weil unsere +Angestellten mehr mit dem Austausch von Seiten beschäftigt sind, als daß sie +noch zu dem Verarbeiten der gelesenen Informationen kommen. Sie überlegen +also, wie das Verfahren zu verbessern ist und kommen auf folgenden Trick: +kopierte Seiten, die zwei oder mehr Angestellte zur gleichen Zeit bearbeiten +wollen, brauchen nur einmal auf dem Tisch zu liegen (schließlich sind unsere +Angestellten gewöhnt, in Gruppen zu arbeiten). Diese Rationalisierungs-Idee +ist ja offensichtlich, denn schließlich benutzen die Angestellten die Bücher +auch gemeinsam. Aber Vorsicht: wenn einer der Angestellten, die gemeinsam +eine Seite bearbeiten, sich etwas auf dieser Seite notieren will, darf nicht +die gemeinsam auf dem Tisch liegende Seite verwendet werden. In diesem Fall +ist es notwendig, vorher eine erneute Kopie zu machen, weil andere Ange- +stellte seine Notizen nicht unbedingt mitlesen sollen, also die unveränderte +Seite brauchen. + +Und das findet im Rechner statt: +Das "demand paging" Verfahren funktioniert natürlich nicht nur mit einer +Datei und einem Programm, sondern auch mit mehreren Dateien und Programmen, +von denen nur diejenigen Seiten in den Zentralspeicher geholt werden, die zu +einem Zeitpunkt in den Rechner passen. Aber erst mit mehreren Benutzern des +EUMEL-Systems entfaltet das "demand paging" Verfahren seine volle Mächtig- +keit, denn alle Benutzer können Programme und/oder Dateien verarbeiten, die +in der Gesamtheit nicht in den Speicher passen würden. Dabei wird eine Eigen- +schaft des EUMEL-Systems gut genutzt: Alle Programme des EUMEL-Systems (und +übrigens alle Programme, die der ELAN-Compiler übersetzt hat) sind reentrant, +d.h. können von mehreren Benutzern gleichzeitig gelesen werden, aber brauchen +nur einmal im Zentralspeicher vorhanden zu sein. Zwei oder mehr Benutzer +können also eine oder mehrere Seiten gemeinsam verwenden (Fachausdruck: +"sharen"), sowohl im Zentralspeicher wie auch im Massenspeicher ("Hinter- +grund"). Dies gilt nicht nur für Programme, sondern auch für Daten. Erst +wenn ein Benutzer eine Veränderung vornimmt, also schreibend auf die Seite +zugreift, wird diese Seite (nur für diesen Benutzer!) kopiert (EUMEL-Fachaus- +druck: "copy on write"). Alle anderen Benutzer arbeiten mit der unveränderten +Seite weiter. Der große Vorteil dieses Verfahrens: eine redundante +Speicherung von Daten und Programmen wird vermieden. + +Es passiert nun oft, daß ein Benutzer zu einem Zeitpunkt relativ wenig Seiten +benötigt: sei es, daß er Daten mit Hilfe des Editors eingibt oder nachdenkt, +sei es, daß ein Programm wenig Daten verwendet und selbst sehr kurz ist. Mit +anderen Worten: die Anzahl der benötigten Seiten zu einem Zeitpunkt (Fachaus- +druck: "working set") für diesen Benutzer ist klein. Dann ist es möglich, daß +andere Benutzer zu diesem Zeitpunkt mehr Seiten im Zentralspeicher des Rech- +ners haben. Deren "working set" ist also groß. + +Merke: Damit wird ein weiterer Vorteil des "demand paging" Verfahrens klar: + Ein "demand paging" System stellt sich automatisch und dynamisch auf + die Anforderungen von Benutzern ein, indem denjenigen Benutzern mehr + Speicher zugeteilt wird, die mehr benötigen und umgekehrt. Aber auch + ein Nachteil wird sichtbar: Benötigen alle Benutzer des Systems viel + Zentralspeicher, dann kann es zu folgender Situation kommen: Benutzer + A benötigt eine neue Seite. Das System verdrängt für diesen Zweck eine + Seite, die Benutzer B gehört. Nachdem Benutzer B an die Reihe kommt, + benötigt er diese Seite wieder. Das System verdrängt eine Seite des + Benutzers A u.s.f.. Eine solche Situation, in der "pages" ständig in + den Speicher kopiert und aus dem Speicher bei einer Seitenverdrängung + auf den Hintergrund geschrieben werden muß (und somit kaum gerechnet + wird), wird als "thrashing" bezeichnet. "thrashing" oder mit anderen + Worten: sehr geringer Verbrauch an Rechenzeit bei gleichzeitig er- + höhtem "paging"-Aufwand ist ein Anzeichen für zu hohe Anforderungen + an das System (Ausweg: Erweiterung des Hauptspeichers oder Be- + schleunigung des Hintergrundmediums (Platte statt Floppy) oder + Reduktion der Anforderungen). + + +Datenräume + +Datenräume sind die Grundlage für Dateien im EUMEL-System. + +Zurück zu unseren Angestellten: +Nachdem die Verbesserung vorgenommen wurde, daß sich zwei oder mehr Ange- +stellte eine Seite auf dem Tisch "teilen", tritt sofort ein neues Problem +auf. Es kann nun nämlich passieren, daß zwei Angestellte eine Original-Seite +verändern und beide in dem gleichen Buch ersetzt werden müssen. Es befinden +sich somit noch mindestens zwei andere mit Notizen versehene Seiten mit +gleicher Seitennummer in einem Buch. Zu allem Unglück wurde die Original- +Seite ersetzt, so daß andere Angestellte nur die mit Notizen versehene Seiten +erhalten können. Was ist zu tun? Das Verfahren sollte doch beibehalten +werden, denn schließlich ist eine totale Abkehr von Arbeitsvorgängen für +Verwaltungsangestellte nicht denkbar. + +Als erste Idee kommt ihnen in den Sinn, einfach alle Bücher für alle Ange- +stellten zu photokopieren. Dann kann es ja nicht zu einer solchen Kollision +kommen, daß zwei oder mehr Angestellte eine Seite in einem Buch ersetzen +wollen, weil jeder Angestellte seine eigene Kopie besitzt. Um die ver- +schiedenen Kopien eines Buches auseinander zu halten, wird von den Ange- +stellten verlangt, ihre Buch-Kopie mit einem sinnvollen Namen zu versehen. +Dies Verfahren funktioniert auch eine Weile, bis ein strebsamer Angestellter +einen Verbesserungsvorschlag macht, der prompt mit DM 5,- honoriert wird: +wie bereits mit den Seiten auf dem Tisch geschehen, ist es ja nicht not- +wendig, die Bücher zu photokopieren, sondern nur die mit Notizen versehenen +in einen Ordner, der entsprechend einer Buch-Kopie angelegt wird, einzu- +ordnen. Alle anderen, nicht veränderten Seiten können noch immer gemeinsam +benutzt werden. + +Und so funktioniert es nun: +Bei Arbeitsbeginn finden die Angestellten einen Buchbestand vor. Um mit einem +Buch arbeiten zu können, muß ein Angestellter einen Ordner für dieses Buch +anlegen, in den die ggf. veränderten Seiten eingeordnet werden. Zu diesem +Zweck muß jeder Ordner einen sinnvollen Namen erhalten, damit die Angestell- +ten ihre Ordner auch wiederfinden. Am Anfang müssen die Angestellten Seiten +der Original-Bücher kopieren. Wird eine solche Seite mit Notizen versehen, +also verändert, muß sie bei einer Verdrängung in den entsprechenden Ordner +eingefügt werden. Muß ein Angestellter eine neue Seite kopieren, so schaut +er erst in seinem Ordner nach, ob sich die entsprechende Seite dort befindet. +Damit wird garantiert, daß jeder Angestellte auch immer seine, mit Notizen +versehene Seiten erhält. Befindet sich eine gesuchte Seite nicht in dem +Ordner (am Arbeitsbeginn ist ein Ordner natürlich immer leer), so kopiert er +sich eine Seite aus dem entsprechenden Original-Buch. + +In der Zwischenzeit passiert folgendes im Rechner: +Eine Sammlung von Daten und/oder Programmen wird im EUMEL-System ein "Daten- +raum" ("dataspace") genannt. Erhält ein Datenraum einen Namen, so wird +dieser Datenraum eine Datei ("file") genannt. Angenommen, es existiert im +System eine Datei mit dem Namen 'Mist', die ein Angestellter mit dem Namen +'Krümel Monster' erstellt hat. Ein anderer Benutzer mit dem Namen 'Grobi' +will mit dieser Datei arbeiten. Grobi kopiert sich also diese Datei und gibt +ihr den Namen 'Grobis Mist'. Durch diese Kopier-Operation wird ein neuer +Datenraum angelegt, der aber anfänglich nur Verweise auf den Datenraum ent- +hält, der sich unter dem Namen 'Mist' verbirgt. Der Datenraum bzw. die +Seiten, die in Datei 'Mist' enthalten sind, werden also "geshared", d.h. von +mehreren Benutzern gemeinsam verwendet (in unserem Beispiel von Grobi und +Krümel Monster). Es erfolgt also eine logische Kopie, aber keine physika- +lische! + +Will der Angestellte Grobi nun eine Seite der Datei 'Grobis Mist' verwenden, +so erhält er natürlich die entsprechende Seite aus der Datei 'Mist'. Ver- +ändert der Angestellte Grobi nun eine Seite, so wird diese veränderte Seite +in dem Datenraum vermerkt, der unter dem Namen 'Grobis Mist' ansprechbar ist. +Davon merkt der Benutzer 'Krümel Monster' natürlich nichts, denn er arbeitet +mit den Seiten seines Datenraums weiter, die unverändert geblieben sind. Aber +auch Grobi merkt nichts davon, daß Seiten soweit wie möglich gemeinsam be- +nutzt werden. + +Merke: Durch das Konzept der Datenräume und Dateien (die nichts anderes sind + als benannte Datenräume), ist es möglich, auch Daten von verschiedenen + Programmen her gemeinsam zu benutzen und somit eine redundante + Speicherung überflüssig zu machen. Programme sind ebenfalls in Daten- + räumen gespeichert, so daß einer gemeinsamen Benutzung von z.B. + Systemprogrammen durch mehrere Nutzer nichts im Wege steht. + + + +Fixpunkte + +In gewissen Zeitabständen wird der gesamte Systemzustand eines EUMEL-Systems +gespeichert ("Fixpunkt"). Bei eventuell auftretenden Störungen kann dadurch +immer bei dem letzten Fixpunkt mit der Verarbeitung fortgefahren werden. + +Zurück zu unseren Angestellten, die typischerweise dieses komische System +weiter benutzen: Es passiert zum ersten Mal ein entsetzliches Unglück: +während im Sommer mehrere Fenster geöffnet wurden, betritt der "reitende" +Bürobote das Zimmer und alle Seiten werden von den Tischen und aus allen +offenen Ordnern herabgeweht. Da unsere Angestellten - wie man sich leicht +vorstellen kann - etwas vergeßlich sind, können sie nicht mehr rekon- +struieren, welche Seiten auf den Tischen und welche sich in den Büchern bzw. +Ordnern befanden. Die Arbeit von mehreren Monaten ist somit verloren! + +Deshalb werden Sicherheitsmaßnahmen getroffen: +In regelmäßigen Zeitabständen müssen alle Angestellten ihre Arbeit unter- +brechen. Dann wird von einem - extra dazu abgestellten - Angestellten Listen +angelegt, in denen die Seiten auf dem Tisch, den Ordnern und den Büchern +vermerkt wird. Im Falle eines erneuten Unglücks braucht man also nur die +letzte dieser Listen zu konsultieren, um eine gesicherte Arbeitssituation +herzustellen. Allerdings ist in einem solchen Fall diejenige Arbeit verloren, +die in der Zwischenzeit seit der Erstellung der letzten Liste geleistet +wurde. Aber das wird ja gerne in Kauf genommen, weil überhaupt weitergemacht +werden kann und nicht die gesamte Arbeit verloren ist. + +Merke: In gewissen (einstellbaren, typisch: 15 Minuten) Zeitabständen wird + vom EUMEL-System der gesamte Zustand des Systems gesichert. Diese + Sicherung wird "Fixpunkt" genannt. Dazu ist es notwendig, daß die + Verarbeitung der Programme kurz (z.Z. 0.2 Sek.) unterbrochen wird, + was sich jedoch meist nicht besonders störend auswirkt. Damit ist es + aber sichergestellt, daß bei einem Stromausfall, Hardware- oder Soft- + warestörungen immer zu einem Zeitpunkt in der Verarbeitung "aufge- + setzt" werden kann, bei dem nur diejenigen Daten verloren sind, die + seit dem letzten "Fixpunkt" aufliefen. + + + +Archiv + +Ein weiteres Sicherungsmittel im EUMEL-System ist das Archiv, mit welchem +man Dateien (also Daten und/oder Programme) extern zum EUMEL-System +speichern kann. + +Verlassen wir nun lieber unsere Angestellten. Dieses Modell würden wir sonst +übermäßig strapazieren. Wenden wir uns vielmehr einem weiteren Sicherungs- +mittel des EUMEL-Systems zu, dem EUMEL-Archiv. Mit Hilfe des EUMEL-Archivs +ist es möglich, Dateien auf Floppies zu schreiben und somit außerhalb des +EUMEL-Systems aufzubewahren. Es ist nun möglich, mehrere Dateien auf einer +Floppy zu speichern. Bloß wie funktioniert das? + +Ein gutes Modell des EUMEL-Archivs stellt ein Tonband oder eine Musikkassette +dar. Auf diesen werden die Musikstücke (unsere Dateien) nacheinander (Fach- +ausdruck: "sequentiell") aufgezeichnet, d.h. neue Musikstücke (Dateien) +können immer nur angefügt werden. Ist das Tonband oder die Kassette voll +beschrieben, so schaltet das Gerät meist automatisch ab. Im EUMEL-System +gibt's in solchen Fällen eine Fehlermeldung. + +Unterschiedlich zu einem Tonband ist jedoch, daß im EUMEL-System die Namen +der Dateien mit abgespeichert werden und diese Dateien - durch die Angabe +des Dateinamens - gezielt vom Archiv gelesen werden können. Bei einem Ton- +band oder einer Kassette muß man sich erst alle Musikstücke anhören, bis +das Musikstück erreicht ist, welches benötigt wird. Dieses "sequentielle" +Überlesen nicht benötigter Dateien erledigt das EUMEL-System "automatisch". + +Im EUMEL-System gibt es nun nicht nur die Möglichkeit, eine Datei auf ein +Archiv zu schreiben oder von einem Archiv zu lesen, sondern auch mehrere Da- +teien mit einem Kommando zu lesen oder zu schreiben. Zusätzlich ist es mög- +lich, ein Archiv zu löschen (und dann ggf. neu zu beschreiben), wenn die +"archivierten" Dateien nicht mehr benötigt werden. + +Nun passiert es oft, daß eine bereits archivierte Datei verändert wird und +nochmals auf das Archiv geschrieben werden soll. Aber durch eine Veränderung +der Datei hat diese gerade ihren Platzbedarf verändert. Somit könnte die +Datei - sofern sie sich vergrössert hat - eine nachfolgende Datei auf dem +Archiv u.U. teilweise überschreiben. Deshalb wurde im EUMEL-Archiv folgende +Vereinbarung getroffen: Wird eine Datei nochmals auf ein Archiv geschrieben, +so wird die Datei, die sich bereits auf dem Archiv befindet, als "ungültig" +gekennzeichnet und die neue Version an das Ende angefügt. Nur wenn die alte +Datei die letzte auf dem Archiv ist, wird sie von der neuen Version über- +schrieben. + +Merke: Durch dieses Verfahren kann es zu einer kuriosen Situation kommen: + zwei Dateien werden abwechselnd auf ein Archiv in mehreren Versionen + geschrieben. Obwohl beide Dateien zusammengenommen bei weitem nicht + das Archiv auffüllen würden, kommt es zum Überlauf. In einem solchen + Fall muß man das Archiv löschen (wobei vorher die Dateien ggf. in das + System geholt werden müssen) und beide Dateien erneut auf das Archiv + schreiben. + + + +4. Kleines #ib#EUMEL-Wörterbuch + +In diesem Wörterbuch werden einige der Begriffe, die häufig in diesem Be- +nutzer-Handbuch verwendet werden, erläutert. Bezüge auf weitere Begriffe, +die in diesem Wörterbuch stehen, werden mit den Zeichen ">" und "<" ge- +klammert. + +Anweisung: Direktive an die Textkosmetik, welche direkt in einen Text + geschrieben wird. Eine Anweisung muß in "\#" eingefaßt + werden. Beachte den Unterschied zu einem Kommando. + +Archiv: Ein Programmsystem, um Dateien des EUMEL-Systems auf + Floppys außerhalb des Systems zu speichern oder von dort + wieder in das EUMEL-System zu holen. Als Archiv wird auch + noch ein Speichermedium bezeichnet (in der Regel eine + Diskette). + +Benutzer-Task: Im Gegensatz zu einer >System-Task< ist eine Benutzer-Task + eine Task, die von einem Benutzer erzeugt worder ist. Sie + ist entweder an ein Terminal gekoppelt oder kann unab- + hängig von einem Terminal im Hintergrund bearbeitet werden. + +BOUND: Attribut von Variablen, das bei einer Deklaration vor die + Typangabe gesetzt wird. Dient zur Aufprägung eines Daten- + typs auf einen Datenraum. + +DATASPACE: Eine Datei ohne Namen. + +Datenraum: Siehe >DATASPACE<. + +Editor: Programm zur Eingabe und Veränderung von Texten, Daten und + Programmen. + +ELAN: Programmiersprache des EUMEL-Systems ("ELementary + LANguage"). + +ELAN-Compiler: Ein Programm, welches ein korrektes ELAN-Programm in ein + äquivalentes, ablauffähiges Programm (im >EUMEL0-Code<) + übersetzt. + +EUMEL0-Code: Maschinensprache des EUMEL-Systems. + +EUMEL-Drucker: Programm zur Ansteuerung von (unterschiedlichen) Druckern. + Der EUMEL-Drucker wird durch Kommandos gesteuert und er- + laubt es, unterschiedliche Drucker mit verschiedenartigen + Leistungen immer gleich anzusprechen. + +EUMEL-Standard: Objekte (also Datentypen, Prozeduren und/oder Operatoren), + die durch Pakete realisiert werden und standardmässig in + jedem EUMEL-System verfügbar sind. + +Fixpunkt: Speicherung des aktuellen Systemzustandes in regelmäßigen + Abständen. Bei Hardware- oder Softwarestörungen kann immer + bei der letzten Fixpunkt-Sicherung aufgesetzt werden. + +Hintergrund-Task: Eine >Task<, die nicht an ein Terminal angekoppelt ist + (d.h. einem Benutzer nicht direkt zugänglich), aber trotz- + dem vom System bearbeitet wird oder im Wartezustand ist + (warten auf einen Auftrag oder eine Ein/Ausgabe-Operation). + +Kommando: Ein ELAN-Programm, welches in der Regel aus einem + Prozeduraufruf besteht. Ein Kommando kann vom >Monitor< + oder Editor gegeben werden. Kommandos können ebenfalls in + Programmen verwandt werden. + +Lokale Dateien: Dateien einer Benutzer-Task. + +Manager: Eine >Task<, die auf Aufträge wartet. Beispiele sind die + Spool-Task bzw. Datei-Manager. Letzterer wird für die + Haltung längerfristig benötigter Dateien gebraucht. + +Monitor: Der Monitor steuert die Kommunikation zwischen einem + Benutzer am Terminal und dem EUMEL-Betriebssystem, nachdem + der Benutzer sich mit Hilfe des >Supervisors< eine Task + erschaffen hat. Die Monitor-Kommandos beziehen sich immer + auf die angekoppelte Benutzer-Task. + +paging: Benötigte Informationen werden in Einheiten ("pages") in + den Zentralspeicher des Rechners geladen. Somit ist es + möglich, bei weitem größere Informationsmengen zu ver- + arbeiten, als auf einmal in den Speicher des Rechners + passen. + +OPERATOR: >Task<, mit der das EUMEL-System u.a. gestartet, "abge- + schaltet" und gesichert werden kann. + +Scanner: Programm, um aus einem Text lexikalische Elemente ("Le- + xeme") herauszublenden. In dem im >EUMEL-Standard< + implementierten Scanner werden Lexeme nach der ELAN-Syntax + erkannt, redundante Leerzeichen (nicht in Texten) sowie + Kommentare überlesen. + +Sendungs-Vermittlung: Steuerung der Übermittlung von Informationen zwischen + verschiedenen >Tasks<. + +sharing: >Datenräume< und/oder >pages< können von mehreren Benutzern + gleichzeitig benutzt werden. Erst bei einer Schreibopera- + tion eines Benutzers wird nur für diesen Nutzer eine Kopie + der Daten angelegt. ("copy on write"). + +Spooler: Systemprogramm des EUMEL-Systems, welches Druckaufträge + zwischenspeichert, so daß unmittelbar weiter gearbeitet + werden kann. + +Supervisor: Kern des EUMEL-Betriebssystems auf der ELAN-Ebene zum Ver- + walten von Tasks. + +Supervisor-Kommando: Kommando zur Steuerung (An-/Abkoppeln, Erzeugen, + Benutzung) einer >Benutzer-Task<. + +System-Task: Eine >Task<, die für Aufrechterhaltung, Betrieb und Steu- + erung des EUMEL-Systems benötigt und nicht von einem + Benutzer erzeugt wird, sondern "immer" im >Taskbaum< + vorhanden ist. + +Task: Eigenständiger Prozeß (Auftrag) im EUMEL-System. + +Taskbaum: Eine baumförmige Anordnung von >Tasks<, in die jede Task + des EUMEL-Systems eingefügt wird. Dabei hat jede Task + - mit Ausnahme des >Urvaters< - eine >Vater-Task<, und + kann weitere Tasks erzeugen ("Söhne"). + +Textkosmetik: Programme des EUMEL-Systems, die die Gestaltung eines + Textes erlauben. + +Urvater: Wurzel des >Task-Baums< mit dem Namen 'UR'. + +Vater-Dateien: Dateien einer >Vater-Task<. + +Vater-Task: Eine >Task<, die einer Task in direkt aufsteigender Linie + im >Taskbaum< übergeordnet ist. Es wird dabei zwischen + einer "unmittelbaren" (die direkt übergeordnete Vater-Task) + und "mittelbaren" Vater-Tasks (Vater-Tasks, die über die + unmittelbare Vater-Task erreichbar sind) unterschieden. + + + +5. ELAN-Literatur + +Bittner, M., Jäckel, J., Jähnichen, S.: + ELAN - Beispielsammlung. + Institut für angewandte Informatik, + Fachbereich 20, TU Berlin, + Berlin, 1979 + +Hahn, R.: + Höhere Programmiersprachen im Vergleich. + Akademische Verlagsgesellschaft, + Wiesbaden, 1981 + +Hahn, R., Nienaber, B.: + Probleme lösen mit dem Computer. + Teil 1: Einführung in die algorithmische Problemlösung. + Teil 2: Werkzeuge und Methoden. + Neuer Verlag Bernhard Bruscha, + Tübingen, 1978 + +Hahn, R., Stock, P.: + ELAN - Handbuch. + Akademische Verlagsgesellschaft, + Wiesbaden, 1979 + +Hommel, G., Jäckel, J., Jähnichen, S., Kleine, K., Koch, W., Koster, K.: + ELAN - Sprachbeschreibung. + Akademische Verlagsgesellschaft, + Wiesbaden, 1979 + +Hommel, G., Jähnichen, S., Koch, W.: + SLAN - Eine erweiterbare Sprache zur Unterstützung der strukturierten + und modularen Programmierung. + 4. GI Fachtagung Programmiersprachen in Erlangen, + Springer Verlag, 1976 + +Hommel, G., Jähnichen, S., Koster, C.H.A.: + Methodisches Programmieren. + De Gruyter, Berlin, 1983 + +Klingen, L., Liedtke, J: + Programmieren mit ELAN + Teubner, Stuttgart, 1983 + +Liedtke, J.: + EUMEL - Ein ELAN-System für Mikroprozessoren. + GMD-Spiegel, + Bonn, 1979 + +Voila, H.T.: + A new computer routine for the generation of publishable data from + nothing. + Computer Quickies 48, 117 (1984) + + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil10 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil10 new file mode 100644 index 0000000..0f3b656 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil10 @@ -0,0 +1,771 @@ + EUMEL-Benutzerhandbuch + + TEIL 10: Graphik + +1. Übersicht + +Dieser Teil des Benutzer-Handbuchs beschreibt die Graphik-Möglichkeiten des +EUMEL-Systems. Die Graphik-Pakete gehören nicht zum EUMEL-Standard, sondern +sind Anwenderpakete, die im Quellcode ausgeliefert und von jeder Instal- +ation in das System aufgenommen werden können. Unter Umständen müssen +Programme erstellt werden, die die Anpassungen für spezielle graphische +Geräte einer Installation vornehmen. + +Das Graphik-System ermöglicht es, durch ELAN-Programme geräteunabhängige +Informationen für Zeichnungen ("Graphiken") zu erstellen. Die Graphik +erzeugenden Programme brauchen dabei keine gerätespezifischen Größen sowie +gerätespezifischen Unterprogramme zu enthalten. Sie befassen sich somit +ausschließlich mit der Erzeugung der problemorientierten Information für die +Konstruktion einer Zeichnung. Nach der geräteunabhängigen Erzeugung einer +Graphik kann diese auf unterschiedlichen Geräten ausgegeben werden (z.B. +erst auf einem Terminal zur Kontrolle und dann auf einem Plotter). + +Die EUMEL-Graphik umfaßt zwei- und dreidimensionale Graphik. Dabei ent- +spricht die Y-Achse bei der zweidimensionalen Graphik der Z-Achse (Höhe) bei +der dreidimensionalen Graphik. Im dreidimensionalen Fall sind perspektivi- +sche, orthografische und schiefwinklige Projektionen mit beliebigen Betrach- +tungswinkeln möglich. + +Bei der EUMEL-Graphik wird streng zwischen Erzeugung und Manipulation von +Graphiken (Bildern) auf der einen und Darstellung der erzeugten Bilder auf +der anderen Seite unterschieden. Für die Erzeugung und Manipulation der +Graphiken existiert der Typ PICTURE, für die Darstellung der Bilder gibt es +den Typ PICFILE. Dabei müssen Ausschnitt, Maßstab, Betrachtungswinkel und +Projektionsart erst bei der Darstellung festgelegt werden. Diese Kon- +struktion des Graphik-Systems hat folgende Vorteile: + +a) Programme, die Graphik-Informationen erzeugen, sind geräteunabhängig. + Das bedeutet, daß Programmierer sich ausschließlich mit einem logischen + Problem zu befassen brauchen und nicht mit gerätespezifischen Besonder- + heiten. + +b) Graphiken können auf mehreren unterschiedlich gearteten Geräten mehrmals + dargestellt werden, ohne daß das erzeugende Programm geändert oder neu + gestartet werden muß. Z.B. kann ein Programmierer eine Graphik erst auf + dem Terminal auf Richtigkeit und Größenverhältnisse überprüfen, bevor er + die Zeichnung auf einem Plotter zeichnen läßt. + +c) Graphiken können leicht geändert (z.B. vergrößert oder in eine Richtung + gestreckt) werden, ohne daß das erzeugende Programm erneut durchlaufen + werden muß. Zudem können Graphiken aneinander oder übereinander gelegt + werden. + +d) Graphiken mit unterschiedlichen Farben, Strichen usw. können leicht er- + zeugt werden. + +e) Der Anschluß von neuen Graphik-Geräten durch Benutzer ist leicht möglich, + ohne daß die Graphik erzeugenden Programme modifiziert werden müssen. + +f) Plotter können wie Drucker an einen SPOOLER gehängt werden. + +g) Bilder können als PICFILEs gespeichert und versandt werden. + + + +Erzeugung von Bildern + +Bilder entstehen in Objekten vom Datentyp + + PICTURE + +Diese müssen mit der Prozedur + + nilpicture + +initialisiert werden. Sie enthalten dann ein leeres Bild, dessen Dimension +noch nicht festgelegt ist. Die Dimension eines PICTUREs wird mit dem ersten +Schreibzugriff ('move' oder 'draw') festgelegt. Ein PICTURE kann immer nur +entweder zwei- oder dreidimensional sein. Außerdem kann einem PICTURE mit +der Prozedur + + pen + +genau ein virtueller Stift zugeordnet oder der aktuelle Stift erfragt werden. + +Die Erzeugung eines Bildes basiert auf dem Modell eines Plotters. Der (vir- +tuelle) Zeichenstift kann mit + + move + +ohne zu zeichnen an beliebige Stellen gefahren werden (reine Positionierung). +Mit + + draw + +wird der Stift veranlaßt, eine Linie von der aktuellen zur angegebenen Ziel- +position zu zeichnen. 'move' löst also Bewegungen mit gehobenem, 'draw' +solche mit gesenktem Stift aus. Um auch 'relatives' Zeichnen zu ermöglichen, +existiert die Prozedur + + where + +die die aktuelle Stiftposition liefert. + + + +Manipulation von Bildern + +Erstellte Bilder können als Ganzes manipuliert werden. Die Prozeduren + + translate (* verschieben *) + stretch (* strecken bzw. stauchen *) + rotate (* drehen *) + reflect (* spiegeln *) + +verändern jeweils das ganze Bild. Es ist aber auch möglich, mehrere Bilder +zusammenzufügen. Mit + + CAT + +kann ein weiteres Bild angefügt werden. Dabei müssen allerdings beide +PICTURE die gleiche Dimension haben. In solchen als ganzes manipulierten +Bildern kann man ohne Einschränkung mit 'draw' und 'move' weiterzeichnen. + + + +Darstellung + +Für die Darstellung der erzeugten Bilder existiert der Typ + + PICFILE + +Dieser besteht aus max. 128 PICTUREs, die mit den Prozeduren + + put + get + +eingegeben bzw. ausgegeben werden können. PICFILE wird durch Datenräume +realisiert, deshalb erfolgt die Assoziation an einen benannten Datenraum +ähnlich wie beim FILE. Dafür wird die Prozedur + + picture file + +verwandt. Ein neuer PICFILE enthält genau ein leeres PICTURE. Die Darstel- +lung der PICFILEs auf Zeichengeräten erfolgt mit der Prozedur + + plot + +Da die Graphiken aber in "Weltkoordinaten" erzeugt werden und die spätere +Darstellung vollkommen unbeachtet bleibt, müssen gewisse Darstellungspara- +meter für die Zeichnung gesetzt werden. Diese Parameter werden im PICFILE +abgelegt und gelten jeweils für den gesamten PICFILE. Dadurch ist es möglich, +einen PICFILE mit spezifizierter Darstellungsart über einen SPOOLER an einen +Plotter zu senden oder die bei der letzten Betrachtung gewählte Darstellung +mit in dem PICFILE gespeichert zu halten. Für die Darstellung können den +virtuellen Stiften mit der Prozedur + + select pen + +reale Stifte zugeordnet werden. Voreingestellt ist für alle virtuellen +Stifte: Standardfarbe, Standardstärke, durchgängige Linie. + +Indem man einigen virtuellen Stiften den leeren Stift als realen Stift zu- +ordnet, kann man einzelne PICTUREs ausblenden. Sowohl bei der Darstellung +von zwei- als auch dreidimensionaler Graphik kann die gewählte Zeichenfläche +auf dem Endgerät mit der Prozedur + + viewport + +festgelegt werden. Voreingestellt ist das Quadrat mit der größtmöglichen +Seitenlänge, d.h. der kürzeren Seite der hardwaremäßigen Zeichenfläche. + + + +Darstellung zweidimensionaler Graphik + +Bei der Darstellung zweidimensionaler Bilder muß der zu zeichnende Ausschnitt +(das 'Fenster') angegeben werden. Mit der Prozedur + + window + +wird durch Angabe der minimalen und maximalen X- bzw. Y-Koordinaten ein +Fenster definiert. Da das so definierte Fenster auf die ganze (mit 'viewport' +definierbare) Zeichenfläche abgebildet wird, ist der Abbildungsmaßstab durch +das Zusammenspiel von 'viewport' und 'window' bestimmt. Da bei 'viewport' +standardmäßig das maximale Zeichenquadrat voreingestellt ist, wird in diesem +Fall durch gleiche X- und Y-Fenstergröße eine winkeltreue Darstellung er- +reicht. + + + +Darstellung dreidimensionaler Graphik + +Im dreidimensionalen Fall wird das Fenster ebenfalls mit + + window + +definiert, wobei dann allerdings auch der Bereich der dritten Dimension +(Z-Koordinaten) zu berücksichtigen ist. Da die dreidimensionale Graphik auf +eine zweidimensionale Fläche projiziert wird, können aber noch weitere Dar- +stellungsparameter angegeben werden. Der Betrachtungswinkel wird mit Hilfe +der Prozedur + + view + +angegeben. Zur Spezifikation der gewünschten Projektionsart gibt es + + orthographic (* orthographische Projektion *) + perspective (* perspektivische Projektion, + der Fluchtpunkt ist frei wählbar *) + oblique (* schiefwinklige Projektion *) + + + +Beispiel (Sinuskurve) + + funktion zeichnen; + bild darstellen . + +funktion zeichen : + PICTURE VAR pic :: nilpicture; + REAL VAR x := -pi; + move (pic, x, sin (x)); + REP x INCR 0.1; + draw (pic, x, sin (x)) + UNTIL x >= pi PER . + +bild darstellen : + PICFILE VAR p :: picture file ("sinus"); + window (p, -pi, pi, -1.0, 1.0); + put (p, pic); + plot (p) . + + + +Beispiel (Würfel) + + wuerfel zeichen; + wuerfel darstellen. + +wuerfel zeichnen : + zeichne vorderseite; + zeichne rueckseite; + zeichne verbindungskanten. + +zeichne vorderseite : + PICTURE VAR vorderseite :: nilpicture; + move (vorderseite, 0.0, 0.0, 0.0); + draw (vorderseite, 1.0, 0.0, 0.0); + draw (vorderseite, 1.0, 0.0, 1.0); + draw (vorderseite, 0.0, 0.0, 1.0); + draw (vorderseite, 0.0, 0.0, 0.0). + +zeichne rueckseite : + PICTURE VAR rueckseite :: translate (vorderseite, 0.0, 1.0, 0.0). + +zeichne verbindungskanten : + PICTURE VAR verbindungskanten :: nilpicture; + move (verbindungskanten, 0.0, 0.0, 0.0); + draw (verbindungskanten, 0.0, 1.0, 0.0); + + move (verbindungskanten, 1.0, 0.0, 0.0); + draw (verbindungskanten, 1.0, 1.0, 0.0); + + move (verbindungskanten, 1.0, 0.0, 1.0); + draw (verbindungskanten, 1.0, 1.0, 1.0); + + move (verbindungskanten, 0.0, 0.0, 1.0); + draw (verbindungskanten, 0.0, 1.0, 1.0). + +wuerfel darstellen : + PICFILE VAR p := picture file ("wuerfel"); + put (p, vorderseite); + put (p, rueckseite); + put (p, verbindungskanten); + window (p, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0); + view (p, 0.0, 40.0, 20.0); + orthographic (p); + plot (p). + + + +Beschreibung der Graphik-Prozeduren + +Zweidimensionale PICTUREs brauchen weniger Speicherplatz als dreidimensio- +nale. Daher werden in einigen Fehlermeldungen unterschiedliche Größen ange- +geben. + +:= + OP := (PICTURE VAR dest, PICTURE CONST source) + Zweck: Zuweisung + + OP := (PICFILE VAR dest, DATASPACE CONST source) + Zweck: Assoziiert die PICFILE Variable 'dest' mit der DATASPACE CONST + 'source' und initialisiert die PICFILE Variable sofern nötig. + Fehlerfall: + * dataspace is no PICFILE + Der anzukoppelnde Datenraum hat einen falschen Typ. + +CAT + OP CAT (PICTURE VAR dest, PICTURE CONST source) + Zweck: Aneinanderfügen von zwei PICTURE's. + Fehlerfälle: + * OP CAT: left dimension <> right dimension + Es können nur PICTUREs mit gleicher Dimension angefügt werden. + * OP CAT: Picture overflow + Die beiden PICTURE überschreiten die maximale Größe eines Pictures. + +act picture + PICTURE PROC act picture (PICFILE VAR p) + Zweck: Liefert das PICTURE des PICFILEs 'p', auf das mit 'backward' o.ä. + positioniert wurde. + +backward + PROC backward (PICFILE VAR p) + Zweck: Positioniert den PICFILE 'p' um ein PICTURE zurück. + Fehlerfall: + * backward at begin of file + Es wurde versucht vor den Anfang des PICFILEs zu positionieren. + +draw + PROC draw (PICTURE VAR pic, REAL CONST x, y) + Zweck: Die Prozedur zeichnet in dem (zweidimensionalen) Bild 'pic' eine + Linie von der aktuellen Position zur Position (x, y). + Fehlerfälle: + * picture overflow + Zu viele Befehle in einem PICTURE (z. Zeit max. 1927) + * picture is three dimensional + Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. + + PROC draw (PICTURE VAR pic, REAL CONST x, y, z) + Zweck: Die Prozedur zeichnet in dem (dreidimensionalen) Bild 'pic' eine + gerade Linie von der aktuellen Position zur Position (x, y, z). + Fehlerfälle: + * picture overflow + Zu viele Befehle in einem PICTURE (z. Zeit max. 1310) + * picture is only two dimensional + Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. + + PROC draw (PICTURE VAR pic, TEXT CONST text) + Zweck: Der angegebene Text wird in das Bild 'pic' eingetragen. Der An- + fang ist dabei die aktuelle Stiftposition. Diese wird nicht ver- + ändert. + Fehlerfall: + * picture overflow + Der Text paßt nicht mehr in das PICTURE. + + PROC draw (PICTURE VAR pic, TEXT CONST text, REAL CONST angle, height) + Zweck: Der angegebene Text wird unter dem Winkel 'angle' gegenüber der + Waagerechten und in der Größe 'height' in das PICTURE 'pic' + eingetragen. Der Anfang ist dabei die aktuelle Stiftposition. + Diese wird nicht verändert. + Fehlerfall: + * picture overflow + Der Text paßt nicht mehr in das PICTURE. + + PROC draw (PICFILE VAR pic, REAL CONST x, y) + Zweck: Die Prozedur zeichnet in dem aktuellen (zweidimensionalen) + PICTURE des PICFILEs 'p' eine gerade Linie. Der (virtuelle) Stift + wird von der aktuellen Position zur Position (x, y) gefahren. + Falls das aktuelle PICTURE zu voll ist, wird automatisch auf das + nächste umgeschaltet. + Fehlerfälle: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128 PICTURE) + * picture is threedimensional + Das aktuelle PICTURE ist dreidimensional. + + PROC draw (PICTFILE VAR pic, REAL CONST x, y, z) + Zweck: s. o. + Fehlerfälle: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128) + * picfile is only twodimensional + Das aktuelle PICTURE ist zweidimensional. + + PROC draw (PICTFILE VAR pic, TEXT CONST text) + Zweck: Der angegebene Text wird in das aktuelle PICTURE des PICFILEs 'p' + eingetragen. Falls das aktuelle PICTURE zu voll ist, wird auto- + matisch auf das nächste umgeschaltet. Der Anfang ist dabei die + aktuelle Stiftposition. Diese wird nicht verändert. + Fehlerfall: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128) + + PROC draw (PICFILE VAR pic, TEXT CONST text, REAL CONST angle, height) + Zweck: Der angegebene Text wird unter dem Winkel 'angle' gegenüber der + Waagerechten und in der Größe 'height' in das aktuelle PICTURE + des PICFILES 'p' eingetragen. Falls das aktuelle PICTURE zu voll + ist, wird automatisch auf das nächste umgeschaltet. Der Anfang ist + dabei die aktuelle Stiftposition. Diese wird nicht verändert. + Fehlerfall: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128) + +eof + BOOL PROC eof (PICFILE CONST p) + Zweck: Liefert 'TRUE' wenn hinter das Ende des PICFILEs positioniert + wurde. + +extrema + PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max) + Zweck: Die Prozedur liefert die größten und kleinsten X- und Y-Koordi- + naten des PICTUREs 'p'. Diese werden in die Parameter 'x min', + 'x max', 'y min' und 'y max' eingetragen. + + PROC extrema (PICTURE CONST p, + REAL VAR x min, x max, y min, y max, z min, z max) + Zweck: s.o. + + PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) + Zweck: s.o. + + PROC extrema (PICFILE VAR p, + REAL VAR x min, x max, y min, y max, z min, z max) + Zweck: s.o. + +forward + PROC forward (PICFILE VAR p) + Zweck: Positioniert den PICFILE um ein PICTURE weiter. + Fehlerfall: + * picfile overflow + Es sollte hinter das Ende des PICFILEs positioniert werden. + +get + PROC get (PICFILE VAR p, PICTURE VAR pic) + Zweck: Liest ein PICTURE aus einem PICFILE und positioniert auf das + Nächste. + Fehlerfall: + * input after end of picfile + Es sollte nach dem Ende des Picfiles gelesen werden. + +move + PROC move (PICTURE VAR pic, REAL CONST x, y) + Zweck: Der (virtuelle) Stift wird zur Position (x, y) gefahren. + Fehlerfälle: + * picture overflow + Zu viele Befehle in einem PICTURE (z. Zeit max. 1927 'moves') + * picture is three dimensional + Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. + + PROC move (PICTURE VAR pic, REAL CONST x, y, z) + Zweck: Der (virtuelle) Stift wird zur Position (x, y, z) gefahren. + Fehlerfälle: + * picture overflow + Zu viele Befehle in einem PICTURE (z. Zeit max. 1310) + * picture is only twodimensional + Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. + + PROC move (PICFILE VAR p, REAL CONST x, y) + Zweck: Der (virtuelle) Stift wird zur Position (x, y) gefahren. Falls + das aktuelle PICTURE des PICFILEs 'p' zu voll ist, wird auto- + matisch auf das nächste umgeschaltet. + Fehlerfall: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128 PICTUREs) + + PROC move (PICFILE VAR p, REAL CONST x, y, z) + Zweck: Der (virtuelle) Stift wird zur Position (x, y, z) gefahren. Falls + das aktuelle PICTURE des PICFILEs 'p' zu voll ist, wird auto- + matisch auf das nächste umgeschaltet. + Fehlerfall: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128 PICTUREs) + +nilpicture + PICTURE PROC nilpicture + Zweck: Die Prozedure liefert ein leeres PICTURE zur Initialisierung. + +oblique + PROC oblique (PICFILE VAR p, REAL CONST a, b) + Zweck: Bei dem (dreidimensionalen!) Bild 'p' wird 'schiefwinklig' als + gewünschte Projektionsart eingestellt. Dabei ist (a, b) der Punkt + in der X-Y-Ebene, auf den der Einheitsvector in Z-Richtung + abgebildet werden soll. + +orthographic + PROC orthographic (PICFILE VAR p) + Zweck: Bei dem (dreidimensionalen!) Bild 'p' wird "orthografisch" als + Projektionsart eingestellt. Bei der orthografischen Projektion + wird ein dreidimensionaler Körper mit parallelen Strahlen senk- + recht auf die Projektionsebene abgebildet. + +pen + INT PROC pen (PICTURE CONST pic) + Zweck: Liefert die Nummer des 'virtuellen Stifts'. + + PICTURE PROC pen (PICTURE CONST pic, INT CONST pen) + Zweck: Liefert ein PICTURE mit dem Inhalt 'pic' und dem 'virtuellen + Stift' mit der Nummer 'pen'. Möglich sind die Nummern 1 - 16. + Fehlerfälle: + * PROC pen: pen [No] < 1 + Der gewünschte Stift ist kleiner als 1. + * PROC pen: pen [No] > 16 + Der gewünschte Stift ist größer als 16. + +perspective + PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) + Zweck: Bei den dreidimensionalen PICTUREs des PICFILE's 'p' wird + "perspektivisch" als gewünschte Projektionsart eingestellt. Der + Punkt (cx, cy, cz) ist der Fluchtpunkt der Projektion, d.h. alle + Parallelen zur Blickrichtung schneiden sich in diesem Punkt. + +pic no + INT PROC pic no (PICFILE CONST p) + Zweck: Liefert die Nummer des aktuellen PICTUREs. + +picture file + DATASPACE PROC picture file (TEXT CONST name) + Zweck: Die Prozedur dient zur Assoziation eines benannten Datenraumes + mit einem PICFILE (s. Operator ':='). + +plot + PROC plot (TEXT CONST name) + Zweck: Der PICFILE mit dem Namen 'name' wird entspechend der angege- + benen Darstellungsart gezeichnet. Diese Parameter ('perspective', + 'orthographic', 'oblique', 'view', 'window' etc.) müssen vorher + eingestellt werden. + Fehlerfall: + * FILE does not exist + Es existiert kein PICFILE mit dem Namen 'name' + + PROC plot (PICFILE VAR p) + Zweck: Der PICFILE 'p' wird entspechend der angegebenen Darstellungsart + gezeichnet. Diese Parameter müssen vorher eingestellt werden. + + + Zweidimensional: + + obligat: 'window' (zweidimensional) + optional: 'view' (zweidimensional) + 'select pen' + 'viewport' + + Dreidimensional: + + obligat: 'window' (dreidimensional) + optional: 'view' (dreidimensional) + 'orthographic', 'perspective', 'oblique' + 'viewport' + 'select pen' + +put + PROC put (PICFILE VAR p, PICTURE CONST pic) + Zweck: Schreibt ein PICTURE in einen PICFILE und positioniert um eins + vor. + Fehlerfall: + * picfile overflow + Der PICFILE ist voll. (z. Z. max. 128 PICTURE) + +reset + PROC reset (PICFILE VAR p) + Zweck: Positioniert auf den Anfang eines Picfiles. + +rotate + PICTURE PROC rotate (PICTURE CONST pic, REAL CONST alpha) + Zweck: Das PICTURE 'pic' wird um den Punkt (0, 0) um den Winkel 'alpha' + (im Gradmaß) im mathematisch positiven Sinn gedreht. + + PICTURE PROC rotate (PICTURE CONST pic, REAL CONST alpha, beta, gamma) + Zweck: Das dreidimensionale PICTURE 'pic' wird um den Winkel 'alpha', + 'beta' oder 'gamma' im mathematisch positiven Sinn gedreht. Der + Winkel 'alpha' dreht um die X-Achse, der Winkel 'beta' um die + Y-Achse und 'gamma' um die Z-Achse. Es darf dabei nur jeweils + ein Winkel von 0.0 verschieden sein. Alle Winkel werden im + Gradmaß angegeben. + +select pen + PROC select pen (PICFILE VAR p, + INT CONST pen, colour, thickness, linetype) + Zweck: Für die Darstellung des Bildes 'p' soll dem "virtuellen Stift" + 'pen' ein realer Stift zugeordnet werden, der möglichst die Farbe + 'colour' und die Dicke 'thickness' hat und dabei Linien mit dem + Typ 'line type' zeichnet. Es wird die beste Annäherung für das + Ausgabegerät für diese Parameter genommen. Dabei gelten folgende + Vereinbarungen: + + Farbe: negative Farben setzten den Hintergrund, positive Farben + zeichnen im Vordergrund. + + 0 Löschstift (falls vorhanden) + 1 Standardfarbe des Endgeräts (schwarz oder weiß) + 2 rot + 3 blau + 4 grün + 5 schwarz + 6 weiß > 20 nicht normierte Sonderfarben + + Dicke: 0 + Standardstrichstärke des Endgerätes > 0 + Strichstärke in 1/10 mm + + Typ: + 0 keine sichtbare Linie + 1 durchgängige Linie + 2 gepunktete Linie + 3 kurz gestrichelte Linie + 4 lang gestrichelte Linie + 5 Strichpunktlinie + + Die hier aufgeführten Möglichkeiten müssen nicht an allen + grafischen Endgeräten vorhanden sein. Der geräteabhängige + Graphik-Treiber wählt jeweils die für ihn bestmögliche Annäherung. + + Fehlerfälle: + * pen < 1 + * pen > 16 + +size + INT PROC size (PICFILE CONST p) + Zweck: Liefert die aktuelle Größe eines PICFILEs in Bytes. + +stretch + PICTURE PROC stretch (PICTURE CONST pic, REAL CONST xc, yc) + Zweck: Das PICTURE 'pic' wird in X-Richtung um den Faktor 'xc', in + Y-Richtung um den Faktor 'yc' gestreckt (bzw. gestaucht). Dabei + bewirkt der Faktor + c > 1 eine Streckung + 0 < c < 1 eine Stauchung + c < 0 zusätzlich eine Achsenspiegelung + + PICTURE PROC stretch (PICTURE CONST pic, REAL CONST xc, yc, zc) + Zweck: Das dreidimensionale PICTURE 'pic' wird entsprechend den + angegeben Faktoren 'xc', 'yc' und 'zc' gestreckt. Wirkung s.o. + +translate + PICTURE PROC translate (PICTURE CONST pic, REAL CONST dx, dy) + Zweck: Das PICTURE 'pic' wird um 'dx' und 'dy' verschoben. + Fehlerfall: + * picture is threedimensional + 'pic' ist dreidimensional. + + PICTURE PROC translate (PICTURE CONST pic, REAL CONST dx, dy, dz) + Zweck: Das PICTURE 'pic' wird um 'dx', 'dy' und 'dz' verschoben. + Fehlerfall: + * picture is twodimensional + Das PICTURE 'pic' ist zweidimensional + +two dimensional + PROC two dimensional (PICFILE VAR p) + Zweck: Setzt als Projektionsart zweidimensional. + +view + PROC view (PICFILE VAR p, REAL CONST alpha, phi, theta) + Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne + dargestellt, sondern für die Betrachtung gedreht. Mit der Prozedur + 'view' kann diese Betrachtungsrichtung durch die Polarwinkel 'phi' + und 'theta' angegeben werden. Mit dem Winkel 'alpha' kann dann + das Bild um den Mittelpunkt der Zeichenfläche gedreht werden. + Dadurch kann ein Bild auch auf einem Terminal hochkant gestellt + werden. Voreingestellt ist 'phi = 0, theta = 0 und alpha = 0', + d.h. direkt von oben. + + Im Gegensatz zu 'rotate' hat 'view' keine Wirkung auf das eigent- + liche Bild (PICFILE), sondern nur auf die gewählte Darstellung. + So addieren sich zwar aufeinanderfolgende "Rotationen", 'view' + aber geht immer von der Nullstellung aus. Auch kann das Bild + durch eine "Rotation" ganz oder teilweise aus oder in das Dar- + stellungsfenster ('window') gedreht werden. Bei 'view' verändern + sich die Koordinaten der Punkte nicht, d.h. das Fenster wird mit- + gedreht. + +viewport + PROC viewport (PICFILE VAR p, + REAL CONST hormin, hormax, vertmin, vertmax) + Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt + werden soll, wird spezifiziert. Dabei wird sowohl die Größe als + auch die relative Lage der Zeichenfläche definiert. Der linke + untere Eckpunkt der physikalischen Zeichenfläche des Gerätes hat + die Koordinaten (0.0, 0.0). Die definierte Zeichenfläche erstreckt + sich + + 'hormin' - 'hormax' in der Horizontalen, + 'vertmin' - 'vertmax' in der Vertikalen. + + So liegt der linke untere Eckpunkt dann bei (hormin, vertmin), der + rechte obere bei (hormax, vertmax). + + Damit sowohl geräteunabhängige als auch maßstabsgerechte + Zeichnungen möglich sind, können die Koordinaten in zwei Arten + spezifiziert werden : + + a) Gerätekoordinaten + Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei + hat die kürzere Seite der physikalischen Zeichenfläche defini- + tionsgemäß die Länge 1.0. + + b) absolute Koordinaten + Die Werte werden in cm angegeben. Für die Maximalwerte sind + nur Werte größer als 2.0 möglich. + + Voreingestellt ist + + viewport (0.0, 1.0, 0.0, 1.0), + + d.h. das größtmöglichste Quadrat, beginnend in der linken unteren + Ecke der physikalischen Zeichenfläche. In vielen Fällen wird + diese Einstellung ausreichen, so daß der Anwender kein eigenes + 'viewport' definieren muß. + + Der Abbildungsmaßstab wird durch das Zusammenspiel von 'viewport' + und 'window' festgelegt (siehe dort). Dabei ist insbesondere + darauf zu achten, daß winkeltreue Darstellungen nur bei gleichem + X- und Y-Maßstab möglich sind. Da man oft quadratische Fenster + ('window') verwendet, wurde als Standardfall auch ein quadrati- + sches 'viewport' gewählt. + +where + PROC where (PICTURE CONST pic, REAL VAR x, y) + Zweck: Die aktuelle Stiftposition wird in 'x' und 'y' eingetragen. + Fehlerfall: + * picture is threedimensional + Das PICTURE 'pic' ist dreidimensional + + PROC where (PICTURE CONST pic, REAL VAR x, y, z) + Zweck: Die aktuelle Stiftposition wird in 'x', 'y' und 'z' eingetragen. + Fehlerfall: + * picture is twodimensional + Das PICTURE 'pic' ist zweidimensional + +window + PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) + Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das + darzustellende Fenster definiert. Alle Bildpunkte, deren X-Ko- + ordinaten im Intervall [x min, x max] und deren Y-Koordinaten im + Intervall [y min, y max] liegen, gehören zum definierten Fenster. + Vektoren, die über dieses Fenster hinausgehen, werden abge- + schnitten. Dieses Fenster wird auf die spezifizierte Zeichen- + fläche abgebildet. (Das ist standardmäßig das größtmögliche + Quadrat auf dem ausgewählten Gerät). + + Der Darstellungsmaßstab ergibt sich als + + x max - x min + ----------------------------------------- + horizontale Seitenlänge der Zeichenfläche + + y max - y min + ----------------------------------------- + vertikale Seitenlänge der Zeichenfläche + + Für eine winkeltreue Darstellung müssen X- und Y-Maßstab + gleich sein! Einfach können winkeltreue Darstellung erreicht + werden, wenn das Fenster eine quadratische Form hat. Die + Zeichenfläche ('viewport') ist dementsprechend als Quadrat vor- + eingestellt. + + PROC window (PICFILE VAR p, + REAL CONST x min, x max, y min, y max, z min, z max) + Zweck: Für die Darstellung eines dreidimensionalen Bildes wird das darzu- + stellende Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im + Intervall [x min, x max] und deren Y-Koordinaten im Intervall + [y min, y max] und deren Z-Koordinaten im Intervall [z min, z max] + liegen, gehören zum definierten Fenster. Dieses dreidimensionale + Fenster (Quader) wird entsprechend der eingestellten Projektions- + art (orthografisch, perspektivisch oder schiefwinklig) und den + Betrachtungswinkeln (s. 'view') auf die spezifizierte Zeichen- + fläche abgebildet. (Das ist standardmäßig das größtmögliche + Quadrat auf dem ausgewählten Gerät.) Linien, die außerhalb dieses + Quadrates liegen, werden abgeschnitten. + + Anders als im zweidimensionalen Fall ist das Problem der Maßstäbe + nicht mehr nur durch das Zusammenspiel von 'window' und 'view- + port' zu beschreiben. Hier spielen auch Projektionsart und Dar- + stellungswinkel eine Rolle. Falls alle Darstellungswinkel den + Wert 0.0 haben, gilt das für den zweidimensionalen Fall gesagte + für die Ebene (y = 0.0) entsprechend. + +write is possible + BOOL PROC write is possible (PICTURE CONST pic, INT CONST space) + Zweck: Liefert 'TRUE', falls 'space' Bytes Platz in 'pic' vorhanden ist. + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil11 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil11 new file mode 100644 index 0000000..cae9c50 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil11 @@ -0,0 +1,1072 @@ + EUMEL-Benutzerhandbuch + + TEIL 11: Utilities + + +In diesem Teil werden einige Dienstprogramme aufgeführt. Diese Programme +sind bei speziellen Anwendungen nützlich. + + + +1. Scanner + +Der Scanner zerlegt einen TEXT in Symbole bzw. "Tokens" entsprechend der +ELAN-Sprachdefinition. + +Der Scanner kann benutzt werden, um festzustellen, welche Art von Symbolen +in einem TEXT enthalten sind. Die Repräsentation der Symbole müssen dabei +der ELAN-Syntax entsprechen. Folgende #ib#Symbole#ie# kann der Scanner +erkennen: + + - "tags", d.h. Namen, + - "bolds", d.h. Schlüsselworte, + - "number", d.h. INT oder REAL Zahlen, + - Operatoren, + - "delimiter", d.h. Begrenzer wie z.B. ";", + - und das Ende des Scan-Textes. + + +Der Scanner überliest Kommentare und Leerzeichen zwischen den Symbolen. +Der (erste) zu verarbeitende Text muß mit der Prozedur + + scan + +in den Scanner "hineingesteckt" werden. Mit der Prozedur + + next symbol + +wird das jeweils nächste Symbol des TEXTes geholt. Am Ende wird "end of scan" +und als Symbol 'niltext' geliefert. Falls innerhalb eines TEXT-Denoters oder +eines Kommentars "end of scan" auftritt, wird "within text" bzw. "within +comment" gemeldet. Der Scan-Prozeß kann dann mit dem nächsten zu scannenden +TEXT (der nächsten Zeile) fortgesetzt werden. Dafür wird nicht die Prozedur +'scan', sondern + + continue scan + +verwandt. Sie setzt im letzten Scan-Zustand (z.B. Kommentar oder TEXT- +Denoter) wieder auf, so daß auch Folgen von TEXTen (Zeilen) wie z.B. Dateien +leicht gescannt werden können. + +Mit den Prozeduren + + scan (* meldet eine Datei zum scannen an *) + next symbol (* holt die Symbole *) + +kann man auch eine Datei nach ELAN-Symbolen untersuchen. Beispiel: + + FILE VAR f :: ... + ... + scan (f); (* beginnt das Scanning in der nächsten Zeile *) + TEXT VAR symbol; + INT VAR type; + REP + next symbol (f, symbol, type); + verarbeite symbol + UNTIL type >= 7 END REP. + +Merke: Mit dem Scanner kann man einen ELAN-Text analysieren. + + + +Scanner-Kommandos + +continue scan + PROC continue scan (TEXT CONST scan text) + Zweck: Das Scanning soll mit 'scan text' fortgesetzt werden. Falls der + Scan-Vorgang beim vorigen 'scan text' innerhalb eines TEXT- + Denoters oder eines Kommentars abgebrochen wurde, wird er jetzt + entsprechend mit dem nächsten 'next symbol' fortgesetzt. Der + erste Teil-Scan einer Folge muß aber stets mit 'scan' einge- + leitet werden! + +next symbol + PROC next symbol (TEXT VAR symbol, INT VAR type) + Zweck: Holt das nächste Symbol. In "symbol" steht der TEXT des Symbols, + so z.B. die Ziffern eines INT-Denoters. Bei TEXT-Denotern + werden die führenden und abschließenden Anführungsstriche ab- + geschnitten. Leerzeichen oder Kommentare spielen in "tags" oder + "numbers" keine Rolle. Zwischen Symbolen spielen Leerzeichen + oder Kommentare keine Rolle. In "type" steht eine Kennzeichung + für den Typ des Symbols: + + tag = 1 , + bold = 2 , + number = 3 , + text = 4 , + operator = 5 , + delimiter = 6 , + end of file = 7 , + within comment = 8 , + within text = 9 . + + Wird Scan-Ende innerhalb eines Kommentars gefunden, so wird + 'niltext' und 'within comment' geliefert. Wird Scan-Ende inner- + halb eines TEXT-Denoters gefunden, so wird der schon analysierte + Teil des Denoters und 'within text' geliefert. + + PROC next symbol (TEXT VAR symbol) + Zweck: s.o. Es wird aber nur der Text des Symbols (ohne Typ) geliefert. + + PROC next symbol (FILE VAR f, TEXT CONST symbol) + Zweck: arbeitet wie obige Prozeduren, jedoch auf einen FILE. + + PROC next symbol (FILE VAR f, TEXT CONST symbol, INT VAR type) + Zweck: arbeitet wie obige Prozeduren, jedoch auf einen FILE. + +scan + PROC scan (TEXT CONST scan text) + Zweck: Meldet einen 'scan text' für den Scanner zur Verarbeitung an. + Die Prozedur 'scan' muß vor dem ersten Aufruf von 'next symbol' + gegeben werden. Im Gegensatz zu 'continue scan' normiert 'scan' + den inneren Zustand des Scanners, d.h. vorherige Scan-Vorgänge + haben keinen Einfluß mehr auf das Scanning. + + PROC scan (FILE VAR f) + Zweck: Wie obige Prozedur, jedoch auf einen FILE. Die zu scannende Zeile + ist die nächste Zeile im FILE 'f' ('scan' macht zuerst ein 'get- + line'). + + + +2. Inspector + +Der Inspector stellt ein Hilfsmittel bei der Programmentwicklung dar. + +Der Inspector informiert über alle + + - insertierten Prozeduren / Operatoren mit dem gleichen Namen + - Prozeduren / Operatoren / Typen, die ein Paket definiert + - bisher insertierten Pakete + - insertierten Prozeduren / Operatoren / Typen. + +Mit dem Aufruf von + + help ("name") + +wird eine Liste aller Prozeduren / Operatoren, die 'name' heißen, auf dem +Bildschirm ausgegeben. Die Liste ist paketweise sortiert unter Angabe des +Paketnamens. Die Ausgabe erfolgt mit der Angabe der Parametertypen. Gibt es +kein Objekt mit dem angegebenen Namen, so erscheint die Ausgabe + + unbekannt: name + +Das Kommando + + bulletin ("paket name") + +informiert über alle Objekte, die in der DEFINES-Liste des Pakets mit dem +Namen "paket name" stehen. Die Ausgabe erfolgt wie beim list-Kommando. + +Eine gesamte Liste aller bisher insertierten Prozeduren/Operatoren/Typen +erhält man mit dem Kommando + + bulletin + +Bei diesen Funktionen ist (noch) zu beachten, daß Typen immer dem textmäßig +vorhergehendem Paket zugeordnet werden. Der Grund hierfür liegt in der +Behandlung abstrakter Datentypen im ELAN-Compiler. Eine Korrektur ist für +spätere Auslieferungen geplant. + +Mit + + packets + +werden die Namen aller bisher insertierten Pakete "gelistet". + +Merke: Mit 'help' kann man sich über verfügbare Prozeduren/Operatoren in- +formieren. + + + +Inspector-Kommandos + +help + PROC help (TEXT CONST name) + Zweck: Listen aller Prozeduren / Operatoren mit dem Namen "name". Die + Ausgabe erfolgt direkt auf den Bildschirm. + +bulletin + PROC bulletin (TEXT CONST paket name) + Zweck: Listen aller in der DEFINES-Liste des Pakets mit dem Namen + "paket name". + + PROC bulletin + Zweck: Es wird eine Liste aller bisher insertierter Objekte erstellt. + Diese Liste ist paketweise sortiert. + +packets + PROC packets + Zweck: Auflisten der Namen aller bisher insertierten Pakete. + + + +3. Lexikographische Vergleiche + +Die üblichen Operatoren für TEXTe arbeiten mit dem der Reihenfolge des EUMEL- +Zeichencodes. Hier wird beschrieben, wie man lexikographische Vergleiche +nach DIN erhält. + +Für TEXT-Vergleiche nach DIN 5007 gibt es die Operatoren + + LEXEQUAL + LEXGREATER + LEXGREATEREQUAL + +Diese Operatoren vergleichen zwei TEXTE nach DIN 5007 mit folgenden +Bedingungen: + +- Die Reihenfolge enspricht 'ABC...Z', wobei große und kleine Buchstaben + gleich behandelt werden. + +- Weitere Entsprechungen: + ö = oe, ä = ae, ü = ue + Ö = Oe, Ü = Ue, Ä = Ae, + Ä = ä, Ü = ü, Ö = ö, + ß = ss + Dadurch ist z.B. + + "muß" LEXGREATER "Muster" --> FALSE + "Goethe" LEXEQUAL "Göthe" --> TRUE + +- Alle Sonderzeichen (außer " " und "-") werden ignoriert. + +- Ein Leerzeichen und ein Bindestrich zwischen Worten werden gleich behan- + delt. Beispiel: + + "EUMEL System" LEXEQUAL "EUMEL-System" --> TRUE + +Anmerkung: Diese drei Operatoren sind - sofern die oben erwähnten Zeichen in +den Operanden vorkommen - langsamer als die "normalen" TEXT-Vergleiche +(=, >, <, usw.). Das liegt daran, daß die Operanden in solchen Fällen +umgewandelt werden. + + + +Lexikographische Operatoren + +LEXEQUAL + BOOL OP LEXEQUAL (TEXT CONST l, r) + Zweck: Lexikographischer Vergleich von 'l' und 'r' auf Gleichheit. + +LEXGREATER + BOOL OP LEXGREATER (TEXT CONST l, r) + Zweck: Lexikographischer Vergleich von 'l' und 'r' auf "Grösser". + +LEXGREATEREQUAL + BOOL OP LEXGREATEREQUAL (TEXT CONST l, r) + Zweck: Lexikographischer Vergleich von 'l' und 'r' auf "Grösser Gleich". + + + +4. Der 'reporter' + +Das Programm 'reporter' dient zur Fehlersuche und/oder Lokalisierung von +besonders häufig durchlaufenen Programmteilen. Zu diesem Zweck werden in ein +Programm Prozeduraufrufe eingefügt, die veranlassen, daß bestimmte Informa- +tionen (normalerweise Ablaufinformationen) in eine Datei (die TRACE-Datei) +geschrieben werden. + +'reporter' ermöglicht + +a) Ablaufinformationen ("trace"); +b) Häufigkeitszählung ("frequency count"); +c) Programmunterbrechung bei Nichterfüllung einer Bedingung ("assertion"). + + + +Installation von 'reporter' + +Das Programm befindet sich in der Datei 'reporter' und kann wie üblich in- +sertiert werden. Jedoch muß es mit 'check off' übersetzt werden, damit keine +Zeilennummern für 'reporter' generiert werden. Dies ist notwendig, damit die +Zeilennummern des zu testenden Programms nicht mit den Zeilennummern des +Programms 'reporter' verwechselt werden können. Beispiel: + + check off; insert ("reporter"); check on + + + +Vorbereitungen + +Mit dem Kommando + + generate reports ("testdatei") + +werden die oben erwähnten Prozeduraufrufe ('report') in das zu testende +Programm, welches in der Datei 'testdatei' steht, geschrieben. Die Prozedur- +aufrufe werden nach jedem Prozedur-, Operator- oder Refinement-Kopf +eingefügt und erhalten den entsprechenden Namen als Parameter. Diese +Prozeduraufrufe werden gekennzeichnet, damit sie von der Prozedur + + eliminate reports ("testdatei") + +automatisch wieder entfernt werden können. Beispiel (für die eingefügten +Prozeduraufrufe): + + ... + PROC beispiel (INT CONST mist): + ##report ("beispiel");## + ... + + + +Automatische Ablaufinformationen + +Ist ein Programm mit 'generate reports' mit 'report'-Aufrufen versehen +worden, kann es wie gewohnt übersetzt werden. Wird das Programm vom ELAN- +Compiler korrekt übersetzt und dann gestartet, wird bei jedem Antreffen +eines 'report'-Aufrufs der Parameter (Name der Prozedur, Operator oder +Refinement) in eine Datei, die TRACE-Datei geschrieben. Die TRACE-Datei wird +beim Programmlauf automatisch von 'reporter' unter dem Namen 'TRACE' einge- +richtet. + +Mit Hilfe dieser Datei kann der Programmablauf verfolgt werden. Es ist damit +auch möglich festzustellen, wo eine "Endlos-Rekursion" auftritt. Die Ablauf- +informationen bestehen nur aus den Namen der angetroffenen Prozeduren und +Refinements. Trotzdem können die Anzahl der Informationen sehr umfangreich +werden. Deshalb gibt es die Möglichkeit, die Erzeugung der Ablaufinforma- +tionen ab- bzw. wieder anzuschalten. Dazu gibt es die Möglichkeit, in das zu +testende Programm die Prozeduren + + report on + report off + +einzufügen und das zu testende Programm mit diesen Prozeduraufrufen (erneut) +zu übersetzen. + + + +Benutzereigene Ablaufinformationen + +Zusätzlich zu den von 'generate reports' eingefügten 'report'-Aufrufen kann +ein Benutzer eigene Aufrufe an geeigneten Stellen in ein Programm schreiben. +Dafür werden weitere 'report'-Prozeduren zur Verfügung gestellt, die als +ersten Parameter ein TEXT-Objekt (meist Name des Objekts oder der Ausdruck +selbst) und als zweiten ein INT/REAL/TEXT/ BOOL-Objekt (der zu überprüfende +Wert oder Ausdruck) enthalten. Beispiel: + + ... + PROC beispiel (INT CONST mist): + ##report ("beispiel");## (* automatisch eingefuegte *) + INT VAR mist :: ...; ... + ##report ("mist:", mist);## (* vom Benutzer per Hand eingefuegt *) + ... + +Folgende 'report'-Routinen stehen zur Verfügung, damit man sie "von Hand" in +ein zu testendes Programm einfügen kann: + + PROC report on + PROC report off + PROC report (TEXT CONST message) + PROC report (TEXT CONST message, INT CONST value) + PROC report (TEXT CONST message, REAL CONST value) + PROC report (TEXT CONST message, TEXT CONST value) + PROC report (TEXT CONST message, BOOL CONST value) + +Wichtig: Hier - wie bei allen anderen "von Hand eingefügten" Aufrufen - +sollte ein Nutzer sich an die Konvention halten, diese in "##" einzuklammern. +Mit 'eliminate reports' werden diese Einfügungen automatisch entfernt. +Sollen diese Aufrufe aber immer im Programm erhalten bleiben (jedoch nicht +wirksam sein), sollten sie + +a) vor 'generate reports'-Aufruf mit jeweils '###' eingefaßt werden. + Beispiel: + ### report ("...") ### + So steht das 'report'-Statement in einem Kommentar. 'generate reports' + wandelt '###' --> '####' um, so daß ein solches Statement wirksam wird. + 'eliminate reports' wandelt ein '####' --> '###' zurück. + +b) nach 'generate reports' in '####' eingefaßt werden. + + + +Häufigkeitszählung + +Eine Häufigkeitszählung erhält man, in dem man in das zu testende Programm +die Aufrufe + + count on + count off + +einfügt. Ist die Häufigkeitszählung eingeschaltet, merkt sich 'reporter' die +Anzahl der Durchläufe für jede Prozedur bzw. Refinement. Mit der Prozedur + + generate counts ("zu testende datei") + +werden die vermerkten Häufigkeiten in das zu testende Programm direkt einge- +fügt. Die Häufigkeiten werden wie oben beschrieben gekennzeichnet, so daß sie +mit 'eliminate reports' entfernt werden können. + + + +Assertions + +Zusätzlich zu den oben erwähnten Möglichkeiten bietet 'reporter' noch die +Prozedur + + assert + +an. Diese Prozedur kann von einem Programmierer an einer Stelle in das zu +testende Programm eingefügt werden, an der bestimmte Bedingungen erfüllt sein +müssen. Die Prozedur 'assert' steht in zwei Formen zur Verfügung: + + PROC assert (BOOL CONST zusicherung) + PROC assert (TEXT CONST message, BOOL CONST zusicherung) + +Ist der Wert von 'zusicherung' nicht TRUE, wird der Programmlauf abgebrochen. + + + +'reporter'-Kommandos + +count on + PROC count on + Zweck: Schaltet die Häufigkeitszählung ein. + +count off + PROC count off + Zweck: Schaltet die Häufigkeitszählung aus. + +eliminate reports + PROC eliminate reports (TEXT CONST datei) + Zweck: Entfernt gekennzeichnete 'report'-Aufrufe aus der Datei 'datei'. + +generate reports + PROC generate reports (TEXT CONST datei) + Zweck: Fügt 'report'-Aufrufe in die Datei 'datei' ein und kennzeichnet + diese mit '##'. + +report on + PROC report on + Zweck: Schaltet die Ablaufinformationen in die Datei 'TRACE' ein. + +report off + PROC report off + Zweck: Schaltet die Ablaufinformationen wieder aus. + +generate counts + PROC generate counts (TEXT CONST datei) + Zweck: Bringt die Häufigkeitszählung (wie oft eine Prozedur oder Refine- + ment durchlaufen wurde) in die Programmdatei 'datei'. Mit + 'eliminate reports' werden diese wieder automatisch entfernt. + +assert + PROC assert (TEXT CONST message, BOOL CONST value) + Zweck: Schreibt 'message' und den Wert von 'value' in die TRACE-Datei. + Ist 'value' FALSE, wird angefragt, ob das Programm fortgesetzt + werden soll. + + + +5. Referencer + +Das Programm 'referencer' erstellt aus einem (syntaktisch korrektem) ELAN- +Programm eine Liste, in der jedes Auftreten eines Objekts mit der betref- +fenden Zeilennummer verzeichnet ist. + + 'referencer' wird durch + + referencer ("ref datei", "referenz liste") + +aufgerufen, wobei die Datei 'referenz liste' nicht existieren darf. +'referenz liste' enthält nach Ablauf des Programms die gewünschte Liste, die +sogenannte Referenzliste. + +Achtung: 'referencer' arbeitet ausschließlich mit Namen und verarbeitet nur +wenige syntaktische Konstrukte. Darum ist es nur erlaubt, ein PACKET auf +einmal von 'referencer' verarbeiten zu lassen. Verarbeitet man mehrere +PACKETs auf einmal, kann es geschehen, daß gleichnamige Objekte in unter- +schiedlichen Paketen zu Warnungen (vergl. die unten beschriebenen Überprü- +fungen) führen. + +In der Referenzliste sind + +- alle Objekte mit ihrem Namen (in der Reihenfolge ihres Auftretens im + Programm) + +- alle Zeilennummern, in der das Objekt angesprochen wird + +- die Zeilennummern, in der das Objekt deklariert wurde ('L' für ein lokales + und 'G' für ein globales Objekt, 'R' für ein Refinement) + +verzeichnet. + +Die Referenzliste kann u.a. dazu dienen, zu kontrollieren, ob und wie (bzw. +wo) ein Objekt angesprochen wird. Dies lohnt sich selbstverständlich nur bei +etwas umfangreicheren Programmen (bei "Mini"-Programmen kann man dies sofort +sehen). + +Bei der Erstellung der Referenzliste nimmt das Programm 'referencer' gleich- +zeitig einige Überprüfungen vor, die helfen können, ein Programm zu ver- +bessern: + +1. Warnung bei mehrzeiligen Kommentaren. + +2. Überdeckungsfehler. Wird ein Objekt global (auf PACKET-Ebene) und noch- + mals lokal in einer Prozedur deklariert, ist das globale Objekt nicht mehr + ansprechbar. Überdeckungen sind nach der gültigen Sprachdefinition z.Zt. + noch erlaubt, werden aber bei einer Revision des Sprachstandards verboten + sein. + +3. Mehrmaliges Einsetzen von Refinements. Wird ein Refinement mehrmals einge- + setzt (das ist völlig legal), sollte man überlegen, ob sich dieses Refine- + ment nicht zu einer Prozedur umgestalten läßt. + +4. Nicht angewandte Refinements. Wird ein Refinement zwar deklariert, aber + nicht "aufgerufen", erfolgt eine Warnung. + +5. Nicht angesprochene Daten-Objekte. Werden Daten-Objekte zwar deklariert, + aber im folgenden nicht angesprochen, wird eine Warnung ausgegeben. + Hinweis: Alle Objekte, die nur wenig angesprochen werden, also nur wenige + Zeilennummern in der Referenzliste besitzen, sind verdächtig (Ausnahmen: + importierte Prozeduren, LET-Objekte u.a.m.). + + + +'referencer'-Kommandos + +referencer + PROC referencer (TEXT CONST check file, dump file) + Zweck: Überprüft 'check file'. In 'dump file' steht nach Abschluß die + Referenzliste. + + + +6. Notizen (Notizbuch, Fehlerprotokoll) + +Das Notizbuch erlaubt es u.a., Fehlermeldungen zwischenzeitig zu speichern +und am Ende einer Verarbeitung die Fehlermeldungen zusammen mit dem bear- +beiteten Text im Paralleleditor anzuzeigen. + +Das Notizbuch wird eingesetzt, wenn Texte bearbeitet werden, die gewissen +Regeln entsprechen müssen (Beispiele: ELAN-Compiler, Textkosmetik usw.). In +solchen Fällen ist es nützlich, die Fehlermeldungen zwischenzeitig zu +speichern und erst am Ende einer Verarbeitung gesammelt dem Benutzer zusam- +men mit dem Quelltext anzuzeigen. Diese Aufgaben übernimmt das Notizbuch. +Mit der Prozedur + + note + +kann eine Meldung im Notizbuch gespeichert werden. Mit + + note line + +wird der Beginn einer neuen Zeile im Notizbuch signalisiert. Das bedeutet, +daß ein Programmierer für alle Zeilenvorschübe in der Fehlermeldungsdatei mit +dieser Prozedur zu sorgen hat. + +Mit der Informationsprozedur + + anything noted + +kann man am Ende einer Verarbeitung abfragen, ob Fehlermeldungen gespeichert +wurden. Ist das der Fall, kann man den Paralleleditor aufrufen: + + note edit + +In der oberen Hälfte werden die Fehlermeldungen dargestellt, in der unteren +den zu bearbeitenden Text. Beispiel: + + PROC verarbeite (TEXT CONST datei): + FILE VAR f :: sequential file (input, datei); + verarbeitung; + ende behandlung. + + verarbeitung: + ... + note (fehlermeldung); + note line. + + ende behandlung: + IF anything noted + THEN note edit (f) + FI + END PROC verarbeite + + + +Notizbuch-Kommandos + +anything noted + BOOL PROC anything noted + Zweck: Informationsprozedur, ob etwas in das Notizbuch geschrieben wurde. + +note edit + PROC note edit + Zweck Bewirkt das Anzeigen des Notizbuchs auf vollem Bildschirm. + + PROC note edit (FILE VAR f) + Zweck: Anzeigen des Notizbuchs und der Datei 'f' durch den Parallel- + editor. + +note file + FILE PROC note file + Zweck: Assoziierungsprozedur. Liefert das Notizbuch. + +note line + PROC note line + Zweck: Zeilenvorschub im Notizbuch. + +note + PROC note (TEXT CONST meldung) + Zweck: Schreibt 'meldung' in das Notizbuch. + + PROC note (INT CONST zahl) + Zweck: Schreibt 'zahl' als TEXT in das Notizbuch (analog 'put'). + + + +7. Sortier-Programme + +Es stehen zwei verschiedene Sortier-Programme zur Verfügung: 'sort' +(Sortierung nach ASCII-Reihenfolge) und 'lex sort' (Sortierung nach +deutschem Alphabet). + +Das Kommando + + sort ("datei") + +sortiert 'datei' zeilenweise. Beispiel: + + Eingabe-Datei: + Berta ist eine Frau. + Adam ist ein Mann. + ... + Sortierte Datei: + Adam ist ein Mann. + Berta ist eine Frau. + ... + +Dabei werden die Zeilen-Anfänge solange zeichenweise miteinander verglichen, +bis ein Unterschied auftritt und dann ggf. umgeordnet. Werden zwei ungleich +lange Zeilen (Anzahl Zeichen/Zeile) miteinander verglichen, dann kann man +sich die kürzere Zeile mit Leerzeichen auf die Länge der längeren Zeile +verlängert denken. + +Die Reihenfolge, in der die Zeilen sortiert werden, erfolgt nach dem ASCII- +Zeichensatz in aufsteigender Reihenfolge (vergl. TEIL 3; EUMEL-Zeichencode): + + Leerzeichen + einige Sonderzeichen + Ziffern + einige Sonderzeichen + Große Buchstaben + einige Sonderzeichen + kleine Buchstaben + einige Sonderzeichen + Umlaute und ß + +Das bedeutet, daß z.B. folgendermaßen sortiert wird: + + Adam + Ball + Zuruf + aber das ist ein Satz + niemals + Überlauf + +Um zu erreichen, daß große und kleine Buchstaben gleichwertig behandelt +werden, kann man das Kommando + + lex sort ("datei") + +geben. In diesem Fall würde die sortierte Datei folgendermaßen aussehen: + + aber das ist ein Satz + Adam + Ball + niemals + Überlauf + Zuruf + +Man beachte, daß der Umlaut 'Ü' wie 'Ue' behandelt wird (für die restlichen +Umlaute gilt eine analoge Behandlung; ebenso wird 'ß' wie 'ss' behandelt). +Weiterhin werden alle Sonderzeichen bei der Sortierreihenfolge ignoriert. + + + +Sortier-Kommandos + +sort + PROC sort (TEXT CONST datei) + Zweck: Die Prozedur 'sort' sortiert die Datei 'datei' zeilenweise. Die + Sortierung erfolgt nach der Ordnung, die der EUMEL-Zeichencode + vorschreibt. Beispielsweise werden Zeilen ("Sätze"), die mit + Ziffern beginnen, vor Sätzen, die mit Buchstaben anfangen, ein- + geordnet. Sätze, die mit großen Buchstaben beginnen, werden vor + Sätzen mit kleinen Buchstaben einsortiert. Weiterhin werden die + Umlaute und das "ß" nach allen anderen Buchstaben eingeordnet. + + PROC sort (TEXT CONST datei, INT CONST anfang) + Zweck: Sortiert eine Datei wie obige Prozedur, jedoch wird bei der + Sortierung nicht der Anfang eines Satzes beachtet, sondern die + Position 'anfang'. + +lex sort + PROC lex sort (TEXT CONST datei) + Zweck: Wie 'sort', jedoch nach (deutscher) lexikographischer Reihen- + folge nach DIN 5007. Bei den Vergleichen werden die Operatoren + LEXEQUAL, LEXGREATER, LEXGREATEREQUAL (vergl. TEIL 11 des + Benutzerhandbuchs) verwandt. Anmerkung: 'lex sort' ist um + einiges langsamer als 'sort'. + + PROC lex sort (TEXT CONST datei, INT CONST anfang) + Zweck: Wie 'lex sort', jedoch wird bei der Sortierung bei 'anfang' + jeder Zeile begonnen. + + + +8. Rechnen im Editor: TeCal + +Das Programm TeCal (Abkürzung für "Text Calculator") ermöglicht das einfache +Rechnen im EUMEL-Editor. + +Das Programm TeCal ermöglicht einfache Rechnungen (ähnlich wie mit einem +Taschenrechner) unter der Benutzung des Editors. Gleichzeitig stehen dem +Benutzer aber alle Fähigkeiten des Editors zur Verfügung. TeCal ermöglicht +Rechnungen auf einfache Weise zu erstellen oder Tabellenspalten zu berechnen. + +TeCal wird aus dem Editor heraus durch 'ESC t' oder durch das Editor- +Kommando + + tecal + +aktiviert. (Anmerkung: TeCal ist nicht standardmäßig insertiert). Dadurch +wird in der untersten Zeile des Bildschirms eine Informationszeile aufgebaut, +in der die (Zwischen-) Ergebnisse einer Rechnung zur Kontrolle festgehalten +werden. + +Merke: TeCal ermöglicht einfache Rechnungen im EUMEL-Editor. + + + +Ein einfaches Beispiel + +Angenommen, Prokurist Meier der Firma 'Software Experts' muß eine Rechnung +schreiben. Er schreibt u.a.: + + ... + Wir berechnen Ihnen + + 1 Manual 'Software Auswahl leicht gemacht' 112.30 DM + 1 Manual 'Ohne Fehler programmieren' 300.- + + Summe + +Nun kann er die TeCal-Funktionen durch + + ESC t + +zuschalten. (Natürlich kann TeCal auch schon während des Schreibens einge- +schaltet sein, das Editorfenster ist dann nur um eine Zeile (nämlich die +TeCal-Informationszeile) kürzer. Zuerst löscht Prokurist Meier eventuell +vorhandene Zwischenergebnisse von TeCal (TeCal vergißt eine angefangene +Rechnung durch Abschalten nicht!) mit + + ESC C + +Das funktioniert wie eine CLEAR-Taste bei einem Taschenrechner, löscht also +ggf. vorhandene Werte. In der Informationszeile (die letzte Zeile des Bild- +schirms) erscheint darum als Wert '0.0'. + +Nun "fährt" er mit dem Cursor auf den ersten Wert ('112.30'). Dabei ist es +belanglos, welche Ziffer er "trifft". Dann betätigt er + + ESC L + +(für Lesen). Damit erscheint dieser Wert in der Informationszeile. Durch +'ESC L' wird versucht, einen Wert von der Stelle aus der Datei zu lesen, die +durch den Cursor angezeigt wird. (Gelingt dies nicht, erfolgt in der +obersten Zeile eine Fehlermeldung). Dann betätigt er + + ESC + + +weil er ja die zwei Werte addieren will. Das Zwischenergebnis in der TeCal- +Informationszeile bleibt dadurch unverändert. Jetzt fährt er auf den zweiten +Wert und betätigt erneut 'ESC L'. Nun erscheint der zweite Wert in der An- +zeige. Um das Ergebnis der Rechnung zu erfahren, betätigt er + + ESC = + +Die Summe der zwei Zahlen erscheint nun in der Informationszeile. Nun fährt +er mit dem Cursor auf die Stelle, an der die Summe stehen soll und betätigt +hier + + ESC S + +(für Schreiben). Damit erscheint die eben errechnete Summe (412.30) an dieser +Stelle der Datei. + +Man bedient TeCal also wie einen Taschenrechner. Man muß allerdings, um die +Rechentasten zu bedienen, ESC zuvor drücken. Dies ist notwendig, um die +"normalen" Tasten von den TeCal-Tasten zu unterscheiden. + +Merke: Mit einigen einfachen Tastendrücken können Berechnungen vorgenommen +werden. 'ESC L' liest einen Wert von der aktuellen Cursor-Position, 'ESC S' +schreibt den angezeigten TeCal-Wert an die aktuelle Cursor-Position. 'ESC C' +löscht alle Werte im TeCal-Rechner. + + + +Einige weitere einfache Rechenoperationen + +In diesem Abschnitt werden weitere einfache Operationen von TeCal be- +schrieben. + +Natürlich kann man mit TeCal nicht nur Addieren. Die folgenden Operationen +laufen analog 'ESC +': + + ESC - (Subtrahieren) + ESC * (Multiplizieren) + ESC / (Dividieren) + +Beispiel: + + ... + Wir berechnen Ihnen + + Artikelbezeichnung Anzahl Einzelpreis Summe + + Schraube, verdreht 27 1.05 28.35 + + Gesamt 28.35 + +Dazu drückt Prokurist Meier folgende Tasten: + + Cursor auf Taste TeCal-Anzeige + + 27 ESC C 0.00 + unverändert ESC L 27.00 + unverändert ESC * 27.00 + 1.05 ESC L 1.05 + unverändert ESC = 28.35 + unter Summe ESC S 28.35 + in Gesamtzeile ESC S 28.35 + +Wie wir sehen, kann Prokurist Meier jederzeit seine Eingaben kontrollieren +mit Hilfe der TeCal-Informationszeile. + +Anmerkung: + +'ESC S' schreibt den aktuellen Wert wie der Dezimal-Tabulator des Editors +(vergleiche Kapitel Editor). Die Stelle, an der der Cursor steht, wird beim +Schreiben die letzte Stelle vor dem Dezimalpunkt. Ziffern vor dem Dezimal- +punkt werden also nach links, Ziffern nach dem Dezimalpunkt nach rechts ge- +schrieben. + +Merke: ESC mit den Tasten '-', '+', '*' und '/' haben die gewohnte Wirkung. + + + +Die Verwendung von Klammern + +TeCal erlaubt bei Rechnungen die Eingabe von Klammern. + +Beispiel (wir haben hier die Taste ESC fortgelassen): + + 2 * (3 + 5) = 16.00 + +Merke: Klammern können bei Rechnungen beliebig verwendet werden. + + + +Der Prozent-Operator + +Angenommen, wir wollen 14 Prozent von 200 DM errechnen. Dann können wir wie +gewohnt verfahren (für bessere Lesbarkeit zeigen wir hier für 'ESC L' den +jeweiligen Wert): + + 200 ESC % ESC = + +Der Prozent-Operator berechnet immer einen eingestellten Prozentsatz von dem +gerade angezeigten Zwischenergebnis. Der eingestellte Prozentsatz wird in der +Informationszeile angezeigt. Er läßt sich mit Hilfe des Kommandos + + prozentsatz ('prozentzahl') + +verändern. + +Was müssen wir machen, um die 14 Prozent von 200 auf den Wert von 200 zu +addieren? Ganz einfach: + + 200 ESC + ESC % ESC = + +Wie wir solche Tastensequenzen einfacher erledigen können, zeigen wir in +einem späteren Abschnitt. + +Merke: Der Prozent-Operator berechnet immer den eingestellten Prozentanteil +vom angezeigten Wert. + + + +Spaltenweise summieren + +Da es beim Schreiben von Rechnungen o.ä. häufig vorkommt, daß eine ganze +Zahlenkolonne addiert werden soll, besitzt TeCal eine Sonderfunktion, die es +dem Benutzer erspart, mit dem Cursor auf jeden einzelnen Wert zu fahren und +'ESC L' sowie 'ESC +' zu drücken. Durch + + ESC V + +addiert TeCal zu der Zahl, auf der der Cursor steht alle, die in gerader +Linie darüberstehen, solange bis eine Zeile gefunden wird, in der Text oder +andere Zeichen stehen, die nicht zu einer Zahl gehören. Leerzeichen führen +also nicht zum Abbruch der Rechnung. Nehmen wir an, Prokurist Meier hätte +seine Rechnung soweit fertig : + + ... + Wir berechnen Ihnen + + Artikelbezeichnung Anzahl Einzelpreis Summe + + Schraube, verdreht 27 1.05 28.35 + Nagel, m. Kopf 33 0.50 16.50 + Hammer, Spezialausführung m. + Eichenholzgriff 1 44.70 44.70 + -------- + +Um nun die Gesamtsumme zu berechnen fährt er einfach mit dem Cursor auf die +unterste Zahl (44.70) und betätigt ESC V. In der Anzeige steht direkt die +Gesamtsumme, die dann mit ESC S unter dem Strich eingetragen werden kann. + +Merke: Zahlenkolonnen können mit ESC V summiert werden. + + + +Direkte Eingabe + +Es kann ein Wert direkt in die Berechnung eingehen, ohne daß er vorher in +der Datei stehen muß. + +Durch das Betätigen von + + ESC E + +erscheint 'gib wert :' in der TeCal-Informationszeile. Nun kann ein Wert +(wie im Editor) eingegeben werden, zugelassen ist auch ein ganzer Ausdruck +wie z.B. + + (3.00 DM + 5.00 DM) * 365 Tage - 2,00 DM * 12 Monate + +Dabei sind auch Buchstaben erlaubt, die aber überlesen werden. Betätigt man +RETURN, wird der Ausdruck ausgewertet und der Wert in die Anzeige über- +nommen. Für das oben gezeigte Beispiel steht die Anzeige also anschließend +auf 2896. Auf diese Weise kann man auch einfach Zwischenrechnungen machen, +ohne daß die verwendeten Zahlen irgendwo in der Datei stehen. Das Ergebnis +kann man dann weiter verrechnen, als wäre es mit ESC L aus der Datei gelesen +worden. Natürlich kann man es auch direkt mit ESC S in die Datei schreiben. + +Merke: Mit ESC E wird ein Wert direkt in TeCal aufgenommen. Durch Eingabe +eines ganzen Rechenausdrucks lassen sich leicht auch Rechnungen durchführen, +ohne daß die Zahlen in einer Datei stehen. + + + +TeCal und Lernen im Editor + +Bei sich wiederholenden Rechnungen ist es sinnvoll, Rechenoperationen "zu +lernen" und auf eine Taste zu legen. + +Angenommen, Prokurist Meier hat häufig Rechnungen zu schreiben und muß des +öfteren die Mehrwertsteuer und Bruttopreis unter die jeweiligen Nettopreise +schreiben. Zu diesem Zweck kann er die "Lern"-Einrichtung des Editors +benutzen (vergl. EUMEL-Benutzerhandbuch: Editor). Beim Lernen "merkt" sich +der Editor jeden Tastendruck (also auch TeCal-Operationen). Die gelernten +Tasten kann man anschließend mit einem Tastendruck abrufen. Meier kann die +Operationen wie folgt vom Editor lernen lassen: + +Er fährt mit dem Cursor zuerst auf den Nettopreis, von der die Mehrwertsteuer +errechnet werden soll. Dann betätigt er ESC HOP (es erscheint LEARN in der +Kopfzeile des Editors). Dann schreibt er die TeCal-Operationen wie oben +gezeigt (in diesem Falle also ESC L ESC + ESC % ; dann steht der Mehrwert- +steuerbetrag in der Anzeige. Er fährt also mit dem Cursor eine Zeile tiefer +und betätigt ESC S, dann geht er noch eine Zeile tiefer und gibt ESC = und +wiederum ESC S um den Bruttobetrag zu berechnen und zu schreiben. Mit dem +abschließenden ESC HOP und einer weiteren Taste (sagen wir mal 'm' als +Abkürzung für Mehrwert) beendet er das Lernen. Nun kann er jederzeit die +Mehrwertsteuer und Bruttobetrag unter einen gegebenen Nettobetrag schreiben, +indem er ESC m betätigt. + +Praktischer Tip: + +Tabulator-Bewegungen kann man ebenfalls lernen. So ist es z.B. möglich, die +Berechnung von Spalten- oder Reihensummen zu erlernen, indem man mit +TAB jeweils zu dem nächsten Wert springt. + +Merke: Es können beliebige Rechnungen erlernt und auf eine Taste gelegt +werden. Die gelernten Rechnungen können mit Hilfe einer Taste abgerufen +werden. + + + +Benutzung des Merkregisters + +Mit + + ESC M + +(für Merken) kann man ein gerade angezeigtes (Zwischen-) Ergebnis im +Speicher aufbewahren, um es später an anderer Stelle wieder in die Rechnung +einzubeziehen. Das geschieht, in dem man dann statt eine Zahl mit ESC L +einzulesen + + ESC K + +(für Konstante) eingibt. Dadurch wird die Zahl aus dem Merkregister wieder +in die Anzeige übertragen, so daß man damit weiterrechnen kann. + +Merke: Man kann Zahlen mit ESC M abspeichern und mit ESC K wiederholen. + + + +Auskunft über TeCal-Funktionen + +Wenn Sie beim Arbeiten mit TeCal noch nicht so sicher sind oder eine Funktion +benutzen möchten, die Sie sonst nur selten verwenden und deren genaue +Wirkung sie vielleicht wieder vergessen haben, so hilft Ihnen + + ESC ? + +weiter. Nach betätigen dieser Tasten meldet sich die TeCal Auskunft mit +Funktionstaste drücken oder . Dann geben Sie das Funktionssymbol ein, das +Sie erklärt bekommen möchten. Geben Sie z.B. ein C ein, wenn Sie die Wirkung +von ESC C wissen möchten. Daraufhin wird ein Text gezeigt, in dem die +entsprechende Auskunft steht. In diesem Text können Sie sich wie im Editor +bewegen. Wenn Sie den Text gelesen haben, können Sie das Fenster wieder mit +ESC Q verlassen. Dadurch wird der alte Zustand vor der Auskunftsfunktion +wiederhergestellt. Durch + + ESC ? ? + +erklärt sich die Auskunft selbst. Sie bekommen dort unter anderem die Liste +aller TeCal-Funktionen gezeigt. + +Merke: Mit ESC ? erhält man Auskünfte über TeCal-Funktionen. + + + +Einstellen von Nachkommastellen + +Durch das Kommando + + kommastellen ('zahl') + +wird die Anzahl der angezeigten Nachkommastellen (0-9) eingestellt. Genau so +viele Nachkommastellen werden auch bei ESC S oder ESC T geschrieben (intern +wird aber jeweils mit höchster Genauigkeit gerechnet). Mit + + ESC R + +kann man ein angezeigtes Zwischenergebnis auch intern auf die angezeigte Zahl +von Nachkommastellen runden. Beispiel: + + ESC ( 1 ESC / 3 ESC ) ESC * 2 ESC= + +führt zur Anzeige von 0.67 (bei zwei eingestellten Nachkommastellen). Gibt +man jetzt (aber nach ESC ) noch ESC R ein, so wird das Zwischenergebnis von +1/3 auf 0.33 gerundet, so daß das Endergebnis 0.66 beträgt. + +Merke: Im Kommandomodus kann man durch das Kommando 'kommastellen' die An- +zahl der Nachkommastellen einstellen. + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil12 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil12 new file mode 100644 index 0000000..ba5d0c6 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil12 @@ -0,0 +1,234 @@ + EUMEL-Benutzerhandbuch + + TEIL 12: SPOOLER / OPERATOR + +1. Spooler-Übersicht + +Ein "Spooler" ist eine Warteschlange von Datenräumen#ie# (Dateien) vor einem +"Worker": + + +------------+ +------------+ + -----> | | | | + -----> | spooler | ------------> | worker | + -----> | | | | + +------------+ +------------+ + +Der Spooler puffert Dateien, die von beliebigen Tasks geschickt werden kön- +nen, in seiner Warteschlange und gibt sie der Reihe nach dem Worker zur +eigentlichen Verarbeitung. Ein typischer Einsatzfall (aber nicht der einzige) +für ein solches System ist der EUMEL-Drucker in Multi-User-Systemen. Unab- +hängig davon, ob der Drucker gerade aktiv ist und wieviele Dateien noch auf +den Ausdruck warten, kann man seine Datei dem Druckspooler schicken und +sofort danach weiterarbeiten. + +Da jeder Spooler und auch jeder Worker eine eigene Task ist, können Spooler +nur im Multi-User-Systemen eingesetzt werden. + +Im folgenden wird nur die anwenderseitige Schnittstelle eines Spoolers be- +schrieben. + +Merke: Ein Spooler puffert Dateien für einen Worker. + + + +2. Die Benutzung eines Spoolers + +Jeder Spooler im System ist eine eigene Task und hat dementsprechend einen +Tasknamen, über den er angesprochen werden kann. So heißt der Druckspooler +beispielsweise " PRINTER". + +Jede Task kann jedem Spooler durch Aufruf von 'save' eine Datei schicken. +Beispiel: + + save ("datei name", task ("spooler name")) + +(Vergl. auch TEIL 7). In der Regel ist ein SPOOLER für (mindestens) einen +Drucker in einem EUMEL-System vorhanden. Dieser kann über den internen +Task-Bezeichner 'print' angesprochen werden. Beispiel: + + save ("datei name", printer) + +Eine so übergebene Datei kann man durch + + erase ("datei name", printer) + +aus der Warteschlange löschen. (Natürlich nur solange sie sich noch in dieser +Warteschlange befindet). Dabei kann man nur auf solche Dateien zugreifen, die +aus der eigenen Task stammen. Durch Aufruf von + + list (printer) + +wird die aktuelle Warteschlange des angegebenen Spoolers auf dem Terminal +angezeigt, so daß man sich über die Anzahl der Dateien und die Position der +eigenen Dateien im Spooler informieren kann. + +Aufbauend auf diesen allgemeinen Kommandos können weitere für spezielle +Spooler programmiert werden. So gibt es für den Spooler 'printer' die Proze- +duren + + print und print ("datei name") + +die im wesentlichen auf + + save ("datei name", printer) + +zurückgeführt werden. + +Merke: Einem SPOOLER kann man eine (oder mehrere) Dateien mit 'save' +schicken. Mit 'list' kann man sich über die Dateien im SPOOLER informieren. +Einem Drucker-SPOOLER übergibt man mit 'print' eine Datei. + + + +3. Privilegierte Spooler-Kommandos + +Gewisse Kommandos können einer #ib#Spooler-Task#ie# direkt im Dialog (ähn- +lich wie im 'maintenance'-Zustand eines globalen Datei-Managers) gegeben +werden. Dazu muß der Spooler mit 'continue' an ein Terminal geholt werden. +Ist der SPOOLER durch ein Paßwort, so sind diese privilegierten Kommandos +nicht für jeden Benutzer zugänglich. + +break + PROC break + Zweck: Beendet den Dialogzustand des Spoolers. Der Spooler koppelt sich + vom Terminal ab und geht in seinen normalen Verarbeitungsmodus + über. + +first + PROC first + Zweck: Vorziehen einer Datei in der Warteschlange auf den ersten Platz. + Alle Dateien von der zweiten an werden im Dialog zum Vorziehen + angeboten. + +start + PROC start + Zweck: Die (vorher gestoppte) Worker-Task wird neu kreiert und ge- + startet. + +stop + PROC stop + Zweck: Die Worker-Task wird abgebrochen und gelöscht. Damit wird auch + ein von ihr belegetes Terminal wieder frei. + + +Hinweis: Die Kommandos 'start/stop' sind gut dazu geeignet, die Verarbeitung + einer Datei durch einen Worker (z.B. Druckoutput) abzubrechen, bei + Hardwareeingriffen zu stoppen oder Worker (wie z.B. Drucker) nur + zeitweise zu betreiben. + +Hinweis: Wenn der Worker mit Verzögerung abgebrochen werden soll, kann man + den Spooler an ein Terminal holen und dann so lange mit der Eingabe + von 'stop' warten, bis der Worker mit der gerade bearbeiteten Datei + fertig ist. Der Spooler kann in dieser Zeit nicht von anderen Tasks + oder dem Worker angesprochen werden. + + + +4. Der OPERATOR + +Im folgenden Abschnitt wird die standardmäßig implementierte Task OPERATOR +erläutert. Erweiterungsmöglichkeiten sind im Systemhandbuch beschrieben. Dem +OPERATOR stehen gewisse privilegierte Kommandos zur Verfügung. Diese Kom- +mandos (System abschalten, fremde Tasks löschen u.a) werden vom "normalen" +Benutzer des Multi-User-Systems nicht benötigt. Sie sind nur für den +"Operateur" interessant. Es empfiehlt sich, OPERATOR mit einem Paßwort zu +versehen, damit die priviligierten Kommandos nicht jedem Benutzer zur Ver- +fügung stehen. + + + +Einschalten des EUMEL-Systems + +Wie ein EUMEL-System eingeschaltet wird, kann hier nicht beschrieben werden, +weil dies abhängig von speziellen Rechnern ist (Lage des Ein/Aus-Schalters +u.a.m.). Üblicherweise liefern die Hersteller für diesen Zweck bei der Aus- +lieferung Anweisungen mit. + +Nach Einschalten des Rechnersystems befindet man sich in der Task OPERATOR. +Diese Task dient zum kontrollierten Ein- und Ausschalten des EUMEL-Systems. +Nach dem Einschalten wird man automatisch von der Task OPERATOR nach dem +aktuellen Datum und der Uhrzeit gefragt. Nach Eingabe dieser Werte erfolgt + + gib kommando : + +Der Benutzer befindet sich also in der Monitor-Ebene (vergl. dazu auch +TEIL 2). Um die Task OPERATOR vom Terminal abzukoppeln, gibt man + + break + +Nach Betätigen der SV-Taste erscheint dann + + gib supervisor kommando : + +Nun kann man mit 'begin' oder 'continue' eine neue Task einrichten oder mit +einer alten Task in der Arbeit fortfahren. + +Merke: Nach dem Einschalten gibt man das Datum und die Uhrzeit an. + Dann koppelt man die Task OPERATOR mit 'break' ab. + + + +EUMEL-System ausschalten + +Nachdem die Arbeiten in der Benutzer-Task beendet wurden, koppelt man die +Task mit + + break + +vom Terminal ab oder beendet die Task mit + + end + +Achtung: Bei 'end' werden alle Dateien der Task gelöscht. + +Nach Betätigen der SV-Taste kann nun ein Supervisor-Kommando gegeben +werden. Um das EUMEL-System kontrolliert auszuschalten, muß man die Task +OPERATOR wieder an das Terminal holen. Das erfolgt mit + + continue ("OPERATOR") + +Die OPERATOR-Task meldet sich mit + + gib kommando : + +Nun kann man das Kommando + + shutup + +geben, welches das System kontrolliert abschließt. 'shutup' garantiert, daß +alle Dateien auf dem Hintergrund des EUMEL-Systems gesichert werden. Wird +das EUMEL-System ohne 'shutup' ausgeschaltet (z.B. indem der Rechner einfach +ausgeschaltet wird), können die Informationen, die seit dem letzten Fixpunkt +(üblicherweise 15 Minuten) aufgelaufen sind, verloren sein. + +Merke: In der Task OPERATOR wird mit dem Kommando 'shutup' das EUMEL-System +kontrolliert abgeschaltet. + + + +Übersicht über die #ib#OPERATOR-Kommandos + +end + PROC end (TASK CONST task) + Zweck: Löschen der Task 'task'. Hierbei findet keine Paßwortüberprüfung + statt. Darum sollte die Task OPERATOR auch mit einem Paßwort + versehen sein, weil man vom OPERATOR jede Task löschen kann. + Beispiel: + + end (task ("hugo")) (* oder: *) + end (/"hugo") + +set date + PROC set date + Zweck: Einstellen des Datums und der Uhrzeit. Das Erfragen der Werte + erfolgt interaktiv. + +shutup + PROC shutup + Zweck: Kontrolliertes Herunterfahren des gesamten Systems. Alle Tasks + bleiben mit ihren Daten erhalten. Beim Start des Systems meldet + sich die OPERATOR-Task wieder auf dem gleichen Terminal. Das + Kommando sollte deshalb möglichst nur am Terminal 0 gegeben + werden. Nach dem Start sollte der OPERATOR mit 'break' vom + Terminal abgekoppelt werden. + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil2 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil2 new file mode 100644 index 0000000..c70ddfc --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil2 @@ -0,0 +1,628 @@ + EUMEL-Benutzerhandbuch + + TEIL 2: Supervisor/Monitor + + +1. Task-Organisation + +In diesem Kapitel wird die Task-Verwaltung und der Task-Baum beschrieben. + +Alle Tasks des EUMEL-Systems werden in einen Task-Baum eingebunden. Das be- +deutet, daß die Task eines Benutzers automatisch einen "Vater" besitzt, aber +auch neue Tasks ("Söhne") erzeugen kann. In einem EUMEL-System gibt es in +der Regel zwei spezielle Tasks (#ib#UR#ie# und #ib#SUPERVISOR#ie#). Alle +anderen Tasks sind Söhne oder Enkel dieser Tasks. Zum Beispiel: + +Die mit großen Buchstaben geschriebenen Tasknamen sind "System"-Tasks; die +mit kleinen Buchstaben geschriebenen Tasknamen sind Benutzer-Tasks (dies +ist nicht zwingend, sondern Konvention). + +- SUPERVISOR: Übernimmt das Einrichten bzw. Löschen von Tasks. + +- OPERATOR: Übernimmt u.a. die Aufgaben für das Ein- bzw. Ausschalten des + EUMEL-Systems. + +- ARCHIVE: Übernimmt die Auslagerung von Dateien auf Archive. + +- UR: Ist der "Urvater" des EUMEL-Systems, enthält u.a. den + ELAN-Compiler. + +- PUBLIC: Enthält Dateien, die längerfristig gehalten werden müssen und + die alle Benutzer des Systems benötigen. + + +Der Task-Baum hat folgende Bedeutung: + +Eine Task, die sich "unter" einer anderen befindet, ist ein "Sohn" dieser +"Vater"-Task. Beispielsweise ist die Task PUBLIC ein Sohn von UR (und UR ist +somit Vater von PUBLIC). + +Die für eine Task zur Verfügung stehenden Datentypen und Operationen (d.h. +die Objekte, die aus insertierten ELAN-Paketen herausgereicht werden), sind +durch die direkte aufsteigende Linie im Task-Baum vorgegeben. Die in "Vater- +Tasks" insertierten und über die Schnittstelle herausgereichten Objekte +stehen in den "Söhnen" automatisch zur Verfügung. Beispielsweise stehen einer +Sohn-Task von 'user 1' alle insertierten Objekte aus der 'user 1'-Task zur +Verfügung (zusätzlich zu denen, die in UR und PUBLIC insertiert wurden). +Somit ist leicht möglich, unterschiedliche Sprachmengen des ELAN-Compilers +zur Verfügung zu stellen. Vergl. dazu auch das Kapitel über den ELAN- +Compiler. +Ähnliches gilt bei Dateien. So ist es erlaubt, Dateien zu direkten Vätern und +Söhnen im Taskbaum zu transportieren, aber nicht unmittelbar in "parallele" +Tasks. Man kann somit in der 'user 1'-Task Dateien von UR oder PUBLIC be- +ziehen, aber nicht von 'user 2' (da diese Task eine "parallele" Task ist). +Soll das trotzdem geschehen, so muß eine Datei erst von 'user 1' zu PUBLIC +geschickt werden und dann von 'user 2' dort abgeholt werden. Genaueres über +solche Operationen findet man im Benutzerhandbuch über die Datenräume. + +Einige Tasks sind speziell dafür eingerichtet, Dateien für mehrere Nutzer +aufzubewahren. So sind UR und PUBLIC Tasks, die Dateien verwalten, die +längerfristig gehalten werden sollen. Solche Tasks werden "Manager"-Tasks +genannt. + + +2. Supervisor und Tasks + +Eine Task ist für einen Benutzer ein "eigener Rechner", in der er Programme +bearbeiten lassen und/oder Daten aufbewahren kann, ohne von anderen Nutzern, +die gleichzeitig im System arbeiten, gestört zu werden. Der Supervisor er- +möglicht u.a. die Einrichtung, Weiterbearbeitung und Beendigung einer Task. + + +Überblick + +Eine Task ist im EUMEL-System ein selbständiger Prozeß. Zu jedem Program- +mierer an einem Terminal gehört eine damit verbundene Task. Für den Benutzer +ist diese Task sozusagen ein "eigener Rechner". In einem EUMEL-System sind +zur gleichen Zeit noch weitere Tasks vorhanden, so z.B. zum Start und Ab- +schalten des Systems (OPERATOR), zur Druckersteuerung (SPOOLER), zur Ver- +waltung längerfristig benötigter Dateien u.a.m.. + +Der Supervisor ist auf der ELAN-Ebene des EUMEL-Systems der Betriebssystem- +kern. Seine Aufgabe ist im wesentlichen die Task-Verwaltung, nämlich die Er- +richtung und das Löschen von Tasks. Im einfachsten Fall kommt ein Benutzer +des EUMEL-Systems mit dem Supervisor also nur bei den Supervisor-Kommandos +in Kontakt, die den Beginn und das Ende einer Task steuern. + +Jede Task wird in einen "Taskbaum" eingeordnet. Jede Benutzer-Task ist +"Sohn" einer bereits vorhandenen "Vater"-Task und "erbt" von dieser vorüber- +setzte Programme. Man kann Dateien zu einer Vater-Task schicken oder von +dieser empfangen. + + +Eine neue Task beginnen + +Mit dem Supervisor-Kommando 'begin' kann eine neue Task eingerichtet werden. + +Soll eine neue Arbeit im EUMEL-System begonnen werden, muß eine neue Task +eingerichtet werden. Dazu muß das Supervisor-Kommando 'begin' gegeben +werden. Jedes Supervisor-Kommando muß durch die Betätigung der SV-Taste +eingeleitet werden. Dadurch meldet sich das EUMEL-System mit + + gib supervisor kommando : + +Jetzt kann eines der Supervisor-Kommandos gegeben werden. In unserem Fall +wollen wir mit dem 'begin'-Kommando eine neue Task einrichten. Beispiel: + + begin ("rainer") + +errichtet eine neue Task in dem EUMEL-System mit dem Namen 'rainer'. Die +Task meldet sich mit + + gib kommando : + +Nun kann ein beliebiges Monitor-Kommando gegeben werden. + +Wird eine Task in der geschilderten Weise eingerichtet, ist diese Task im +Taskbaum automatisch ein "Sohn" der Task 'PUBLIC'. 'PUBLIC' ist in der Lage, +Dateien von der neuen Sohn-Task zu empfangen ('save'-Kommando) oder man kann +Dateien von 'PUBLIC' in die Sohn-Task holen ('fetch'-Kommando). Solche Tasks, +die Dateien verwalten können, werden 'manager' genannt. + +Merke: Nach dem Betätigen der SV-Taste meldet sich der Supervisor. + Mit dem 'begin'-Kommando wird eine neue Task eingerichtet. + + + +Eine Task ab- und ankoppeln + +Mit dem 'break'- und 'continue'-Kommandos können die Arbeiten in einer Task +unterbrochen und später wieder aufgenommen werden. + +Soll die Arbeit in einer Task unterbrochen werden, so kann man das (Monitor-) +Kommando + + break + +geben, welches die Task vom Benutzer-Terminal abkoppelt. Die Task wird dann +vom System als "Hintergrund-Task" geführt, bleibt also weiterhin bestehen. +Mit dem Supervisor-Kommando + + continue ("meine task") + +kann eine solche "abgekoppelte" Task wieder an ein Terminal angekoppelt und +die unterbrochenen Arbeiten weitergeführt werden. + +Mit 'break' wird eine Task unterbrochen, während durch das 'continue'-Kom- +mando die Arbeiten fortgesetzt werden können. + + + +Eine Task beenden + +Mit dem 'end'-Kommando wird eine Task beendet und gelöscht. + +Sind die Arbeiten in einer Task beendet, so sollte sie aus dem System ent- +fernt werden. Dies erfolgt mit dem Kommando + + end + +Nach einer Rückfrage des Systems wird die Task gelöscht. Beachte, daß mit dem +Löschen der Task auch alle in ihr befindlichen Dateien gelöscht werden. + +Merke: Mit dem 'end'-Kommando wird eine Task beendet und alle in ihr befind- +lichen Daten werden gelöscht. + + + +Eine Task als Sohn einer Task einrichten + +Mit dem 'begin'-Kommando ist es auch möglich, eine Task als Sohn einer be- +stimmten Task einzurichten. Damit die Vater-Task auch Dateien der einzu- +richtenden Sohn-Task verwalten kann, muß man sie vorher zu einer 'manager'- +Task machen. + +In der Regel richtet man seine Task als Sohn von PUBLIC ein. Das erfolgt +automatisch, sofern man im 'begin'-Kommando nichts anderes als den neuen +Tasknamen angibt. Manchmal ergibt sich aber die Notwendigkeit, eine Task als +Sohn einer bestimmten Task einzurichten. Gründe können dafür u.a. sein: + +- Man will eine eigene Datei-Hierarchie über mehrere Tasks einrichten. + +- Man will ein Programmsystem anderen Benutzern zur Verfügung stellen. + +Damit eine Task als Vater für andere, noch einzurichtende Task arbeiten kann, +muß man sie zuerst zu einer 'manager'-Task machen. Das erfolgt mit dem +Kommando + + global manager + +Dies Kommando muß in der Task gegeben werden, die eine Vater-Task werden +soll. Damit wird die Task befähigt, Söhne einzurichten und Dateien, die von +einem (oder mehreren) Söhnen geschickt werden, zu verwalten. + +Durch das 'global manager'-Kommando wird implizit ein 'break'-Kommando ge- +geben, so daß der Benutzer in der Supervisor-Ebene landet. Koppelt man nun +zu irgendeinem Zeitpunkt diese (zunächst potentielle) Vater-Task wieder an +('continue'-Kommando), meldet sich die Task nicht wie gewohnt mit 'gib +kommando :', sondern mit + + maintenance : + +um anzudeuten, daß es sich um eine 'manager'-Task handelt. + +Um eine Sohn-Task "unterhalb" der 'manager'-Task einzurichten, gibt man das +'begin'-Kommando, wobei man die Vater-Task mit angibt. Beispiel: + + begin ("rainer", "vatername") + +richtet eine neue Task 'rainer' ein, die als Sohn der Vater-Task 'vatername' +in den Taskbaum eingeordnet wird. + +Merke: Das Kommando 'global manager' macht eine Task zu einer 'manager'-Task. +Mit dem 'begin'-Kommando kann man auch eine Task als Sohn einer bestimmten +Task einrichten. + + + +Ein laufendes Programm unterbrechen + +Mit dem Betätigen der SV-Taste und dem Supervisor-Kommando 'halt' kann ein +Programm abgebrochen werden. + +Soll ein Programm, welches gerade ausgeführt wird, vorzeitig abgebrochen +werden, so betätigt man die SV-Taste und gibt das Supervisor-Kommando + + halt + +Anschließend kann man wieder ein Monitor-Kommando geben, weil man durch das +'halt'-Kommando automatisch wieder in seine Task gelangt. + +Merke: Mit dem 'halt'-Kommando wird ein Programm abgebrochen. + + + +Eine Task mit Paßwort schützen + +Man kann eine Task durch ein Paßwort vor unberechtigtem Zugriff schützen. + +Das Kommando + + task password + +welches nur im Monitor gegeben werden kann, sorgt dafür, daß eine Task fort- +an nur wieder mit einem 'continue'-Kommando 'betreten' werden kann, wenn man +vorher das richtige Paßwort angibt. Beispiel: + + task passwort ("mein geburtstag") + +Versucht nun ein Benutzer, die mit dem Paßwort geschützte Task mit dem +'continue'-Kommando an sein Terminal anzukoppeln, wird er zunächst nach dem +'Paßwort' gefragt. Nur unter Angabe des Paßwortes wird die Task angekoppelt. #count("1")#) + +Man sollte Paßwörter möglichst behalten! Durch Paßwörter geschützte Tasks +kann niemand - außer durch die Angabe des korrekten Paßworts - die Task +wieder ankoppeln. Hat man das Paßwort vergessen, kann man nur noch die Task +löschen. + +Damit ist gewährleistet, daß kein unberechtigter Benutzer an die Dateien und +Programme der Task gelangen kann. Es gibt jedoch noch zwei Situationen, die +einen unberechtigten Zugang zu Dateien erlauben: + +a) Dateien in die Vater-Task schicken: + Transportiert man Dateien in die Vater-Task ('save'-Kommando, vergl. auch + Teil 7: Datei-Verwaltung), können Benutzer auf diese Dateien zugreifen + (sofern sie Zugang zu dieser Task haben). Dies kann man verhindern, in dem + man ein Datei-Paßwort angibt (siehe Teil 7 für die Beschreibung dieser + Paßworte). Man beachte, daß das Paßwort für Dateien und das oben be- + schriebene Paßwort für Tasks nichts miteinander zu tun haben. + +b) Dateien werden in eine Sohn-Task geholt: + Ist die Task als Vater-Task eingerichtet (Kommando 'global manager') dann + ist es möglich, von der Sohn-Task Dateien ('fetch'-Kommando) aus der + Vater-Task zu holen, die mit einem Paßwort geschützt ist. Darum muß man + verhindern, daß Unberechtigte Söhne einer mit Paßwort geschützten Task + einrichten können. Das kann man mit dem Kommando + + begin password ("geheim") + + Wird dieses Kommando gegeben, wird man bei dem Versuch, eine Sohn-Task + einzurichten, nach einem Paßwort gefragt. Beachte, daß das 'begin- + password' nichts mit dem Task-Paßwort und Datei-Paßwort zu tun hat. + +Merke: Mit dem 'task password'-Kommando wird eine Task durch ein Paßwort +geschützt. + + + +Informations-Kommandos + +(Die Informations-Kommandos können auch vom Monitor aus gegeben werden). + +Mit der Informationsprozedur + + task status + +können Sie sich über den Zustand einer Task informieren. Beispiele: + + task status (* informiert über die eigene Task *) + task status (father) (* informiert über die Vater-Task *) + +'task status' informiert u.a. über die verbrauchte CPU-Zeit der Task, den +belegten Speicherplatz (man beachte, daß Dateien mit Vater-Tasks oder Sohn- +Tasks werden), den Kanal, an dem die Task angekoppelt ist und dem Zustand +der Task (vergl. auch 'task info'). + +Mit der Prozedur + + task info + +können Sie eine Übersicht über alle in dem System befindlichen Tasks er- +halten. +Mit dem Kommando + + storage info + +kann man erfahren, wieviel Speicherplatz auf dem EUMEL-Hintergrund (noch) +zur Verfügung steht. + +Durch einige Kommandos, die man nur vom Monitor aus geben kann, kann man +sich den Namen von Tasks liefern lassen. Die Kommandos + + myself + father + +liefern den (internen) Task-Namen. Mit dem Kommando + + name + +bekommt man den internen Tasknamen in einen Text gewandelt. Beispiel: + + put (name (myself)) + put (name (father)) + +Mit dem Kommando + + rename myself + +kann der Task-Name der Benutzer-Task geändert werden. + +Merke: Durch die Informations-Kommandos 'storage info' und 'task info' kann +man erfahren, wieviel Speicherplatz und welche Tasks in dem EUMEL-System +sind. Mit den Kommandos 'myself' und 'father' kann man mehrere Dateien auf +einmal manipulieren (vergl. Teil 7). + + + +Übersicht über Supervisor- und Task-Kommandos + +In diesem Abschnitt werden alle Supervisor- und Task-Kommandos in der ELAN- +Notation dargestellt. + +Die Supervisor-Kommandos entsprechen - wie alle anderen Kommandos im EUMEL- +System - der ELAN-Syntax (Kommando-Namen werden klein geschrieben, Parameter +in Klammern, mehrere Parameter durch Kommata getrennt, TEXT-Parameter in +Anführungstrichen usw.). Dabei ist jedoch zu beachten, daß diese Kommandos +zum Teil nur im Supervisor-Zustand (vorheriges Betätigen der SV-Taste) ge- +geben werden können. Die Kommandos 'break', 'end', 'storage info' und +'task info' können auch im Monitor gegeben werden. +Folgende Supervisor-Kommandos stehen zur Verfügung: + +begin + PROC begin (TEXT CONST task name) + Zweck: Richtet eine neue Task als Sohn von PUBLIC ein. + + PROC begin (TEXT CONST task name, father task name) + Zweck: Richtet eine neue Task als Sohn der 'father task name'-Task ein. + +begin password + PROC begin password (TEXT CONST geheim) + Zweck: Verhindert das unberechtigte Einrichten einer Sohn-Task. + +break + PROC break + Zweck: Die zum Terminal aktuell zugeordnete Task wird abgekoppelt. Sie + wird damit zu einer Hintergrund-Task, d.h. sie wird entweder bis + zu ihrem Ende oder bis zur nächsten angeforderten Terminal-Ein-/ + Ausgabe oder bis zum nächsten 'continue'- Kommando weiter be- + arbeitet. + +continue + PROC continue (TEXT CONST task name) + Zweck: Eine im Hintergrund laufende Task wird an das Terminal des + Benutzers angekoppelt. + +end + PROC end + Zweck: Die zum Terminal aktuell gehörende Task wird abgebrochen und + gelöscht. Das Kommando ist im Monitor verfügbar. + +father + TASK PROC father + Zweck: Liefert den internen Tasknamen. + +global manager + PROC global manager + Zweck: Macht eine Task zur 'manager'-Task. Erst nach Aufruf dieser + Prozedur sind Sohn-Tasks möglich. + +halt + PROC halt + Zweck: Das laufende Programm der dem Terminal aktuell zugeordneten Task + wird abgebrochen. Im Gegensatz zum 'end'-Kommando wird nur das + laufende Programm abgebrochen, aber die Task wird nicht gelöscht. + Genauer: + Es wird der Fehler 'halt from terminal' induziert. Normalerweise + wird das Programm dadurch wie durch jeden anderen Fehler abge- + brochen. Genaueres findet man im Systemhandbuch unter Fehler- + behandlung. + +name + TEXT PROC name (TASK CONST interner name) + Zweck: Wandelt den internen Task-Namen in einen TEXT. + +rename myself + PROC rename myself (TEXT CONST neuer name) + Zweck: Umbenennen einer Benutzer-Task. + +myself + TASK PROC myself + Zweck: Liefert den internen Task-Namen der Benutzer-Task. + +storage info + PROC storage info + Zweck: Informationsprozedur über den verfügbaren Hintergrund-Speicher. + +task info + PROC task info + Zweck: Informiert über alle Tasknamen im System unter gleichzeitiger An- + gabe der Vater/Sohn-Beziehungen (Angabe durch Einrückungen). + + PROC task info (INT CONST art) + Zweck: Informiert über alle Tasks im System. Mit 'art' kann man die Art + der Zusatz-Information auswählen. Für 'art' sind zur Zeit + folgende Werte zugelassen: + + 1: entspricht 'task info' ohne Parameter, d.h. gibt nur die + Tasknamen unter angabe der Vater/Sohn-Beziehungen aus. + + 2: gibt die Tasknamen aus. Zusätzlich erhalten Sie Informationen + über die verbrauchte CPU-Zeit der Task, die Priorität, den + Kanal, an dem die Task angekoppelt ist und den eigentlichen + Taskstatus. Hierbei bedeuten: + + 0 -busy- Task ist aktiv. + 1 i/o Task wartet auf Beendigung des Outputs + oder auf Eingabe. + 2 wait Task wartet auf Sendung von einer anderen + Task. + 4 busy-blocked Task ist rechenwillig, aber blockiert. + 5 i/o -blocked Task wartet auf I/O, ist aber blockiert. + 6 wait-blocked Task wartet auf Sendung, ist aber blockiert. + Achtung: Die Task wird beim Eintreffen einer + Sendung automatisch entblockiert. + + 3: wie 2, aber zusätzlich wird der belegte Speicher angezeigt. + (Achtung: Prozedur ist aufwendig!). Beachten Sie, daß Dateien + mit Väter/Söhnen "geshared" werden. Beispiel: + Mit 'begin ("sohn", "vater")' wird eine neue Task eingerichtet. + Für 'sohn' wird in diesem Zustand der gleiche belegte Speicher + angezeigt wie für 'vater'. Erst wenn (Datei-)Operationen in + der Sohn- oder Vater-Task vorgenommen werden, wird ein unter- + schiedlicher Speicherplatz angezeigt. + +task status + PROC task status + Zweck: Informationsprozedur über den Zustand der eigenen Task. + Informiert u.a. über + - Name der Task, Datum und Uhrzeit; + - verbrauchte CPU-Zeit; + - belegten Speicherplatz; + - Kanal, an den die Task angekoppelt ist; + - Zustand der Task (rechnend u.a.m.); + - Priorität. + + PROC task status (TASK CONST t) + Zweck: Wie obige Prozedur, aber über die Task mit dem internen Task- + namen 't'. Beispiel: task status (father) + +task password + PROC password (TEXT CONST geheim) + Zweck: Einstellen eines Paßworts für eine Task im Monitor. Das Kommando + 'task password' ist ein Monitor-Kommando. Ist eine Task mit einem + Paßwort geschützt, so wird durch den Supervisor nach dem + 'continue'-Kommando das Paßwort angefragt. Nur nach Eingabe des + richtigen Paßworts gelangt man in die gewünschte Task. Das Paß- + wort kann durch nochmaligen Aufruf von 'task password' geändert + werden, z.B., wenn es in regelmäßigen Abständen geändert werden + muß, um personenbezogene Daten zu schützen. + + Es gibt keine Möglichkeit, ein einmal eingestelltes Paßwort in + Erfahrung zu bringen. Sollte das Paßwort vergessen werden, kann + somit die Task nur noch gelöscht werden. + + Wird als Paßwort ein '-'-Zeichen eingegeben, so wird verhindert, + daß die betreffende Task jemals wieder mit dem 'continue'-Kom- + mando angekoppelt werden kann. Dies ist z.B. für Manager-Tasks + sinnvoll. + + + +3. Der Monitor + +Der EUMEL-Monitor führt den Dialog mit dem Benutzer innerhalb einer Task. In +diesem Kapitel werden nur die Ausführung der Kommandos und die Kommando- +Arten beschrieben, während die einzelnen Kommandos selbst in den jeweiligen +Kapiteln des Benutzerhandbuchs erläutert werden. + +Der Monitor ermöglicht es, Leistungen im Dialog mit Hilfe von Kommandos +(ELAN-Prozeduraufrufen) vom EUMEL-Betriebssystem anzufordern. Nach dem +Beginn einer Sitzung meldet sich der Monitor mit + + gib kommando : + +Danach kann der Benutzer Monitor-Kommandos geben. Erfolgt dabei ein Schreib- +fehler, so kann er (wie beim Editor) innerhalb der Zeile positionieren, über- +schreiben, löschen, einfügen u.a.m.. Die Ausführung des/der Kommandos wird +mit der Taste RETURN ausgelöst. Nach Abschluß einer Kommando-Ausführung er- +scheint wieder obige Meldung. Die Tastenfolge ESC k stellt das zuletzt gege- +bene Kommando wieder dar. + +Monitor-Kommandos müssen gemäß der ELAN-Syntax geschrieben werden (Kommando- +Namen werden klein geschrieben, Parameter in Klammern, mehrere Parameter +durch Kommata getrennt, TEXT-Parameter in Anführungstrichen usw.). Beispiele: + + edit ("meine datei") + copy ("meine datei", "Duplikat") + +Bei den meisten Kommandos mit einem TEXT-Parameter kann der Parameter fort- +gelassen werden. Der Monitor versorgt das Kommando immer mit dem zuletzt an- +gegebenen Parameter und zeigt dies auch auf dem Bildschirm des Benutzers an. +Beispiel: + + edit ("Datei vom 17.4.") + +schreibt der Nutzer nun z.B. + + run + +und betätigt RETURN, dann ergänzt der Monitor das Kommando: + + run ("Datei vom 17.4.") + +Monitor-Kommandos sind einzeilige ELAN-Programme, die dem ELAN-Compiler zur +Übersetzung und anschließender Ausführung zugeleitet werden. Darum können +die Monitor-Kommandos auch von Programmen aus verwendet werden. Falsch ge- +schriebene oder nicht vorhandene Kommandos werden vom ELAN-Compiler mit ent- +sprechender Fehlermeldung abgewiesen. Oft benutzte Kommandos werden aus +Effizienzgründen vom Monitor selbst interpretiert und ausgeführt. Durch die +automatische Überleitung von Kommandos zum ELAN-Compiler ist es möglich + +a) einzeilige ELAN-Programme direkt in der Monitor-Ebene ausführen zu + lassen, d.h. ohne das Programm in eine Datei zu schreiben. Beispiel: + + put (sin (0.5)) + +b) mehrere Kommandos (ELAN-Anweisungen), durch ";" getrennt, auf einmal zu + schreiben. Beispiele: + + edit ("datei"); lineform ("datei"); print ("datei") + INT VAR i; FOR i FROM 1 UPTO90 REP print ("x") ENDREP + +c) eine Erweiterung des Kommando-Vorrats jederzeit vorzunehmen, indem man + die gewünschte Prozedur (in einem PACKET "verpackt") 'insertiert'. + +Im folgenden werden die am häufigsten benutzten Kommandos aufgeführt. +Genauere Informationen über die einzelnen Kommandos findet man in den +entsprechenden Kapiteln des Benutzerhandbuchs. + +Informations-Kommandos + + storage info Belegter externer Speicher + task info Zeigt die im System befindlichen Tasks + task status Zustände der im System befindlichen Tasks + + +Verbindung zum Supervisor + + end Task und die in ihr befindlichen Dateien + löschen + break Task abkoppeln + task password ("geheim") Paßwort einstellen + + +Editor-Kommandos + + edit ("datei") Datei editieren + edit ("datei1", "datei2") Parallel-Editor + + +Compiler-Kommandos + + run ("datei") Übersetzen und ausführen eines ELAN-Programms + run again Letztes übersetztes Programm nochmal aus- + führen + insert ("datei") Übersetztes Programm eintragen + + +Datei-Kommandos + + copy ("datei", "duplikat") Datei kopieren + rename ("alt", "neu") Datei umbenennen + reorganize ("datei") Datei "reorganisieren" + fetch ("datei") Datei von Vater-Task holen + save ("datei") Datei zur Vater-Task schicken + erase ("datei") Datei in Vater-Task löschen + forget ("datei") Datei in Benutzer-Task löschen + list Dateien der Benutzer-Task anzeigen + + +Archiv-Kommandos + + archive ("name") Archiv mit einem Namen reservieren + release (archive) Archiv freigeben + clear (archive) Löscht ein Archiv + list (archive) Dateien des Archivs anzeigen + save all (archive) Archiviert alle Dateien einer Task + fetch all (archive) Holt alle Dateien eines Archivs in eine Task + save ("datei", archive) Datei archivieren + fetch ("datei", archive) Datei vom Archiv holen + + +Textkosmetik und Drucker + + lineform ("datei") Zeilenweises Formatieren + pageform ("datei") Seitenweises Formatieren + index ("datei") Stichwort- und Inhaltsverzeichnis + print ("datei.p") Drucken + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil3 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil3 new file mode 100644 index 0000000..eaf1ed6 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil3 @@ -0,0 +1,2097 @@ + EUMEL-Benutzerhandbuch + + TEIL 3: Editor + +Vorwort + +Der EUMEL-Editor ist ein Programm zur Bearbeitung von Texten. Er bietet +vielfältige Möglichkeiten, um Autoren oder Programmierer bei dem Erstellen, +Korrigieren und Gestalten von Manuskripten oder Programmen zu unterstützen. +Die größte Hilfe beim Schreiben besteht (durch die Speicherfähigkeit von +Computern) aus dem Zugriff auf einmal geschriebene Informationen. Im Gegen- +satz zu einer Schreibmaschine können durch den EUMEL-Editor (beliebig oft) +Einfügungen vorgenommen, Texte korrigiert, gelöscht und umgeordnet werden. +Somit ist das Schreiben von Texten mittels des EUMEL-Systems besonders dann +vorteilhaft und zeitsparend, wenn Texte häufig geändert werden oder wenn +sie in einer besonders schönen Form gedruckt werden sollen (sofern ein ent- +sprechender Drucker zur Verfügung steht). Weiterhin bietet der Editor Hilfen +zum Schreiben an, wie z.B. automatischen Wortumbruch am Zeilenende, eine +Einrückungsautomatik, "Lernen" von Texten u.a.m.. Zusätzlich kann der Editor +in seinen Fähigkeiten erweitert und somit für spezielle Schreibarbeiten an- +gepaßt werden. Bei der Entwicklung des Editors wurde besonderer Wert auf +einfache Bedienung gelegt: innerhalb von wenigen Minuten kann schon ge- +schrieben werden und auf dem Bildschirm sieht man direkt, was mit dem Text +passiert. Das Schreiben und die Korrektur werden durch einige wenige, aber +leistungsstarke Funktionstasten unterstützt. + +Anfänger sollten zumindest das erste Kapitel lesen, bevor mit dem Schreiben +begonnen wird. Dort wird geschildert, wie auf einfache Weise Texte ge- +schrieben und geändert werden können. Die beschriebenen Tätigkeiten sollte +man an einem kleinen Probetext erst einmal ausprobieren. Lesen und an- +schließendes Ausprobieren eines der hier beschriebenen Vorgänge beschleunigt +stark das Erlernen der Funktionen des Editors. + +Weitere Fähigkeiten des Editors werden in den folgenden Kapiteln erläutert. +Diese Kapitel sollte man lesen, wenn die ersten Texte geschrieben worden +sind. Die dort erklärten Möglichkeiten des Editors kann man dann bei Bedarf +nachlesen, erlernen und einsetzen. Im letzten Kapitel werden Programmierern +Hinweise gegeben, wie sie die Benutzerschnittstelle des Editors an indivi- +duelle Bedürfnisse anpassen können. + +Einige Gestaltungsmöglichkeiten für Texte kann man nicht auf dem Terminal +"sehen", wie z.B. Proportionalschriften, Fettdruck usw.. Solche Leistungen +können durch Anweisungen an die Textkosmetik-Programme und den EUMEL-Drucker +angefordert werden. Diese Anweisungen müssen in den Text eingefügt werden. +Dazu sollte das Kapitel über die Textkosmetik gelesen werden. + +is nämlich alles ohne Radiergummi-Abbildung !!! + + + +1. Einführung in die Benutzung des Editors + +In diesem Kapitel beschreiben wir das Tastenfeld eines EUMEL-Terminals, weil +es hier einige Tasten gibt, die auf einer Schreibmaschine nicht vorhanden +sind. Anschließend erklären wir, wie der Editor ein- und ausgeschaltet wird, +wie Texte geschrieben und auf einfache Weise korrigiert werden können. Eine +kurze Erklärung des Tabulators beendet die Einführung. + + + +Das Tastenfeld + +In diesem Abschnitt wird das Tastenfeld eines EUMEL-Terminals erklärt. Es +wird erläutert, wo sich die Tasten befinden und wie man Umlaute schreibt. + +Das Tastenfeld eines EUMEL-Terminals entspricht weitgehend dem einer +Schreibmaschine. Wir finden also die Buchstaben a-z und die Ziffern 0-9 auf +Tasten. Mit der SHIFT-Taste und gleichzeitigem Drücken einer anderen Taste +können die großen Buchstaben und eine Reihe von speziellen anderen Zeichen, +die Sonderzeichen genannt werden, geschrieben werden. Die "Zwischenraum- +taste" oder Leertaste erzeugt immer ein Leerzeichen. + +Nun gibt es in der Praxis zwei unterschiedliche Tastaturen. Zum einen +existiert die EDV-Tastatur, die zum Schreiben von Programmen benutzt wird. +Sie erkennt man daran, daß keine Umlaute (ä, ü, ö) und kein ß auf den Tasten +eingraviert sind. Dafür gibt es Tasten für eckige und geschweifte Klammern. +Sollen auf einer solchen Tastatur die Umlaute geschrieben werden, muß man +sich eines Tricks bedienen: mit der Taste ESC und nachfolgendem Betätigen +einer anderen Taste erhalten wir den entsprechenden Umlaut. +Diese Tasten sind standardmäßig vorbelegt, können aber von Benutzern und in +Anwenderprogrammen geändert werden. + + ESC a bringt ä, ESC A bringt Ä + ESC u bringt ü, ESC U bringt Ü + ESC o bringt ö, ESC O bringt Ö und + ESC s bringt ß. + +In der Regel kann man die Umlaute auf dem Bildschirm eines solchen EDV- +Terminals nicht sehen, sondern sie erscheinen als a, u, usw.. Beim Druck +eines Textes werden sie aber richtig dargestellt. + +Die andere Tastatur entspricht in der Tastenbelegung weitgehend einer deut- +schen Schreibmaschine und besitzt Tasten für die Umlaute und ß. Sollen vor- +wiegend deutsche Texte geschrieben werden, empfiehlt es sich, solch ein +Terminal zu verwenden. + +Neben diesen "einfachen" Tasten gibt es noch einige wenige Tasten, die zur +Bedienung des Editors (aber auch anderer Programme) notwendig sind. Wo die +Tasten auf Ihrem Gerät liegen, hängt von dem jeweiligen Gerätetyp ab. Die +Wirkung der Tasten erklären wir in den anschließenden Abschnitten. +Es kann sein, daß die Tasten nicht richtig beschriftet sind. Dann sollten Sie +den Betreuer ihrer Installation bitten, diese zu beschriften. Zusätzlich zu +den hier beschriebenen können sich noch weitere Tasten auf ihrem Terminal +befinden, die aber keine besondere Bedeutung für den Editor haben. + +Taste Bedeutung +----------------------------------------------------------------------------- +SHIFT Umschalttaste. + Für Großbuchstaben statt Kleinbuchstaben und Sonderzeichen + statt Ziffern. + +RETURN Beginn einer neuen Zeile (Absatz). + Die RETURN-Taste ist oft mit einem geknicktem Pfeil nach + links gekennzeichnet. Im Kommandomodus (also bei "gib + kommando :") wird ein gegebenes Kommando ausgeführt. + +LINKS Tasten für die Positionierung. +RECHTS +OBEN +UNTEN + Positionierung der Schreibmarke (Cursor) in die jeweilige + Richtung (auf den Tasten oft auch durch Pfeile dargestellt). + +HOP "Verstärkertaste": Wirkt als Vorschalttaste. + +RUBOUT Löschtaste. + +RUBIN Ein- bzw. Ausschalten des Einfügezustandes. + +TAB Tabulatortaste. + +MARK Ein- bzw. Ausschalten der Markierung. + +ESC Kommandotaste. + +Merke: Das Tastenfeld eines EUMEL-Terminals ist in der Regel wie das einer +Schreibmaschine und kann ebenso bedient werden. Umlaute müssen bei EDV- +Tastaturen mit Hilfe der Taste ESC geschrieben werden. Einige Spezialtasten +werden benutzt, um die Textbearbeitung des Editors zu steuern. + +Weitere Kommandotasten: + SV Supervisor-Taste im Mehrbenutzer-Betrieb ("multi-user"). + Diese Taste bewirkt den Aufruf des Supervisors und ist keine + spezielle Editor-Taste. + STOP Anhalten eines Programms. + Wird die Taste aus Versehen betätigt (erkennbar daran, daß + der Editor nicht "reagiert"), muß WEITER betätigt werden. + WEITER Programm soll weiterlaufen. + + + +Speicherung von Texten + +In diesem Abschnitt wird der Begriff "Datei" erklärt und erläutert, wie +unterschiedliche Texte auseinandergehalten werden können. + +Das EUMEL-System speichert einmal geschriebene Texte, bis sie vom Benutzer +gelöscht werden. In der Regel wird nicht nur ein (langer) Text oder ein Pro- +grammtext geschrieben, sondern mehrere und unterschiedliche. Um diese aus- +einanderhalten zu können, versehen wir sie jeweils mit einem Namen, der frei +gewählt werden kann. Beispiele für Namen: + + "Brief vom 1.8.83" + "1. Kapitel meines Buches" + +Eine Sammlung von Zeichen (also im Normalfall unsere geschriebenen Texte), +die mit einem Namen versehen worden ist, nennt man eine 'Datei' ('file'). Der +Editor erstellt also eine Datei, wenn wir einen Text schreiben. Eine Datei +kann bis zu 4 000 Zeilen fassen, wobei eine Zeile bis zu 32 000 Zeichen lang +sein darf. + +Mit Hilfe des (Datei-) Namens kann man den Text (immer) wieder ansprechen, +solange, bis die Datei gelöscht wird. Bei der Bearbeitung einer Datei durch +den Editor wirkt sich jede Änderung des Textes auf dem Bildschirm sofort bis +in die gespeicherte Datei aus. Eine Datei kann durch Kommandos verarbeitet +werden. Eine Auswahl (Vergl. dazu die Beschreibung des Monitors): + +edit (Datei bearbeiten), rename (Datei umbenennen), copy (Duplizieren der +Datei), to archive (Archivieren), lineform bzw. autoform (Zeilen +formatieren), pageform (Seiten formatieren), print (Drucken) usw. + +Merke: Ein Text wird im EUMEL-System in einer Datei gehalten. Eine Datei +faßt bis zu 4000 Zeilen Text. Eine Datei kann über den Dateinamen ange- +sprochen werden, der frei gewählt werden kann. + + + +Ein- und Ausschalten des Editors + +Hier beschreiben wir, wie der Editor ein- und ausgeschaltet wird und wie +der Editor eine Datei einrichtet. Zusätzlich wird das Ausschalten des auto- +matischen Wortumbruchs erklärt. + +Wenn auf dem Bildschirm die Aufforderung + + gib kommando : + +erscheint, befindet man sich in der Monitor-Ebene. Durch + + edit ("dateiname") + +kann der EUMEL-Editor eingeschaltet (programmtechnisch: "aufgerufen") +werden. Ist die Datei noch nicht vorhanden, d.h. kein Text unter dem ange- +gebenen Namen im System gespeichert, folgt eine Anfrage, ob eine neue Datei +eingerichtet werden soll. Dies dient zur Kontrolle von Schreibfehlern, die +besonders bei ähnlichen Dateinamen auftreten. Man kann dann das Einrichten +der Datei ablehnen, den Dateinamen verbessern und das Kommando erneut geben. + +Der Editor zeigt jetzt in der obersten Zeile des Bildschirms die Titelzeile, +die den Dateinamen und die Zeilennummer enthält, die gerade bearbeitet wird. +Im Fall einer bereits beschriebenen Datei zeigt der Editor das zuletzt bear- +beitete Textstück. Bei einer neuen Datei ist der Bildschirm unterhalb der +Titelzeile leer. Dieser Teil dient als "Schreibfläche". Der Cursor, so nennt +man die blinkende Schreibmarke, steht dann direkt unter der Titelzeile. Er +zeigt immer die aktuelle Schreibposition an. Jetzt kann sofort mit dem +Schreiben begonnen werden, ganz wie mit einer normalen Schreibmaschine. + +Beenden der Schreibarbeit und Ausschalten des Editors erfolgt durch Drücken +der beiden Tasten + + ESC q + +nacheinander. Man befindet sich wieder in der alten Kommando-Ebene. + +Es ist aber auch möglich, während der Schreibarbeit (also bei eingeschalte- +tem Editor) durch zweimaliges Drücken von ESC in die (Editor) Kommando- +Ebene zu gelangen. Nach Abarbeitung des Kommandos gelangt man wieder in den +normalen Schreibzustand. + +Der Editor ist auf das Schreiben von "normalen" Texten eingestellt. Bei +"normalen" Texten soll ein Wort, welches über das Ende einer Zeile gehen +würde, automatisch in die nächste Zeile gebracht werden. Dies wird +"Wortumbruch" genannt. + +Ist kein Wortumbruch erwünscht, so gibt man das Kommando + + word wrap (false) + +In diesem Fall schreibt der Editor bis zum Zeilenende und springt dann auto- +matisch (u.U. mitten im Wort) auf die nächste Zeile. Der Wortumbruch kann +durch + + word wrap (true) + +wieder eingeschaltet werden. + +Merke: Der Editor wird durch das Kommando 'edit ("name")' aufgerufen und +und wird durch ESC q wieder verlassen. Der Cursor zeigt die aktuelle +Schreibposition an. Der Editor ist auf automatischen Wortumbruch eingestellt. + + + +Schreiben eines Textes + +In diesem Abschnitt wird erklärt, wie ein Text geschrieben wird und was es +mit Absätzen auf sich hat. + +Nach dieser etwas langen Vorrede können wir endlich losschreiben. Wird ein +Zeichen geschrieben, rückt der Cursor automatisch nach rechts auf die +nächste Schreibstelle. Durch den automatischen Wortumbruch werden ange- +fangene Worte, die über ein Zeilenende hinausgehen würden, ohne Silbentren- +nung in die nächste Zeile gebracht. +Nehmen Sie bitte keine Silbentrennung "per Hand" vor (wie in dieser An- +leitung).Eingebrachte Trennstriche gelten als Bindestrich und bleiben somit +auch bei Umformatierungen erhalten, was unerwünscht ist. Für diese mühevolle +Aufgabe gibt es in der Textkosmetik ein Programm! + +Die RETURN-Taste (bei einer Schreibmaschine bedeutet sie "Wagenrücklauf") +braucht also nur noch betätigt zu werden, wenn eine Zeile vorzeitig beendet +werden soll: also bei einem Absatz oder einer Leerzeile. Der Cursor wird da- +bei an den Anfang der nächsten Zeile positioniert. Gleichzeitig erscheint in +der vorherigen Zeile am rechten Rand des Bildschirms eine Markierung, die +anzeigt, daß hier ein Absatz gemacht wurde. + +Diese Absatzkennzeichnung ist wichtig: Sie bedeutet u.a. eine "Grenze" für +die Textkosmetik-Programme beim (optimalen) Auffüllen von Zeilen. Für den +Drucker bedeutet ein Absatz, keinen rechten Randausgleich (druckertechnisch: +"Blocksatz") in dieser Zeile vorzunehmen. +Die Absatzkennzeichnung besteht aus einem Leerzeichen in der Datei ("blank"; +im Unterschied zur Schreibmaschine ist das Leerzeichen in der EDV auch ein +Zeichen und wird gespeichert). Absatzkennzeichen können gelöscht oder auch +hinzugefügt werden (wie das gemacht wird, erfahren Sie in den nächsten Ab- +schnitten). Ist der Wortumbruch ausgeschaltet, erscheint keine Absatzkenn- +zeichnung beim Betätigen der RETURN-Taste. + +Darum ist das Betätigen der RETURN-Taste bei Tabellenzeilen und Programm- +texten besonders wichtig, denn hier soll ja jede Zeile separat bleiben. + +Ein Bildschirm faßt (neben der Titelzeile) üblicherweise 23 Zeilen, die mit +Text beschrieben werden können. Ist die letzte Zeile voll und muß eine neue +Zeile begonnen werden, "rutscht" der Bildschirminhalt automatisch um eine +Zeile nach oben. Damit ist Platz für eine Leerzeile, die nun ebenfalls be- +schrieben werden kann usw.. Keine Angst: die so verschwundenen Zeilen sind +natürlich nicht "weg". Da ein Bildschirm immer nur eine beschränkte Anzahl +von Zeilen hat, kann der Editor nur einen Ausschnitt aus der Datei zeigen. +In unserem Fall, wo wir zunächst nur am Ende der Datei schreiben, werden +also immer die letzten Zeilen der Datei angezeigt. + +Merke: Ist der Wortumbruch eingeschaltet, wird ein angefangenes Wort, das +über das Zeilenende gehen würden, an den Anfang der neuen Zeile gebracht. +Die RETURN-Taste wird nur bei Absätzen, Tabellenzeilen oder Leerzeilen be- +tätigt. In diesem Fall erscheint eine Absatzkennzeichnung am rechten Rand +des Bildschirms. Ist der Bildschirm vollgeschrieben, werden beim fort- +laufenden Schreiben alle Zeilen um eine Zeile nach oben gerückt. + + + +Einrückungen + +Hier wird die Einrückungsautomatik erklärt. + +Soll ein Text eingerückt werden (wie in den obigen "Merke"-Zeilen) oder bei +Aufzählungen, so wird die in der ersten Zeile geschriebene Einrückung auto- +matisch in den folgenden Zeilen beibehalten, bis sie durch die Posi- +tionierungstasten wieder aufgehoben wird. Es gibt also kein Einrückkommando. +Wie der rechte Rand (also die Zeilenbreite) eingestellt wird, erklären wir +später. +Dies kann für die gesamte Datei (und somit für den gesamten Text) durch ein +ein Kommando erfolgen, mit welchem man den Editor auf diese Zeilenbreite +einstellt. Um den rechten Rand nur für einige Zeilen zu verändern (wie z.B. +bei unseren "Merke"-Zeilen) kann ein 'limit'-Kommando der Textkosmetik +verwandt werden. + +Merke: Einrückungen werden automatisch beibehalten. + + + +Einfaches Positionieren und das Editor-Fenster + +Um Korrekturen (Überschreiben, Löschen oder Einfügen) vorzunehmen, muß der +Cursor, der die aktuelle Schreibposition anzeigt, bewegt werden können. Bei +längeren Texten ist es möglich, den Cursor auch auf Zeilen zu positionieren, +die sich (noch nicht) auf dem Bildschirm befinden. Somit zeigt der Editor +nicht nur immer das Ende einer Datei, sondern einen beliebigen Ausschnitt, +der auf dem Bildschirm im sogenannten Fenster sichtbar ist. + +Ist eine Korrektur notwendig, muß der Cursor (blinkende Schreibmarke) auf die +Stelle positioniert werden, an der die Korrektur vorgenommen werden soll. +Dazu verwenden wir die Positionierungstasten LINKS, RECHTS, OBEN und UNTEN. +LINKS und RECHTS bewegen den Cursor innerhalb einer Zeile. Stößt man mit +RECHTS an das Ende einer Zeile, wird der Cursor an den Anfang der nachfol- +genden Zeile bewegt. (Positionierungen jenseits des linken Randes sind nicht +möglich). + +Ein Zeilenwechsel kann einfacher mit den Tasten OBEN und UNTEN vorgenommen +werden. Die Taste OBEN bewegt den Cursor eine Zeile nach oben, die Taste +UNTEN entsprechend eine Zeile tiefer. + +Was passiert nun, wenn der untere oder der obere Rand des Bildschirms er- +reicht wird und es wird darüber hinaus positioniert? In diesem Fall wird der +Text zeilenweise nach oben oder nach unten verschoben und es erscheint die +gewünschte Zeile, wobei andere am anderen Rand "verschwinden". Wir sehen +also, daß wir mit den Positionierungstasten den Bildschirm als Fenster über +die Datei hinweggleiten lassen können (Fachausdrücke: "roll up" oder "roll +down"). Den Text selbst können wir uns auf einem langen Band geschrieben +vorstellen. Die Zeilennummer, in der der Cursor steht, wird stets in der +Titelzeile angezeigt. + +Innerhalb einer Zeile ist es etwas anders: Positionieren wir bei einer Zeile, +die breiter als der Bildschirm ist, nach rechts, wird das Fenster nur für +diese Zeile verschoben (Fachausdruck: "scrolling"). + +Merke: Mit Hilfe der vier Positionierungstasten kann man den Cursor auf dem +Bildschirm bewegen. Außerdem ist es möglich, das Fenster mittels der +Positionierungstasten über den Text zu bewegen. + + + +Einfache Korrekturen: Zeichen überschreiben, löschen und einfügen + +In diesem Abschnitt wird erklärt, wie einfache Korrekturen durch Über- +schreiben von Zeichen, Löschen von Zeichen und Einfügen von Zeichen vorge- +nommen werden können. + +Es können Korrekturen gleich beim Schreiben vorgenommen werden, indem die +zuletzt geschriebenen Zeichen mit der RUBOUT-Taste gelöscht werden. Häufig +merkt man aber Schreibfehler erst etwas später, so daß man diese Fehler nicht +so leicht korrigieren kann. Für solche Zwecke muß man den Cursor an die Text- +stelle bewegen, an dem korrigiert werden soll. Wie man das macht, haben wir +im letzten Abschnitt geschildert. + +Die einfachste Möglichkeit der Korrektur ist das Überschreiben. Soll z.B. ein +Zeichen durch ein anderes ersetzt werden, so positioniert man den Cursor +genau über dieses und tippt das richtige Zeichen ein.Das kann natürlich auch +mit mehreren Zeichen nacheinander erfolgen. + +Will man ein Zeichen löschen, so positioniert man auch hier den Cursor auf +dieses Zeichen und betätigt die Taste RUBOUT. Das Zeichen verschwindet und +die Restzeile rückt heran. Sollen mehrere Zeichen gelöscht werden, muß die +RUBOUT-Taste entsprechend oft gedrückt werden. + +Steht der Cursor hinter dem letzten Zeichen der Zeile, wird immer das letzte +Zeichen der Zeile gelöscht. Man kann also mit dieser Eigenschaft eine Zeile +"von hinten wegradieren". + +Fehlende Zeichen kann man genauso einfach einfügen. Man bringt den Cursor +auf das Zeichen, vor das eingefügt werden soll. Dann drückt man die Taste +RUBIN. Der Editor gelangt in den Einfüge-Zustand, was in der Titelzeile durch +RUBIN angezeigt wird. Er fügt alle Zeichen ein, die jetzt getippt werden (an- +statt zu überschreiben). Der Teil der Zeile rechts vom Cursor rückt jeweils +um entsprechend viele Stellen nach rechts. + +Wichtig ist, daß im RUBIN-Zustand der Editor genauso funktioniert wie im +Normal-Zustand (natürlich mit der Ausnahme, daß eingefügt statt überschrieben +wird). + +Ein neuerliches Betätigen der RUBIN-Taste beendet den Einfüge-Zustand. Die +RUBIN-Taste wirkt also wie ein Schalter, der den Einfüge-Zustand ein- und +ausschaltet. Allerdings kann man nur so viele Zeichen in eine Zeile einfügen, +bis das letzte Wort der Zeile an das Zeilenende stößt. Das angefangene Wort +wird am Anfang der folgenden Zeile eingefügt, sofern dort noch Platz ist und +es nicht offensichtlich ein Absatzende kennzeichnet. Andernfalls wird auto- +matisch eine neue Zeile für das angefangene Wort eingefügt. + +Im eingeschalteten RUBIN-Zustand können keine Zeichen verloren gehen. Viele +Benutzer lassen darum den RUBIN-Zustand immer eingeschaltet, um sich vor dem +unbeabsichtigten Überschreiben von Texten zu schützen. Es wird korrigiert, +indem man die Verbesserung einfügt und den alten Text löscht. + +Merke: Mit Hilfe der Positionierungstasten LINKS, RECHTS, OBEN und UNTEN +kann eine Stelle in der Datei ausgewählt werden, an der eine Korrektur vor- +genommen werden soll. Die einfachste Korrektur ist das Überschreiben von +fehlerhaften Zeichen. Zeichen löschen erfolgt mit der Taste RUBOUT. Mit +RUBIN kann der Einfüge-Zustand ein- und ausgeschaltet werden. Im Einfüge-Zu- +stand wird nicht überschrieben, sondern es wird vor der Cursor-Position das +getippte Zeichen eingefügt. + + + +Springen, Zeilen einfügen/löschen mittels HOP-Taste + +Bewegungen des Cursors sind mit den Positionierungstasten bei größeren "Ab- +ständen" etwas mühsam, ebenso bei umfangreichen Löschungen und Einfügungen. +Die "Verstärkertaste" HOP ermöglicht es, diese Operationen auf einfache +Weise zu beschleunigen. Mit der HOP-Taste kann man das Fenster über der +Datei nicht nur zeilenweise, sondern auch um jeweils eine Fensterlänge ver- +schieben. Das nennt man Blättern. + +Wird die HOP-Taste vor einer anderen der schon erklärten Funktionstasten +gedrückt, verstärkt sie deren Wirkung. Die HOP-Taste ist eine "Präfix"-Taste: +sie wird vor (und nicht gleichzeitig, wie z.B. die Umschalttaste SHIFT) einer +anderen Taste gedrückt. Zuerst das springende Positionieren: +Weitere wichtige Anwendungen der HOP-Taste beschreiben wir in den nächsten +Abschnitten. + +HOP RECHTS Sprung an das rechte Zeilenende. + Falls die Zeile länger als das Fenster breit ist, wird seitlich + geblättert. + +HOP LINKS Sprung an den Zeilenanfang (ggf. seitlich blätternd). + +HOP OBEN Sprung auf die erste Zeile des Bildschirms. + Nochmaliges Betätigen dieser Tastenkombination positioniert den + Cursor (und damit das Fenster in der Datei) um ein Fenster + zurück. + +HOP UNTEN Sprung auf die letzte Zeile des Bildschirms. + Das Blättern erfolgt analog HOP OBEN. + +HOP RETURN Macht die aktuelle Zeile zur ersten des Fensters. + Die Zeile, in der sich der Cursor befindet, wird die erste + Zeile des Fensters. + +Die HOP-Taste in Verbindung mit RUBIN und RUBOUT wird zum "verstärkten" +Löschen und Einfügen verwandt: + +HOP RUBIN Einfügen von Textpassagen: + Ab der aktuellen Position des Cursors verschwindet der rest- + liche Text. Es kann wie bei der anfänglichen Texteingabe fort- + gefahren werden. Die Anzeige REST in der Titelzeile erinnert + daran, daß noch ein Resttext existiert. Dieser erscheint nach + einem neuerlichen Betätigen der beiden Tasten HOP RUBIN wieder + auf dem Bildschirm (die Anzeige REST verschwindet dann wieder). + +HOP RUBOUT Löscht Zeile ab Cursor-Position bis Zeilenende: + Löscht die Zeile rechts vom Cursor. Steht der Cursor am Zeilen- + anfang, wird dementsprechend die ganze Zeile gelöscht und die + Lücke durch Nachrücken der Folgezeilen geschlossen. + +Merke: Die HOP-Taste dient in Verbindung mit den Positionierungstasten zum +"Springen" oder zum "Blättern" innerhalb der Datei. Vor der Taste RUBOUT ge- +drückt, bewirkt sie die Löschung von Zeilen. Mit HOP RUBIN kann man längere +Texte in einen Text einfügen. + + + +Der Tabulator + +Eine weitere wichtige Positionierungshilfe ist die TAB-Taste. Sie wird zum +Schreiben von Tabellen benötigt. Wie bei einer Schreibmaschine können Ta- +bulatormarken gesetzt bzw. gelöscht werden. + +Der Tabulator hat eine wichtige Funktion für das schnelle Positionieren, auch +wenn keine Marken eingestellt wurden. Voreingestellte Tabulatormarken sind +nämlich der Textanfang einer Zeile (Einrückung; falls vorhanden) und die +Stelle direkt hinter dem letzten Zeichen der Zeile. Betätigt man also die +Taste TAB, dann springt der Cursor an die nächste dieser voreingestellten +Positionen. So kann man schnell an den Anfang oder das Ende einer Zeile mit +dem Cursor gelangen (und z.B. am Zeilenende Zeichen "von hinten" löschen +oder dort weiterschreiben). + +Nun zum Setzen des Tabulators: Er wird gesetzt, indem man den Cursor auf die +Zeilenposition bringt, in der die Marke plaziert werden soll. Hier betätigt +man nun HOP TAB. Die Tabulatorsetzung kann man in der Titelzeile an einer +Markierung ("Dach"-Zeichen) sehen (falls sie im Fensterbereich ist und die +aktuelle Zeile nicht seitlich verschoben ist). Betätigt man nun an irgend- +einer Position innerhalb einer Zeile die TAB-Taste, wird der Cursor auf die +Position der nächsten Tabulatormarkierung (die sich rechts vom Cursor be- +findet) oder eine der voreingestellten Positionen bewegt. + +Gesetzte Tabulatormarken können gelöscht werden, indem man mit der TAB- +Taste die Position der Tabulatormarke einstellt und dann HOP TAB betätigt. +Die Marke ist dann gelöscht (das Dach verschwindet in der Titelzeile). + +Tabulatormarkierungen hinterlassen keine Spuren in der Datei, sondern dienen +nur als Positionierungshilfen. + +Werden Tabulatormarken gesetzt (HOP TAB), gelten die voreingestellten Tabu- +latormarken (Anfang und Ende einer Zeile) nicht mehr. Dies ist z.B. bei dem +Schreiben von Tabellen notwendig. Andererseits möchte man beim Schreiben von +"normalen" Text wieder die voreingestellten Tabulatormarken bedienen können. +Mit den Tasten + + ESC TAB + +kann man die gesetzten Tabulatormarken (erkenntlich an dem "Dach"-Zeichen in +der Kopfzeile) verschwinden lassen. Dann gelten wieder die voreingestellten +Marken. Erneutes ESC TAB stellt die gesetzten Tabulatormarken wieder her +usw. + +Merke: Das Einstellen und Löschen von Tabulatormarken erfolgt mit HOP TAB; +das Positionieren auf diese mit TAB. Voreingestellte Tabulatormarken sind +Zeilenanfang und -ende. ESC TAB wirkt wie ein Umschalter zwischen voreinge- +stellten und gesetzten Tabulatormarken. + + + +2. Beschreibung weiterer Funktionen + +In diesem Kapitel werden weitere Funktionen des Editors beschrieben, die bei +dem Erstellen von Texten und Korrekturen sinnvoll einsetzbar sind. Die +Kenntnis der hier beschriebenen Funktionen sind für erste Arbeiten nicht +notwendig (dafür reicht das erste Kapitel). Man sollte aber dieses Kapitel +zumindest überfliegen, damit bei Bedarf die zusätzlichen Möglichkeiten des +Editors erlernt und angewandt werden können. + + + +Zeilen aufbrechen und Rückumbruch + +Um grössere Textpassagen einzufügen, betätigt man HOP RUBIN nacheinander. +Diese Tastenfolge kann benutzt werden, um eine Zeile zu spalten (Zeile auf- +zubrechen). HOP RUBOUT am Ende einer Zeile macht einen Rückumbruch. + +Wie bereits beschrieben, bewirkt HOP RUBIN in einer Zeile, daß der Zeilenrest +rechts vom Cursor und alle Zeilen unterhalb der aktuellen Zeile scheinbar +verschwinden. REST in der Titelzeile erinnert daran, daß ein Teil der Datei +nicht sichtbar ist. + +Wird unmittelbar nach HOP RUBIN wiederum HOP RUBIN betätigt, wird der vor- +herige Zeilenrest als eigenständige Zeile dargestellt. Es ist damit eine Auf- +spaltung einer Zeile in zwei Zeilen vollzogen. + +Der umgekehrte Fall, nämlich zwei Zeilen zu einer zusammenzufassen (sog. +Rückumbruch), ist durch HOP RUBOUT hinter dem letzten Zeichen einer Zeile +möglich. (Hinter das letzte Zeichen einer Zeile kann einfach mit dem +Tabulator positioniert werden). + +Das Aufbrechen einer Zeile und der Rückumbruch zusammen angewandt stellen +also den ursprünglichen Zustand wieder her. Beispiel: Mit HOP RUBIN bricht +man eine Zeile auf (der Rest der Zeile und nachfolgende Zeilen verschwinden +vom Bildschirm). Erneutes HOP RUBIN stellt den rechten Zeilenteil auf der +nächsten Zeile und die nachfolgenden Zeilen auf dem Bildschirm wieder dar. Da +der Cursor sich noch immer am rechten Rand der aufgebrochenen Zeile befindet, +kann man mit HOP RUBOUT den ursprünglichen rechten Zeilenteil wieder re- +kombinieren. + +Merke: Zweimaliges HOP RUBIN spaltet eine Zeile auf; HOP RUBOUT hinter dem +Ende einer Zeile fügt die nachfolgende Zeile an die aktuelle an (Rück- +umbruch). + + + +Zahlentabellen schreiben: Dezimaltabulator + +Beim Schreiben von Zahlentabellen sollen die Zahlen oft rechtsbündig im Text +erscheinen. Dazu bietet der Editor den Dezimaltabulator an. + +Für jede Zahlenkolonne wird die gewünschte Position der Einerstelle (also der +letzten Stelle) mit Hilfe eines Tabulators eingestellt. Mit TAB wird der +Cursor zur jeweils nächsten Tabulatormarke vorgerückt. Werden nun Ziffern +geschrieben, so schreibt man nicht - wie gewohnt - nach rechts, sondern die +Ziffern werden nach links eingerückt. Etwas genauer: Beim Drücken einer +Zifferntaste wird, solange links vor der Zahl noch ein Blank, eine Zahl, "+", +"-" oder ein Punkt sichtbar ist, diese gelöscht und die hierdurch neu ent- +standene Ziffernfolge rechtsbündig an der Tabulatorposition geschrieben. +Zahlenkolonnen können so leicht und rechtsbündig geschrieben werden. +Wird eine Proportionalschrift (Schrift, bei der die Zeichen unterschiedliche +Breiten haben) verwandt, sollte man zwischen den einzelnen Zahlenkolonnen +mindestens zwei Leerzeichen schreiben. Andernfalls bekommt man - auf Grund +der unterschiedlicher Zeichenbreiten - keine rechtsbündigen Kolonnen ge- +druckt. + + 12 12345,78 + 1 0,23 + 12345 1234,00 + +Merke: Ziffern werden bei Einsatz des Tabulators automatisch rechtsbündig ab +der Tabulatormarke geschrieben. + +Es gibt somit vier nützliche Automatiken: neben dem automatischen Dezimal- +tabulator der Wortumbruch, die Einrückautomatik und die Zeileneinfügeauto- +matik beim einfügenden Schreiben. + + + +Den Editor lernen lassen + +Beliebige Folgen von Tastenbetätigungen können gelernt und Tasten zugeordnet +werden. Das ist sinnvoll, wenn wiederholt immer die gleichen Tastenbe- +tätigungen ausgeführt werden müssen, wie z.B. in Tabellenzeilen etwas ein- +fügen oder wenn des öfteren gleiche Texte geschrieben werden müssen, wie +z.B. ein Absender, Grußformeln usw. + +Der Lernmodus wird durch Betätigen der Tasten ESC HOP eingeschaltet (es +erscheint LEARN als Kontrolle in der Titelzeile). Alle Tastenanschläge (auch +Tastenanschläge wie RETURN: man kann also auch mehrere Zeilen lernen lassen) +werden jetzt gelernt bis zum expliziten Ausschalten des Lernmodus. + +Das Beenden oder Ausschalten des Lernmodus erfolgt durch Drücken der drei +Tasten ESC HOP 'taste'. Dabei wird die gelernte Tastenanschlagsfolge, auch +Lernsequenz genannt, der Taste 'taste' zugeordnet. + +Durch späteres Betätigen der Tastenfolge ESC 'taste' kann der gelernte Text +an jeder Stelle der Datei geschrieben werden. Beispiel: Ein "Schreiberling" +hat jeden Tag 27 mal die Worte 'Hochschulrechenzentrum der Universität +Bielefeld' zu tippen. Er läßt diese Worte den Editor lernen mit + + ESC HOP Hochschulrechenzentrum der Universität Bielefeld + ESC HOP b + +Die Worte liegen jetzt auf der Taste 'b'. Wird 'b' gedrückt, erscheint ein +'b' auf dem Bildschirm. Mit ESC 'b' erscheinen die obigen Worte. ESC ist +also notwendig, um das normale 'b' von der Lernsequenz zu unterscheiden. + +Bei einigen Terminaltypen gibt es Tasten, die vom EUMEL-System nicht benutzt +werden. Bei diesen kann man ESC beim Aufruf der Lernsequenz weglassen. + +Welche Tasten dürfen zum Lernen belegt werden? Alle Tasten, außer + +- vom System benutzte Tasten, wie SV, CTRL; +- vom Editor (je nach Anwendung) vorbelegte Tasten, wie die Tasten q oder + ESC und HOP; +- durch Programmierung (siehe dieses Kapitel) fest belegte Tasten. + +Praktische Tips: Man sollte die Tastatur nicht mit Lernsequenzen überlasten, +weil man sich viele Tasten nicht merken kann. Besser ist es, einige wenige +Tasten fest zu belegen und andere für momentane Aufgaben einzusetzen. + +Der Einsatz von Lernsequenzen ist besonders sinnvoll zum Schreiben von An- +weisungen für die Textkosmetik. Anweisungen wie z.B. 'unterstreichen ein- +schalten', Schrifttyp-Anweisung usw. werden zweckmäßigerweise auf Tasten +gelegt. + +Hat man sich einmal beim Lernen verschrieben, so ist das nicht weiter +schlimm: es kann ohne Bedenken korrigiert werden (z.B. mit der Taste RUBOUT). +Solche Tastenanschläge werden dann allerdings auch gelernt, was man aber +beim Einsetzen der Lernsequenz kaum sieht. + +Merke: Tastenanschläge werden mit ESC HOP gelernt und mit ESC HOP 'taste' +auf eine Taste gelegt. Mit ESC 'taste' kann die Lernsequenz jederzeit abge- +rufen werden. + + + +Mehrere Zeilen auf einmal verarbeiten: Markieren + +Oft ergibt sich die Notwendigkeit, mehrere Zeilen oder ganze Textpassagen zu +löschen oder zu verschieben. Hierbei hilft die Taste MARK, mit der man Texte +markieren (also kennzeichnen) kann. Die so markierten Texte können dann auf +verschiedene Weisen als Ganzes verarbeitet werden. + +Durch Drücken der Taste MARK wird die Markierung eingeschaltet und - bei +erneuter Betätigung - wieder ausgeschaltet. Der Anfang der Markierung wird +"festgehalten" und man kann nun das Markierende durch die Positionierungs- +tasten und die HOP-Taste in Richtung auf das Dateiende verschieben, wobei +die dazwischen liegenden Zeichen markiert (in der Regel "video-invertiert" +dargestellt) werden. Ein so markierter Text kann mit ESC RUBOUT gelöscht +werden. Markieren und löschen mit ESC RUBOUT ist eine bequeme und sichere +Löschmethode, da man genau sieht, was gelöscht wird. + +Der gelöschte Abschnitt ist aber nicht vollständig gelöscht, sondern er kann +an anderer (oder an der gleichen) Stelle im Text durch ESC RUBIN wieder ein- +efügt werden. Dies gilt aber nur für den zuletzt gelöschten Text. Auf diese +Art kann ein Textabschnitt beliebiger Länge an eine andere Stelle des Textes +sicher, schnell und bequem verschoben werden. Zusätzlich ist das nachträg- +liche Korrigieren von fehlerhaften Löschungen leicht möglich, weil der Text +wieder mit ESC RUBIN leicht reproduziert werden kann. + +Mit eingeschalteter Markierung kann auch geschrieben werden. Das markierende +Schreiben ist eine besonders vorsichtige Art der Texterstellung, denn der +Texteinschub bleibt erst durch Ausschalten der Markierung (MARK) wirklich +bestehen. Er kann wieder gelöscht werden (ESC RUBOUT) und an eine andere +Stelle gebracht werden (ESC RUBIN). Beim markierenden Schreiben wirkt +RUBOUT immer auf das zuletzt geschriebene Zeichen. + +Die Markierung kann auch dazu verwendet werden, auf markierte Textabschnitte +eigene Benutzerprogramme anzuwenden. + +Merke: Die Markierung schaltet man durch die Taste MARK ein und aus. Ein +markierter Abschnitt kann gelöscht werden (ESC RUBOUT) und an einer anderen +Stelle wieder eingefügt werden (ESC RUBIN). Mit eingeschalteter Markierung +kann auch geschrieben werden. Die Markierung dient ebenfalls als Parameter +für Textverarbeitungsprogramme. + + + +Zwei einfache Kommandos + +Einige Operationen kann man nur mühselig mit den bis jetzt beschriebenen +Tasten durchführen. Z.B. ist es sehr zeitaufwendig, eine bestimmte Text- +stelle zu finden. Andere Operationen sind mit den im vorigen Kapitel be- +schriebenen Tasten überhaupt nicht möglich, wie etwa die Zeilenbreite ein- +zustellen oder Programme aufzurufen, die die zu editierende Datei ver- +arbeiten. Solche Operationen werden durch Kommandos ermöglicht, die man vom +Editor aus geben kann. + +Durch zweimaliges Betätigen von ESC erfolgt die Aufforderung + + gib kommando : + +Es erscheint auf dem Bildschirm eine Kommandozeile, in der der Benutzer +Kommandos (d.h. ELAN-Programme) schreiben kann. Durch Betätigen der Taste +RETURN wird das Kommando ausgeführt. Beispiel: + + ESC ESC (* es erscheint 'gib kommando :' *) + "diese Zeichen" + RETURN + +Durch die Angabe eines TEXTes in Anführungstrichen wird nach dem einge- +schlossenen TEXT 'diese Zeichen' ab der aktuellen Cursor-Position gesucht. +Wird 'diese Zeichen' gefunden, bleibt der Cursor auf dem gesuchten Text +stehen. Andernfalls steht der Cursor hinter dem Ende der letzten Zeile der +Datei. Weiteres Beispiel: + + ESC ESC + 127 + RETURN + +Durch dieses Kommando wird auf die 127. Zeile positioniert. + +Diese beiden häufig benötigten Kommandos haben eine Sonderstellung und +werden speziell behandelt, weil sie nicht der allgemeinen ELAN-Syntax ent- +sprechen. Darum dürfen sie auch nicht in Verbindung mit anderen Kommandos +verwendet werden (siehe nächsten Abschnitt). Alle anderen Kommandos, die wir +in den nächsten Abschnitten beschreiben, entsprechen der ELAN-Syntax und +sind somit allgemeine Kommandos. + +Merke: Kommandos nach man nach zweimaligen Betätigen der ESC-Taste schreiben. +Mit RETURN wird die Ausführung des Kommandos ausgelöst. Durch Angabe eines +TEXTes wird ab der aktuellen Cursor-Position nach diesem TEXT gesucht. Durch +die Angabe einer ganzen Zahl (INT) wird auf die entsprechende Zeilennummer +in der Datei positioniert. + + + +Beliebige Kommandos + +Beliebige Kommandos (siehe Monitor-Beschreibung) und ELAN-Programme sind +zulässig. + +Die Kommandozeile kann wie eine "normale" Textzeile editiert werden (Posi- +tionieren, Überschreiben, Einfügen, Löschen und Markieren). Erzeugt ein +Programm eine Ausgabe oder rufen fehlerhafte Kommandos Fehlermeldungen +hervor, werden diese in der ersten Zeile des Bildschirms angezeigt. Danach +ist man wieder im Editor und kann wie gewohnt arbeiten. + +Die oben beschriebenen zwei Spezial-Kommandos kann man nicht mit anderen +Kommandos zusammen verbinden (mit ';'). Deshalb gibt es für sie auch eine +ELAN-Form, die es erlaubt, sie mit anderen Kommandos zusammen zu verwenden: + +a) TEXT suchen ab der aktuellen Cursor-Position (D ist eine Abkürzung für + 'DOWN'): + + "diese Zeichen" (* Spezial-Version *) + D "diese Zeichen" (* Allgemeine Version *) + +b) Auf eine Zeile Positionieren (T ist eine Abkürzung für TO LINE): + + 127 (* Spezial-Version *) + T 127 (* Allgemeine Version *) + +Es können mehrere Kommandos in der Kommandozeile angegeben werden. Die ein- +zelnen Kommandos müssen in diesem Fall mit ';' voneinander getrennt werden. +Beispiel: + + ESC ESC + T 1; D "noch Zeichen" RETURN + +Diese zwei Kommandos werden nacheinander ausgeführt. Zuerst wird auf die +erste Zeile positioniert und dann (von der ersten Zeile) nach 'noch Zeichen' +gesucht. Damit ist es möglich, die Datei nicht nur von der aktuellen Zeile zu +durchsuchen, sondern die gesamte Datei. Soll nicht in Richtung auf das Datei- +ende, sondern in Richtung auf den Dateianfang (also nach "oben") gesucht +werden, kann man das U-Kommando (Abkürzung für UP) verwenden: + + ESC ESC + U "noch'n Text" RETURN + +Ein weiteres Kommando ist das C-Kommando (Abkürzung für 'CHANGE'), mit +welchem man einen TEXT sucht und diesen dann ersetzen kann. Beispiel: + + ESC ESC + "alte Zeichen" C "neue Zeichen" RETURN + +Es wird ab der aktuellen Cursor-Position nach 'alte Zeichen' gesucht. Wird +der TEXT gefunden, wird er durch 'neue Zeichen' ersetzt. Der Cursor befindet +sich in diesem Fall nach dem ersetzten TEXT. Wird 'alte Zeichen' dagegen +nicht in der Datei gefunden, befindet sich der Cursor (wie beim erfolglosen +Suchen mit D) am Ende der letzten Zeile der Datei. + +Wie alle andern Kommandos kann auch das C-Kommando mit anderen Kommandos +verbunden werden. Beispiel: + + ESC ESC + T 500; "Schreibfelher" C "Schreibfehler" RETURN + +Hier wird ab der 500. Zeile der Datei nach 'Schreibfelher' gesucht und ggf. +ersetzt. Soll ein TEXT nicht nur einmal, sondern bei jedem Auftreten ersetzt +werden, benutzt man das CA-Kommando (Abkürzung für CHANGEALL): + + ESC ESC + "dieser alte Text" CA "dieser neue Text" RETURN + +Dadurch wird 'dieser alte Text' bei jedem Auftreten ab der aktuellen Cursor- +Position durch 'dieser neue Text' ersetzt. + +Merke: Mehrere Kommandos werden mit ';' verbunden. + + + +Kommandos auf Tasten legen + +Oft benutzte Kommandos können auf Tasten gelegt werden. Damit ist es möglich, +den Editor auf spezielle Bedürfnisse eines Benutzers zu modifizieren. + +Anstatt der Taste RETURN beim Abschluß können oft benutzte Kommandos mit der +Drei-Tastenfolge ESC ! 'taste' auf eine Taste gelegt werden. Beispiel: + + ESC ESC (* es erscheint die Kommandozeile *) + D "Schreibfehler" + ESC ! s (* das Kommando 'DOWN "Schreibfehler"' ist + nun auf die Taste 's' gelegt *) + +Wird nun die Taste 's' gedrückt, erscheint das Zeichen 's' auf dem Bildschirm. +Mit ESC s wird das D-Kommando ausgeführt. Natürlich können auch komplizier- +tere ziertere Kommandos auf Tasten gelegt werden. + +Einige Tasten sind bereits mit Kommandos belegt (man kann sie aber ver- +ändern). Will man ein Kommando, welches auf eine Taste gelegt wurde, ver- +ändern oder löschen, drückt man im Kommandodialog (!) die Drei-Tastenfolge +ESC ? 'taste'. Beispiel: + + ESC ESC (* in den Kommandodialog gehen *) + ESC ? s (* es erscheint nun: 'D "Schreibfehler"' *) + +Dieses Kommando kann nun z.B. verändert und ausgeführt (durch RETURN) oder +wiederum auf die gleiche oder eine andere Taste gelegt werden (durch +ESC ! 'taste'). + +Die Ausführung eines Kommandos kann meist mit ESC abgebrochen werden, +z.B. wenn ein Suchkommando unerwünscht weit reicht. + +Merke: Kommandos können auf Tasten gelegt werden (wie beim Lernen). Das +letzte Kommando kann durch ESC f wiederholt werden. + + + +Die wichtigsten Kommandos zur Textverarbeitung + +Einige Kommandos sind speziell für die Textverarbeitung im Editor program- +miert. Die wichtigsten werden hier vorgestellt. + +Kommando Bedeutung +----------------------------------------------------------------------------- +"text" Text suchen: +D "text" Der zu suchende Text muß in Anführungszeichen geschrieben + werden (damit werden auch Leerzeichen innerhalb des ge- + suchten Textes wichtig). Es wird ab der Stelle in der + Datei in Richtung auf das Dateiende hin gesucht (also + "nach unten"), an der sich der Cursor befindet. Wird der + Text gefunden, positioniert der Editor den Cursor direkt + dahinter. Beispiel: + + D "Autor" + + sucht nach dem ersten Auftreten von 'Autor'. Beachte, daß + bei der Suche nach Zeichen, die man nicht direkt mit der + Tastatur schreiben kann, der Codewert angegeben werden + muß (vergl. dazu die EUMEL-Codetabelle). Beispiel: + + DOWN ""217"" (* sucht ein ä *) + DOWN "Diesen Text mu"251" man finden" + + (Ein Codewert innerhalb eines Textes muß in " einge- + schlossen werden). + Wird nur ein Text gesucht, kann man auch nur diesen + angeben. Beispiel: + + "diesen fehler" + +D nummer (Relatives) Positionieren in Richtung auf das Dateiende. + Beispiel: + + D 75 + + positioniert um 75 Zeilen in Richtung auf das Dateiende. + +U "text" Analog D, aber in Richtung auf den Dateianfang ("nach + oben"). + +U nummer Analog D, aber in Richtung auf den Dateianfang. + +nummer Absolutes Positionieren: +T nummer Durch Angabe einer Zahl, wird auf die entsprechende + Zeile der Datei positioniert. Beispiel: + + T 317 + 317 + + Ist die Datei bereits vor der Zeile '317' zu Ende, wird + auf die letzte Zeile der Datei positioniert. + +"alt" C "neu" Suchen und Ersetzen eines Textes: Sucht nach dem Text + 'alt'. Falls vorhanden, wird 'alt' durch 'neu' ersetzt. + Beispiel: + + "einfach" C "leicht" + + ersetzt 'einfach' durch 'leicht'. + +"alt" CA "neu" Suchen aller 'alt' ab der aktuellen Position bis zum + Dateiende und ersetzen durch 'neu'. + +type ("text") Schreiben eines 'text' durch ein Kommando. Das type-Kom- + mando wird häufig benutzt, um Zeichen zu schreiben, die + nicht auf der Tastatur zu finden sind. In diesem Fall muß + der Codewert des Zeichens angegeben werden (jeweils in + doppelten "). Beispiel (vergl. auch EUMEL-Codetabelle): + + type (""251"") + + schreibt ein ß an die aktuelle Position der Zeile. + +Merke: Durch das D- bzw. U-Kommando kann ein Text in der Datei gesucht +werden. Mit C kann ein Text gesucht und ersetzt werden. "alt" CA "neu" er- +setzt alle 'alt' durch 'neu'. 'type' schreibt ein Zeichen (oder einen Text). +Durch T kann auf eine bestimmte Zeile der Datei positioniert werden. + + + +Texte aus anderen Dateien einfügen oder in andere Dateien schreiben + +Manchmal ist es notwendig, einen Text in eine andere Datei zu schreiben +(z.B. wenn man diesen Text noch einmal verwenden will) oder einen Text einer +anderen Datei in den zu bearbeitenden Text einzufügen. Die GET- und PUT- +Kommandos bieten die Möglichkeit, Texte zwischen Dateien auszutauschen +(vergl. auch Paralleleditor). + +Das Kommando GET 'dateiname' holt den Text der Datei "dateiname" an die +aktuelle Schreibposition. Beispiel: + + GET "absender" + +holt den Text 'absender'. Wenn also des öfteren Briefe geschrieben werden, +braucht man sich den Absender nur einmalig in die Datei 'absender' zu schrei- +ben und kann diesen mit dem Kommando GET (was man auf eine Taste legen kann) +u.U. mehrmals an verschiedenen Stellen in die Datei einfügen. + +Das Kommando PUT (abgekürzt: P) schreibt einen vorher markierten Text in +eine Datei. Beispiel: + + PUT "Tabelle" + +schreibt einen markierten Text in die Datei 'Tabelle'. 'Tabelle' wird ggf. +eingerichtet. Ist die Datei 'Tabelle' bereits vorhanden, so wird erfragt, ob +die Datei gelöscht werden kann, um den markierten Text aufzunehmen (über- +schreiben). Andernfalls wird der markierte Text an den bereits vorhandenen +Text in 'Tabelle' angefügt. Es ist somit durch mehrmaliges markieren und dem +PUT-Kommando möglich, Texte aus einer Datei aufzusammeln und in eine neue +Datei zu geben. + +Merke: Die GET- und PUT-Kommandos schreiben bzw. holen Texte aus Dateien. + + + +Breitere Zeilen bearbeiten + +Der Editor ist auf eine Zeilenbreite von 77 Zeichen eingestellt. Oft ist es +notwendig, mit einer anderen Zeilenbreite zu schreiben, welches man mit dem +LIMIT-Kommando einstellen kann. Aber auch die Positionierung innerhalb einer +Zeile wird dadurch etwas anders, weil bei breiteren Zeilen als die Bild- +schirmbreite die Zeile nicht auf einmal auf den Bildschirm paßt. In diesem +Fall wird gerollt. + +Eine andere Zeilenbreite stellt man durch 'limit' ein. Beachte, daß die somit +eingestellte Zeilenbreite für die gesamte Datei gilt. Beispiel: +(Soll eine veränderte Zeilenbreite nur für einen Abschnitt gelten, muß man +eine Textkosmetik-Anweisung einfügen, welches erst nach Anwendung von +'lineform' wirkt.) + + limit (180) + +Nun kann man wie gewohnt schreiben. Allerdings wird die aktuelle Zeile, in +der man sich befindet, nicht wie gewohnt am Bildschirmende umgebrochen, +sondern erst an der Spalte 180 (sofern sie nicht vorher durch die RETURN- +Taste beendigt wird). Wird über das rechte Bildschirmende hinaus geschrieben, +bleibt die Cursor-Position am Ende des Bildschirms erhalten, aber die Zeile +wird beim weiteren Schreiben nach links verschoben, "rollt" also nach links +(der Anfang der Zeile verschwindet scheinbar nach links). + +Mit der Positionierung verhält es sich ähnlich. Wird über den rechten Bild- +schirmrand mit RECHTS positioniert, wird die Zeile ebenfalls gerollt. HOP +RECHTS dagegen bewirkt ein Blättern nur innerhalb dieser Zeile nach rechts. +Analog verläuft es bei verschobener Zeile, wenn nach links (LINKS bzw. HOP +LINKS) positioniert wird. + +Beim Schreiben von Tabellen kann es sinnvoll sein, das Fenster vorübergehend +auf eine andere Anfangsposition (als 1) einzustellen. Das kann mit dem +'margin'-Kommando erfolgen. Beispiel: + + margin (50) + +Das Fenster des Editors zeigt nun einen Ausschnitt aus der Datei, beginnend +ab Spalte 50. In der Titelzeile wird "M50" angezeigt. + +Merke: Eine veränderte Zeilenbreite wird mit dem limit-Kommando eingestellt. +Wird über den Bildschirmrand positioniert, wird die Zeile gerollt. Mit dem +'margin'-Kommando kann spaltenmäßig ein Anfangspunkt des Fensters einge- +stellt werden. + + + +Paralleles Editieren (Fenstereditor) + +Oft ist notwendig, mit mehreren Dateien gleichzeitig zu arbeiten, z.B. wenn +aus einer Datei etwas in eine andere kopiert werden muß, wenn Fehler durch +die Textkosmetik-Programme oder einen Compiler gefunden werden oder wenn man +kurz etwas in einer andern Datei nachschauen will. Zu diesem Zweck bietet der +Editor die Möglichkeit, zwei (oder mehr) Dateien zur gleichen Zeit zu be- +arbeiten. + +Um ein neues Editor-Fenster einzuschachteln, betätigt man im Editor + + ESC e + +Dies eröffnet ein Fenster auf eine andere Datei, deren Name interaktiv er- +fragt wird. Die obere linke Ecke des Fensters befindet sich an der aktuellen +Cursor-Position. Dabei darf sich der Cursor nicht zu sehr am rechten oder +unteren Rand befinden (weil das Fenster sonst zu klein würde). In diesem +"Fenster" auf eine andere Datei kann man genauso arbeiten, wie im "normalen" +Editor. ESC q verläßt den aktuellen Fenstereditor (und alle darin einge- +schachtelten Fenster). + +Mit der Tastenfolge + + ESC w + +kann man von einem Fenster in das benachbarte wechseln (zyklisch). Insbeson- +dere kann ein markierter Teil einer Datei mit dem Kommando + + ESC p (* oder: PUT "" *) + +in eine temporäre Datei geschrieben und nach ESC w mit + + ESC g (* oder: GET "" *) + +in die andere Datei eingefügt werden. + +Betätigt man ESC e ungefähr in der Mitte des Bildschirms, hat man das Fenster +auf die neue Datei in der unteren Hälfte des Bildschirms und die "alte" Datei +in der oberen Bildschirmhälfte. Dies nennt man "Paralleleditor", weil zwei +Dateien zur gleichen Zeit editiert werden können. Der Paralleleditor wird +auch von anderen Programmen benutzt, wie z.B. dem ELAN-Compiler, um Fehler- +meldungen bequem anzuzeigen. + +Das Notizbuch schlägt man mit + + ESC n + +auf. In diesem Notizbuch werden Informationen durch die Prozedur + + note + +geschrieben. + +Merke: Der Fenstereditor wird durch ESC e aufgerufen und mit ESC q verlassen. +Mit ESC w kann zwischen Dateien umgeschaltet werden. In jeder Datei stehen +die gleichen Funktionen wie im "einfachen" Editor zur Verfügung. Man kann +markierte Texte mit PUT bzw. GET von einer Datei in die andere bringen +(Kopieren). + + + +Arbeiten mit dem Zeileneditor + +Der Zeileneditor erlaubt ein Editieren einer Eingabe mit allen Editor- +Funktionen. + +Der Zeileneditor (auch "Feldeditor" genannt) wird über die Prozedur + + editget + +aufgerufen. Durch diese Prozedur kann eine Zeile vom Terminal wie im Editor +eingegeben werden, d.h. es können u.a. Einfügungen bzw. Löschungen in der +Zeile vorgenommen werden. 'editget' dient darum als Grundlage für alle 'get'- +Prozeduren. Beispiel: + + TEXT VAR eingabe :: ""; + put ("Bitte geben Sie einen Wert ein:"); + editget (eingabe); + line + +'editget' kann aber auch einen Wert ausgeben, den ein Benutzer ggf. +verändern kann. Beispiel: + + TEXT VAR eingabe :: "trium10"); + put ("Bitte Schrifttyp angeben:"); + editget (eingabe); + line + +Hier kann ein Benutzer den TEXT 'trium10' verändern oder nur RETURN betäti- +gen. + +Es gibt noch weitere Versionen von 'editget', bei denen man die Zeilenbreite, +reservierte Tasten u.a.m. angeben kann. + +Merke: 'editget' ist der Zeileneditor. + + + +3. Vorbelegung von Tasten + +Wie schon beschrieben, können Lernsequenzen und Kommandos (d.h. ELAN- +Programme) Tasten zugeordnet werden. Da einige Funktionen häufig benötigt +werden, sind diese standardmäßig bestimmten Tasten zugeordnet. + + + +Kommandodialog + +ESC ESC Kommandodialog einschalten. + +ESC ! taste Im Kommandodialog: geschriebenes Kommando auf Taste legen. + +ESC ? taste Im Kommandodialog: Auf 'taste' gelegtes Kommando anzeigen zum + Editieren. + +ESC k Im Kommandodialog: Das zuletzt editierte ELAN-Programm an- + zeigen. + + + +Lernen + +ESC HOP Lernen einschalten. + +ESC HOP taste Lernsequenz auf 'taste' legen. + + + +Operationen auf Markierungen + +ESC RUBOUT Markiertes "vorsichtig" löschen. + +ESC RUBIN Vorsichtig Gelöschtes einfügen. + +ESC p Markiertes in die Scratch-Datei kopieren (PUT ""), an + schließend löschen (kann mit ESC g an anderer Stelle re- + produziert werden). + +ESC d Duplizieren: Markiertes in die Scratch-Datei kopieren + (PUT ""), anschließend die Markierung abschalten. (Kann mit + ESC g beliebig oft reproduziert werden). + +ESC g MIT ESC p gelöschtes oder mit ESC d dupliziertes an aktuelle + Cursor-Stelle schreiben, d.h. Scratch-Datei an aktueller + Stelle einfügen (GET ""). + + + +Weitere Operationen + +ESC q Verlassen des Editors. + +ESC e Fenstereditor einschalten. + +ESC n Notizbuch "aufschlagen". + +ESC w Dateiwechsel beim Fenstereditor. + +ESC f Nochmalige Ausführung des letzten Kommandos + +ESC b Das Fenster wird auf den linken Rand der aktuellen (ggf. + verschobenen) Zeile gesetzt. + +ESC RECHTS Zum nächsten Wortanfang. + +ESC LINKS Zum vorigen Wortanfang. + +ESC 1 Zum Anfang der Datei. + +ESC 9 Zum Ende der Datei. + + + +Zeichen schreiben + +ESC a Schreibt ein ä. +ESC A Schreibt ein Ä. +ESC o Schreibt ein ö. +ESC O Schreibt ein Ö. +ESC u Schreibt ein ü. +ESC U Schreibt ein Ü. +ESC s Schreibt ein ß. +ESC ( Schreibt eine [. +ESC ) Schreibt eine ]. +ESC < Schreibt eine {. +ESC > Schreibt eine }. +ESC \# Schreibt ein \#, was auch gedruckt werden kann. +ESC blank Schreibt ein (geschütztes) Leerzeichen. + + + +4. Komplexere Kommandos (ELAN-Programme) + +In diesem Kapitel finden Sie (neben den bereits in den vorherigen Kapiteln +beschriebenen) eine Übersicht über die vorgefertigten Kommandos. Weitere +können leicht vom Benutzer und Programmierer selbst erstellt werden. + + + +Wiederholungen schreiben + +In der Programmiersprache ELAN gibt es ein Sprachmittel, um Anweisungen +wiederholen zu lassen. Dieses Sprachmittel nennt man Wiederholungsanweisung +oder Schleife. Durch dieses Sprachmittel ist es leicht möglich, eine oder +mehrere Kommandos mehrmals ausführen zu lassen. + +Eine Wiederholung, meist Schleife genannt, wird durch die Worte REP (steht +für 'REPEAT', was soviel wie 'wiederhole' heißt) und PER (die Umkehrung von +REP) oder END REP gebildet. Alle Anweisungen, die zwischen diesen Worten +stehen, werden wiederholt ausgeführt (bis das Ende der Datei erreicht ist). +Damit kann man einen Text in der gesamten Datei ändern. (In den folgenden +Beispielen schreiben wir die Kommandozeile der besseren Übersichtlichkeit +halber in mehreren Zeilen). Beispiel: + + T 1; + WHILE NOT eof REP + "alter text" C "neuer text" + PER + +Durch die erste Anweisung wird zur ersten Zeile der Datei positioniert. Dann +steht im Programm eine sogenannte "abweisende Schleife", die durch 'WHILE +bedingung' eingeleitet wird (die Schleife wird solange ausgeführt, bis die +Bedingung nicht mehr erfüllt ist). Die Bedingung besteht hier aus einer Ab- +frage auf das Dateiende der bearbeiteten Datei ('eof'). Nach Eintritt in die +Schleife wird nach 'alter text' gesucht. Falls gefunden, wird er durch +'neuer text' ersetzt. Das Suchen und ersetzen wird solange durchgeführt, bis +das Dateiende erreicht wird. Falls 'alter text' nicht gefunden wird, steht +man auf dem letzten Zeichen der letzten Zeile der Datei (wie bei einer er- +folglosen wiederholten letzten Suche), so daß die nächste WHILE-Überprüfung +die Schleife abbricht. + +Die meisten der oben beschriebenen Kommandos gibt es nicht nur als Operato- +ren, sondern auch als Prozeduren. Beispiele: + + T 1 ==> toline (1) + D "text" ==> down ("text") + U "text" ==> up ("text") + D 17 ==> down (17) + U 18 ==> up (18) + "alt" C "neu" ==> change to ("alt", "neu") + "alt" CA "neu" ==> change all ("alt", "neu") + +Man kann also das obige Beispiel auch folgendermaßen programmieren: + + toline (1); + WHILE NOT eof REP + change to ("alter text", "neuer text") + PER + +Durch dieses zusammengesetzte Editor-Kommando können also ein oder mehrere +Worte in der gesamten Datei auf einfache Weise geändert werden. +Natürlich kann man das obige Beispiel einfacher schreiben: + + toline (1); change all ("alter text", "neuer text") + +Was muß man nun programmieren, um eine Ersetzung nur einmal pro Zeile vor- +zunehmen? Erinnern wir uns: nach einer Ersetzung steht der Cursor hinter dem +ersetzten Text. Somit finden wir bei der erneuten Suche unter Umständen den +Text nochmals in der aktuellen Zeile. Wenn wir nach einer Ersetzung aber um +eine Zeile vorwärts positionieren (mit 'down (1)'), kann dies nicht ge- +schehen. Leider wird durch die Vorwärts-Positionierung die Position des +Cursors nicht verändert. Somit kann die erneute Suche einen Text in der +nächsten Zeile verpassen. Man muß also neben der Vorwärts-Positionierung um +eine Zeile zusätzlich auch noch an den Anfang der Zeile gehen. Für die +Positionierung innerhalb einer Zeile gibt es die Prozedur + + col (17) (* Positioniert auf die 17. Spalte + der aktuellen Zeile *) + +Damit können wir nun eine einmalige Ersetzung in einer Zeile programmieren: + + toline (1); + WHILE NOT eof REP + col (1); + change to ("alter text", "neuer text"); + down (1); + PER + +Es wird erst auf die erste Zeile, erste Spalte positioniert. Dann wird 'alter +text' gesucht und ggf. durch 'neuer text' ersetzt. Danach wird eine Zeile +vorwärts positioniert, wiederum auf Spalte 1. Dadurch ist gewährleistet, daß +eine Ersetzung nur einmal pro Zeile vorgenommen wird und immer von der +ersten Spalte einer Zeile aus gesucht wird. Dies geschieht solange, bis das +Ende der Datei erreicht ist. + +Manchmal ergibt sich die Notwendigkeit, in Tabellen in jeder Zeile noch Leer- +spalten einzufügen oder zu entfernen. Auch dies kann mit der Schleife leicht +erledigt werden: + + toline (1); + WHILE NOT eof REP + col (48); + "" C " "; + down (1) + PER + +Hier werden in jeder Zeile an der Spalte 48 drei Leerzeichen eingefügt. In +diesem Fall suchen wir ab der Spaltenposition 48 einen sogenannten "Niltext" +("leerer Text"). Dieser Text wird natürlich immer gefunden. Aber man muß +hier aufpassen, denn der gesuchte Text sollte in dieser Zeile vorhanden sein, +sonst wird in einer der nächsten Zeilen ein TEXT ersetzt, der nicht unbe- +dingt an der Spaltenposition 48 steht! + +Wie bereits angemerkt, sollten in den zu verändernden Zeilen an der Position +48 ein Leerzeichen stehen, sonst wird das C-Kommando fehlerhaft bei dem +nächsten TEXT ausgeführt. Das kann man verhindern, indem man folgendes +programmiert: + + toline (1); + WHILE NOT eof REP + down (" "); (* sucht das naechste Blank ab Spalte 48 *) + IF col = 48 + THEN change to (" ", " "); + FI + END REP + +Die Prozedur 'col' (ohne Parameter) liefert die aktuelle Spaltenposition +innerhalb einer Zeile. + +Manchmal soll eine Änderung nur in einem bestimmten Bereich vorgenommen +werden. Dazu gibt es die Prozedur 'line no', mit der man die aktuelle Zeilen- +nummer erfragen kann. Beispiel: + + toline (50); + WHILE NOT eof REP + aenderungen + UNTIL line no = 100 END REP + +In diesem Beispiel werden 'aenderungen' im Zeilenbereich 50 - 100 vorgenom- +men. 'line no' liefert die aktuelle Zeilennummer des FILEs, welches gerade +vom Editor bearbeitet wird. + +Weitere Beispiele: + + (* suchen in Spalte 17: *) + REP + down ("muster") + UNTIL eof OR col = 17 END REP + + (* in Spalte 1 ersetzen: *) + REP + down ("alt"); + IF col = 1 + THEN "alt" C "neu" + FI + UNTIL eof END REP + +Merke: Eine Wiederholung REP ... PER führt die in ihr enthaltenen An- +weisungen wiederholt aus. Eine Abfrage auf das Dateiende der bearbeiteten +Datei ist durch 'eof' möglich. + + + +Das Notizbuch + +Im Notizbuch kann man sich Notizen über den Ablauf von Kommandos machen. + +Die Prozedur + + note + +schreibt einen INT- oder TEXT-Parameter in eine Zwischendatei. Diese Datei +kann man sich mit + + ESC n + +anschauen. Beispiel: + + (* ersetzen und notieren: *) + REP + "alt" C "neu"; + note (line no) (* Zeilennummer der Ersetzung notieren *) + UNTIL eof END REP + +Merke: Die Prozedur 'note' schreibt in das Notizbuch. Mit ESC n kann man +sich das Notizbuch anschauen. + + + +Neue Editor-Kommandos bereitstellen + +Sollen neue Editor-Kommandos bereitgestellt werden, muß man dem Editor ggf. +mitteilen, ob und wie das Fenster auf die Datei auf dem Bildschirm neu ge- +schrieben werden muß. + +Neue Editor-Kommandos kann man allen Benutzern bereitstellen, in dem ein +Programm geschrieben wird. Beispiel: + + PROC datum schreiben: + type (datum). + + datum: + date (clock (1)). (* Siehe auch TEIL 8: Standardpakete *) + END PROC datum schreiben + +Diese Prozedur (oder mehrere) muß noch in ein PACKET "gekleidet" und dann +insertiert werden. Dann steht 'datum schreiben' allen Benutzern dieser Task +oder dessen Sohn-Task zur Verfügung (siehe dazu auch TEIL 5: ELAN-Compiler). + +Bei etwas komplizierteren Prozeduren sollte man dem Editor mitteilen, ob und +wie er das Fenster auf die Datei auf dem Bildschirm neu schreiben muß. +Normalerweise schreibt der Editor nach einem Kommando den gesamten Bild- +schirm neu. Dies kann man verhindern, indem man die Prozedur + + nichts neu + +aufruft. Sie teilt dem Editor mit, daß das Fenster nicht neu geschrieben +werden muß. Weitere Prozeduren teilen dem Editor mit, daß Teile des Fensters +neu geschrieben werden müssen: + + satznr neu (* Zeilennummer links oben *) + ueberschrift neu + zeile neu + abschnitt neu + bild neu + +Dabei kann man die Prozeduren in beliebiger Reihenfolge aufrufen, wobei +jeweils immer die größte Änderung dominiert. Beispiel: + + nichts neu; + ... + zeile neu; + ... + bild neu; + ... + ueberschrift neu + ... + +'bild neu' dominiert über 'zeile neu', +'zeile neu' dominiert über 'ueberschrift neu'; +'ueberschrift neu' dominiert über 'nichts neu'. + +Im obigen Beispiel 'datum schreiben' würde es also ausreichen, am Anfang der +Prozedur 'nichts neu' und am Ende 'zeile neu' aufzurufen, damit nur die +aktuelle Zeile neu geschrieben wird. + +Manchmal ist es notwendig, dem Benutzer bei einer Kommandoverarbeitung neue +Zustände direkt anzuzeigen. Dafür gibt es die Prozeduren + + satznr zeigen + ueberschrift zeigen + bild zeigen + +Beispiel: + + satznr zeigen (line no) + +zeigt bei einer Kommandoverarbeitung die aktuelle Zeilenummer. + +Merke: Normalerweise baut der Editor nach einer Kommandoausführung das +Fenster auf dem Bildschirm neu auf. Mit 'nichts neu' kann das verhindert +werden. Weitere Prozeduren teilen dem Editor mit, welche Fensterteile neu +geschrieben werden müssen. Das Schreiben von Fensterteilen kann auch direkt +ausgelöst werden. + + + +Die ELAN-Notation + +Kommandos werden in ELAN-Notation beschrieben. Dabei bedeuten: + +OP Operator. + Der Name des Operators muß mit grossen Buchstaben vor oder + zwischen die Operanden geschrieben werden. Beispiele: + OP C (TEXT CONST muster, pattern) + --> "alt" C "neu" + +PROC Prozedur. + Der Name der Prozedur muß klein geschrieben werden. Die + Parameter werden in Klammern angefügt. Beispiele: + PROC getchar (TEXT VAR zeichen) + --> getchar (character) + PROC edit (TEXT CONST datei, + INT CONST x, y, xsize, ysize) + --> edit ("meine datei", 1, 1, 79, 24) + +INT Ganze Zahl ('Integer'). + Der Wert ist eine ganze Zahl (ohne Dezimalpunkt!). + +BOOL Wahrheitswert ('Boolean'). + Hat zwei Werte: TRUE ('Wahr') und FALSE ('Falsch'). + +TEXT Text. + Muß in Anführungszeichen geschrieben werden. Soll das + '"'-Zeichen in einem Text vorkommen, muß es doppelt + geschrieben werden. + +VAR Veränderbarer Wert. + Wert kann von der Prozedur oder dem Operator verändert + werden. + +CONST Unveränderbarer Wert. + Wert kann von der Prozedur oder dem Operator nicht ver- + ändert werden. + + + +Kommando-Übersicht + +In dieser Übersicht werden Editor-Kommandos, die in der Regel nur in Pro- +grammen verwendet werden, mit (P) gekennzeichnet. "Nicht-Programmierer" +brauchen also nur die nicht gekennzeichneten Kommandos zu lesen. Alle hier +aufgeführten Kommandos arbeiten auf die vom Editor bearbeitete Datei +('editfile'). Einige der Prozeduren stehen auch zur allgemeinen Dateiver- +arbeitung zur Verfügung (siehe TEIL 7), allerdings dann mit einem zusätz- +lichen FILE-Parameter. + +abschnitt neu (P) + PROC abschnitt neu (INT CONST von zeile, bis zeile) + Zweck: Mitteilung an den Editor, daß der entsprechende Abschnitt + auf dem Bildschirm neu geschrieben werden muß. + +at (P) + BOOL PROC at (TEXT CONST muster) + Zweck: Feststellen, ob der Editor auf 'muster' steht. Die Cursor- + Position wird dabei nicht verändert. + +bild neu (P) + PROC bild neu + Zweck: Mitteilung an den Editor, daß das Bild nach Kommandover- + arbeitung neu geschrieben werden muß. + +bild zeigen + PROC bild zeigen + Zweck: Mitteilung an den Editor, daß das Bild sofort neu geschrieben + werden muß. + +C + OP C (TEXT CONST muster, pattern) + Zweck: Wie D "muster" mit anschließender Ersetzung desselben durch + 'pattern'. + +change to (P) + PROC change to (TEXT CONST muster, pattern) + Zweck: Analog C. + + PROC change to (TEXT CONST muster, pattern, INT CONST number) + Zweck: Analog C, aber nur 'number' Zeilen weit. + +CA + OP CA (TEXT CONST source, destination) + Zweck: Arbeitet ab der aktuellen Position wie + + WHILE NOT eof REP + "source" C "destination" + END REP + +change all (P) + PROC change all (TEXT CONST source, destination) + Zweck: Analog CA. + +col (P) + PROC col (INT CONST pos) + Zweck: Positioniert auf die Spalte 'pos' der aktuellen Zeile. + Beispiel: + + col (37) + + positioniert auf die 37. Spalte der aktuellen Zeile. + + INT PROC col + Zweck: Liefert die aktuelle Position des Cursors innerhalb einer Zeile. + +D + OP D (INT CONST n) + Zweck: Positioniert das Fenster n Zeilen vorwärts in Richtung auf das + Dateiende. + + OP D (TEXT CONST muster) + Zweck: Sucht 'muster' vorwärts in Richtung auf das Dateiende. Die Suche + beginnt direkt hinter der aktuellen Cursor-Position. Wird 'muster' + nicht gefunden, steht der Cursor hinter dem letzten Zeichen der + Datei. Wird 'muster' gefunden, steht der Cursor direkt auf dem + ersten Zeichen von 'muster'. + +down (P) + PROC down (INT CONST n) + Zweck: Analog D. + + PROC down (TEXT CONST muster) + Zweck: Analog D. + + PROC down (TEXT CONST muster, INT CONST n) + Zweck: Analog D, jedoch geht die Suche nur 'n' Zeilen. + +downety (P) + PROC downety (TEXT CONST muster) + Zweck: Im Gegensatz zu 'down' beginnt die Suche mit dem aktuellen Zeiche + n, d.h. der Aufruf führt zu einer leeren Leistung, wenn der Cursor schon + auf 'muster' steht. Deshalb bei der Programmierung vorsichtig verwenden. + + PROC downety (TEXT CONST muster, INT CONST n) + Zweck: Analog 'downety', jedoch geht die Suche nur 'n' Zeilen und + beginnt bei der aktuellen Cursor-Position (siehe oben). + +editfile (P) + FILE PROC editfile + Zweck: Liefert die aktuell editierte Datei. + +eof + BOOL PROC eof + Zweck: Abfrage auf das Dateiende der zu bearbeitenden Datei. + +GET + OP GET (TEXT CONST dateiname) + Zweck: Kopiert den Inhalt der Datei mit dem angegebenen Namen vor die + aktuelle Cursor-Position. Ist die Quelldatei kopiert, wird nur + der markierte Teil kopiert. + + OP G (TEXT CONST dateiname) + Zweck: Wie GET. + +len (P) + INT PROC len + Zweck: Liefert die Länge der aktuellen Zeile. + +limit + OP limit (INT CONST limit) + Zweck: Setzt die rechte Schreibgrenze auf 'limit'. Beispiel: + + limit (120) + + stellt den Editor auf eine Zeilenlänge von 120 Zeichen. + + INT PROC limit + Zweck: Liefert die eingestellte Zeilenbreite. + +line no (P) + INT PROC line no + Zweck: Liefert die aktuelle Zeilennummer der editierten Datei. + +margin + PROC margin (INT CONST anfang) + Zweck: Alle Zeilen erscheinen erst ab Spalte 'anfang' im Sichtfenster. + Beispiel: + + margin (50) + + legt das Fenster ab Spalte 50 fest. + + INT PROC margin + Zweck: Liefert den eingestellten linken Rand. + +mark (P) + PROC mark (BOOL CONST an) + (Zweck: Schaltet die Markierung an der aktuellen Stelle ein bzw. aus. + Beispiel: + + mark (true) (* schaltet Markierung an *) + mark (false) (* schaltet Markierung aus *) + + BOOL PROC mark + Zweck: Liefert TRUE, sofern die Markierung eingeschaltet ist. + +nichts neu (P) + PROC nichts neu + Zweck: Mitteilung an den Editor, daß nach Kommandoverarbeitung das Bild + nicht neu geschrieben werden muß. + +note (P) + PROC note (INT CONST wert) + Zweck: Schreibt 'wert' in das Notizbuch. + + PROC note (TEXT CONST message) + Zweck: Schreibt 'message' in das Notizbuch. + +pattern found (P) + BOOL PROC pattern found + Zweck: Gibt an, ob der letzte Suchprozeß erfolgreich war. + +PUT + OP PUT (TEXT CONST dateiname) + Zweck: Richtet eine Datei mit dem angegebenen Namen ein, kopiert den + markierten Textabschnitt in diese. + + OP P (TEXT CONST dateiname) + Zweck: Wie PUT. + +satznr neu (P) + PROC satznr zeigen + Zweck: Mitteilung an den Editor, daß nach Kommandoverarbeitung die + Zeilennummer rechts oben neu geschrieben werden muß. + +satznr zeigen (P) + PROC satznr zeigen (INT CONST nr) + Zweck: Mitteilung an den Editor, die Zeilennummer 'nr' sofort neu zu + schreiben. + +T + OP T (INT CONST n) + Zweck: Positioniert auf die Zeile 'n'. + +toline (P) + PROC toline (INT CONST n) + Zweck: Analog T. + +type (P) + PROC type (TEXT CONST t) + Zweck: Trägt 't' in den Eingabestrom ('f kommando') des Editors ein. + Beispiel: + + type (text (sqrt (2.0))) + + fügt an die aktuelle Cursor-Position den Wert 1.41... ein. + Beispiel: + + INT VAR i; + FOR i FROM 1 UPTO 10 REP + type (text (i) + " ") + END REP + (* Ausgabe: 1 2 3 4 5 6 7 8 9 10 *) + +U + OP U (INT CONST n) + Zweck: Positioniert das Fenster n Zeilen rückwärts in Richtung auf den + Dateianfang. + + OP U (TEXT CONST muster) + Zweck: Sucht 'muster' rückwärts in Richtung auf den Dateianfang. Die + Suche beginnt links neben der aktuellen Cursor-Position. Vergl. D + +ueberschrift neu (P) + PROC ueberschrift neu + Zweck: Mitteilung an den Editor, daß nach Kommandoverarbeitung die + Überschriftszeile neu zu schreiben ist. + +ueberschrift zeigen (P) + PROC ueberschrift zeigen + Zweck: Mitteilung an den Editor, daß sofort die Überschriftszeile neu + zu schreiben ist. + +up (P) + PROC up (INT CONST n) + Zweck: Analog U. + + PROC up (TEXT CONST muster) + Zweck: Analog U. + + PROC up (TEXT CONST muster, INT CONST n) + Zweck: Analog U, aber nur 'n' Zeilen weit. + +uppety (P) + PROC uppety (TEXT CONST muster) + Zweck: Im Gegensatz zu 'up' beginnt die Suche direkt auf der aktuellen + Cursor-Position. Vergl. 'down'. + + PROC uppety (TEXT CONST muster, INT CONST n) + Zweck: Analog 'uppety', aber nur 'n' Zeilen weit. + +word (P) + TEXT PROC word + Zweck: Liefert das Wort von der aktuellen Position bis zum nächsten + Blank bzw. Zeilenende. Die Cursor-Position wird nicht verändert. + + TEXT PROC word (TEXT CONST muster) + Zweck: Liefert das Wort von der aktuellen Position bis zum nächsten Auf- + treten von 'muster' (ausschließlich) bzw. Zeilenende. Die Cursor- + Position wird nicht verändert. + + TEXT PROC word (INT CONST laenge) + Zweck: Liefert das Wort von der aktuellen Position in der angegebenen + 'laenge' bzw. bis zum Zeilenende. Die Cursor-Position wird nicht + verändert. + +word wrap + PROC word wrap (BOOL CONST an) + Zweck: Schaltet den automatischen Wortumbruch an (voreingestellt) bzw. + aus. Beispiel: + + word wrap (true) (* angeschaltet *) + word wrap (false) (* ausgeschaltet *) + +zeile neu (P) + PROC zeile neu + Zweck: Mitteilung an den Editor, daß nach Kommandoverarbeitung die + aktuelle Zeile neu zu schreiben ist. + + + +5. EUMEL-Zeichensatz + +Das EUMEL-System definiert einen Zeichensatz, der gewährleistet, daß Zeichen +auf allen Maschinen überall gleich codiert werden. Dadurch ist es z.B. mög- +lich, Dateien und Programme ohne Konvertierungen zwischen EUMEL-Systemen +unterschiedlicher Hersteller zu übertragen. Der EUMEL-Zeichensatz beruht auf +dem ASCII-Zeichensatz (DIN 66 003) mit Erweiterungen. + + + +Darstellbare Zeichen + +Die genaue Darstellung der einzelnen Zeichen hängt vom Endgerät ab. Die hier +aufgeführten Zeichen sind i.A. auf allen Geräten vorhanden. Ein erweiterter +Zeichensatz (mit mathematischen, diakritischen und griechischen Zeichen) ist +nur auf Spezialgeräten verfügbar und wird deshalb hier nicht angegeben. + +Beispiele zum Lesen der Tabelle: + + code (" ") -> 32 + code ("m") -> 109 + + |3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 +-+------------------------------------------------------------------- +0| ( 2 < F P Z d n x k + | +1| ) 3 = G Q [ e o y - ß + | +2|SP * 4 > H R \\ f p z \# + | +3|! + 5 ? I S ] g q { SP + | +4|" , 6 § J T ^ h r | Ä + | +5|\# - 7 A K U _ i s } Ö + | +6|$ . 8 B L V ` j t ~ Ü + | +7|% / 9 C M W a k u ä + | +8|& 0 : D N X b l v ö + | +9|' 1 ; E O Y c m w ü + +Anmerkungen: +1) SP bedeutet Leerzeichen ("blank"). +2) Die Zeichen 'k', '-' und 'SP' mit den Codes 220, 221, 223 werden für die + Zwecke der Textkosmetik benötigt (Trenn 'k' bei der Umwandlung von 'ck' in + 'kk'; Trennzeichen; geschütztes Leerzeichen). +3) Das Zeichen '\#' (Code 222) ist druckbar, während das Zeichen '\#' (Code 35) + nicht druckbar ist (Einleitungszeichen für Anweisungen der Textkosmetik + und Drucker). +4) Das Zeichen SP (Code 223) wird zur besseren Identifizierung als Unter- +streichungsstrich auf dem Terminal dargestellt. Im einem Ausdruck erscheint +es als ein Leerzeichen. + + + +Steuerzeichen und -tasten + +Das EUMEL-System definiert neben den darstellbaren Zeichen auch Steuer- +zeichen, die entsprechend der angeschlossenen Geräte ggf. jeweils umcodiert +werden. + +Das EUMEL-System definiert (Ausgabe-) Steuerzeichen mit ihren (ausgabesei- +tigen) Wirkungen. Diese Steuerzeichen sind geräteunabhängig und werden vom +EUMEL-System automatisch für die jeweiligen Geräte passend umcodiert. Bei +Standard-Geräteschnittstellen ist die Wirkung anderer Steuerzeichen nicht +definiert. Für den Anschluß von Druckern, für Datenfernübertragung u.ä. +können sogenannte "Transparent"-Schnittstellen verwandt werden. Bei diesen +Schnittstellen ist die Wirkung aller Steuerzeichen undefiniert (vom ange- +schlossenen Gerät abhängig); es wird aber garantiert, daß alle Zeichen ohne +Code-Umsetzung direkt ausgegeben werden. + + + +Ausgabesteuerzeichen + +Wert | Bezeichnung | Wirkung +------+--------------+----------------------------------------- + 0 | NUL | keine Wirkung, Füllzeichen + 1 | HOME | Cursor auf linke obere Ecke des Bildschirms + 2 | RECHTS | Cursor eine Stelle nach rechts + 3 | OBEN | Cursor eine Zeile nach oben + 4 | CL EOP | Löschen von Cursor-Position bis Bildschirmende + 5 | CL EOL | Löschen von Cursor-Position bis Zeilenende + 6 | CPOS | Cursor positionieren, nächstes Ausgabezeichen be- + | | stimmt die y-Position (0 <= code (y) <= 23), darauf- + | | folgendes Ausgabezeichen die x-Position + | | (0 <= code (x) <= 78). + 7 | BELL | akustisches Signal + 8 | LINKS | Cursor eine Stelle nach links +10 | UNTEN | Cursor eine Zeile nach unten bzw. 'roll up', falls + | | der Cursor schon in der letzten Zeile stand +13 | RETURN | Cursor an den Anfang der aktuellen Zeile +14 | ENDMARK | Ende des zu markierenden Bereichs +15 | BEGINMARK | Anfang des zu markierenden Bereichs + + + +Eingabe-Steuertasten + +Für die Eingabeseite sind im EUMEL ebenfalls Steuertasten definiert. Diese +Tasten sollten am angeschlossenen Gerät vorhanden sein oder bereitgestellt +werden (z.B. durch Überkleben von Tasten) oder müssen mit Hilfe der +CONTROL-Taste simuliert werden. Das EUMEL-System führt entsprechend der +folgenden Tabelle evtl. notwendige Umcodierungen der Eingabe durch. Weitere +vorhandene Spezialtasten erzeugen gerätespezifische Codes. Bei der "Transpa- +rent"-Schnittstelle werden - symmetrisch zur Ausgabeseite - alle hereinkom- +menden Zeichen ohne Code-Umsetzung weitergereicht. + +Wert | Bezeichnung +------+------------ + 1 | HOP + 2 | RECHTS + 3 | OBEN + 8 | LINKS + 9 | TAB +10 | UNTEN +11 | RUBIN +12 | RUBOUT +13 | RETURN +16 | MARK +27 | ESC + + + +6. Der Editor als Unterprogramm + +Um eine Anpassung der Benutzerschnittstelle an spezielle Bedürfnisse vor- +nehmen zu können, werden einige noch nicht erläuterte ELAN-Prozeduren zur +Verfügung gestellt. Mit diesen kann für jede Anwendung ein Spezialprogramm +zur Verfügung gestellt werden, das den Editor als Unterprogramm aufruft. Für +den "normalen" Editor-Benutzer ist dieses Kapitel somit nicht weiter von +Interesse. + + + +Tastenverwaltung + +kommando auf taste legen + PROC kommando auf taste legen (TEXT CONST taste, elan programm) + Zweck: Belegt die Taste 'taste' mit dem ELAN-Programm 'elan programm'. + Beispiel: + + kommando auf taste legen + ("v", "edit (""meine datei"")") + + belegt die Taste 'v' mit der 'edit'-Prozedur. + +kommando auf taste + TEXT PROC kommando auf taste (TEXT CONST taste) + Zweck: Liefert den Quelltext des auf die Taste 'taste' gelegten ELAN-Pro- + gramms oder niltext, wenn diese nicht entsprechend belegt ist. + +lernsequenz auf taste legen + PROC lernsequenz auf taste legen (TEXT CONST taste, lernsequenz) + Zweck: Belegt die Taste 'taste' mit den Zeichen 'lernsequenz'. Beispiel: + + lernsequenz auf taste legen ("a", ""217"") + + belegt die Taste 'a' mit dem 'ä'. + +lernsequenz auf taste + TEXT PROC lernsequenz auf taste (TEXT CONST taste) + Zweck: Liefert die auf 'taste' gelegte Tastenanschlagsfolge + oder niltext, wenn diese nicht entsprechend belegt ist. + +taste enthaelt kommando + BOOL PROC taste enthaelt kommando (TEXT CONST taste) + Zweck: Liefert TRUE, wenn 'taste' mit einem ELAN-Programm belegt ist. + +std tastenbelegung + PROC std tastenbelegung + Zweck: Belegt die Tasten mit der Standardbelegung. + + + +Aufruf des Editors, Zeilen- und Fenstereditors + +edit + PROC edit + Zweck: a) Im Monitor: + Ruft den Editor mit den zuletzt verwandten Dateinamen auf. + b) Im Editor: + Der Dateiname wird erfragt. + Für jedes 'edit' gilt: + Wurde der 'edit' zum ersten mal aufgerufen, nimmt das Fenster + den gesamten Bildschirm ein. Bei erneuten 'edit'-Aufruf wird + ein Fenster nach rechts unten ab aktuellen Cursor-Punkt eröffnet. + + PROC edit (TEXT CONST datei) + Zweck: Ruft den Editor mit 'datei' auf. + + PROC edit (TEXT CONST datei, x, y, xsize, ysize) + Zweck: Wie obiger 'edit'-Aufruf, jedoch kann das Fenster, in der 'datei' + editierbar ist, gesetzt werden. Die Parameter definieren ein + Editor-Fenster mit der linken oberen Ecke auf den Bildschirmkoor- + dinaten 'x' und 'y' und einer Zeilenbreite 'xsize' und 'ysize' + Zeilen. Wird der Editor mit 'edit ("datei")' aufgerufen, wird + implizit 'edit ("datei", 1, 1, 79, 24)' aufgerufen. + + PROC edit (FILE VAR f) + Zweck: Vergl. obige 'edit'-Prozedur. + + PROC edit (THESAURUS CONST t) + Zweck: Editieren aller in dem Thesaurus 't' enthaltenen Dateien nachein- + ander. Beispiel: + + edit (ALL myself) + + PROC edit (FILE VAR f, INT CONST x, y, xsize, ysize) + Zweck: Vergl. obige 'edit'-Prozedur. + +editget + PROC editget (TEXT VAR editsatz) + Zweck: Eingabe mit Editiermöglichkeit von 'editsatz' vom Terminal an der + aktuellen Bildschirmposition. 'editsatz' wird ausgegeben. Die + Eingabe wird mit RETURN beendet. Im Gegensatz zu 'get' ist hier + auch eine leere Eingabe (RETURN) erlaubt. + + PROC editget (TEXT VAR editsatz, INT CONST editlimit, editlaenge, + TEXT CONST sep, res, TEXT VAR exit char) + Zweck: Wie oben. Dabei bedeuten: + + editsatz: TEXT, der zum Editieren ausgegeben wird. + editlimit: Einstellung des 'limit's der Zeile (max. Anzahl von Zeichen). + Bei obiger 'editget'-Prozedur wird 'editlimit' mit + 'maxtextlength' aufgerufen. + editlaenge: Breite des Zeilenfensters, bevor gerollt wird (bei leerer + Zeile ist dies 77). + sep: Zeichen, bei denen die Eingabe (zusätzlich zu RETURN) + beendet werden soll. + res: Angabe von reservierten Tasten. Wird einer 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. + + PROC editget (TEXT VAR editsatz, INT CONST editlimit, + TEXT VAR exit char) + Zweck: Siehe oben. + + PROC editget (TEXT VAR editsatz, TEXT CONST sep, res, + TEXT VAR exit char) + Zweck: Siehe oben. + +show + PROC show (FILE VAR f) + Zweck: Zeigt eine Datei 'f' auf dem Bildschirm. Wie beim Editor kann mit + Hilfe der Positionierungstasten UNTEN bzw. OBEN oder HOP UNTEN bzw. + HOP OBEN oder HOP RETURN "geblättert" werden. Die Datei 'f' muß + deshalb mit der Verarbeitungsart 'modify' assoziiert worden sein. + Soll die Prozedur 'show' verlassen werden, müssen - wie beim Editor + - die zwei Tasten ESC und q betätigt werden. Die Datei kann nicht + schreibend verändert werden. + + PROC show (TEXT CONST filename) + Zweck: Wie obige Prozedur. + + + +Zeichen verarbeiten + +getchar + PROC getchar (TEXT VAR zeichen) + Zweck: Holt das nächste Eingabezeichen von der Tastatur. + +is incharety + BOOL PROC is incharety (TEXT CONST zeichen) + Zweck: Ist das nächste Eingabezeichen der Tastatur 'zeichen', liefert + 'is incharety' TRUE. In diesem Fall wird 'zeichen' von der Eingabe + verschluckt. Ist das nächste Zeichen von der Tastatur nicht 'zei- + chen', liefert 'is incharety' FALSE. Die Eingabe bleibt unver- + ändert. + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil4 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil4 new file mode 100644 index 0000000..ecca7e6 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil4 @@ -0,0 +1,2306 @@ + EUMEL-Benutzerhandbuch + + TEIL 4: Textkosmetik und Druck + +TEIL 4: Textkosmetik und Druck + + +Vorwort + +Die Textkosmetik-Programme des EUMEL-Systems bieten eine einfach zu er- +lernende und zu bedienende Möglichkeit, Texte für den endgültigen Druck zu +gestalten (Programmtechnisch: #ib#formatieren#ie#). Die Textkosmetik ermög- +licht zusätzlich, Texte in einer Art und Weise zu manipulieren, die auf +preiswerten Terminals zur Zeit nicht darstellbar ist, wie z.B. verschieden- +artige Schriften. "Nebenbei" erledigt die Textkosmetik aufwendige Routine- +arbeiten, wie z.B. Seitennumerierung und die Plazierung von Fußnoten. + +Die Textkosmetik-Programme bearbeiten Dateien, die durch den EUMEL-Editor +erstellt wurden. Darum sollte man sich zuerst mit dem EUMEL-Editor vertraut +machen. + +Für die meisten Aufgaben ist kein Benutzereingriff erforderlich, darum sind +die Programme so konstruiert, daß sie durch in den Text eingefügte Anweisun- +gen gesteuert werden. Einige Arbeiten erfordern den Benutzereingriff, wie +z.B. die Kontrolle von Silbentrennungen bei fremdsprachigen Texten und die +Plazierungen von Seitenenden. Diese Arbeiten werden auf einfache Weise +interaktiv vorgenommen. Die Form der Anweisung ist für die Textkosmetik und +den EUMEL-Drucker gleich und entspricht der ELAN-Syntax. Man beachte den +Unterschied zwischen einem Kommando und einer Text-Anweisung: während ein +Kommando direkt ausgeführt wird, wird eine im Text eingebettete Text-Anwei- +sung (im weiteren kurz "#ib#Anweisung#ie#" genannt) erst nach dem Aufruf von +Textkosmetik-und Drucker-Programmen wirksam. + +Die Wirkungsweise der Textkosmetik-Anweisungen ist leicht zu erlernen und +kann vor allen Dingen stufenweise erfolgen. Deshalb ein guter Rat für An- +fänger: Lesen Sie diesen Teil des Benutzer-Handbuchs erst oberflächlich, so +daß Sie ungefähr Bescheid wissen, welche Möglichkeiten die Textkosmetik-Pro- +gramme bieten. Dann können Sie diejenigen Teile der Textkosmetik auswählen +und bei Bedarf anwenden, die sie für Ihre spezielle Anwendung benötigen. + +Zum Schluß noch eine Warnung: Die Regeln, Konventionen und Wirkungsweisen +des EUMEL-Systems und der Textkosmetik-Programme muß ein Nutzer beherrschen, +will er das System gut nutzen. Der Lernaufwand erfordert etwas Zeit und Mühe, +der aber bei der Benutzung einer jeden Maschine erforderlich ist. Soll nur +ein kurzer Brief geschrieben werden, ist man mit einer Schreibmaschine +besser bedient. Beherrscht man dagegen die Benutzung des EUMEL-Systems +einigermaßen, so kann auch die Erstellung eines kurzen Briefes schneller +erfolgen als auf einer Schreibmaschine. + + + +1. Einführung in die Benutzung der Textkosmetik + +In diesem Kapitel wird eine Übersicht über die verfügbaren Programme der +Textkosmetik gegeben. + + + +Schreiben, Gestalten und Drucken von Texten + +Im EUMEL-System unterscheiden wir zwischen drei Stufen einer Textbehandlung: +Erstellung, Gestaltung und Druck. Die Trennung in verschiedene Arbeitsstufen +hat den Vorteil, daß man sich zu einem Zeitpunkt nur auf einen Arbeits- +schritt konzentrieren muß. + + +a) Texterstellung bzw. Textbearbeitung + +Das Schreiben von Texten wird mit Hilfe des Editors erledigt. In dieser Stufe +der Texterstellung kann ein Benutzer sich ausschließlich auf das Schreiben +und die inhaltliche Korrektheit seines Textes konzentrieren. Wird ein Text +ohne Anweisungen gedruckt, dann erscheint er so, wie er mit dem Editor ge- +schrieben wurde. Bei der Erstellung des Textes können bereits Textkosmetik- +Anweisungen in den Text eingefügt werden. + +Texte sollten im 'Fließtext'-Modus erstellt werden, d.h. Worte, die über +Zeilengrenzen gehen würden, werden ohne Silbentrennung vom Editor in die +nächste Zeile gebracht. + + +b) Textkosmetik bzw. Textgestaltung + +Nachdem ein Text geschrieben wurde, kann man ihn mit Textkosmetik-Programmen +gestalten, ohne ihn inhaltlich zu verändern. Dies kann auch vor oder nach +eventuellen Korrekturen erfolgen. Die Textkosmetik bietet zur Zeit drei +Programme an, die je nach Bedarf eingesetzt werden können: + +I) 'autoform/lineform' formatiert einen Text zeilenweise und vollzieht + eine Silbentrennung. Weiterhin erlaubt 'autoform/lineform' die Verwen- + dung unterschiedlicher Schrifttypen und Schrifthöhen. + +II) 'pageform' gestattet die Formatierung eines Textes in Seiten (drucktech- + nisch: "Paginieren"). Es ist mit 'pageform' u.a. möglich, die Seiten- + einteilung zu bestimmen, eine Seite in Spalten zu formatiern ("Zeitungs- + format"), Zeilen am Anfang bzw. Ende jeder Seite einfügen zu lassen, + eine Seitennummerierung zu erhalten und Fußnoten zu gestalten. + +III) 'index' erlaubt die Erstellung von Stichwort- und Inhaltsverzeichnissen. + + +c) Drucken + +Zu jedem Zeitpunkt der Textbehandlung kann gedruckt werden. Um Drucker mit +unterschiedlichen Eigenschaften betreiben zu können, wurde der (Fachausdruck: +"virtuelle") EUMEL-Drucker als Schnittstelle zwischen dem EUMEL-System und +(echten) Druckern geschaffen. Der EUMEL-Drucker beachtet die gleichen An- +weisungen wie die Textkosmetik-Programme und noch einige zusätzliche, die +nur für die Druckaufbereitung notwendig sind. Spezielle Druckleistungen, wie +z.B. verschiedenartige Schrifttypen, können nur auf besonderen Druckern er- +zeugt werden. Verfügt ein Drucker nicht über eine bestimmte Hardware-Eigen- +schaft, wird die vom Benutzer geforderte Leistung ignoriert. Somit ist es +möglich, Probedrucke für Korrekturen auch auf preiswerten Druckern herzu- +stellen. + +Merke: Der EUMEL-Editor übernimmt die Texterstellung; 'lineform' formatiert +zeilenweise; 'pageform' formatiert seitenweise; 'index' erstellt Stich- und +Inhaltsverzeichnisse; der EUMEL-Drucker ist eine Software-Anpassung an +unterschiedliche Ausgabe-Geräte. + + + +Anweisungen für die Textkosmetik und den Drucker + +In diesem Abschnitt wird beschrieben, wie Anweisungen für die Textkosmetik- +Programme in einen Text eingefügt werden. + +Die Ausführung von 'lineform', 'pageform', 'index' und EUMEL-Drucker wird +mit Hilfe von Anweisungen gesteuert, die man in den Text an geeigneter +Stelle einfügt. Anweisungen haben die Form + + #kommando# + +Beachte, daß jede Anweisung von #-Zeichen eingeschlossen sein muß, damit +die Anweisung vom eigentlichen Text unterschieden werden kann. Beispiele: + + #page# (* aber auch z.B.: # page # *) + #free (3.0)# + #type ("elitedeutsch")# + +Das "#"-Zeichen darf nur für Anweisungen verwandt werden, also sonst nicht +im Text vorkommen. (Wird das "#"-Zeichen benötigt, muß das Zeichen mit ESC # +geschrieben werden. Vergl. auch die Tastenbelegung in der Editor-Beschrei- +bung). + +Die von '#'-Zeichen eingeschlossenen Anweisungen sind so konstruiert, daß +sie - wie alle anderen Kommandos im EUMEL-System auch - der ELAN-Syntax +entsprechen (u.a. müssen sie klein geschrieben werden; Parameter in runden +Klammern; mehrere Parameter werden durch Kommata getrennt; TEXT-Parameter +in Anführungsstrichen; REAL-Parameter mit Dezimalpunkt usw.). Leerzeichen +spielen (außer in TEXT-Parametern) keine Rolle und können zur besseren Les- +barkeit beliebig verwandt werden. + +Man beachte den Unterschied zwischen einer Anweisung und einem Kommando: +während es nur eine beschränkte Anzahl von Anweisungen gibt, die nur von den +Textkosmetik-Programmen ausgeführt werden (also sonst nicht in Programmen +oder Monitor benutzt werden können), kann ein Benutzer ein Kommando in der +Regel in einem Programm, im Editor oder im Monitor verwenden. Hinzu kommt, +daß neben dem vom EUMEL-System zur Verfügung gestellten Kommandos in der +Regel noch installationsspezifische und/oder benutzereigene Kommandos gibt. + +Anweisungen dürfen im allgemeinen überall auf einer Zeile stehen (wie z.B. +in der nächsten Zeile). #on("underline")#Ausnahmen#off("underline")# werden +bei der Beschreibung der Anweisungen speziell erwähnt. Alle Anweisungen +werden zum frühest möglichen Zeitpunkt ausgeführt, haben also u.U. bereits +Auswirkungen auf die Zeile, in der sie stehen. + +Die Zeichen, aus denen eine Anweisung besteht, werden bei der Formatierung +einer Zeile oder Seite nicht mitgezählt und vom EUMEL-Drucker nicht gedruckt. +Eine Zeile, die nur aus Anweisungen besteht, wird ebenso behandelt. + +Merke: Anweisungen steuern die Verarbeitung der Textkosmetik-Programme. Sie +müssen in '#'-Zeichen eingeschlossen sein und dürfen in der Regel überall +auf einer Zeile stehen. Sie werden an der Stelle ausgeführt, an der sie +stehen. + + + +Aufruf der Textkosmetik-Programme + +In diesem Abschnitt wird beschrieben, wie die Textkosmetik-Programme +aktiviert werden. + +Die Textkosmetik-Programme werden durch Kommandos aktiviert (d.h. in der +'gib kommando:'-Ebene). Die Aktivierung (Fachausdruck: "Aufruf") erfolgt - +ebenso wie beim Editor - durch den Namen des Programms und die Angabe +der Datei. Beispiele: + + autoform ("meine datei") + lineform ("text1"); + pageform ("1. Kapitel") + index ("Buch.p") + +Das Programm 'pageform' erzeugt aus der Eingabedatei eine Druckdatei, die +entsprechend umgeformt wird (Fußnoten werden an die richtige Stelle plaziert, +Seitenummern eingesetzt u.a.m.). Diese Druckdatei bekommt den Namen der +angegebenen Eingabedatei mit dem Zusatz '.p'. Beispiel: 'pageform ("text")' +erzeugt eine Datei 'text.p'. Es ist auch erlaubt, 'pageform' durch die Angabe +eines zweiten Parameters mitzuteilen, wie die Druckdatei heißen soll: + + pageform ("mein text", "erste Druckdatei") + +Ähnlich verhält es sich mit dem Programm 'index', welches bis zu 9 Stichwort- +bzw. Inhaltsverzeichnisse erstellen kann. Da in den Verzeichnissen die +Seitennummern aufgeführt werden, kann 'index' nur Druckdateien bearbeiten. +Beispiel: + + index ("handbuch.p") + +Das Programm 'index' erstellt die angeforderten Verzeichnisse in Dateien, +die mit dem Zusatz '.i' gekennzeichnet werden. Beispiele (für den +obigen Aufruf): + + 'Handbuch.i1', 'Handbuch.i2' + +usw.. + +Merke: Die Textkosmetik-Programme werden durch Kommandos aufgerufen mit der +Angabe der Dateinamen als Parameter. + + + +Vorzeitiger Abbruch und Fehlermeldungen + +Alle Textkosmetik-Programme können vorzeitig vom Benutzer abgebrochen werden. +Eventuelle Fehlermeldungen werden durch den Paralleleditor angezeigt. + +Durch die Taste SV und das Supervisor-Kommando 'halt' können die Textkosme- +tik-Programme jederzeit vorzeitig abgebrochen werden. Die Eingabedatei steht +dann unverändert zur Verfügung. Ein vorzeitiger Abbruch kann notwendig sein, +wenn ein Programm mit einer falschen Datei aufgerufen wurde oder zu viele +Fehler gemeldet wurden. + +Alle Textkosmetik-Programme melden Fehler, wenn eine oder mehrere Anweisun- +gen falsch benutzt werden. Die Fehlermeldungen werden auf dem Bildschirm +angezeigt. Bei Beendigung eines Programms wird - falls Fehler entdeckt +wurden - die Fehlermeldungen im oberen Fenster des Paralleleditors angezeigt, +während im unteren Fenster die Eingabedatei zur Korrektur angeboten wird. + +Merke: Vorzeitiger Abbruch eines Programms durch SV und 'halt'. (Die Eingabe- +datei steht unverändert zur Verfügung.) Fehlermeldungen werden im Parallel- +editor angezeigt. + + + +2. Zeilenweises formatieren: 'autoform/lineform' + +Die Programme 'autoform' oder 'lineform' formatieren einen Text zeilenweise +(ggf. mit Silbentrennung), unter Berücksichtigung von Schrifttyp und Zeilen- +breite. + + + +Eine Datei formatieren: 'autoform/lineform'-Kommando + +Die Programme 'lineform/autoform' werden unter Angabe der Datei aufgerufen. +Beispiel: + + lineform ("meine datei") + autoform ("Brief vom 24.12.") + + + +Unterschied von 'autoform' und 'lineform' + +Zur Zeilenformatierung werden zwei Programme angeboten, die sich nur in der +Art der Behandlung von Silbentrennungen unterscheiden: + +a) autoform: + Zeilenformatierung mit automatischer Silbentrennung. 'autoform' sollte + nur bei deutschen Texten eingesetzt werden, weil die Silbentrennung bei + fremdsprachigen Texten nach anderen Regeln erfolgen muß. + +b) lineform: + Zeilenformatierung mit Silbentrennung "per Hand", wobei (nach deutschen + Trennregeln) ein sinnvoller Trennvorschlag gemacht wird. Die Trennstelle + kann interaktiv soweit verschoben werden, wie das zu trennende Wort noch + auf die Zeile paßt. + +Merke: 'autoform' nimmt eine automatische Silbentrennung vor, während +'lineform' die #ib#Silbentrennung "per Hand"#ie# erlaubt. + + + +Übersicht über 'autoform'/'lineform' + +'autoform'/'lineform' formatieren eine Datei zeilenweise. Dabei werden +Zeilen möglichst vollständig aufgefüllt. + +'autoform'/'lineform' haben im wesentlichen vier Aufgaben: + +a) Auffüllen von Zeilen: + 'autoform'/'lineform' können besonders gut nach Korrekturen eingesetzt + werden, bei denen - nach Einfügungen oder Löschungen - nicht vollstän- + dige oder zu lange Zeilen in der Datei stehen bleiben können. + +b) Erstellen von Zeilen mit unterschiedlichen Schrifttypen: + Werden in einer Datei mehrere Schriftarten ('type'-Anweisung) verwandt, + berechnen 'autoform'/'lineform' nach der eingestellten Zeilenbreite die + Anzahl Zeichen, die auf eine Zeile passen. + +c) Erstellen von unterschiedlichen Zeilenlängen: + Manchmal ist es notwendig, die Breite von Zeilen zu verändern ('limit'- + Anweisung). Dies wird von 'autoform'/'lineform' berücksichtigt. + +d) Silbentrennung: + Automatische ('autoform') und interaktive Silbentrennung ('lineform'). + Sofern notwendig, werden Silbentrennungen rückgängig gemacht. + +'autoform'/'lineform' beachten nur wenige Anweisungen: + +Anweisung Zweck + + limit Zeilenbreite einstellen + off Schrifttyp-Modifikation ausstellen + on Schrifttyp-Modifikation einstellen + type Schrifttyp einstellen + + +'autoform'/'lineform' akzeptieren als Eingabe eine Datei und verändern diese. +Dafür wird eine (interne) Zwischendatei benötigt. Deshalb ist darauf zu +achten, daß noch ausreichend Platz auf dem System ist, der jedoch nur +zwischenzeitig für den Formatierungsschritt benötigt wird. + +'autoform'/'lineform' fragen nach ihrem Aufruf an, auf welche Zeilenbreiten +und mit welchem Schrifttyp die Datei formatiert werden soll. Diese Informa- +ionen werden von 'autoform'/'lineform' in Form von 'limit'- und 'type'-An- +weisungen in der Datei vermerkt, so daß die Anfragen bei weiteren Datei- +Bearbeitungen entfallen. + +Bei Zeilen, die länger als die angegebene Zeilenbreite sind, werden die- +jenigen Worte, die über die Zeilenbreite hinausgehen, in die nächste Zeile +umgebrochen. Kürzere Zeilen werden aus der nachfolgenden Zeile bis zur +Zeilenbreite aufgefüllt. Worte werden jedoch nicht über Absatzgrenzen hinweg +verschoben. Deshalb ist vor Anwendung von 'lineform' darauf zu achten, daß +Absätze richtig markiert wurden. Fehlende Markierungen sollte man nachträg- +lich einfügen (RETURN am Ende einer Zeile), andernfalls werden Zeilen über +Absatzgrenzen zusammen gezogen. Dies gilt insbesondere für Tabellenzeilen. + +Einrückungen (Leerzeichen am Anfang einer Zeile) werden von 'autoform'/'line- +form' ebenfalls bei der Formatierung von Zeilen eingehalten. +Dabei behandelt die Prozedur 'autoform'/'lineform' Einrückungen in einem +speziellen Fall nicht so, wie ein Benutzer es erwarten würde. Bei ein- +zeiligen Absätzen wird - falls die Zeile länger als das eingestellte Limit +ist und der "überschüssige" Teil in eine neue Zeile umgebrochen werden muß +- die Einrückung der aktuellen Zeile beibehalten. Das ist meist das +"richtige" Verhalten, während es bei Aufzählungen falsch ist, weil die +zweite Zeile einer Aufzählung oft eingerückt wird. Beispiel: + + - Diese Zeile war zu lang und wurde unter + das "-"-Zeichen umgebrochen. + +Man sollte daher - nach Verarbeitungsende - die Datei nach solchen Fällen +durchsuchen. + +Merke: 'autoform'/'lineform' vervollständigen zu kurze Zeilen oder brechen +zu lange Zeilen um. Dabei werden Absätze beachtet. + + + +Interaktive Silbentrennung mit 'lineform' + +'lineform' trennt Silben interaktiv. 'lineform' sollte deshalb für fremd- +sprachige Texte angewandt werden. + +Paßt ein Wort nicht mehr ganz auf eine Zeile, dann wird dieses Wort inter- +aktiv zur Trennung angeboten. Die Umgebung dieses Wortes wird zur Er- +leichterung des Trennvorgangs mit angezeigt. Das Trennzeichen erscheint an +einer sinnvollen Stelle im zu trennenden Wort. Beispiel: + + Text vor dem Trennwort; das + Trenn-wort steht mit nachfolgendem Text in dieser Zeile + +Der Benutzer hat die Möglichkeit, das Trennzeichen mit Hilfe der Positionie- +rungstasten innerhalb des "Trennbereichs" (das ist der markierte Bereich, der +noch auf die Zeile passen würde), zu verschieben. An der gewünschten Trenn- +position (der Wortteil, der noch auf die Zeile kommen soll, steht links vom +Trennstrich) kann die RETURN-Taste betätigt werden. RETURN zeigt dem Pro- +gramm 'lineform' an, daß an dieser Stelle die Trennung erfolgen soll. 'line- +form' fügt an den ersten Teil des Wortes das "-"-Zeichen an und schreibt den +abgetrennten Wortteil in die nächste Zeile. +Hinweis: Das Trennzeichen "-" hat einen anderen Code als der "normale" +Bindestrich (vergl. dazu die Codetabelle), da Trennungen ggf. bei erneuten +Änderungen wieder rückgängig gemacht werden müssen. + +Es stehen folgende Operationen bei der interaktiven Trennung zur Verfügung: + + Taste Bedeutung + + RETURN Trennen. + LINKS Trennstelle um ein Zeichen nach links verschieben. + RECHTS Trennstelle um ein Zeichen nach rechts verschieben. + HOP LINKS Trennstelle vor das Wort setzen (das Wort wird an dieser + Position nicht getrennt). + HOP RECHTS Trennstelle in die ursprüngliche Position setzen. + BLANK Trennzeichen wird von "-" auf " " umgeschaltet. + Dies kann verwandt werden, um Worte, die nicht zusammen + geschrieben werden sollen, beim Trennvorgang in zwei + Worte aufzuspalten. + - Schaltet das Trennzeichen von Leerzeichen (" ") wieder auf + den Trennstrich ("-") um. + +Zwei Sonderbedingungen sind bei der interaktiven Trennung noch zu beachten: + + - Bei Worten mit Bindestrich wird die Trennstelle hinter dem Bindestrich als + Leerzeichen angezeigt. Die Trennstelle vor dem Bindestrich wird bei + weiterem Positionieren nach links übersprungen. Das verhindert, daß Worte + mit führendem Bindestrich im Text erscheinen. + + - Bei einer Trennposition zwischen den Zeichen "ck" wird das Zeichen "c" in + ein "k" umgewandelt. Beispiel: + + Druk-ker +Hinweis: Das umgewandelte "k" hat einen anderen Code als das "normale" +"k" (vergl. dazu die Codetabelle). Das ist notwendig, um bei späteren +Änderungen solche Trennungen wieder rückgängig machen zu können. + +Sofern für die Zeilenformatierung notwendig, macht die Prozedur 'lineform' +bereits erfolgte Trennungen rückgängig (das Trennzeichen wird entfernt und +die Wortteile wieder zusammengefügt), wenn sich das getrennte Wort nicht mehr +am Zeilenende (etwa durch Korrekturen oder Veränderungen der Zeilenbreite) +befinden sollte. + +Merke: 'lineform' bietet Worte zur Silbentrennung an. Die "Trennstelle" kann +durch den Nutzer verschoben werden. + + + +Automatische Silbentrennung mit 'autoform' + +'autoform' arbeitet wie 'lineform', nur werden die Silbentrennungen auto- +matisch vorgenommen. + +Ist eine Silbentrennung bei der Formatierung notwendig, übernimmt 'autoform' +diese automatisch und gibt diese zur Kontrolle auf dem Bildschirm aus. Die +automatische Silbentrennung arbeitet mit einer hohen Trenngüte; allerdings +nur für deutsche Texte. Trotzdem kann es vorkommen, daß einige Trennungen +(insbesondere bei Fremdworten) falsch vorgenommen werden. In diesem Fall +muß man diese nachträglich mit dem Editor korrigieren. Dabei sollte man das +oben erwähnte Trennzeichen verwenden (ESC -). + + +Wenige oder viele Silbentrennungen: Trennpunkt einstellen + +Viele Silbentrennungen in einem Text erschweren das Lesen. Würde man nun +keine Silbentrennungen vornehmen, wird der rechte Rand stark "ausgefranst" +oder beim Blocksatz ("rechter Randausgleich") müssen viele Zwischenräume +zwischen den Worten eingefügt werden. Durch das Kommando + + hyphenation width (prozentuale angabe) + +kann der Trennpunkt, ab dem die Silbentrennung einsetzen soll, eingestellt +werden. Die Angabe erfolgt in Prozenten der Zeilenbreite. Beispielsweise +stellt 'hyphenation width (5)' den Trennpunkt auf 5% der Zeilenbreite ein +(Voreingestellt ist 7). Bei einer Angabe von 20 werden sehr wenige Worte zur +Silbentrennung angeboten, während bei einer Angabe von '3' ungefähr jede +dritte Zeile eine Silbentrennung versucht wird. Die Einstellung des Trenn- +punktes bestimmt also, ab wann ein Wort zur Silbentrennung untersucht wird. +Andererseits bestimmt die Einstellung auch, wieviel Zwischenraum zwischen +Worten eingefügt werden muß, um einen rechten Randausgleich zu erzielen. + +Merke: 'hyphenation width' bestimmt, an welchem Punkt Worte zur Silbentren- +nung angeboten werden. + + +Mit unterschiedlichen Schriften schreiben: 'type' + +Unterschiedliche Schrifttypen#ie# werden mit der 'type'-Anweisung ange- +fordert. + +Es ist möglich, mit 'lineform' verschiedenartige Schrifttypen (kurz Typen +genannt) verarbeiten zu lassen. Jeder Typ hat - neben dem speziellen Aus- +sehen der Zeichen - die Eigenschaft, daß jedes Zeichen eine bestimmte Breite +und Höhe hat. + +Es gibt zwei Arten von Schriften: bei äquidistanten Schriften sind alle +Zeichen gleich breit (wie bei einer "normalen" Schreibmaschine). Proportio- +nalschrift findet man in gedruckten Büchern. Hier haben unterschiedliche +Zeichen auch unterschiedliche Breiten. Die Zeichen ".", "i", "!" sind z.B. +schmaler als die Zeichen "w", "o", "m" usw. + +Mit der Anweisung + + type ("schriftname") + +kann auf einen anderen Schrifttyp umgeschaltet werden (auch mehrmals inner- +halb einer Zeile). Dieser Typ gilt solange, bis wieder ein neue 'type'-An- +weisung gegeben wird. Beispiel: + + \#type("basker12")\#Jetzt schreiben wir in einer Schrift. Und jetzt + schalten wir um auf\#type ("modern12")\# noch eine andere Schrift. + +Welche Schriftarten zur Verfügung stehen, hängt natürlich von dem verfügbaren +Drucker ab. Sie können die Schrifttypen bei Ihrer EUMEL-Installation er- +fragen. +Schrifttypen können modifiziert gedruckt werden (vergl. dazu den nächsten Ab- +schnitt). Durch die Angabe einer 'type'-Anweisung werden alle Modifikationen +ausgeschaltet. + +Merke: Eine 'type'-Anweisung gibt einen gewünschten Schrifttyp an. + + + +Kursiv, fett, unterstrichen, revers drucken: 'on/off' + +Mit der 'on'- und 'off'-Anweisung ist es möglich, einen Schrifttyp zu modi-f +izieren. Die Schrift wird zwar nicht gewechselt, aber verändert gedruckt. +Zur Zeit ist unterstrichen, fett, kursiv und der Druck von weiß auf schwarz +möglich (abhängig vom eingesetzten Drucker). + +Die 'on'/'off'-Anweisung wirkt wie ein Schalter, der die gewünschte Schrift- +typ-Modifikation ein- bzw. ausschaltet. Beispiel: + +... Das EUMEL-System ermöglicht es, +\#on("italic")\#kursiv\#off("italic")\# +und +\#on("underline")\#unterstrichen\#off("underline")\# +und +\#on("bold")\#fett\#off("bold")\# +und +\#on("revers")\#revers\#off("revers")\# +zu schreiben. + +Die Anweisung 'on' schaltet die Modifikation ein, 'off' schaltet sie aus. +Folgende Modifikationen sind z.Zt. implementiert: + + bold (Fettdruck) + italic (Kursivdruck) + underline (Unterstreichung) + revers (Weiß auf Schwarz) + +Dabei ist folgendes zu beachten: + +a) Ein 'type'-Anweisung schaltet eine Modifikation immer aus. + +b) Eine Modifikation sollte nicht über einen Absatz gehen ('lineform' er- + zeugt eine Warnung). Somit ist es gewährleistet, daß das Ausschalten + einer Modifikation nicht vergessen wird. + +c) Nicht alle Drucker können die hier angegebenen Modifikationen auch + drucken. Bitte erkundigen Sie sich bei Ihrer Installation. + +d) Welche Modifikationen gleichzeitig eingeschaltet werden können, ist + ebenfalls druckerabhängig. + +Merke: Die Anweisungen 'on' und 'off' schalten eine Modifikation an- und aus. + + + +Gesperrt schreiben + +Wird ein Wort g e s p e r r t geschrieben, muß natürlich verhindert werden, +daß dieses Wort beim Formatieren getrennt wird. Andere Worte, wie z.B. in +Formeln, sollten ebenfalls zusammen auf eine Zeile geschrieben werden (z.B. +'sin (x)'). + +Dies kann man erreichen, indem man nicht das Leerzeichen zwischen die Zeichen +schreibt, denn das Leerzeichen bedeutet für 'autoform'/'lineform' immer das +Ende eines Wortes. Man nimmt stattdessen ESC blank. ESC blank erscheint auf +dem Bildschirm zur besseren Identifizierung als Unterstreichungsstrich (oder +invers:  ) Beim Drucken wird jedoch wieder ein Leerzeichen produziert. +Beispiel: + + g_e_s_p_e_r_r_t (auf dem Terminal) + g e s p e r r t (auf Papier) + +Wir nennen dieses Leerzeichen auch "geschütztes Leerzeichen". + +Merke: G e s p e r r t wird mit dem geschützten Leerzeichen geschrieben. + + + +Tabellen und Aufzählungen schreiben + +Aufzählungen und Tabellen werden automatisch richtig formatiert und gedruckt, +wenn man sich an einige einfache Regeln hält. + +Verwendet man eine Proportionalschrift beim Tabellenschreiben, so sind die +Spalten in der Regel unterschiedlich breit, selbst wenn eine gleiche Anzahl +Zeichen in jeder Spalte geschrieben wird. Dies kann man durch das Schreiben +von einem "Doppelblank" vermeiden. Beispiel: + + nnnnn | zweite Spalte + mmmmm | steht nicht untereinander + +aber mit Doppelblank: + + nnnn | zweite Spalte + mmmm | stehen jetzt untereinander + +Das Doppelblank dient 'lineform/autoform' und dem Drucker als Zeichen, daß +die Positionen speziell berechnet ('lineform') und beim Druck berücksichtigt +werden müssen. In seltenen Fällen (insbesondere beim Einsatz von Schriftypen, +die in der Größe stark voneinander abweichen) kann es vorkommen, daß diese +Tabellenautomatik nicht funktioniert und Spalten übereinander gedruckt +werden. In solchen Fällen muß man die Anzahl der trennenden Doppelblanks +erhöhen. + +Praktischer Tip: +Beachte, daß für das Funktionieren der "Tabellenautomatik" bei proportionalen +Schriften es erforderlich ist, das jede Tabellenzeile eine Absatzzeile ist. +Man sollte diese Zeilen vor dem Druck daraufhin überprüfen oder durch 'line- +form/autoform' die Datei bearbeiten lassen. Sollte durch die zeilenweise +Formatierung einmal zwei Zeilen zusammengezogen sein (wegen fehlender Absatz- +kennzeichnung), kann man diese leicht mit dem Editor wieder "auseinander- +brechen" (zweimaliges HOP RUBIN). + +Ähnliches gilt bei Aufzählungen. Beispiel: + + 1) Das ist die erste Aufzählung. + Dieser Satz wird bündig gedruckt. + 2) Hier auch. + +Auch in solchen Fällen wird der gedruckte Text in der Regel richtig einge- +rückt. Die Aufzählungsautomatik wirkt nur nach einem Absatz und bei Propor- +tionalschriften. Die Regeln sind etwas kompliziert, so daß sie hier nicht +einzeln aufgeführt werden (siehe S. #topage("block")# unter dem Kommando +'block'). Trifft man auf einen der seltenen Fälle, wo die Einrückungsautoma- +tik nicht funktioniert, kann man immer das Doppelblank der Tabellenautomatik +verwenden. + +Merke: Die Tabellen- und die Aufzählungsautomatik sorgen dafür, daß Tabellen- +spalten und Aufzählungen bündig gedruckt werden. + + + +Zeilenbreite einstellen: 'limit' + +Mit der 'limit'-Anweisung kann die Zeilenbreite eingestellt werden. + +Die 'limit'-Anweisung gibt (in cm) an, wie breit die Zeile sein soll. Be- +achte, daß die Angabe der Zeilenbreite nichts mit dem LIMIT-Kommando des +Editors zu tun hat. Dieses gibt an, wieviel Zeichen einer äquidistanten +Schrift beim Schreiben auf eine Bildschirmzeile passen sollen. + +Die Zeilenbreite wird zusammen mit dem Schrifttyp beim erstmaligen Aufruf von +'autoform'/'lineform' interaktiv erfragt und als 'limit'-Anweisung (zusammen +mit der 'type'-Anweisung) in die erste Zeile der Datei eingetragen. Es kann +in einer Datei mehrmals verändert werden. Die Zeilenbreite gilt immer ab der +Zeile, in der die 'limit'-Anweisung steht. Beispiel: + + \#limit(10.0)\#Mit der 'limit'-Anwei­ + sung kann man Paragraphen in einem + anderen Format leicht gestalten. + Die rechte Schreibgrenze wird durch + die 'limit'-Anweisung eingestellt, + während der linke Rand durch eine + entsprechende Einrückung gestaltet + wird. \#limit(13.5)\# + +Man beachte, daß als Parameter in der 'limit'-Anweisung eine Zahl mit Dezi- +malpunkt angegeben werden muß. + +Die folgende Tabelle gibt sinnvolle 'limit'-Einstellungen für die am +häufigsten verwandten Papiergrößen an: + + + Format 'limit' Verbleibender + (Zeilenbreite) Rand + + DIN A4 16.0 cm je 2.65 cm + + DIN A5 12.0 cm je 1.42 cm + + DIN A4 quer 25.0 cm je 2.35 cm + +Merke: Die 'limit'-Anweisung stellt die Zeilenbreite in cm ein, während das +'LIMIT'-Kommando des Editors die Zeilenbreite in Anzahl Zeichen angibt. + + + +3. Seitenweises formatieren: 'pageform' + +'pageform' formatiert eine Datei seitenweise, wobei Routinearbeiten, wie +etwa die Plazierung von Fußnoten, Seitennummerierung usw. ebenfalls von +'pageform' erledigt werden. + + + +Eine Datei in Seiten teilen: 'pageform'-Kommando + +Das Programm 'pageform' wird mit dem Kommando + + pageform ("Buch") + +aufgerufen. 'pageform' erzeugt aus der Eingabedatei (hier: 'Buch') eine +Druckdatei, deren Name durch ein angehängtes '.p' gebildet wird (in unserem +Beispiel: 'Buch.p'). + + +Übersicht über die Arbeitsweise von 'pageform' + +'pageform' erzeugt aus einer Eingabedatei eine Druckdatei, wobei z.B. Fuß- +noten und Seitennummern an den richtigen Stellen eingefügt werden. + +'pageform' akzeptiert als Eingabe eine Datei und produziert eine neue Datei, +die "Druckdatei". Die Druckdatei besteht aus der Eingabedatei mit ggf. neu +eingefügten Zeilen. Die eingesetzten Zeilen stammen aus 'head'-, 'bottom' +oder 'footnote'-Anweisungen. Dadurch erhöht sich die Zeilenanzahl der Datei +(bis zu 15%). + +Durch 'pageform' ist es möglich, am Anfang und am Ende jeder Seite Zeilen +einfügen zu lassen. Solche Textzeilen aus Kopf- bzw. Fußbereichen sowie +Zeilen aus Fußnoten werden in der Druckdatei in jede Seite an entsprechender +Stelle eingefügt. + +Es ist möglich, in Kopf- oder Fußzeilen Seitennummern aufzunehmen. Diese Sei- +tennummern werden von 'pageform' bei Seitenwechseln automatisch erhöht und +an eine vom Benutzer gekennzeichnete Stelle eingesetzt. Fußnoten können auch +durch Nummern gekennzeichnet werden. Querverweise sind ebenfalls möglich. + +'pageform' berechnet die Anzahl von Zeilen, die auf eine Seite passen sollen, +aus den Angaben für die Seitenlänge, eingestellten Zeilenvorschub und even- +tuelle Kopf-, Fuß- und Fußnotenzeilen. Bei der Berechnung wird von der je- +weiligen Schrifthöhe des eingestellten Schriftyps ('type'-Anweisung) ausge- +gangen. Dann zeigt 'pageform' das errechnete Seitenende auf dem Bildschirm +an. Das Seitenende kann interaktiv verschoben werden, um es an eine ge- +wünschte Stellen zu plazieren oder es können Leerzeilen eingefügt/gelöscht +werden, um Seiten gleich lang zu machen. Zusätzlich ist es auch möglich, +Seiten in Spalten ("Zeitungsdruck") aufzuteilen und diese interaktiv zu +formatieren. + + Anweisungs-Übersicht + + bottom Fußzeilen *) + bottomeven " *) + bottomodd " *) + columns Spaltenformatieren + columnsend Spalten ausschalten + count Zähler erhöhen und einsetzen + end Beendet 'head', 'bottom' und *) + 'foot'-Bereiche + foot Fußnote *) + free Zeilen freilassen *) + goalpage Seitenverweis (Ziel) + head Kopfzeilen *) + headeven " *) + headodd " *) + linefeed Zeilenabstand *) + page Neue Seite anfangen *) + pagelength Seitenlänge setzen + pagenr Seitennummer bzw. -zeichen + setcount Zähler setzen + topage Seitenverweis (Ursprung) + value Wert des Zählers einsetzen + +*) Diese Anweisungen dürfen nur allein oder als letztes auf einer Zeile stehen. + + +Merke: 'pageform' erlaubt nicht nur eine Seitenformatierung, sondern auch +Spaltenformatierung, Fußnoten-Plazierung, Kopf- und/oder Fußzeilen, Seiten- +numerierung und Querverweise. 'pageform' erzeugt eine neue Datei, die +"Druckdatei" mit dem Namen der Eingabedatei, an den ".p" angefügt wird. + + + +Seitenende interaktiv verschieben#ie# mit 'pageform' + +In diesem Abschnitt wird beschrieben, welche interaktiven Möglichkeiten +'pageform' bietet, um Seiten zu gestalten. + +Auf dem Bildschirm wird das von 'pageform' errechnete jeweilige Seitenende +unter Angabe der aktuellen Seitennummer angezeigt. Das Seitenende erscheint +ungefähr in der Mitte des Bildschirmes und wird durch eine von 'pageform' ge- +kennzeichnete Zeile markiert, die auch - nach erfolgter Seitenformatierung - +in der Druckdatei zu sehen ist. (Der EUMEL-Drucker druckt diese Zeile nicht.) +Beispiel: + +\#page\#\#--------------------- Ende Seite 1 ---\# + +Über der Markierung erscheinen die letzten Zeilen der bereits verarbeiteten +Seite, darunter Zeilen der nächsten Seite. Es ist nun mit Hilfe der Positio- +nierungstasten möglich, die Markierung und damit das Seitenende nach "oben +zu verschieben". Somit kann vermieden werden, daß logisch zusammengehörender +Text auseinandergerissen wird und z.B. "Waisenkinder" entstehen (letzte +Zeile eines Abschnittes kommt noch auf die neue Seite). + +Bei der interaktiven Seitenformatierung kann die Markierung nicht über das +errechnete Ende einer Seite nach "unten" oder über das vorherige, bereits +verarbeitete Seitenende nach "oben" verschoben werden. Die Markierung kann +auch nicht in einen Fußnotenbereich plaziert werden, weil Fußnoten sinn- +vollerweise nicht geteilt werden sollten. + +Entstehen Leerzeilen bei der Seitenformatierung am Anfang einer Seite (z.B. +durch Plazierung des Seitenendes zwischen zwei Absätzen), so werden diese +von 'pageform' automatisch aus der Druckdatei entfernt. Will man Leerzeilen +am Anfang einer Seite#ie#, dann sollte das 'free' in Verbindung mit der +'page'-Anweisung verwandt werden. + +Zusätzlich ist es möglich, Leerzeilen in eine Seite der Druckdatei einzu- +fügen und/oder beliebige Zeilen zu löschen (vergl. b)). + +Folgende Operationen stehen bei der interaktiven Seitenformatierung zur +Verfügung: + +a) Seitenende verschieben: + +'pageform' berechnet das "rechnerische" Seitenende und zeigt dieses auf dem +Bildschirm durch die Markierung an. Die Markierung kann interaktiv verschoben +werden: + + Taste Bedeutung + + RETURN Seitenende an diese Stelle plazieren. + OBEN Seitenende eine Zeile nach oben verschieben. + UNTEN Seitenende eine Zeile nach unten verschieben + (wenn vorher nach "oben" verschoben). + HOP OBEN Seitenende um einen Bildschirm nach oben verschieben. + HOP UNTEN Seitenende um einen Bildschirm nach unten verschieben. + +b) Leerzeilen einfügen und/oder Zeilen löschen + +Ergeben die Berechnungen von 'pageform', daß der bearbeitete Text nicht +richtig auf der Seite plaziert ist, können in die Seite (der Druckdatei!) +Leerzeilen eingefügt und/ oder Zeilen gelöscht werden. Dies kann beispiels- +weise sinnvoll sein, wenn durch die Löschung einer Zeile ein Absatz noch auf +die Seite passen würde oder durch die Einfügung von Leerzeilen ein Absatz +auf der letzten Zeile der Seite endet. Oft ist es auch sinnvoll, daß alle +Seiten gleich lang sind. In diesem Fall sollten vor Kapiteln und Absätzen +Leerzeilen eingefügt oder gelöscht werden. + +Um Leerzeilen einzufügen und/oder Zeilen zu löschen, muß die Markierung (wie +unter a) beschrieben) an die Stelle plaziert werden, an der die Änderung +vorgenommen werden soll. Abschließend berechnet 'pageform' die Seite erneut. + + Taste Bedeutung + + HOP RUBIN Leerzeilen einfügen. + Anstatt der Markierung können durch (u.U. mehrmaliges) + RETURN Leerzeilen eingefügt werden. HOP RUBIN beendet + den Vorgang (wie Zeileneinfügen im Editor). + + HOP RUBOUT Zeile löschen. + Die Zeile unmittelbar oberhalb der Markierung wird + gelöscht. + +'page'-Anweisung bestätigen/löschen + +Wird von der Prozedur 'pageform' eine 'page'-Anweisung angetroffen, so wird +das so gewünschte Seitenende auf dem Bildschirm des Benutzers angezeigt. Die +'page'-Anweisung kann entweder bestätigt oder gelöscht werden. + + Taste Bedeutung + + RETURN Seitenende bestätigen. + + RUBOUT 'page'-Anweisung ignorieren. Die Prozedur 'pageform' + bearbeitet in diesem Fall die Datei weiter, als ob + keine 'page'-Anweisung angetroffen wurde. + +Merke: Ein Seitenende wird von 'pageform' auf dem Bildschirm angezeigt. Dies +kann man mit den Positionierungstasten verschieben. Es können in die Seite +Leerzeilen eingefügt oder Zeilen gelöscht werden. Eine 'page'-Anweisung kann +man bestätigen oder löschen. + + + +Seitenlänge einstellen: 'pagelength' + +'pageform' ist auf eine Seitenlänge von 25.0 cm eingestellt (entspricht +einem DINA4-Schreibfeld). Ist eine andere Seitenlänge erwünscht, muß die +'pagelength'-Anweisung in den Text eingefügt werden. + +Beispiel: + + \#pagelength (20.0)\# + +stellt die Seitenlänge auf 20 cm ein. Man beachte, daß der Dezimalpunkt bei +der Seitenlänge mit angegeben werden muß. + +Die folgende Tabelle gibt die Seitenlänge für die am häufigsten gewählten +Papiergrößen an: + + Format Seitenlänge oberer und + (in cm) unterer Rand + + DIN A4 25.0 je 2.35 cm + + DIN A5 18.0 je 2.15 cm + + DIN A4 quer 18.0 je 2.15 cm + +Merke: Mit der 'pagelength'-Anweisung kann die Seitenlänge (in cm) einge- +tellt werden. + + + +Zeilenabstand einstellen: 'linefeed' + +Die 'linefeed'-Anweisung stellt einen Zeilenvorschub relativ zu der Schrift- +höhe des eingestellten Schrifttyps ein. + +'pageform' berechnet die Anzahl Zeilen/Seite immer in Abhängigkeit vom einge- +stellten Schrifttyp. Hat man z.B. eine Schrift gewählt, die doppelt so hoch +wie z.B. eine Schreibmaschinenschrift ist, bekommt man auch entsprechend +weniger Zeilen auf eine Seite. Um diesen Berechnungsvorgang braucht sich ein +Nutzer in der Regel nicht zu kümmern. + +Anders verhält es sich, wenn ein anderer Zeilenvorschub als der "normale" +Abstand zwischen Zeilen vorgenommen werden soll. In diesem Fall muß man wis- +sen, daß die "Höhe" einer Zeile sich aus der Schrifttypgröße errechnet plus +(ca.) 10%, welches den Abstand zwischen den Zeilen darstellt. + +Soll nun ein anderer Abstand eingestellt werden, wird die 'linefeed'-An- +weisung eingesetzt. Der Parameter gibt an, um wieviel eine Zeilenhöhe erhöht +oder verringert werden soll. Beispiel: + + \#linefeed (2.0)\# + +Nach Antreffen dieser Anweisung wird die Zeilenhöhe durch 2 * eingestellte +Schrifttypgröße errechnet. Es wird also der Zeilenabstand zwischen den Zeilen +entsprechend vergrößert, da die Schriftgröße gleich bleibt. Dies entspricht +dem zweizeiligen Schreiben bei einer Schreibmaschine (wenn man davon absieht, +daß hier auch unterschiedliche Schrifthöhen berücksichtigt werden). Ein +1 1/2 zeiliges Schreiben wäre mit + + \#linefeed (1.5)\# + +einzustellen. + + \#linefeed (0.5)\# + +stellt die Zeilenhöhe = 1/2 * eingestellte Schrifthöhe ein, so daß die Zeilen +teilweise ineinander gedruckt werden. Bei 'linefeed (0.0)' werden Zeilen +übereinander gedruckt (druckerabhängig). + +Man beachte, daß die Angabe in der 'linefeed'-Anweisung relativ erfolgt. Bei +allen anderen Anweisungen der Textkosmetik werden Angabe in Zentimeter ver- +langt. Die 'linefeed'-Anweisung bildet somit eine Ausnahme (von der Regel). + +Merke: Wieviel Zeilen auf eine Seite passen, ist von den Höhen der einge- +stellten Schrifttypen abhängig. Diese Berechnung erfolgt automatisch durch +'pageform'. Die 'linefeed'-Anweisung stellt einen Zeilenvorschub relativ zum +eingestellten Schrifttyp ein. + + + +Platz freihalten: 'free' + +Mit der 'free'-Anweisung kann man einen zusammenhängenden Teil auf einer +Seite freihalten. + +Die 'free'-Anweisung wird an solchen Stellen im Text eingesetzt, an denen - +nach dem Druck - Zeichnungen, Tabellen und ähnliches eingeklebt werden sol- +len. Es wird der in der 'free'-Anweisung angebene Platz freigehalten. Bei- +spiel: + +\#free (2.0)\# +hält zwei Zentimeter frei. Paßt der angeforderte Platz nicht mehr auf die +Seite, so wird der angeforderte Platz auf der nächsten Seite reserviert +('pageform' plaziert das Seitenende vor die 'free'-Anweisung). + +Merke: Die 'free'-Anweisung hält einen Platz auf dem Papier frei (Angabe in +cm). + + + +Neue Seite beginnen: 'page' + +An einigen Stellen im Text, z.B. zu Beginn eines neuen Kapitels, soll unbe- +ingt eine neue Seite angefangen werden. + +Dies erreicht - wie bereits erwähnt - man mit der 'page'-Anweisung. 'page- +form' meldet im diesem Fall, nach wieviel cm auf der Seite die Anweisung an- +getroffen wurde. Man kann nun mit RETURN das Seitenende bestätigen, oder die +Anweisung (in der Druckdatei) löschen. Im letzteren Fall berechnet 'page- +form' die Seite neu (als ob die 'page'-Anweisung nicht dagewesen wäre). + +Gleichzeitig ist es möglich, mit Hilfe der 'page'-Anweisungs eine neue Sei- +tennummer#ie# für die neue Seite einzustellen (vergl. die nächsten Ab- +chnitte). + +Merke: Die 'page'-Anweisung bewirkt eine neue Seite und muß beim Formatieren +bestätigt werden. + + + +Kopf- und Fußzeilen: 'head/bottom' + +Mit den 'head'- und #ib#'bottom'-Anweisung#ie#en ist es möglich, Zeilen am +Anfang und Ende jeder Seite einfügen zu lassen. + +Zeilen am Anfang ("Kopfzeilen") und Ende ("Fußzeilen") jeder Seite werden +nur einmal geschrieben und mit Anweisungen gekennzeichnet. Diese Zeilen fügt +'pageform' dann an den entsprechenden Stellen ein. Beispiel: + +\#head\# + Unser EUMEL-Benutzerhandbuch + +\#end\# + +Diese zwei Zeilen (also die zwischen den 'head'- und 'end'-Anweisungen ein- +geschlossenen Zeilen) werden unverändert von 'pageform' an den Anfang jeder +Seite in die Druckdatei plaziert. Man beachte, daß zweckmäßigerweise (minde- +stens) eine Leerzeile nach einer solchen Kopfzeile in den 'head'-Bereich ein- +gefügt werden sollte, um die Kopfzeile von dem eigentlichen Text der Seite zu +trennen. + +Entsprechendes gilt für Fußzeilen, die zwischen 'bottom' und 'end' einge- +chlossen werden müssen: + +\#bottom\# + Autor: I. Listig +\#end\# + +Praktischer Tip: Man füge nach einer Schriftzeile mindestens eine Leerzeile +ein (in einem 'head') bzw. vor der Schriftzeile (in einem 'bottom'), um den +eigentlichen Text von den Kopf- bzw. Fußzeilen abzuheben. + +'pageform' zählt die Seiten, beginnend mit der Seitennummer '1'. (Wie man +Seitennummern in die Kopf- und Fußzeilen bekommt, verraten wir im nächsten +Abschnitt). Es ist nun möglich, getrennte Kopf- und Fußzeilen für gerade und +ungerade Seiten zu gestalten (wie in diesem Benutzerhandbuch). Dies erfolgt +mit den Anweisungen 'headeven' und 'headodd' für Seiten mit geraden und un- +geraden Seitennummern; ('bottomeven' und 'bottomodd' dito). + +Diese Anweisungen müssen ebenfalls jeweils mit einer 'end'-Anweisung be- +endet werden. + +Es ist möglich, Kopf- und Fußzeilen mehrmals innerhalb einer Datei zu +wechseln, um unterschiedliche Beschriftungen zu erhalten (z.B. kapitelweise). +Dies ist jedoch nur sinnvoll, wenn dies auf einer neuen Seite erfolgt, also +unmittelbar nach einer 'page'-Anweisung in den Text eingefügt wird. Beispiel: + + \#page\# + \#head\# + Neuer Seiten Kopf + + \#end\# + +"Fußzeilen" sollen überall gleiches Aussehen haben, unabhängig davon, welche +Anweisungen im restlichen Text gegeben werden. Darum werden die bei der De- +finition einer Fußzeile aktuellen Werte für + + limit + type + linefeed + +bei dem Einsetzen der Zeilen berücksichtigt. Es ist somit erlaubt, einen +anderen Schrifttyp (z.B. als der restliche Text) für Fußzeilen zu verwenden, +indem die 'type'-Anweisung innerhalb des 'bottom'-Bereiches gegeben wird. +Beachte, daß nach 'head'-, 'bottom' und auch 'foot'-Bereiche die o.a. Kom- +mandos nicht automatisch zurückgestellt werden. Darum sollte vor der 'end'- +Anweisung wieder auf den im übrigen Text verwandten Schrifttyp zurückge- +stellt werden. Gleiches gilt für die 'limit'- und 'linefeed'-Anweisung. +Beispiel: + + \#bottom\# + \#type ("besonders schoen")\# + Autor: I. Listig + + (Schriftyp zurückstellen): \#type ("normal")\# \#end\# + +Merke: Kopf- und Fußzeilen können durch die Anweisungen 'head' bzw. 'bottom' +oder 'headeven', 'headodd' bzw. 'bottomeven', 'bottomodd' definiert werden. +Die Zeilen müssen jeweils durch die 'end'-Anweisung beendet werden. + + + +Seiten numerieren + +In den Kopf- und Fußzeilen steht das '%'-Zeichen für die aktuelle Seiten- +nummer. + +Erscheint das '%'-Zeichen innerhalb eines Kopf- oder Fußbereiches, wird von +'pageform' beim Einsetzen dieser Zeilen auf jeder Seite die aktuelle Seiten- +nummer#ie# eingesetzt (sind mehrere '%'-Zeichen vorhanden, wird die Seiten- +nummer mehrmals eingesetzt). Beispiel: + +\#head\# + Seite: - % - + +\#end\# + +Durch einen Fußbereich kann man die Seitennummern auch am Ende einer Seite +haben. Man beachte, daß sich bei mehrstelligen Seitennummern durch das Ein- +setzen die Zeilenlänge vergrößert. + +Manchmal ist es notwendig und sinnvoll, einen Text in mehreren Dateien zu +halten. Bei einer Folgedatei muß die Seitennummer dann neu gesetzt werden. +Das erfolgt mit der 'page'-Anweisung. Beispiel: + +\#page (4)\# + +vollzieht eine neue Seite. Die Seitennummer der neuen Seite ist '4'. + +Bei einigen Spezialanwendungen benötigt man mehr als eine Seitennummer. +Beispielsweise soll ein Text nicht nur absolut, sondern auch jede Seite in +jedem Kapitel separat durchgezählt werden. Eine andere Anwendung ist die +Benennung einer Folgeseite, wie in diesem Beispiel: + +\#page (4711)\# +\#head\# + Mein Buch Seite: % + +\#end\# +\#pagenr ("$", 4712)\# +\#bottom\# + + Nächste Seite: $ +\#end\# + +Durch die 'pagenr'-Anweisung gibt man ein neues "Seitenzeichen" (hier: '$') +und den Anfangwert für diese Seitennummer (hier: '4712'), der ebenfalls wie +das '%'-Seitenzeichen von 'pageform' bei jeder neuen Seite um '1' erhöht und +ggf. in die Kopf- und Fußzeilen eingesetzt wird. Es sind zwei zusätzliche +Seitenzeichen (neben dem '%') möglich. + +Merke: In den Kopf- und Fußzeilen wird ein '%'-Zeichen von 'pageform' durch +die aktuelle Seitennummer ersetzt. Die Seitennummer kann durch das 'page'- +Anweisung neu gesetzt werden. + + + +Fußnoten schreiben: 'foot' + +Fußnoten werden direkt im Text durch die Anweisungen 'foot' und 'end' ge- +kennzeichnet. Die Fußnoten plaziert 'pageform' an das Ende einer Seite. + +Fußnoten werden vom Benutzer direkt in den Text geschrieben, am besten nach +einem Absatz. Die Fußnote wird von 'pageform' an das Ende einer Seite, ggf. +vor Fußzeilen plaziert. Für die Kennzeichnung von Fußnoten und die ent- +sprechende Markierung im Text ist der Benutzer selbst zuständig. Allerdings +wird von 'pageform' bei dem Einsetzen einer Fußnote am Ende einer Seite +Unterstreichungsstriche vor die Fußnoten eingefügt, damit Fußnoten vom +"normalen" Text abgehoben werden. + +\#foot\# +*) Das ist die erste Anmerkung auf dieser Seite. +\#end\# + +Mehrere Fußnoten innerhalb einer Seite werden von 'pageform' in der Reihen- +folge ihres Auftretens gesammelt und am Ende der Seite plaziert. Für eine +entsprechende Trennung der Fußnoten voneinander (z.B. durch Leerzeilen) hat +der Benutzer selbst zu sorgen. + +Man sollte eine Fußnote unmittelbar hinter den Absatz schreiben, in der die +Markierung für die Fußnote erscheint, denn u.U. paßt die Fußnote nicht mehr +auf die aktuelle Seite und muß somit von 'pageform' auf die nächste Seite +gebracht werden. 'pageform' geht davon aus, daß die Kennzeichnung der Fuß- +note in der Zeile unmittelbar vor der Fußnote steht und bringt diese Zeile +ebenfalls auf die neue Seite. + +Merke: Fußnoten werden direkt hinter einem Absatz in den Text mittels der +Anweisungen 'foot' und 'end' geschrieben, die 'pageform' an das Ende der +Seite einfügt. Die Kennzeichnung der Fußnoten hat der Benutzer selbst vorzu- +nehmen oder man kann sie mit Hilfe von 'count'- und 'value'-Anweisungen +durchnumerieren (siehe nächsten Abschnitt). + + + +Fußnoten numerieren: Zählen lassen + +Bei vielen Fußnoten in einem Text ist es nicht möglich, die Fußnoten beim +Schreiben des Textes entsprechend zu beschriften. Für diesen Fall und um auf +die Fußnote im Text nochmals Bezug nehmen zu können, bietet 'pageform' die +Möglichkeit an, die Fußnoten zu numerieren. + +Durch die 'count'-Anweisung wird 'pageform' veranlaßt, einen internen Zähler +(beginnend bei dem Wert 0) zu erhöhen und diesen Wert anstatt der 'count'- +Anweisungen in den Text einzusetzen. Beispiel: + +\#count\# + +setzt den Wert 1 anstatt der Anweisung ein (Anmerkung: trifft 'lineform' auf +eine 'count'-Anweisung, so wird die Zeile berechnet, als ob drei Ziffern +anstatt der Anweisung ständen). Jede weitere 'count'-Anweisung erhöht den +internen Zähler und der Zählerwert wird wiederum eingesetzt: + +\#count\# + +setzt den Wert 2 ein usw. Dadurch ist es möglich, beliebige Textteile +(Kapitel, mathematische Sätze u.a.m.) fortlaufend zu numerieren, ohne auf +die Numerierung beim Schreiben und Ändern des Textes zu achten. + +Mit der 'value'-Anweisung kann man den letzten erreichten count-Wert noch- +mals einsetzen. Das ist insbesondere für Fußnoten sinnvoll einsetzbar. +Beispiel: + + Bla Bla Bla (\#count\#) + \#foot\# + Eine Fußnote + \#end\# + ... + +Das Resultat würde folgendermaßen aussehen: + + Bla Bla Bla (3) + .... + + _____ + (3) Eine Fußnote + +Man beachte, daß in diesem Fall die 'value'-Anweisung der 'count'-Anweisung +folgen muß, ohne das eine weitere 'count'-Anweisung dazwischen steht. Das +liegt - wie bereits erwähnt - daran, daß die 'value'-Anweisung immer den +letzten 'count' Wert einsetzt. + +Das kann man umgehen, indem die 'count'- und 'value'-Anweisungen mit einem +TEXT-Parameter versehen werden, der als Kennzeichnung dient. Beispiel: + + \#count ("Merk1")\# + +arbeitet ebenso wie 'count' ohne Parameter (setzt also hier den Wert 4 ein), +aber zusätzlich vermerkt 'pageform' den aktuellen Zählerwert neben dem Kenn- +zeichen. Nun ist es mit der 'value'-Anweisung möglich, den vermerkten Zähler- +wert durch Angabe des Kennzeichens an beliebigen Stellen im Text zu reprodu- +zieren (auch wenn der interne Zähler weitergezählt wurde). Beispiel: + + \#count\#\#count\# + \#value("Merk1")\# + +Die ersten zwei 'count'-Anweisungen produzieren - wie beschrieben - die +Werte 5 bzw. 6. Die 'value'-Anweisung dagegen setzt den vermerkten Wert 4 +ein. + +Dies ist insbesondere sinnvoll, wenn man im Text auf eine Fußnote verweisen +will. Beispiel: + + Bla Bla. Siehe auch Anmerkung (\#value ("Waldschrat")\#). Bla + ... + ... + Bla Bla Bla (\#count ("Waldschrat")\#) + \#foot\# + (\#value ("Waldschrat")\#) Waldschrate kommen in vier Farben vor: + Rot, schwarz, grün und blau/gelb. + \#end\# + +Manchmal ist es notwendig (ebenso wie bei der Seitennummer), den internen +Zähler neu zu setzen. Beispiel: + + \#setcount (13)\#\#count ("aha!")\# + +produziert den Wert 13. + +Merke: Die 'count'-Anweisung setzt einen internen Zähler in die Druckdatei +ein. Durch die #ib#'value'-Anweisung#ie# werden gespeicherte Werte einge- +setzt, was man bei Fußnoten ausnutzen kann. + + + +Querverweise mit 'topage'/'goalpage' + +Mit den Anweisungen 'topage' und 'goalpage' sind Querverweise möglich, die +von 'pageform' in die Druckdatei eingefügt werden. + +Mit Hilfe von Querverweisen soll auf andere Stellen im Text verwiesen werden, +was nur bei längeren Texten üblich ist. Um dem Leser die mühselige Suche +nach der Textstelle zu ersparen, gibt man in der Regel die Seitennummer an. +Leider steht die Seitennummer vor der Fertigstellung des Textes meist noch +nicht fest. Auch in diesem Fall kann 'pageform' helfen. Die 'topage'- An- +weisung verweist auf eine andere Seite im Text, an der sich eine Anweisung +'goalpage' befinden muß. Anstatt der Anweisung 'topage' wird die Seitennum- +mer der Seite eingesetzt, auf der sich 'goalpage' befindet. Damit jedes +'topage' auch (sein) entsprechendes 'goalpage' findet, wird bei beiden An- +weisungen ein TEXT-Parameter angegeben. Beispiel: + + Man schreibt: ... siehe auch auf Seite \#topage("verweis1")\# + ... + Auf einer anderen Seite befindet sich \#goalpage("verweis1")\# + +Nach 'Seite' wird die entsprechende Seitennummer eingesetzt. + +Es ist möglich, mehrmals auf die gleiche (Ziel-) Seite zu verweisen, man muß +nur darauf achten, daß immer das gleiche Merkmal (TEXT-Parameter) verwandt +wird. + +Merke: Mit den 'topage'- und 'goalpage'-Anweisungen sind Seitenquerverweise +möglich. Für 'topage' wird die Seitennummer eingesetzt, auf der 'goalpage' +steht. + + + +Formatierung von Spalten: 'columns' + +Mit der 'columns'-Anweisung ist es möglich, einen Text in Spalten zu forma- +tieren ("Zeitungsdruck"). + +Durch die Angabe der 'columns'-Anweisung wird 'pageform' aufgefordert, den +Text in Spalten zu formatieren. Die Spaltenbreite muß der Benutzer mit der +'limit'-Anweisung einstellen. Beispiel: + + \#limit (18.0)\# + ... + \#columns (2, 2.0)\#\#limit (8.0)\# + ... + +Anfangs schreibt der Benutzer mit einer Zeilenbreite von 18 cm. Dann fordert +er mit der 'columns'-Anweisung zweispaltigen Druck an (zwischen den Spalten +soll 2 cm Abstand sein). Somit muß die 'limit'-Anweisung auf 8 cm einge- +stellt werden. + +Die interaktive Spaltenformatierung wird von 'pageform' wie gewohnt vorgenom- +men. Auf dem Bildschirm erscheint nun das Spaltenende, wobei die Nummer der +Spalte angezeigt wird. Fußnoten werden spaltenweise eingeordnet und müssen +somit die gleiche Zeilenbreite haben, wie die restlichen Spalten. + +'pageform' erzeugt in der Druckdatei die Spalten hintereinander. Das folgende +Beispiel zeigt einen Ausschnitt aus der Druckdatei mit Kopf- und Fußzeilen +bei einem zweispaltigen Druck: + + head-Zeilen + xx + xx + xx + bottom-Zeilen + \#page\#\#------- Ende Seite 1 Spalte 1 ----\# + xx + xx + xx + \#page\#\#------- Ende Seite 1 Spalte 2 ----\# + +Die zweite Spalte erscheint also ohne Kopf- und Fußzeilen, die jedoch bei der +Berechnung berücksichtigt werden. Man beachte, daß die Kopf- und Fußzeilen +über die Spalten gehen können. Dies erreicht man durch geeignete 'limit'- +Anweisungen in den genannten Bereichen. Hochwertige Drucker plazieren die +zweite Spalte im Druckbild neben die erste. Bei preiswerteren Druckern muß +man die Spalten nebeneinander kleben. + +Es ist zwar prinzipiell möglich, die Spalten in der Druckdatei nebeneinander +zu schreiben. Jedoch hätte das Druckerprogramm Schwierigkeiten, diese neben- +einander zu drucken, ohne daß z.B. ein Schrifttypwechsel in einer Spalte +Auswirkungen auf eine Benachbarte hat. Praktischer Tip: Bei Druckern mit +"Traktorführung" kann man erst alle ersten Spalten drucken, dann das Papier +"von Hand" zurückdrehen und die zweiten Spalten drucken usw. + +Alle Anweisungen funktionieren beim spaltenweisen Formatieren wie üblich. Die +'free'-Anweisung z.B. hält entsprechenden Platz in einer Spalte frei. Eine +Ausnahme bildet die 'page'-Anweisung. Sie vollzieht hier ein Spaltenende. Die +'page'-Anweisung mit einem Parameter (welcher die Seitennummer der nächsten +Seite angibt), vollzieht dagegen ein Seitenende. + +Die 'columns end'-Anweisung beendet die spaltenweise Formatierung. Es ist +zweckmäßig, unmittelbar vor der 'columns'- und hinter der 'columns end'- +Anweisung eine 'page'-Anweisung zu schreiben. + +Überschriften (bzw. Textblöcke) über mehrere Spalten hinweg sind nur in der +ersten Seite direkt hinter der 'columns'-Anweisung möglich. Beispiel: + + \#page\# + \#limit (18.0)\# + HEAD + Breite Überschrift + \#columns (2, ...)\#\#limit (8.0)\# + XX + XX + XX + Bottom + \#page\#\#------- Ende Seite 1 Spalte 1 ----\# + XX + XX + XX + \#page\#\#------- Ende Seite 1 Spalte 2 ----\# + +Die Zeilen für die zweispaltige Überschrift werden berücksichtigt. Dies gilt +jedoch nur unmittelbar hinter der 'columns'-Anweisung. Will man diesen Effekt +nochmals haben, beendet man mit 'columns end', schreibt die 'page'-Anweisung, +die breite Überschrift und schaltet die 'columns'-Anweisung wieder ein usw. + +Merke: Die Anweisungen 'columns'- und 'columns end' bewirken ein spalten- +weises Formatieren des Textes durch 'pageform'. Die Spaltenbreite ('limit'- +Anweisung) hat der Benutzer selbst einzustellen. + + + +4. Stichwortverzeichnisse erstellen: 'index'-Kommando + +Das Programm 'index' kann Stichwort- und Inhaltsverzeichnisse erstellen. +Stichwortverzeichnisse#ie# können sortiert werden. Mehrere Stichwortver- +zeichnisse können durch 'index merge' zusammengeführt werden. + + + +Übersicht über die Arbeitsweise von 'index' + +Durch den Aufruf von + + index ("datei.p") + +werden durch Indexanweisungen gekennzeichnete Worte in Dateien, den soge- +nannten Indexdateien, gespeichert. + +Anweisung Zweck + + ib Anfang Index + (folgende Worte werden bis zur 'ie'-Anweisung in den + Index übernommen) + ie Ende eines Index + +Solche Verzeichnisse von Worten werden im EUMEL-System allgemein als Index +bezeichnet. Nachdem eine oder mehrere Indexdateien aus einer Druckdatei +erstellt sind, werden die Indexdateien auf Anfrage alphabetisch sortiert. +Bei einem Inhaltsverzeichnis sollte man die Sortierung natürlich ablehnen. + +Nach der Sortierung werden gleiche Einträge automatisch zusammengefaßt und +die entsprechenden Seitennummern nacheinander aufgeführt. + +Praktischer Tip: Will man nur eine Sortierung, aber keine Zusammenfassung +von Einträgen, dann lehnt man die Sortieranfrage ab. Anschließend kann man +die Indexdatei mit 'lex sort ("indexdatei namen")' sortieren. Hierbei +bleiben gleiche Einträge erhalten. + +Das Programm + + index merge ("index.i1", "index.i2") + +erlaubt es, zwei durch 'index' erzeugte Verzeichnisse zusammenzuführen. +'index' kann ebenfalls benutzt werden, um ein Inhaltsverzeichnis und/oder +ein Verzeichnis aller Abbildungen zu erstellen oder Literaturhinweise zu +überprüfen. + +Die Worte, die durch 'index' in einen Index übernommen werden sollen, müssen +in der Eingabedatei (der Druckdatei aus 'pageform') für 'index' durch An- +weisungen gekennzeichnet werden. Die Form der Anweisungen entspricht der +ELAN-Syntax (analog den Anweisungen für 'lineform', 'pageform' und EUMEL- +Drucker). Solche #ib(1,"ff")#Indexanweisungen#ie# werden von den anderen +Textbe- und -verarbeitungs Programmen ('lineform', 'pageform', EUMEL- +Drucker) ignoriert. Man kann also bei dem Schreiben mit dem Editor gleich +festlegen, welche Worte in einen Index aufgenommen werden sollen. + + + +Worte kennzeichnen: 'ib'/'ie' + +Da in einem Index - neben dem eigentlichen Worteintrag - die Seitennummer +enthalten sein soll, arbeitet das Programm 'index' nur mit einer Druckdatei, +d.h. einer Ausgabedatei von 'pageform'. Die Indexworte werden in Indexda- +teien gesammelt. Die Indexdateien erhalten den Namen der zu bearbeitenden +Datei, an den ".i" und die Nummer des Index angefügt wird. Beispiel: + + ... Hier wird eine Eigenschaft des \#ib(1)\#EUMEL-Systems\#ie(1)\# beschrieben. + +(Die durch die Anweisungen 'ib' und 'ie' gekennzeichneten Worte werden mit +der dazugehörigen Seitennummer in die erste Indexdatei geschrieben.) + +Die Einträge in einer Indexdatei werden von den Seitennummern durch min- +destens drei Punkte getrennt. + +Werden diese nicht gewünscht, kann man sie leicht mit dem Editor entfernen. +Beachte, daß man nur bei einer äquidistanten Schrift ein rechtsbündiges +Verzeichnis erhalten kann. + +Es gibt die Möglichkeit, bis zu neun unterschiedliche Indexdateien zu er- +stellen, z.B. durch + + \#ib (1)\# und \#ie (1)\# + +gekennzeichnete Worte gehen in die Indexdatei mit der Nummer 1, durch + + \#ib (9)\# und \#ie (9)\# + +gekennzeichnete Worte gehen in die Indexdatei mit der Nummer 9. Als Erleich- +terung für diejenigen, die nur einen Index erstellen müssen, dürfen die 'ib'- +und 'ie'-Anweisungen ohne Parameter benutzt werden, welches gleichbedeutend +ist mit 'ib(1)' und 'ie(1)'. + +Die durch 'ib'- und 'ie'-Anweisungen gekennzeichneten Worte können auch über +Zeilengrenzen (mit Silbentrennungen) gehen. Beispiel: + + .... \#ib\#schöne Index-An- + weisungen\#ie\# ... + +'index' zieht getrennte Worte zusammen (hier: 'schöne Index-Anweisungen'). +Will man einige Worte in verschiedenen Indexdateien haben, darf man die 'ib'- +und 'ie'-Anweisungen auch "schachteln". Dies kann man besonders bei Kapitel- +überschriften nutzen. Beispiel (vergl. auch die Überschrift dieses Ab- +schnitts): + + \#ib(9)\#Worte kennzeichnen: '\#ib\#ib\#ie\#'/'\#ib\#ie\#ie\#'\#ie(9)\# + +In diesem Beispiel wird das Inhaltsverzeichnis in die Indexdatei '9' ge- +bracht, während der "allgemeine" Index in der Indexdatei '1' gesammelt wird. + + + +Nebeneinträge erzeugen + +Es ist möglich, an die Seitennummer eines Eintrags einen beliebigen Text +anfügen zu lassen. Beispiele: + + EUMEL-System ... 27ff. + Monitor ........ 13(Def.) + EUMEL-Editor ... 2(Kap.4) + +Dies wird durch die generische Form der 'ib'-Anweisung ermöglicht: + + ... der \#ib(1,"(Kap.4)")\#EUMEL-Editor\#ie\# ist gut geeignet, + Texte zu erstellen ... + +(erzeugt den letzten obigen Eintrag). + +An einen Eintrag kann ein weiterer TEXT angefügt werden, um etwa Unterein- +träge zu bilden: + + EUMEL-System .............. 27 + EUMEL-System, kapitales ... 28 + EUMEL-System, schönes ..... 29 + +Das wird ebenfalls durch eine andere Form der 'ie'-Anweisung ermöglicht: + + ... ist das \#ib\#EUMEL-System\#ie(1,", schönes")\# wirklich ein + schönes System ... + +(erzeugt den letzten obigen Eintrag). + +Nach der Erstellung einer Indexdatei können - nach interaktiver Anfrage - die +Einträge sortiert werden. Die Sortierung erfolgt alphabetisch nach DIN 5007, +Abschnitt 1 und 3.2 (Umlaute werden "richtig" eingeordnet). + +Wie bereits erwähnt, kann 'index' vielseitig eingesetzt werden: + +a) Erstellung von Stichwortverzeichnissen: + Wie bereits beschrieben. + +b) Erstellung von Inhaltsverzeichnissen: + Kapitelüberschriften mit eigenen Indexanweisungen klammern und durch + 'index' wie beschrieben verarbeiten. Beispiel: + + \#ib(8)\#9.1.3 Das abenteuerliche Leben von Micky Maus unter + besonderer Berücksichtigung seiner Geburtsstadt Entenhausen\#ie(8)\# + + Dann ist man sicher, daß das Inhaltsverzeichnis bezüglich Seitennummern + und Kapitelüberschriften korrekt ist. + +c) Erstellung von Abbildungsverzeichnissen: + Abbildungsüber- bzw. -unterschriften wie Inhaltsverzeichnisse verarbeiten. + +d) Überprüfung von Literaturhinweisen auf Vollständigkeit: + Man klammert alle Literaturhinweise mit extra Indexanweisungen (Beispiel: + \#ib(9)\#/Meier82/\#ie(9)\#) und überprüft dann mit Hilfe dieser Indexdatei + die Literaturverweise. Dann ist man sicher, daß alle Literaturverweise im + Text auch in der Literaturaufstellung stehen. + + + +Indexdateien zusammenführen: 'index merge' + +Durch das Programm 'index merge' kann eine Indexdatei in eine zweite "einge- +mischt" werden. Es ist somit möglich, einen Index zu erstellen, der sich über +mehrere Dateien erstreckt, indem man 'index' die Druckdateien dieser Dateien +bearbeiten läßt und anschließend die entstandenen Indexdateien mit 'index +merge ' zusammenfaßt. Indexdateien können ggf. mit dem Editor bzw. 'lineform' +und/ oder 'pageform' bearbeitet und anschließend gedruckt werden. Beispiel: + + index merge ("1.kapitel.i1", "2.kapitel.i1") + +Hier wird die Indexdatei des '1.kapitel' in die Indexdatei des '2.kapitel' +eingeordnet und auf Wunsch sortiert. + +Beachte, daß 'index' und 'index merge' Kommandos und keine Anweisungen sind. + +Merke: 'index' verarbeitet eine Druckdatei (Zusatz: ".p") und erzeugt eine +oder mehrere Indexdateien (Zusatz: ".i"). Die in einen Index zu +übernehmenden Worte müssen im Text durch die 'ib'- und 'ie'-Anweisungen +eingefaßt sein. + + + +5. Drucken: 'print' + +Der EUMEL-Drucker, der mit dem Kommando 'print' angesprochen wird, ist eine +Software-Schnittstelle zu einem angeschlossenem Drucker. In diesem Kapitel +wird erklärt, wie man mit dem EUMEL-Drucker eine Datei druckt und welche +speziellen Anweisungen den Drucker steuern. + +Jeder Drucker erbringt "hardwaremäßig" unterschiedliche Leistungen (z.B. +Randausgleich, Unterstreichung). Diese Leistungen werden durch Eingabe +spezieller Zeichenfolgen veranlaßt, die zwar genormt sind, aber von den Druk- +kerherstellern nicht eingehalten werden oder unterschiedlich interpretiert +werden. + +Um vom EUMEL-System unterschiedliche Drucker auf gleiche Weise ansprechen +zu können, wurde eine Software-Schnittstelle geschaffen, die EUMEL-Drucker +genannt wird. Der EUMEL-Drucker akzeptiert eine Datei und veranlaßt, daß +diese in geeigneter Weise gedruckt wird. Weiterhin beachtet der EUMEL- +Drucker die Anweisungen der Textkosmetik. Die Form der Anweisungen der +Textkosmetik und des EUMEL-Druckers sind gleich. + + + +Eine Datei drucken: 'print'-Kommando + +Mit dem Kommando + + print + +kann dem EUMEL-Drucker eine Datei zum Drucken übergeben werden. Beispiel: + + print ("Drucker Beschreibung") + +In der Regel ist im EUMEL-System (Multi-User) ein "Spooler" installiert, so +daß sofort mit der Arbeit fortgefahren werden kann. Der EUMEL-Drucker ar- +beitet in diesem Fall parallel zu anderen Arbeiten des Nutzers. + + + +Anweisungen für den EUMEL-Drucker + +Ein Text (eine Datei) kann vom Drucker auch ohne Anweisungen gedruckt +werden, etwa für Probedrucke. Für diesen Fall hat der Drucker vernünftige +Voreinstellungen. Für einen "normalen" Text braucht ein Benutzer keine spe- +ziellen Druckeranweisungen in den zu druckenden Text einzufügen, denn die +Anweisungen für die Textkosmetik reichen zur Druckersteuerung aus. Nur wenn +besondere Leistungen verlangt werden, wie z.B. Blocksatz oder den gedruckten +Text an eine bestimmte Stelle zu plazieren, sind Druckeranweisungen notwen- +dig. + +Werden vom Drucker Leistungen verlangt, die hardwaremäßig nicht vorhanden +sind, so sorgt der EUMEL-Drucker dafür, daß eine möglichst äquivalente +Leistung erbracht wird. Wird beispielsweise ein nicht vorhandener Schrifttyp +angefordert, wird mit dem Standard-Schrifttyp der jeweiligen Installation +gedruckt. + +Damit ist es möglich, einen Text auf einem Drucker zu drucken, der den ge- +forderten Typ nicht kennt und der eigentlich für einen anderen Drucker +bestimmt ist. + +Wie bereits erwähnt, beachtet der EUMEL-Drucker die gleichen Anweisungen wie +die Textkosmetik-Programme. Eine 'type'-Anweisung beispielsweise, welches +einen bestimmten Schrifttyp anfordert, wird also auch vom EUMEL-Drucker als +Befehlsfolge an den angeschlossenen Hardware-Drucker übergeben (sofern der +Schrifttyp auf dem Drucker realisierbar ist). Wie die Anweisungen ge- +schrieben werden müssen, wird in der Beschreibung der Textkosmetik ge- +schildert. + +Anweisungen werden nicht gedruckt. Besteht eine Zeile nur aus Anweisungen, +so wird diese Zeile vom EUMEL-Drucker nicht gedruckt. Im Gegensatz zu den +Programmen der Textkosmetik werden unbekannte oder fehlerhafte Anweisungen +vom EUMEL-Drucker ohne Fehlermeldung "verschluckt". Alle Anweisungen werden +zum frühest möglichen Zeitpunkt ausgeführt, haben also u.U. bereits Aus- +wirkungen auf die Zeile, in der sie stehen. + +Einige Anweisungen sind speziell nur für den EUMEL-Drucker vorhanden. +Diese werden in diesem Kapitel erklärt bzw. werden in der Anweisungs-Über- +sicht mit aufgeführt. + +Neben den "normalen" Anweisungen, die nur in "\#"-Zeichen eingeschlossen +werden, gibt es noch zwei andere Formen: + +a) Kommentar-Anweisungen: + Werden in "\#-" und "\#"-Zeichen eingeschlossen. Solche Anweisungen + werden ignoriert. Beispiel: + + \#---- Ende der Seite 1 ---\# + +b) Spezielle Druckeranweisungen: + Werden in "\#/" und "\#"-Zeichen eingefaßt. Die von diesen Anweisungs- + Zeichen eingeschlossenen Druckerbefehlen werden unverändert (ohne die + "\#/" und "\#"-Zeichen) an den Drucker weitergereicht. Beispiel: + + \#/C05\# (* C05 geht an den Drucker *) + + Solche Anweisungen werden manchmal benötigt, um spezielle Druckereigen- + schaften auszunutzen, die schwer oder garnicht im EUMEL-Drucker reali- + sierbar sind. + +Anmerkung: Diese Anweisungen werden, wie die normalen Anweisungen auch, bei +der Berechnung einer Zeile nicht berücksichtigt und nicht gedruckt. + +Merke: Der EUMEL-Drucker übernimmt die Anpassung an spezielle Hardware- +Drucker. Er beachtet die gleichen Anweisungen wie die Textkosmetik-Programme. +Zusätzlich gibt es noch einige wenige spezielle Druckeranweisungen. + + + +Blocksatz drucken: 'block' + +Die Anweisung 'block' bewirkt einen Blocksatz beim Druck. + +Fügt man in den Text (meist am Anfang einer Datei) die Anweisung + + \#block\# + +ein, druckt der Drucker ab dieser Stelle alle Zeilen, die nicht mit einem +Absatzkennzeichen versehen sind, im Blocksatz. Dies heißt, daß durch Ver- +größern der Wortabstände alle Zeilen an der gleichen Position enden (rechter +Randausgleich). Preiswerte Drucker können dies nur durch Einfügen ganzer +Leerzeichen zwischen den Worten vornehmen, was sich oft beim Lesen störend +bemerkbar macht. Bei qualitativ hochwertigen Druckern wird dagegen der +Blocksatz durch Einfügen kleinerer Abstände zwischen den Worten oder sogar +zwischen den Zeichen erreicht. + +Merke: Die Anweisung 'block' bewirkt den Blocksatz beim Druck. + + +Schreibfeld verschieben: 'start' + +Durch die Anweisung 'start' ist es möglich, das Schreibfeld beim Druck auf +dem Papier an eine andere Stelle zu plazieren. + +Der EUMEL-Drucker plaziert das Schreibfeld auf einem Drucker automatisch der- +art, daß ein genügender Rand verbleibt. Diese Voreinstellung ist natürlich +abhängig vom Drucker und der Installation. Mit der 'start'-Anweisung kann +die automatische Einstellung verändert werden. Beispiel: + + \#start (1.0, 2.0)\# + +legt die linke, obere Ecke des Schreibfeldes fest (vom linken Rand 1 cm, vom +oberen Rand 2 cm). + +Merke: Die 'start'-Anweisung legt den linken oberen Rand des Schreibfeldes +fest. + + + +Zentrieren + +Mit dem '#ib#center#ie#'-Kommando kann man eine Zeile in der Mitte der Zeile +drucken lassen. + +Das 'center'-Kommando zentriert die Schrift einer Zeile. Beispiel: + +\#center\#Diese Zeile ist zentriert + +Dies Kommando ist nur bei Proportionalschriften sinnvoll einzusetzen, da man +bei einer äquidistanten Schrift man direkt auf dem Bildschirm sehen kann, +wie der Text auf einer Zeile plaziert ist. + +Merke: 'center' zentriert eine Zeile beim Drucken. + + + +6. Textkosmetik-Makros + +Makros dienen als Abkürzung für immer wiederkehrende Textteile und/oder +Kommandos. + +Textkosmetik-Makros kommen zum Einsatz bei + +- immer wiederkehrenden Textteilen; + +- immer wiederkehrenden Anweisungssequenzen; + +- bei der Erstellung von Manuskripten, deren endgültige Form man anfänglich + noch nicht weiß oder die man noch ändern will. + +Die Definition von einem oder mehreren Makros wird mit dem Editor vorgenom- +men. Diese Makro-Datei wird dann geladen. Von diesem Augenblick an "kennen" +'lineform'/'autoform' und 'pageform' die Makros (d.h. die Textzeilen und/ +oder Anweisungen, die sich unter dem dem Makronamen "verbergen"). + +'lineform'/'autoform' beachten die Anweisungen, die in den Makros enthalten +sind. Man beachte, daß die Anweisungen und Textzeilen, die in den Makros ent- +halten sind, nicht in der Datei erscheinen. Erst 'pageform' setzt diese in +die Druckdatei ein. + + +Ein Beispiel + +Hier wird ein einfaches Beispiel für einen Briefkopf gezeigt. + +Angenommen, die Firma 'Meier' schreibt mit dem EUMEL-System ihre Geschäfts- +briefe. Sie hat einen Drucker zur Verfügung, mit dem man auch die Briefköpfe +erstellen kann. Für den Briefkopf schreibt die Junior-Chefin ein Makro'kopf' +in eine Datei 'macro definitionen': + + \#*kopf\# + \#type("fett und gross")\# Firma Meier + \#type("fett")\# Gemischtwaren in kleinen Mengen + \#type("klein")\# Straße + Stadt + \#type ("normal")\# + \#*macro end\# + +Der Name des Makros ist 'kopf'. Man beachte, daß eine Makro-Definition mit +dem Namen des Makros beginnen müssen. Der Makroname muß mit einem '*' +gekennzeichnet werden, um ihn von "normalen" Text-Anweisungen unterscheiden +zu können. Jedes Makro wird mit einer 'macro end'-Anweisung beendet +(es dürfen mehrere Makros hintereinander in die Datei geschrieben werden). + +Nun muß die Junior-Chefin das so definierte Makro 'laden': + + load macros ("macro defintionen") + +Zur Kontrolle kann sie sich die "geladenen" Makros in einen Datei ausgeben +lassen: + + list macros ("kontroll datei") + +Nun kann die Junior-Chefin ihrem Sekretär sagen, daß er von jetzt ab ein +neues Kommando zur Verfügung hat, welches einen Briefkopf in jeden Brief +drucken kann (mit dem Namen 'kopf'). Der Sekretär schreibt also nun +folgenden Brief: + +\#kopf\# + +Sehr geehrte Frau .... +usw. + +Nachdem er mit 'lineform' den Brief zeilenweise formatiert hat, kontrolliert +er die formatierte Datei. Hier hat sich noch nichts verändert, die neue An- +weisung 'kopf' steht unverändert in der Datei. ('lineform' beachtet zwar +alle Anweisungen und Textzeilen eines Makros, setzt diese jedoch nicht in +die Datei ein). + +Nun formatiert der Sekretär die Datei, welche den Brief enthält, mit 'page- +form'. In der Druckdatei ist nun die Anweisung 'kopf' verschwunden, dafür +stehen aber nun die Zeilen des Makrorumpfes ('pageform' setzt die Zeilen des +Makros in die Druckdatei ein): + + \#type("fett und gross")\# Firma Meier + \#type("fett")\# Gemischtwaren in kleinen Mengen + \#type("klein")\# Straße + Stadt + \#type ("normal")\# + + + Sehr geehrte Frau ... + usw. + +Merke: Makros sind bei der Verwendung von wenigen Text- und/oder Anweisungs- +folgen nützlich, die immer in der gleichen Form benötigt werden. + + +Ein Beispiel mit Makro-Parametern + +Unsere Junior-Chefin fällt nun auf, daß sie ihr Makro noch etwas verbessern +kann. Sie will noch das Datum mit in den Briefkopf aufnehmen. Somit editiert +sie ihre Makro-Datei folgendermaßen (man beachte die '$'-Zeichen): + + \#*kopf ($1)\# + \#type("fett und gross")\# Firma Meier + \#type("fett")\# Gemischtwaren in kleinen Mengen + \#type("klein")\# Straße + Stadtname + \#type ("normal")\# + + Stadtname, den $1 + \#*macro end\# + +Damit hat sie dem 'kopf'-Makro einem Parameter gegeben ('$1'; die Parameter +werden numeriert. Ein zweiter Parameter würde '$2' heißen usw.). + +Der Sekretär muß nun die Anweisung 'kopf' mit dem jeweiligen Datum in einen +Brief schreiben: + + \#kopf ("9.1.1984")\# + +'pageform' setzt nun das angegebene Datum direkt hinter 'Stadtname, den' in +den Briefkopf ein (in der Druckdatei). Beachte, daß nur TEXT-Denoter als +aktuelle Parameter eines Makros erlaubt sind. + +Merke: Durch die Makro-Parameter ist es also möglich, immer wiederkehrende +Textteile in Schriftstücke einsetzen zu lassen, die sich nur in Kleinigkei- +ten unterscheiden. + + +Ein Beispiel für Manuskripte + +Hier wird gezeigt, wie man mit Makros Anweisungen formulieren kann, die aus- +sagen, um was es sich bei einem Text handelt und nicht, wie es behandelt +werden soll. + +Bei Manuskripten für Artikel, Bücher und Manuals weiß ein Autor oft vorher +nicht, in welchem Format das Manuskript gedruckt werden wird. Zu diesem +Zweck ist es ebenfalls nützlich, die Makros zu verwenden. Beispiel: + + \#*kapitel anfang ($1)\# + \#free (2.0)\# + \#type ("gross und fett")\#\#ib (9)\#$1\#ie (9)\#\#type ("normal")\# + + \#*macro end\# + +In diesem Beispiel wird ein Makro für den Anfang eines Kapitels definiert. +Zwischen zwei Kapiteln soll hier zwei cm Zwischenraum bleiben, die Kapitel- +Überschrift (als Parameter) wird in einer grösseren Schrift gedruckt. Zu- +sätzlich wird die Überschrift in den 9. Index aufgenommen für ein Inhalts- +verzeichnis. Nach der Überschrift wird eine Leerzeile eingeschoben, bevor +der "richtige" Text anfängt. + +Ein(e) Anwender(in) dieses Makros schreibt also z.B. folgende Anweisung: + + \#kapitel anfang ("Ein Beispiel fuer Manuskripte")\# + +(Beachte, daß die Kapitel-Überschrift nicht länger als eine Textzeile sein +darf. Das liegt daran, das 'lineform'/'autoform' zwar die Zeile bearbeitet, +aber nicht in den Text einsetzt. 'pageform' setzt also die unveränderte +- nicht aufgebrochene Textzeile - ein). + +Man kann nun Makros für die meisten Textstrukturen definieren. Schreibkräfte +brauchen dann in der Regel die meisten der Text-Anweisungen nicht zu kennen, +sondern nur noch eine Anzahl von einfachen Makro-Anweisungen. + +Die Makro-Definitionen können jederzeit geändert werden, um wechselnden +Bedürfnissen angepaßt zu werden (z.B. wenn ein Verlag ein bestimmtes +Schreibformat verbindlich vorschreibt). In diesem Fall brauchen nicht alle +Text-Dateien geändert zu werden, sondern nur die Makro-Definitionen. + +Ein weiterer Vorteil einer solchen Vorgehensweise ist, daß die Makro-Anwei- +sungen in diesem Fall angeben, was eine bestimmte Text-Struktur ist, und +nicht, wie die Struktur behandelt werden soll. + +Anmerkung: +In eine Makro-Definition sollte man ggf. 'limit'-, 'type'- und 'linefeed'- +Angaben einsetzen, um die Makros unabhängig von der Aufrufstelle zu machen. +Ggf. sollte man die Datei vorher mit 'lineform' bearbeiten, um Trennungen +vorzunehmen. + +Merke: Makros dienen zur flexiblen Behandlung von Text-Strukturen, indem +Makros definiert werden, die angeben, um was es sich dabei handelt. + + + +Beschreibung der Makro-Kommandos + +Mit dem Kommando + + load macros ("macro datei") + +kann eine Datei, in denen die Makro-Definitionen enthalten sind, in den +Makro-Speicher des Textsystems geladen werden. Ist dies fehlerfrei erfolgt, +kann man 'lineform'/'autoform' Dateien übergeben, die die definierten Makro- +Anweisungen "kennen" und befolgen. 'pageform' setzt bei Antreffen einer +Makro-Anweisung den Makrorumpf in die Ausgabe-Datei ein. + +Die Definition eines Makros erfolgt mit dem Makronamen, der von Anweisungs- +zeichen eingeschlossen ist. Um Makro-Anweisungen von "normalen" Textkosmetik- +Anweisungen zu unterscheiden, müssen diese nach dem ersten Anweisungszeichen +mit einem '*' gekennzeichnet werden. Beispiel: + + \#*macro eins\# + Makrorumpf mit "normalen" Kommandos, wie z.B. + \#type ("x")\# + \#*macro end\# + +Der Aufruf eines Makros, welcher z.B. in einer von 'lineform' zu bearbeiten- +den Datei steht, unterscheidet sich nicht von einer "normalen" Textanweisung. +Beispiel: + + ... \#macro eins\# ... + +Hat das Makro Parameter (bei der Definition mit '$'-Zeichen durchnumeriert), +müssen beim Aufruf TEXT-Parameter eingesetzt werden (also in Anführungs- +strichen). Beispiel: + + \#*macro zwei ($1)\# + ... $1 ... + \#*macro end\# + + (* Aufruf: *) + + \#macro zwei ("ein einzusetzender Text")\# + +Anmerkung: +Bei Makros gibt es keine generischen Anweisungen. Makros, die gleiche Namen +haben, aber sich durch die Anzahl der Parameter unterscheiden, sind also +nicht erlaubt. + +Beachten Sie ferner, daß Makro-Texte so verwendet werden, wie diese mit +'load macros' geladen werden. Beispiel: + + \#*a\# + \#on("underline")\# + \#*macro end\# + + \#*b\# + \#off("underline")\# + \#*macro end\# + +Betätigt man in der Makro-Datei nach jeder Zeile die RETURN-Taste (Absatz), +dann erhält man bei folgender Verwendung Fehlermeldungen von 'lineform': + + ... \#a\#zu unterstreichender Text\#b\# ... + +weil hier Mitten im Satz Absätze erscheinen und 'lineform' bei jedem Absatz +prüft, ob noch Modifikationen "offen" sind. In solchen Anwendungen sollte +man also Makros ohne Absätze speichern. + + + +7. Anweisungs-Übersicht + +* block + Zweck: Blocksatz (rechter Randausgleich). Der Text einer Zeile wird durch + Vergrößern der Wortlücken auf die Zeilenlänge, die durch das + 'limit'-Kommando eingestellt ist, verlängert. Es gelten folgende + Bedingungen: + a) Leerzeichen werden nicht verbreitert bei + - Zeilen mit Absatzzeichen; + - Mehrfache Leerzeichen; + - führende Leerzeichen (Einrückung); + - ein Leerzeichen hinter dem ersten Wort einer Zeile, wenn es auf + die Zeichen "]", ")", ".", "-", ":" endet. + b) Einrückungen werden äquidistant berechnet (Anzahl Zeichen * + Breite eines "Standard-Blanks"). Dies gilt nur für Proportional- + schriften und vor einer Absatzzeile. Es gilt als Einrückung: + - "Spiegelstrich" (Bindestrich und Leerzeichen am Anfang der + Zeile); + - Doppelpunkt als Ende des ersten Wortes (Position < 20); + - Schliessende Klammer oder Punkt als Ende des ersten Wortes, + wenn eine Ziffer davor steht (Position < 7); + c) Tabellen werden auch äquidistant berechnet. Dies gilt ebenfalls + nur für Proportionalschriften und vor einer Absatzzeile. Es gilt + als Teil einer Tabelle: + - Position des letzten Mehrfachblank. + +* bottom + Zweck: Erzeugen von "Fußzeilen" am Ende jeder Seite in der Druckdatei für + Untertitel und Seitennummern. Die Textzeilen zwischen den Anwei- + sungen 'bottom' und 'end' werden von 'pageform' am Ende jeder Seite + eingesetzt. + +* bottom even + Zweck: Definition von Fußzeilen für Seiten mit geraden Seitennummern. Es + gilt das unter 'bottom' gesagte. + +* bottom odd + Zweck: Definition von Fußzeilen für Seiten mit ungeraden Seitennummern. Es + gilt das bei 'bottom' gesagte. + +* center + Zweck: Zentrieren einer Zeile (Absatzzeile). + +* columns (INT CONST anzahl, REAL CONST luecke) + Zweck: Einschalten der Spaltenformatierung. + +* columnsend + Zweck: Ausschalten der Spaltenformatierung. + +* count + Zweck: Erhöhung eines internen Zählers und Einsetzen des Wertes anstatt + der Anweisung in die Druckdatei. + +* count (TEXT CONST merkmal) + Zweck: Wie obiges 'count', jedoch wird der Wert des Zählers vermerkt, so + daß er mit 'value' wieder erfragt werden kann. + +* end + Zweck: Beendet die Defintion von 'head', 'bottom' oder Fußnotenbereichen. + +* foot + Zweck: Definieren von Fußnoten. Es werden die aktuellen Werte von 'limit', + 'linefeed' und 'type' für die Fußnote verwendet (vergl. 'bottom'- + Anweisung). + +* free (REAL CONST freier platz) + Zweck: Es werden 'freier platz' cm freigehalten. + +* goalpage (TEXT CONST merkmal) + Zweck: (Ziel-) Verweis für Seitenquerverweise in Verbindung mit der Anwei- + sung 'topage'. 'merkmal' muß mit dem Parameter des entsprechenden + 'topage' übereinstimmen. + +* head + Zweck: Definieren von Kopfzeilen, die von 'pageform' am Anfang jeder Seite + eingefügt werden. Es gilt das unter 'bottom' gesagte. + +* head even + Zweck: Definieren von Kopfzeilen für Seiten mit geraden Seitennummern. Es + gilt das unter 'bottom' gesagte. + +* head odd + Zweck: Definieren von Kopfzeilen für Seiten mit ungeraden Seitennummern. + Es gilt das unter 'bottom' gesagte. + +* ib + Zweck: Arbeitet wie 'ib (1)', man darf aber den Parameter weglassen. + +* ib (INT CONST index nummer) + Zweck: Indexanfang einer oder mehrerer Indexworte bis zur entsprechenden + 'ie'-Anweisung. Die Worte zwischen 'ib' und 'ie' werden in die + Indexdatei geschrieben. 'index nummer' gibt die Indexdatei an. + +* ib (INT CONST index nummer, TEXT CONST seitennummer zusatz) + Zweck: Indexanfang mit Zusatztext für die Seitennummer. Das oben gesagte + gilt entsprechend. 'seitennummer zusatz' wird unmittelbar hinter + die Seitennummer angefügt. 'seitennummer zusatz' muß in jeder 'ib'- + Anweisung neu gesetzt werden. + +* ie + Zweck: Arbeitet wie 'ie (1)', man darf aber den Parameter weglassen. + +* ie (INT CONST index nummer) + Zweck: Abschluß eines Index. Ein Index darf nicht über Absatz- und Seiten- + grenzen gehen. Ein Index über mehr als zwei Zeilen ist ebenfalls + aus Sicherheitsgründen (vergessene Abschlußanweisung) nicht erlaubt. + +* ie (INT CONST index nummer, TEXT CONST index zusatz) + Zweck: Es wird 'index zusatz' an die durch die Index-Anweisungen einge- + faßten Worte angefügt. Beispiel: + + \#ib (1)\#EUMEL-System\#ie(1, ", kapitales")\# ist + schön. + + Erscheint als 'EUMEL-System, kapitales ... 4' in der Indexdatei. + Diese Anweisung dient also dazu, auch Sub-Indizes zu ermöglichen. + +* limit (REAL CONST wert) + Zweck: Einstellen einer neuen Zeilenbreite in cm. Die Zeilenbreite gilt + solange, bis sie durch ein erneute 'limit'-Anweisung verändert wird. + +* linefeed (REAL CONST wert) + Zweck: Einstellen eines neuen Zeilenvorschubs in Abhängigkeit vom einge- + stellten Schrifttyp. + +* material (TEXT CONST mat) + Zweck: Angabe von installationsspezifischen Merkmalen für den Drucker. + +* off (TEXT CONST modification) + Zweck: Abschalten einer Modifikation. + +* on (TEXT CONST modification) + Zweck: Einschalten einer Modifikation. Folgende Modifikationen sind zur + Zeit möglich: + bold (Fettdruck) + italic (Kursivdruck) + underline (Unterstreichung) + revers (Weiß auf Schwarz) + +* page + Zweck: Anfang einer neuen Seite. 'page' muß als letztes auf einer Zeile + stehen. + +* page (INT CONST nr) + Zweck: Anfang einer neuen Seite mit 'nr' Seitennummer. + +* page length (REAL CONST cm) + Zweck: Einstellen der Seitenlänge in cm. + +* page nr (TEXT CONST seitennr zeichen, start) + Zweck: Einstellen eines neuen Seitennr-Zeichens und Anfangwerts bzw. + setzen der Seitennummer des bereits vorhandenen Seitenzeichens + ("%"). Neben dem vorhandenen "%"-Zeichen können zwei zusätzliche + (beliebige, aber von den "\#"-Zeichen unterschiedliche) Seiten- + zeichen definiert werden. + +* papersize (REAL CONST width, length) + Zweck: Angabe der Papiergröße des Druckers in cm. + +* print (INT CONST von, bis) + Zweck: Teilausdruck einer Datei. Der Drucker verarbeitet die Datei, bis er + an die Seite 'von' angelangt ist. Dann druckt er die Seiten bis + einschließlich 'bis'. Beachte, daß der EUMEL-Drucker die Seiten + immer ab 1 durchzählt (und eine eventuelle Seitennumerierung nicht + beachtet). + +* start (REAL CONST x, y) + Zweck: Legt den linken, oberen Eckpunkt des Schreibfeldes fest. Die + Angaben erfolgen in cm. + +* topage (TEXT CONST merkmal) + Zweck: Verweis auf eine Seite mit der Anweisung 'goalpage' und dem + gleichen 'merkmal'. Für 'topage' wird die Seitennummer von + 'goalpage' eingesetzt. + +* type (TEXT CONST schrifttyp name) + Zweck: Einstellen eines anderen Schrifttyps. Die verfügbaren Schriftarten + und deren Namen sind installationsspezifisch und deshalb hier nicht + beschrieben. + +* value + Zweck: Einsetzen des letzten 'count' Wertes. + +* value (TEXT CONST merkmal) + Zweck: Erfragen des mit 'count' gespeicherten Zählerwertes für 'merkmal' + und Einsetzen dieses Wertes durch 'pageform' in die Druckdatei. + + + +7. Kommando-Übersicht + +autoform + PROC autoform + Zweck: Aufruf von 'autoform' unter Verwendung des letzten eingestellten + Dateinamens. + + PROC autoform (TEXT CONST datei) + Zweck: 'lineform' mit automatischer Silbentrennung. Nur die vorgenomme- + nen Trennungen werden auf dem Bildschirm angezeigt. + + PROC autoform (FILE VAR f, TEXT CONST type name, REAL CONST width) + Zweck: Wie oben, jedoch auf einer Datei. + +index + PROC index (TEXT CONST eingabe datei) + Zweck: Erstellen von Indexdateien aus einer Druckdatei wie beschrieben. + Eine Indexdatei erhält den Namen der zu bearbeitenden Datei mit + dem Zusatz ".i" und der entsprechenden Indexnummer. Hat das + Programm 'index' die Druckdatei bearbeitet, werden die in die + Indexdatei geschriebenen Einträge alphabetisch sortiert (nach + Anfrage). Gleiche Einträge werden zusammengezogen: ein gleich- + lautender Eintrag wird entfernt, seine Seitennummer wird jedoch + an den bereits vorhandenen mit einem Komma aggefügt. + + Die Sortierung entspricht DIN 5007: + - Die Sortierreihenfolge enspricht 'ABC...Z', wobei große und + kleine Buchstaben gleich behandelt werden. + - Weitere Entsprechungen: + ö = oe, ä = ae, ü = ue + Ö = Oe, Ü = Ue, Ä = Ae, Ä = ä, Ü = ü, Ö = ö, ß = ss + Dadurch wird z.B. 'muß' vor 'Muster' einsortiert und 'Goethe' + ist gleich 'Göthe'. + - Alle Sonderzeichen (außer " " und "-") werden ignoriert. + - Ein Leerzeichen und ein Bindestrich zwischen Worten werden + gleich behandelt. Beispiel: + + 'EUMEL System' und 'EUMEL-System' sind also gleich. + + Es sind z.Z. max. neun unterschiedliche Indexdateien vorgesehen. + Der Name einer Indexdatei ergibt sich aus dem Namen der zu bear- + beitenden Druckdatei, wobei '.p' durch '.i' mit der entsprechen- + den Ziffer ersetzt wird. Beispiel (für Indizes mit + 'index nummer' = 1, z.B. \#ib\# ... \#ie\#): + + skript.p --> skript.i1 + +index merge + PROC index merge (TEXT CONST von, hinzu) + Zweck: Einmischen der Indizes der Indexdatei 'von' in die Indexdatei + 'hinzu'. Beide Indexdateien müssen vorhanden sein. Dabei wird + 'von' vor dem ersten Satz von 'hinzu' eingefügt und anschließend + ggf. sortiert. + +list macros + PROC list macros (TEXT CONST datei) + Zweck: Ausgabe der "geladenen" Makros in die Datei 'datei'. 'datei' darf + vorher nicht existieren, wird also von 'list macros' eingerichtet. + Die "geladenen" Makros bleiben unberührt. Man kann die mit 'list + macros' in die Datei 'datei' geschriebenen Makro-Definitionen ggf. + verändern und erneut mit 'load macros' laden. + Fehlerfall: + * file already exists + Ausgabe-Datei 'datei' ist bereits vorhanden. + +lineform + PROC lineform + Zweck: Der zuletzt verwandte Dateiname wird benutzt. Beispiel: + + edit ("test") + ... + lineform (* wird zu 'lineform ("test") *) + + PROC lineform (TEXT CONST dateiname) + Zweck: Formatieren einer Datei zeilenweise. + + PROC lineform (FILE VAR f, TEXT CONST type name, REAL CONST width) + Zweck: Aufruf von 'lineform' von einem Programm. + +load macros + PROC load macros (TEXT CONST datei) + Zweck: Lädt Makro-Definitionen in den Makro-Speicher des Textsystems. Die + Definitionen müssen in der Datei 'datei' enthalten sein (mit dem + Editor erstellen). Es können mehrere Definitionen in der Datei ent- + halten sein. Um den Makro-Speicher zu leeren, übergibt man eine + leere 'datei'. + + Eine Makro-Definition besteht aus einem + - Makro-Kopf: + Muß alleine auf einer Zeile stehen. Der Makro-Kopf fängt mit + '\#*'-Zeichen an und wird mit '\#' beendet. Beispiel: \#*ein macro\# + Der Name eines Macros muß (wie alle andern Anweisungen auch) + mit kleinen Buchstaben geschrieben werden. Leerzeichen spielen + keine Rolle. + Eventuelle Parameter müssen in Klammern (bei mehreren durch + Kommata getrennt) und mit einem $-Zeichen numeriert werden. + Beispiel: + \#*macro1 ($1)\# + \#*macro 2 ($1, $2)\# + + - Makro-Rumpf: + Besteht aus beliebig vielen Text-Zeilen, die Kommandos enthalten + können. Parameter (also das $-Zeichen mit anschließender Nummer) + werden bei Aufruf eines Makros ersetzt. In einem Makro-Rumpf + darf keine Makro-Anweisung erscheinen, die noch nicht definiert + wurde (sog. "Vorwärts-Referenzen"). + + - Makro-Ende: + besteht aus der Anweisung + \#*macro end\# + und muß wie der Makro-Kopf alleine auf einer Zeile stehen. + + Fehlerfälle: + * file does not exists + Die Eingabe-Datei 'datei' ist nicht vorhanden. + * macro store overflow (number lines) + Es passen zur Zeit nicht mehr als 1 000 Zeilen in den Makro-Speicher. + * macro store overflow (number macros) + Es passen zur Zeit nicht mehr als 100 Makro-Defintionen in den + Makro-Speicher. + +pageform + PROC pageform + Zweck: Wie beschrieben, jedoch ohne Parameter. Die zuletzt benutzte + Datei wird bearbeitet. Für die Druckdatei wird dieser Dateiname, + an den ".p" angehängt wird, eingesetzt. Beispiel: + + edit ("test") + ... + pageform (* wird zu 'pageform ("test", "test.p")' + ergaenzt *) + + PROC pageform (TEXT CONST dateiname) + Zweck: Wie beschrieben, wobei der Parameter für die Druckdatei ergänzt + wird (an 'dateiname' wird '.p' angehängt). Beispiel: + + pageform ("test") + (* wird zu 'pageform ("test", "test.p")' ergaenzt *) + + PROC pageform (TEXT CONST dateiname, druckdatei) + Zweck: Wie oben. + +print + PROC print (TEXT CONST datei) + Zweck: Druck der Datei 'datei' unter Berücksichtigung von Anweisungen. + + + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil5 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil5 new file mode 100644 index 0000000..d59b147 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil5 @@ -0,0 +1,667 @@ + EUMEL-Benutzerhandbuch + + + TEIL 5: ELAN-Compiler + + +Der ELAN-Compiler im EUMEL-System + +In diesem Kapitel wird die Benutzung des ELAN-Compilers im EUMEL-System be- +schrieben. Es enthält Angaben, welche Einschränkungen bzw. Erweiterungen +gegenüber dem Sprachstandard existieren. Eine Einführung in die Programmier- +sprache ELAN wird hier nicht gegeben. + + + +1. Einführung + +Der im EUMEL-System eingesetzte ELAN-Compiler wurde von J. Liedtke und +U. Bartling am HRZ Bielefeld in den Jahren 1975/76 erstellt und in den +folgenden Jahren erweitert und der Sprachbeschreibung angepaßt. Der gleiche +ELAN-Compiler wird auch auf verschiedenen Großrechnern (TR440, IBM, SIEMENS) +eingesetzt. + +Den ELAN-Compiler kann man sich als aus zwei Teilen bestehend vorstellen. +Einmal gibt es den "eigentlichen" ELAN-Compiler, der ein ELAN-Programm in +eine Maschinensprache (im EUMEL-System der sogenannte EUMEL0-Code) übersetzt. +Zum anderen verwaltet der ELAN-Compiler übersetzte Moduln (in ELAN Packets +genannt). + +In einem Packet können Prozeduren, Datentypen und/oder Operatoren definiert +werden. Ist ein solches Packet vorübersetzt (im EUMEL-System wird dieser +Vorgang 'insertieren' genannt), stehen diese Objekte zur Benutzung zur Ver- +fügung. Durch Packets kann man somit die Sprache ELAN erweitern. + +Weitere Informationen über die Programmiersprache ELAN finden Sie in den +folgenden Büchern: + +Hommel / Jähnichen / Koster: +Methodisches Programmieren +W. de Gruyter, Berlin, 1983 + +Klingen / Liedtke: +Programmieren mit ELAN +Teubner, Stuttgart, 1983 + +In der Regel sind in einem EUMEL-System die Standard-Packets bereits in- +sertiert (Ausnahmen: Datentypen #ib#VECTOR#ie# und #ib#MATRIX#ie#). Zusätz- +lich sind weitere Packets vorübersetzt, die Kommandos zur Verfügung stellen. +Welche weiteren Packets insertiert werden, kann jede EUMEL-Installation und +jeder Nutzer entscheiden. Somit kann man sein System auf spezielle +Anwendungen zuschneiden. + + + +2. Übersetzen mit dem ELAN-Compiler + +In diesem Abschnitt wird erklärt, wie Programme mit dem ELAN-Compiler über- +setzt oder vorübersetzt werden können. + + + +Einfaches Übersetzen: 'run'-Kommando + +Mit dem 'run'-Kommando kann ein ELAN-Programm übersetzt und ausgeführt +werden. + +Das 'run'-Kommando (vergl. auch die Kommandos in der Beschreibung des +Monitors) übersetzt ein in einer Datei befindliches ELAN-Programm. Beispiel: + + run ("mein programm") + +übersetzt das ELAN-Programm, welches in der Datei 'mein programm' enthalten +ist. (Wie man ELAN-Programme schreibt, ist u.a. im Editor-Kapitel beschrie- +ben). + +Der Fortschritt der Übersetzung wird durch laufende Nummern auf dem Bild- +schirm des Benutzers angezeigt, die die gerade verarbeiteten Zeilennummern +anzeigen. Da der ELAN-Compiler ein Zwei-Paß Compiler ist, werden alle +Zeilen (mindestens) zweimal überprüft. + +Ist das Programm syntaktisch korrekt, d.h. hat der ELAN-Compiler keine +Fehler gefunden, wird eine Ende-Meldung abgesetzt, die den Speicherumfang +des übersetzten Programms enthält. Die Ende-Meldung entfällt, wenn die Task +an kein Terminal angekoppelt ist. + +Nach der Ende-Meldung wird das Programm unmittelbar ausgeführt (ein Binder +ist im EUMEL-System nicht notwendig). + +Merke: Das Kommando 'run' übersetzt ein in einer Datei befindliches Programm +und führt fehlerfreie Programme aus. + + + +Korrektur von Fehlern + +In diesem Abschnitt wird beschrieben, wie (syntaktische bzw. semantische) +Fehler korrigiert werden können. + +Entdeckt der ELAN-Compiler Fehler, so meldet er sie dem Benutzer unter An- +Angabe der Zeilennummer. Die zwei Pässe des Compilers sind so konstruiert, +daß sie unterschiedliche Fehler entdecken. Ist bereits im ersten Paß ein +Fehler entdeckt worden, wird der zweite Paß nicht gestartet. Somit kann es +vorkommen, daß man glaubt, alle Fehler beseitigt zu haben und dann werden +wieder (andere) Fehler durch den zweiten Paß gemeldet ... + +Fehlermeldungen und Quelldatei werden nach Abschluß der Übersetzung durch +den Paralleleditor angezeigt. Vergl. dazu auch die Beschreibung des Editors. + +Merke: Eventuelle Fehler und das zu korrigierende Programm werden durch den +Paralleleditor angezeigt. So kann man das fehlerhafte Programm bequem ver- +ändern. + + +Nochmalige Ausführung eines Programms: 'run again' + +Mit 'run again' kann das zuletzt fehlerfrei übersetzte Programm nochmals +ausgeführt werden. + +Ist ein Programm fehlerfrei übersetzt worden, so kann man es mit dem Komman- +do 'run again' (beispielsweise mit anderen Eingabedaten) nochmals ausführen. + +Merke: Das Kommando 'run again' führt das zuletzt übersetzte Programm noch- +mals aus. + + + +Übersetzen von Kommandos + +Auch Kommandos werden in der Regel vom ELAN-Compiler übersetzt. + +Der ELAN-Compiler wird nicht nur für Programme eingesetzt, sondern auch als +Übersetzer für die EUMEL-Kommandosprache (in anderen Systemen "job control +language", abgekürzt JCL genannt) und für Kommandos, die man im Editor geben +kann. Jedes Kommando der EUMEL-Kommandosprache ist ein kleines ELAN-Programm, +welches in der Regel aus einem Prozeduraufruf besteht. Einige häufig be- +nutzte Kommandos werden der Effizienz halber über einen Kommando-Interpreter +abgewickelt. Beispiel: + + edit ("mein erstes Programm") + +Natürlich ist es möglich, mehrere Kommandos oder ein richtiges, einzeiliges +Programm als Kommando zu verwenden. Beispiele: + + put (17 * 4) + + INT VAR i; FOR i FROM 1 UPTO 100 REP put ("i") PER + + edit ("datei"); lineform ("datei"); print ("datei") + + INT VAR i; FOR i FROM 1 UPTO 10 REP print ("d") END REP + +Mit vorübersetzten Prozeduren (siehe auch das Kommando 'insert') ist es +möglich, eine eigene Kommandosprache zusammenzustellen. + +Merke: Der ELAN-Compiler wird auch für die Übersetzung und Ausführung von +Kommandos benutzt. + + + +Vorübersetzen: 'insert' + +Das Kommando 'insert' übersetzt ein in einer Datei befindliches ELAN-Pro- +gramm und trägt dieses in den Tabellenspeicher des Compilers ein. + +Mit dem Kommando 'insert' kann ein ELAN-Programm (d.h. ein Packet oder eine +Packetfolge) in den Tabellenspeicher (eine Art "Compilerdatenbank") des +ELAN-Compilers eingetragen werden. Die in den Packets enthaltenen Objekte +stehen nach Abschluß der Übersetzung zur Verfügung. Beispiel: + +Die Datei 'mein druck' enthalte folgendes Programm: + + PACKET mein druck DEFINES drucke: + + PROC drucke (TEXT CONST datei): + edit (datei); + lineform (datei); + pageform (datei); + print (datei) + END PROC drucke; + + END PACKET drucke; + +Mit dem Kommando + + insert ("mein druck") + +wird das Packet 'drucke' in die Tabellen des ELAN-Compilers aufgenommen. +Nun kann (als Kommando oder in einem Programm) der Prozeduraufruf 'drucke' +verwandt werden. + +Man beachte, daß der Nutzer beim Einrichten seiner Task alle insertierten Ob- +jekte der Vater-Task erhält. Insertiert der Benutzer in seiner Task weitere +Packets, so sind diese nur ihm verfügbar (oder ggf. seinen Sohn-Tasks). Es +ist somit möglich, Tasks mit unterschiedlichem Sprachumfang einzurichten. + +Einmal insertierte Packets können nicht mehr aus den Compilertabellen ent- +fernt werden. Man kann also nur die Task löschen (bitte vorher alle Dateien +archivieren oder bei der Vater-Task aufheben (siehe Kommando: 'save')). + +Das Kommando 'insert' arbeitet auch mit einem Thesaurus (vergl. dazu auch +den Teil über Dateien). Beispiel: + + insert (ALL myself) + +insertiert alle Dateien der Benutzer-Task in Reihenfolge. + +Merke: Das Kommando 'insert' übersetzt die in einer Datei enthaltene Packet- +folge und trägt diese in die Tabellen des Compilers ein. + + + +Programme von einem Programm übersetzen lassen + +Manchmal ist es notwendig, daß ein Programm den ELAN-Compiler zur Über- +setzung und Ausführung eines Programms aufrufen muß. + +Natürlich kann man auch die Kommandos 'run' oder 'insert' von einem Programm +aus aufrufen. Leider müssen die zu übersetzenden Programme in einer Datei +enthalten sein. Will man jedoch nur eine Anweisung übersetzen und ausführen +lassen und nicht den "Umweg" über eine Datei gehen (wie z.B. die Kommandos +im Monitor oder Editor), so kann man die Prozedur '#ib#do#ie#' verwenden. +Beispiel: + + ... + get (eingabe); + do (eingabe); + ... + +Findet der ELAN-Compiler bei der Übersetzung eines Textes der Prozedur 'do' +einen Fehler, so wird dieser Fehler über 'errorstop' gemeldet (vergl. dazu +auch das Kapitel über die Fehlerbehandlung im System-Handbuch) und die Über- +setzung bei der ersten Fehlermeldung abgebrochen. In diesem Fall kann ein +Nutzer den Fehler durch eine #ib#Fängerebene#ie# leicht selbst behandeln. + +Merke: Die Prozedur 'do' übersetzt (kleinere) ELAN-Programme von einem Pro- +gramm aus. + + + +Kommandos zur Steuerung des ELAN-Compilers + +In diesem Abschnitt beschreiben wir die Kommandos für die Steuerung des +ELAN-Compilers#ie#. Ebenso wie die Kommandos zur Übersetzung eines Programms +müssen die Kommandos zur Steuerung des Compilers vom Monitor gegeben werden. + +Mit dem Kommando + + prot ("datei name") + +wird das Listing des ELAN-Compilers eingeschaltet und in die angegebene +Datei ausgegeben. Mit + + prot off + +wird es wieder ausgeschaltet. 'prot off' ist voreingestellt. + +Normalerweise werden Zeilennummern des Quellprogramms im übersetzten Pro- +gramm mitgeführt, so daß bei einem Fehler zusätzlich zur Fehlermeldung auch +die Nummer der Zeile ausgegeben werden kann, in der der Fehler aufgetreten +ist. Mit dem Kommando + + check off + +kann die Generierung von Zeilenummern für das Objektprogramm abgeschaltet +werden. Durch die Angabe dieses Kommandos wird weniger Code für das +Programm erzeugt. Mit + + check on + +wird die Generierung von Zeilennummern durch den Compiler wieder einge- +schaltet. 'check on' ist voreingestellt. Mit der Prozedur + + check + +die ein boolesches Resultat liefert, kann in einem Programm abgefragt werden, +ob der 'check'-Zustand ein- oder ausgeschaltet ist. Beispiel: + + IF check THEN check off FI + +Merke: Die Kommandos 'check on' bzw. 'check off' schalten das Einfügen von +Zeilennummern in den erzeugten Code ein bzw. aus. + + + +3. Abweichungen gegenüber dem Sprachstandard + +Der im HRZ Bielefeld entwickelte ELAN-Compiler weist einige Abweichungen +gegenüber dem Sprachstandard auf, wie er in der Sprachbeschreibung formu- +liert ist. Es existieren einige Einschränkungen, die einen Programmierer +jedoch nicht weiter behindern. Die Spracherweiterungen wurden meist speziell +für das EUMEL-System geschaffen. Weitere Abweichungen gegenüber dem aktuellen +Sprachstandard, die aber in der nächsten Sprachbeschreibung enthalten sein +werden, sind in einem weiteren Abschnitt aufgeführt. + + + +Einschränkungen gegenüber dem Sprachstandard + + * Das "row display" wurde nicht implementiert. Der Grund dafür liegt in + dem unverhältnismäßig hohen Aufwand, dieses Sprachmittel bei der gegen- + wärtigen Compiler-Struktur zu implementieren. Abhilfe: Man verwende den + Konstruktor. Beispiel: + + ROW 5 INT VAR vektor; + vektor := [1, 2, 3, 4, 5]; (* nicht möglich *) + vektor := ROW 5 INT :(1, 2, 3, 4, 5); (* Ersatz: Konstruktor *) + + * Einige alternative Darstellungen von Symbolen können nicht verwendet + werden. Diese sind: + + "&"-Zeichen für "AND", + "/="-Zeichen für "<>", + "%"- und "//"-Zeichen für "DIV". + + * Eine Typ-Definition muß einer Deklaration immer textuell vorangehen. + Beispiel: + + TYPE QUADRAT = ... (* erlaubt *) + QUADRAT VAR rundes quadrat; + ... + PUNKT VAR meiner; (* verboten *) + TYPE PUNKT = ... + + Es ist jedoch erlaubt, einen Typ in einer Typ-Definition zu verwenden, + der textuell erst später definiert wird. Beispiel: + + TYPE PERSON = STRUCT (TEXT name, vorname, ADRESSE wohnort); + TYPE ADRESSE = ... + + Diese Einschränkung ("defined before applied") gilt nur für Typen, + nicht für Datenobjekte u.ä.. Selbstverständlich ist + + otto := 0; + INT VAR otto; + ... + + erlaubt (aber kein besonders schöner Programmierstil)! + + * Die Operatoren AND und OR können nicht redefiniert werden, sofern einer + ihrer Operanden vom Typ BOOL ist. + + + +Implementationsbedingte Einschränkungen + + * Es sind bis zu 32 000 Zeichen in einem TEXT zugelassen. Hat ein TEXT + bis 13 Zeichen, so wird er vollständig auf dem Stack untergebracht. + TEXTe mit mehr als 13 Zeichen werden auf dem Heap gespeichert. Die + Benutzung des Heaps bedeutet unter Umständen eine Verlangsamung eines + Programms. Darum ist + +max text length = 32 000 + + * Die Anzahl der Zeichen in einem TEXT-Denoter (Angabe eines TEXTes in + einem Programm) ist auf 254 Zeichen beschränkt. + + * INT-Werte werden in sechzehn Bit dargestellt (einschließlich Vor- + zeichen). Das bedeutet, daß + + maxint = 32 767 + minint = - 32 768 + + ist. + + * REAL-Werte werden intern mit einer Mantisse von 13 Stellen abgespei- + chert, von denen die ersten sieben Stellen bei der Ausgabe dargestellt + werden. Das bedeutet, daß + + maxreal = 9.999999999999e126 + + ist. + + * Die lexikographische Reihenfolge von Zeichen entspricht dem ASCII-Code + (vergl. dazu die Code-Tabelle). + + * Weiterhin sieht der ASCII-Code noch eine Anzahl von Steuerzeichen vor, + die jedoch von Herstellern leider nicht immer gleich interpretiert + werden. Diese Zeichen sind im EUMEL-System teilweise normiert und + können verwandt werden. Die verfügbaren Steuerzeichen sind ebenfalls im + EUMEL-Taschenbuch aufgeführt. + + * Die Initialisierung von Paketen (genauer: die Initialisierung von + Datenobjekten, die in vorübersetzten PACKETs außerhalb von Prozeduren + deklariert wurden) wird nur einmal, während der Übersetzung, durchge- + führt. Werden mehrere Pakete hintereinander (aus einer Datei) übersetzt, + dürfen die Prozeduren 'run', 'run again', 'insert' und 'do', die wieder + den ELAN-Compiler aufrufen, nur bei der Ausführung des letzten Packets + verwandt werden, weil der ELAN-Compiler nicht rekursiv benutzbar ist. + + + +Erweiterungen gegenüber dem Standard + + * Einem Datenobjekt, das an einen #ib#Datenraum#ie# gebunden werden soll, + wird bei der Deklaration das Schlüsselwort #ib#BOUND#ie# vorangestellt. + Damit wird dem ELAN-Compiler mitgeteilt, daß er für ein solches Objekt + keinen Speicherplatz reservieren muß. Die Assoziation mit einem Daten- + raum erfolgt bei der Deklaration mit Hilfe der Initialisierung. + Beispiel: + + BOUND INT VAR objekt :: old ("hugo"); + (* eine bereits errichtete Datei wird unter dem Namen "hugo" benutzt. + "objekt" ist jetzt an die Datei mit dem Namen "hugo" "gebunden" *) + + + +Vorweggenommene Implementation des nächsten Standards + +In diesem Abschnitt sind Erweiterungen/Einschränkungen des ELAN-Compilers +hinsichtlich der aktuellen ELAN-Sprachbeschreibung aufgeführt, die in der +nächsten Sprachbeschreibung mit aufgenommen werden. + + * ASCII-Zeichen, die nicht unmittelbar dargestellt werden können, können + in TEXT-Denotern angegeben werden, sofern sie in Anführungszeichen + eingeschlossen werden. Beispiele: + + ""13"" + + ist ein TEXT-Denoter, der nur CR (carriage return) enthält. + + "Jetzt erfolgt ein Zeilenwechsel "13""10"" + + Hier wird nach der Ausgabe des Textes ein "Wagenrücklauf" ('CR', + Code = 13) und einen Zeilenvorschub ('LF', Code = 10) erzeugt. + + ""1""4"" + + positioniert in die linke obere Ecke eines Bildschirms (Code = 1) und + löscht den Bildschirm (Code = 4). + + * Im aktuellen Standard wurde die #ib#Reihenfolge der Auswertung von + Operanden#ie# nicht definiert. Nunmehr wird zusätzlich nicht garantiert, + daß alle Operanden ausgewertet werden, wenn dies nicht notwendig ist. + Beispiel: + + IF f (x) > 0 AND x <> 0 THEN ... FI + + Hier muß beispielsweise 'f (x)' nicht ausgewertet werden, wenn 'x = 0' + ist. + + * Die booleschen Operatoren CAND und COR stehen zusätzlich zur Verfügung. + Wirkung: + + a CAND b :<==> IF a THEN b ELSE FALSE FI + + a COR b :<==> IF a THEN TRUE ELSE b FI + + Beispiel: + + IF element vorhanden + THEN verarbeite element + FI. + + element vorhanden: + index > 0 CAND liste (index) > 0. + + * Prozeduren als Parameter. Beispiel: + + (* Deklaration: *) + PROC draw (REAL PROC (REAL CONST) funktion, + REAL CONST von, bis, delta) + (* Aufruf: *) + draw (REAL PROC (REAL CONST) sin, -pi, pi, 0.1) + + Die obige Form von Prozedur-Parametern wird als "Langform" bezeichnet. + Die Langform muß verwandt werden, wenn generische aktuelle Parameter + benutzt werden. Eine "Kurzform" reicht aus, wenn der aktuelle Prozedur- + Parameter keine generischen Prozedur ist, d.h. eindeutig über den + Prozedurnamen (und nicht noch über die Datentypen seiner Parameter) + identifiziert werden kann. Die Kurzform unterscheidet sich von der + Langform nur beim Aufruf, bei dem eventuelle Resultate und die Daten- + typen der Parameter nicht mit angegeben werden müssen. Beispiel: + + (* Aufruf obiger Prozedur bei nichtgenerischer aktueller Prozedur + 'sin' *) + draw (PROC sin, -pi, pi, 0.1) + + * In Paketen sind auch außerhalb von Prozeduren Refinements zugelassen. + In solchen "Paket-Refinements" dürfen nur Paket-Objekte angesprochen + werden. Insbesondere ist es erlaubt, auch im letzten Paket ('main + packet') neben Prozeduren auch Refinements in beliebiger Reihenfolge zu + benutzen. Beispiel: + + PROC kommando erkennung: + ... + END PROC kommando erkennung; + + PROC kommando ausführung: + ... + END PROC kommando ausführung; + + datei assoziieren; + saetze lesen und bearbeiten; + ende behandlung. + + datei assoziieren: + FILE VAR f :: sequential file ...; + ... + saetze lesen und bearbeiten: + ... + ende behandlung: + put ("Ende der Bearbeitung"). + + Dies ist die Schreibweise, die wir empfehlen. Will man aber Refinements + auch zwischen Prozeduren deklarieren, wird es etwas komplizierter. + Beispiel: + + PROC a: + END PROC a; + ref; (* Refinement Aufruf *) + PROC b: + END PROC b; + (* Achtung: Semikolon, Punkt vor dem Refinement *) + .ref: . ; (* Punkt, Semikolon nach dem Refinement *) + PROC c: + END PROC c + + Paket-Refinements dürfen auch von Prozeduren benutzt werden, allerdings + sind dann auch die Sichtbarkeitsregeln zu beachten. D.h. die Paket- + Refinements, die in Prozeduren verwandt werden, dürfen dann auch nur + Paket-Objekte ansprechen. Die Aufnahme eines Refinements in das Inter- + face ist verboten. + + + +4. Interne Fehlermeldungen des Compilers + +Interne Fehlermeldungen des Compilers#ie# erfolgen, wenn der ELAN-Übersetzer +an implementationsbedingte Einschränkungen stößt. + + Interne Fehlermeldungen erfolgen in der Form: + + COMPILER ERROR: + +wobei folgende Werte annehmen kann: + + Bedeutung und eventuelle Abhilfe: + + 101 name table overflow: + Die Anzahl der Namen im Programm ist zu groß oder es wurden die + Anführungstriche eines TEXT-Denoters vergessen. Keine Abhilfe. + + 102 symbol table overflow: + Die Anzahl der deklarierten Objekte ist zu groß. + Abhilfe: Programm in Pakete unterteilen. + + 103 intermediate string overflow: + Abhilfe: Programm in Pakete unterteilen. + + 104 permanent table overflow + Zu viele Pakete insertiert. + Abhilfe: Keine (neue Task beginnen). + + 106 packet address overflow: + Insgesamt zu viele Adressen in Paketen ( > 64K ), d.h. ein Daten- + objekt ist zu groß. + Keine Abhilfe. + + 107 local data overflow: + Ein Datenobjekt in einer Prozedur ist zu groß ( > 32K ). + Abhilfe: + Datenobjekt in mehrere unterteilen. + + 204 compiler stack overflow: + Keine Abhilfe. + + 301 too many modules: + Zu viele Pakete, Prozeduren und Operatoren ( > 2048 ). + Keine Abhilfe. + + 303 applied table overflow: + siehe 304 + + 304 too many labels: + In dem gerade übersetzten Modul (Prozedur, Operator oder Paket- + rumpf) werden vom Compiler zu viele Marken benötigt (mehr als + 2000). Marken werden z.B. für die Codegenerierung von Auswahl + (IF ...) und Wiederholung (REP ...) gebraucht. Insbesondere bei + SELECT-Anweisungen werden 'casemax - casemin + 2' Marken + benötigt, wobei 'casemax' der INT-Wert des maximalen, 'casemin' + der des minimalen CASE-Wertes ist. Dieser Fehler ist somit fast + immer auf zu viele und/oder zu weit gespannte SELECT-Anweisungen + zurückzuführen. + Abhilfe: SELECT-Anweisungen über mehrere Prozeduren verteilen oder + Spannweiten verringern. + + 305 code overflow: + Der insgesamt erzeugte Code ist zu umfangreich ( > 256K ). + Keine Abhilfe. + + 306 packet data overflow: + Insgesamt zu viele Datenobjekte in den Paketen ( > 128K ). + Keine Abhilfe. + + 307 local data overflow: + Zu viele (lokale) Datenobjekte in einer Prozedur ( > 32K ). + Abhilfe: Prozedur in mehrere unterteilen, so daß die Datenobjekte + sich über mehrere Prozeduren verteilen. + + 308 module code overflow: + Ein Modul (Prozedur, Operator oder Paket-Initialisierungsteil) ist + zu groß ( > 7.5 KB Code). + Abhilfe: In mehrere Prozeduren oder Pakete zerlegen. + +Anmerkung: Fehlermeldungen, die hier nicht aufgeführt sind, weisen in der +Regel auf ein fehlerhaftes Arbeiten des ELAN-Compilers hin. In diesem Fall +bitten wir um die Einsendung des Programms (Listing, Quelldatei auf Diskette +bei umfangreichen Programmen) und entsprechender Fehlermeldung. + + + +5. Übersicht über die Compiler-Kommandos + +check + BOOL PROC check + Zweck: Informationsprozedur. + + PROC check on + Zweck: Einschalten der Generierung von Zeilennummern durch den + ELAN-Compiler. Voreingestellt ist 'check on'. + + PROC check off + Zweck: Ausschalten der Generierung von Zeilennummern durch den + ELAN-Compiler. + +do + PROC do (TEXT CONST program) + Zweck: Übersetzen und Ausführen von 'program' von einem Programm aus. + +insert + PROC insert + Zweck: Insertieren eines oder mehrerer PACKETs. Der Programmtext muß sich + in einer Datei befinden. Der Dateiname ist der zuletzt benutzte + Dateiname. + + PROC insert (TEXT CONST dateiname) + Zweck: Wie oben. Der Programmtext wird aus der Datei mit dem Namen + 'dateiname' geholt. + + PROC insert (THESAURUS CONST t) + Zweck: Insertieren aller PACKETs, die in den Dateien des Thesaurus 't' + enthalten sind. + +prot + BOOL PROC prot + Zweck: Informationsprozedur, ob 'prot' eingeschaltet ist. + + PROC prot (TEXT CONST dateiname) + Zweck: Einschalten des Compilerlistings auf dem Bildschirm. Das Listing + wird gleichzeitig in die Datei 'dateiname' geschrieben. + +prot off + PROC prot off + Zweck: Ausschalten des Listings. + +run + PROC run + Zweck: Übersetzen und Ausführen eines ELAN-Programms. Der Programmtext + muß sich in einer Datei befinden. Der Dateiname ist der zuletzt + benutzte Dateiname. + + PROC run (TEXT CONST dateiname) + Zweck: Wie oben. Der Programmtext wird aus der Datei mit dem Namen + 'dateiname' geholt. + + + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6a b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6a new file mode 100644 index 0000000..1ee80ec --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6a @@ -0,0 +1,1590 @@ + EUMEL-Benutzerhandbuch + + + TEIL 6: Erste Hilfe in ELAN + + +Vorwort + +Dieser Teil des EUMEL-Handbuchs ist keine "Einführung in die Programmierung +mit ELAN", sondern ist als Begleitmaterial für einen ELAN-Kurs gedacht. +Zudem beschreibt das Skript nicht die vollständige Sprache; dafür ist die +Sprachbeschreibung und das Handbuch vorgesehen. Folgende ELAN-Bücher sind +z.Zt. erhältlich: + +Klingen / Liedtke: +Programmieren mit ELAN +Teubner, Stuttgart, 1982 + +Jähnichen u.a.: +Systematisches Programmieren mit ELAN +W. de Gruyter, 1982 + +Wir haben in dieses Skript auch einige Aufgaben mit aufgenommen, die An- +fänger auf jeden Fall lösen sollten. Die Aufgaben dienen aber nur dazu, das +erlernte Wissen über ELAN zu überprüfen und sind keine eigentlichen Program- +mieraufgaben, die es im begleitenden Kurs geben sollte. Es gibt zwei Arten +von Aufgaben: + +a) HSG (Hätten Sie's gewußt?): Aufgaben, die das bis dahin Gelernte über- + prüfen sollen. +b) TSW (Trau', Schau', wem!): Aufgaben mit Programmen, die Fehler enthalten + können. Alle Programme dieses Skripts sind übrigens von der Art TSW. + +Es ist auch sinnvoll und notwendig, möglichst viele Programme dieses Skripts +direkt auf dem Terminal zu probieren und zu verändern. Auf diese Weise wird +ein Anfänger auch mit den Fehlermeldungen des ELAN-Compilers vertraut. + + + +Das erste Programm + +Gleich am Anfang einer Programmierlaufbahn haben Anfänger eine schwierige +Hürde zu nehmen: das erste Programm "zum Laufen" zu bringen. Das wird einem +Anfänger meist nicht leicht gemacht: schließlich hat er mit dem Betriebs- +system eines Computers zu kämpfen. Ein #ib#Betriebssystem#ie# sorgt u.a. für +die Steuerung so unterschiedlicher Peripheriegeräte wie Drucker, Lochkarten- +leser, Magnetplatten und -bänder usw. Zusätzlich hat es dafür Sorge zu +tragen, daß Informationen sicher gespeichert werden und nicht unbeabsichtigt +verändert werden können. Letztendlich hat ein Betriebsystem die Aufgabe, die +Aufträge von Benutzern ("jobs") - und das können mehrere auf einmal sein - +sicher und effizient bearbeiten zu lassen. Um mit einem Betriebsystem +"sprechen" zu können, ist meist eine eigene Sprache vorhanden, die Kommando- +sprache ("job control language", abgekürzt: JCL). + +Eine Kommandosprache kann - auf Grund der vielfältigen Aufgaben, die mit +ihrer Hilfe formuliert werden müssen - mehr oder weniger kompliziert sein. +Zusätzlich sind Kommandosprachen sehr unterschiedlich: aus leicht einsichti- +gen Gründen wollen sich Hersteller nicht auf eine Kommandosprache einigen. +Deshalb können wir die Anweisungen in einer speziellen Kommandosprache hier +nicht angeben; man erfragt diese am besten. Auf jeden Fall muß etwas getan +werden, um ein Programm auf einem Rechner "zum Laufen" zu bringen. + +Wie bereits erwähnt, beschränken wir uns hier auf die eigentlichen Programme. +Um den Mechanismus mit den Anweisungen an das Betriebsystem von Anfang +an kennen zu lernen, denken wir uns ein sehr einfaches Programm aus, das wir +bearbeiten lassen wollen. + +Programm 1: + + put ("Hallo: mein erstes Programm") + +Dieses Programm muß nun dem Rechner zur Bearbeitung übergeben werden. +Auch hier treffen wir auf Unterschiede bei den verschiedenen Rechensystemen: +bei einigen Rechnern muß ein solches Programm (mit Anweisungen der +Kommandosprache) auf Lochkarten übertragen werden, bei anderen dagegen +tippt man das Programm direkt an einem Sichtgerät ("Terminal") ein. Die +Ausgabe erfolgt dann über einen Schnelldrucker oder auch über das Sichtgerät. +Um von Geräten bestimmter Installationen zu abstrahieren, nennen wir im +folgenden das Eingabemedium #ib#Eingabegerät#ie# und das Gerät, auf dem die +Resultate erscheinen, dementsprechend Ausgabegerät. + +Aufgabe (TSW): + + Versuchen Sie, Programm 1 auf dem Rechner Ihrer Installation zu "rechnen". +Übungsziel: Umgang mit dem Betriebsystem + + +Das Ergebnis unseres ersten Programms ist nun das Erscheinen des Textes: +'Hallo: mein erstes Programm'. Was ist hier passiert? Da ein Rechner ein +ELAN-Programm meist nicht direkt ausführen kann, muß es in eine Form +gebracht werden, die der Rechner "versteht". Diese Form ist wiederum eine +(sehr andersartige und - für Menschen - nicht leicht verständliche) Sprache, +die Maschinensprache. Man muß also ein ELAN-Programm übersetzen. Dies wird +von einem Programm (und nicht etwa einer festverdrahteten Schaltung) vorge- +nommen, einem Übersetzer. Eine bestimmte Art von Übersetzer heißt Compiler; +er übersetzt ein Programm als Ganzes (im Gegensatz zu einem Interpreter, der +nur einzelne Anweisungen übersetzt und anschließend ausführt). Darum sind +bei ELAN-Programmen, die meist durch Compiler übersetzt ("kompiliert") +werden, zwei Phasen zu unterscheiden: + +a) Übersetzungsphase: + + In dieser Phase wird ein ELAN-Programm (man spricht von Quellprogramm + bzw. "source program") in ein äquivalentes Maschinenprogramm (Objektpro- + gramm) transformiert. Dabei überprüft der Übersetzer das Quellprogramm + auf eventuelle Fehler (Anweisungen, die nicht der ELAN-Sprachbeschreibung + entsprechen). Bei solchen Fehlern, die ein Compiler entdecken kann, + spricht man von syntaktischen Fehlern oder von Fehlern zur Übersetzungs- + zeit. + +b) Bearbeitungsphase: + + In dieser Phase ("run time") wird das übersetzte (Maschinen-) Programm + abgearbeitet. Auch hier können Fehler auftreten (z.B. wenn auf einen Wert + vom Programm zugegriffen wird, der noch gar nicht berechnet wurde). + Solche Fehler nennt man Laufzeitfehler. + +Haben wir das erste Programm so geschrieben, wie oben angegeben, dürften +keine Fehler entdeckt werden und das Programm wird (hoffentlich korrekt, d.h. +mit den geforderten Ergebnissen) beendet. Was für ein Programm haben wir nun +geschrieben bzw. was haben wir vom Rechner verlangt? + +Das Wort 'put' bezeichnet eine Prozedur. Eine Prozedur ist ein Algorithmus +(hier mit Parametern): eine bestimmte Sammlung von Anweisungen und unter +Umständen Daten. Eine solche Prozedur können wir in einem Programm unter +einem Namen (nämlich 'put') ansprechen und ausführen lassen. Man spricht +dann von dem Aufruf einer Prozedur, wenn ein Prozedurname geschrieben wird. +Von einer Prozedur brauchen wir nur zu wissen, was die Prozedur macht, aber +gottseidank nicht, wie sie es macht. + +Eine Prozedur wie 'put' ist vorgefertigt und einfach benutzbar, wobei wir +später sehen werden, wie man solche Prozeduren selber schreiben kann. Die +Prozedur 'put' hat einen Parameter, nämlich den in Klammern geschriebenen +Text, der auf dem Ausgabegerät ausgegeben werden soll. Wir können eine +solche Prozedur auch mit anderen Parametern versehen und mehrmals aufrufen: + +Programm 2: + + put ("Programm:"); + put (2) + +Mit dem zweiten Programm ist es uns gelungen, ein Programm mit zwei Anwei- +sungen zu schreiben (dabei ist der Parameter bei dem ersten Aufruf der +'put'-Prozedur ein Text, beim zweiten Parameter eine ganze Zahl). + +ELAN ist eine formatfreie Sprache, d.h. Anweisungen können so auf eine Zeile +verteilt werden, wie es uns gefällt und zweckmäßig erscheint. + +Programm 3: + + put ("mein"); put (3); put (".Programm") + +Man kann also eine oder mehrere Anweisungen auf eine Zeile schreiben oder +eine Anweisung über mehrere Zeilen. Das setzt jedoch voraus, daß die Anwei- +sungen voneinander getrennt werden (schließlich muß der Übersetzer erkennen +können, wo eine Anweisung anfängt und aufhört). Das ist besonders notwendig, +weil man in Namen in ELAN beliebig Leerzeichen zur besseren Lesbarkeit +verwenden kann. + + +Programm 4: + + p u t ( "aha"); + put ("aha") + +Beide Anweisungen bewirken also das Gleiche. + +Die Trennung von Anweisungen erfolgt in ELAN durch das Trennsymbol +Semikolon. Es bedeutet soviel wie: "führe die nächste Anweisung aus". Aus +diesem Grund darf hinter der letzten Anweisung eines Programms kein Semiko- +lon geschrieben werden (es folgt ja auch keine Anweisung mehr). + +Der Aufruf einer Prozedur (wie z.B. 'put') verlangt von unserem Rechner im- +mer eine Leistung. Wollen wir aber in einem Programm eine Bemerkung schrei- +ben (z.B. um uns etwas zu merken), dann können wir einen Kommentar schrei- +ben, der vom Übersetzer überlesen und somit keinen Einfluß auf die Aus- +führung eines Programms hat. Ein Kommentar in ELAN wird durch die Zeichen +(* und *) eingeschlossen und darf über mehrere Zeilen gehen. Kommentare sind +in ELAN aber nur in wenigen Fällen notwendig, weil wir Programme durch +andere Mittel gut lesbar machen können. + + + +Ziel der Programmierung + +Was wollen wir eigentlich mit dem Programmieren von Computern erreichen? +Häufig wiederkehrende und somit oft langweilige Tätigkeiten oder solche, die +besonders schnell erledigt werden müssen, sollen von dem "Werkzeug Computer +erledigt werden. Gehaltsberechnungen, Unterstützung beim Schreiben von +Texten, Katalogsysteme für Bibliotheken, Steuerung von Walzstraßen usw. sind +typische Aufgaben für Computer. + +Bei der Programmierung wird also versucht, Objekte (wie z.B. Geld bei einer +Gehaltsberechnung) und Prozesse (wie z.B. die Simulation von Wirtschaftsab- +läufen) der realen Welt mit Hilfe von Programmen in einem Computer nachzu- +bilden und nach bestimmten Vorstellungen so zu verändern, daß man "brauch- +bare" Ergebnisse erlangt. In einem Programm sind Befehle an einen Rechner +für eine solche Abbildung enthalten. Die Befehle in einem Programm werden +Anweisungen genannt. Ein Programmierer muß also folgendes tun: + +1. Abbilden von Objekten und Prozessen der realen Welt in ein Programm. + Dabei müssen die Bedingungen der Aufgabe beachtet werden. Was das Pro- + gramm Programm leisten soll, wird darum in einer Spezifikation festgelegt. + +2. Einbringen des Programms in einen Rechner und Bearbeitung desselben. Die + Formulierung von Anweisungen in einem Programm erfolgt in einer bestimmten + Sprache, nämlich einer Programmiersprache. + +3. Interpretation der Ergebnisse. + + + +Das Konzept des Datentyps + +Befassen wir uns vorerst nur mit Objekten. Sicherlich gibt es sehr viele Ob- +jekte in unserer Welt. Einige von ihnen haben aber gleiche Eigenschaften: + +- Fahrzeuge (Autos, Mofas, Dreiräder) bringen uns von Ort A nach Ort B. + +- Geld (Münzen, Geldscheine, Murmeln, Franc, DM) erlaubt es, etwas zu kaufen. + +- Schreibgeräte (Bleistift, Kugelschreiber, Schreibmaschine) sind die Werk- + zeuge von Leuten, die etwas zu schreiben haben. + +- ... + +Es ist also möglich, einige Objekte der realen Welt in Klassen zusammenzu- +fassen. Eine solche Zusammenfassung kann hinsichtlich gleicher Eigenschaften +bzw. gleicher Operationen, die für solche Objekte zugelassen sind, erfolgen. +Eine Klasse von Objekten mit gleichen Eigenschaften wird in Programmier- +sprachen Datentyp genannt. Dabei hat ein Datentyp immer einen Namen, der die +Klasse von Objekten sinnvoll kennzeichnet. Als ein Datenobjekt wird ein +Exemplar eines Datentyps (also ein spez. Objekt einer Klasse) bezeichnet. + +Datentypen sind in ELAN ein zentrales Konzept. Jedes der in einem ELAN- +Programm verwandten Datenobjekte hat einen Datentyp; somit kann man Daten- +typen auch als Eigenschaften von Datenobjekten ansehen. Für jeden Datentyp +sind nur spezielle Operationen sinnvoll. Z.B. sind für einen Datentyp +"UBoot" die Operationen "erstellen", "tauchen", "auftauchen", "versenken" +und "lieber nicht verwenden" sinnvoll, aber nicht die Operation "+" wie bei +ganzen Zahlen. Man kann nun Übersetzern die Aufgabe überlassen zu überprüfen, +ob stets die richtige Operation auf einen Datentyp angewandt wird. + +Aufgabe (HSG): + + Was ist ein Datentyp? Welche Funktion erfüllen Datentypen? +Übungsziel: Datentyp-Konzept + +Einige Datentypen spielen bei der Programmierung eine besondere Rolle, weil +sie häufig benötigt werden. In ELAN sind das die Datentypen für + +- ganze Zahlen. Dieser Datentyp wird INT (für "integer") genannt. + +- reelle Zahlen (REAL). + +- Zeichen und Zeichenfolgen (TEXT). + +- Wahrheitswerte (BOOL). + +Diese Typen werden in ELAN elementare Datentypen genannt. Für effiziente +Rechnungen mit elementaren Datentypen gibt es in den meisten Rechnern +spezielle Schaltungen, so daß die Hervorhebung und besondere Rolle, die +sie in Programmiersprachen spielen, gerechtfertigt ist. Zudem hat man +Werte-Darstellungen innerhalb von Programmen für die elementaren Datentypen +vorgesehen, was wir im nächsten Abschnitt erklären wollen. + +Im weiteren Teil dieses Skripts werden wir uns zunächst auf die Behandlung +der elementaren Datentypen beschränken. Das bedeutet für den Programmierer, +daß er alle Objekte der realen Welt mit Hilfe der elementaren Datentypen in +den Computer abbilden muß. Das kann manchmal sehr schwierig sein (wie bilden +wir z.B. Personen oder UBoote mit den elementaren Datentypen ab?). Später +werden wir dann Möglichkeiten kennenlernen, neue - problemgerechte - +Datentypen in ELAN zu formulieren. + + + +Denoter (Werte-Repräsentationen) elementarer Datentypen + +Wenn wir mit Objekten elementarer Datentypen arbeiten, müssen wir die +Möglichkeit haben, Werte in ein Programm zu schreiben. Leider kann man einen +Wert "an sich" in einem Programm nicht direkt angeben. Schreiben wir z.B. +4711, dann meinen wir zwar einen INT-Wert, haben aber die Ziffern 4, 7, 1 und +1 geschrieben. Der eigentliche Wert wird in unserem Kopf oder - für unsere +Zwecke - in einem Rechner gebildet. + +Die Werte-Darstellungen oder Werte-Repräsentationen, die in ELAN "Denoter" +genannt werden, sind für jeden Datentyp unterschiedlich. Wie bereits erwähnt, +haben alle Datenobjekte in ELAN (also auch Denoter) nur einen - vom Über­ +setzer feststellbaren - Datentyp. Aus der Form eines Denoters ist also der +Datentyp erkennbar: + +- INT-Denoter: + Bestehen aus einer Aneinanderreihung von Ziffern. Beispiele: + + 17, 007, 32767, 0 + + Führende Nullen spielen bei der Bildung des Wertes keine Rolle (sie werden + vom ELAN-Compiler überlesen). Negative INT-Denoter gibt es nicht (wie + negative Werte-Darstellungen in einem Programm geschrieben werden, lernen + wir bei den Ausdrücken). + +- REAL-Denoter: + Hier gibt es zwei Formen. Die erste besteht aus zwei INT-Denotern, die + durch einen Dezimalpunkt getrennt werden. Beispiele: + + 0.314159, 17.28 + + Der Dezimalpunkt wird analog der deutschen Schreibweise als Komma + verwendet. Negative REAL-Denoter gibt es wiederum nicht. + + Eine zweite Form wird kurioserweise als "wissenschaftliche Notation" be- + zeichnet. Sie findet dann Verwendung, wenn sehr große oder Zahlen, die + nahe bei Null liegen, dargestellt werden müssen. Beispiele: + + 3.0 e5, 3.0e-5 + + Der (INT-) Denoter hinter dem Buchstaben e gibt an, wie viele Stellen der + Dezimalpunkt nach rechts (positive Werte) oder nach links zu verschieben + ist. Dieser Wert wird Exponent, der Teil vor dem Buchstaben e Mantisse + genannt. + +- TEXT-Denoter: + TEXT-Denoter werden in Anführungszeichen eingeschlossen. Beispiele: + + "Das ist ein TEXT-Denoter" + "Jetzt ein Text-Denoter ohne ein Zeichen: ein leerer Text" + "" + + Beachte, daß das Leerzeichen ebenfalls ein Zeichen ist. Soll ein An- + führungszeichen in einem TEXT erscheinen (also gerade das Zeichen, welches + einen TEXT-Denoter beendet), so muß es doppelt geschrieben werden: + + "Ein TEXT mit dem ""-Zeichen" + "Ein TEXT-Denoter nur mit dem ""-Zeichen:" + """" + + Manchmal sollen Zeichen in einem TEXT-Denoter enthalten sein, die auf dem + Eingabegerät nicht zur Verfügung stehen. In diesem Fall kann der Code- + Wert des Zeichens angegeben werden: + + ""32"" + + bedeutet z.B. das (ASCII-) Leerzeichen. Der Code-Wert eines Zeichens er- + gibt sich aus einer Code-Tabelle (installationsspezifisch), in der jedem + Zeichen eine ganze Zahl zugeordnet ist. + +- BOOL-Denoter: + Es gibt nur zwei BOOL-Denoter: TRUE (für "wahr") und FALSE (für "falsch"). + +Nun wird auch klar, was für Parameter wir in den obigen Programmen verwandt +haben. Es waren natürlich TEXT- bzw. INT-Denoter. + + +Aufgabe (TSW): + + Welche der folgenden Denotationen ist falsch? + + a) 1. e) 1 . 0 i) 007 + b) -1 f) "" j) "Ein "Getuem" stellt sich vor" + c) """ g) """" + d) "das ist ein text" h) TRUE k) 1.0 e 37 + +Übungsziel: Lernen von Denotationen + + + +ELAN-Datenobjekte + +Wie bereits erwähnt, wollen wir mit Hilfe von Programmen Datenobjekte so +verändern, daß wir erwünschte Ergebnisse erhalten. Meist wird zu dieser Ver- +änderung von Datenobjekten "Rechnen" gesagt, obwohl - wie wir gleich sehen +werden - nicht nur numerische Objekte manipuliert werden. Die Veränderung +der Datenobjekte findet zur "Laufzeit" (nicht zur Übersetzungszeit) im +Rechner statt. Die Darstellung eines Werts in einem Rechner zur Laufzeit +eines Programms wird #ib#Repräsentation#ie# genannt. Wenn es eindeutig ist, +daß es sich nur um die Repräsentation im Rechner handelt, sprechen wir kurz +von Werten. +Da also ein Datenobjekt wechselnde Werte annehmen kann, brauchen wir eine +Möglichkeit, es in einem Programm anzusprechen, egal welchen Wert das Objekt +zu einem Zeitpunkt beinhaltet. Zu diesem Zweck können wir einem Datenobjekt +einen Namen geben (wie z.B. einen Personennamen, hinter dem sich eine wirk­ +liche Person "verbirgt"). Wenn wir also den Namen des Datenobjekts in ein +Programm schreiben, dann meinen wir (meist) den Wert des Datenobjekts, den +es zu diesem Zeitpunkt besitzt. + +Nun sollen die zu behandelnden Datenobjekte ja auch neue Werte erhalten. In +diesem Fall müssen wir die Speicherstelle finden, in die der neue Wert ge- +bracht werden soll. Für diesen Zweck benutzen wir ebenfalls den Namen, zu- +sätzlich zu der Angabe einer Operation, durch die das Objekt einen neuen +Wert erhalten soll. Diese Operation (Wert "schreiben") nennen wir Zuweisung. +Der Zuweisungs-Befehl wird ':=' geschrieben. Beispiel: + + a := 5 + +Bedeutet, daß das Datenobjekt mit dem Namen 'a' den Wert '5' erhält. + +Von manchen Datenobjekten wissen wir, daß wir ihnen nur einmal einen Wert +geben wollen. Sie sollen also nicht verändert werden. Oder wir wissen, daß +in einem Programmbereich ein Datenobjekt nicht verändert werden soll. Um ein +unbeabsichtigtes Verändern zu verhindern, wird in ELAN dem Namen eines +Datenobjekts ein zusätzlicher Schutz mitgegeben: das Zugriffsrecht oder +Accessrecht. Es besteht aus der Angabe der Worte VAR (für Lesen und Ver- +ändern) oder CONST (für ausschließliches Lesen). + + + +Die Deklaration (Vereinbarung) von Datenobjekten + +Wollen wir ein Datenobjekt in einem Programm verwenden, so müssen wir dem +Übersetzer mitteilen, welchen Datentyp und welches Accessrecht das Objekt +haben soll. Das dient u.a. dazu, nicht vereinbarte Namen (z.B. verschriebene) +vom Übersetzer entdecken zu lassen. Weiterhin ist aus dem bei der Deklaration +angegebenen Datentyp zu entnehmen, wieviel Speicherplatz für das Objekt zur +Laufzeit zu reservieren ist. Beispiel: + +INT VAR mein datenobjekt + +Zuerst wird der Datentyp, dann das Accessrecht und schließlich der Name des +Datenobjekts angegeben. Wie werden nun Namen in ELAN formuliert? + +Das erste Zeichen eines Namens muß immer ein kleiner Buchstabe sein. Danach +dürfen beliebig viele kleine Buchstaben, aber auch Ziffern folgen. Zur bes- +seren Lesbarkeit können (wie bei den obigen Prozedurnamen) Leerzeichen in +einem Namen erscheinen, die aber nicht zum Namen zählen. Beispiele: + + name1 + n a m e 1 + x27 + gehalts konto + das ist ein langer name + +Verschiedene Datenobjekte mit gleichem Datentyp und Accessrecht dürfen in +einer Deklaration angegeben werden (durch Kommata trennen). Mehrere Dekla- +rationen werden - genauso wie Anweisungen - durch das Trennsymbol +voneinander getrennt. Beispiele: + + INT VAR mein wert, dein wert, unser wert; + BOOL VAR listen ende; + TEXT VAR zeile, wort + + + +Die Initialisierung von Datenobjekten + +Um mit den so vereinbarten Datenobjekten arbeiten zu können, muß man ihnen +eine Wert geben. Hat ein Datenobjekt noch keinen Wert erhalten, so sagt man, +sein Wert sei undefiniert. Das versehentliche Arbeiten mit undefinierten +Werten ist eine beliebte Fehlerquelle. Deshalb wird von Programmierern +streng darauf geachtet, diese Fehlerquelle zu vermeiden. Eine Wertgebung an +ein Datenobjekt kann (muß aber nicht) bereits bei der Deklaration erfolgen, +was man in ELAN Initialisierung nennt. Beispiele: + + INT CONST gewuenschtes gehalt :: 12 000; + TEXT VAR zeile :: ""; + REAL CONST pi :: 3.14159; + BOOL VAR bereits sortiert :: TRUE + +Allerdings: für mit CONST vereinbarte Datenobjekte ist die Initialisierung +die einzige Möglichkeit, ihnen einen Wert zu geben. + +Die Initialisierung erfolgt mit Hilfe des '::'-Symbols. Anschließend folgt +der Wert, den das Datenobjekt erhalten soll. (In den Beispielen haben wir +nur Denoter geschrieben. Es sind aber auch allgemeinere Ausdrücke erlaubt.). +Es ist nun möglich, mit der oben erwähnten 'put'-Prozedur auch den Wert von +Datenobjekten ausgeben zu lassen. + + +Programm 5: + + INT VAR nummer :: 5; + TEXT CONST bemerkung :: ".Programm"; + put (nummer); + put (bemerkung) + +Beachte dabei, daß bei der Aufführung eines Namens in diesem Fall immer der +Wert des Datenobjekts gemeint ist. Auch die 'put'-Prozedur druckt nicht etwa +den Namen des Datenobjekts oder die Adresse der Speicherstelle, sondern +ebenfalls den Wert. + + +Aufgabe (HSG): + + Welche Aufgabe erfüllen Deklarationen? Was heißt: "Eine Variable hat + einen undefinierten Wert"? Was ist eine Initialisierung? Was ist ein + CONST-Datenobjekt? Warum müssen CONST-Datenobjekte initialisiert + werden? +Übungsziel: Verständnis von Deklarationen und Accessrecht + + + +Schlüsselworte + +Einige Worte haben in ELAN eine feste Bedeutung und können somit nicht - +wie etwa Namen - frei gewählt werden. Solche Worte werden bei den meisten +ELAN-Übersetzern mit großen Buchstaben geschrieben, wie z.B. VAR, CONST, +INT oder REAL u.a.m. Wie wir später sehen werden, besteht die Möglichkeit, +neue Schlüsselworte einzuführen. Halten wir vorläufig fest, daß feste +Bestandteile der Sprache (wie z.B. CONST oder VAR) und Datentypen (wie INT +oder REAL) Schlüsselworte sind, also mit großen Buchstaben geschrieben +werden. + + + +Ausdrücke + +Nun wäre es natürlich schlecht, wenn Programmierer nicht mehr machen könnten, +als Werte ausgeben. Als erste Stufe von etwas komplexeren "Rechnungen" +dürfen Ausdrücke gebildet werden. Ausdrücke sind eine Zusammenstellung von +Datenobjekten (Denoter, VAR- oder CONST-Objekte) und Operatoren. Schauen wir +uns dazu erst ein Programm an: + + +Programm 6: + + INT CONST wert 1 :: 1, + wert 2 :: 2, + wert 3 :: 3; + + put (wert1 + wert2); + put (wert2 - wert1); + put (wert2 * wert3); + put (wert3 DIV wert2); + put (wert2 ** wert3) + +In diesem Programm werden drei Datenobjekte initialisiert. Anschließend +werden jeweils die Werte von zwei Objekten addiert (Operatorzeichen: '+'), +subtrahiert ('-'), multipliziert ('*'), dividiert (ganzzahlige Division ohne +Rest: 'DIV') und potenziert ('**'). Dies sind Operatoren, die zwei Operanden +haben: man nennt sie dyadische Operatoren. Die monadischen Operatoren da- +gegen haben nur einen Operanden. Beispiel: + + put ( - wert1) + +Operatoren in ELAN werden - wie wir an den obigen Beispielen sehen - durch +ein oder zwei spezielle Zeichen oder durch große Buchstaben (in den Fällen, +in denen kein "vernünftiges" Zeichen mehr zur Verfügung steht) als Schlüssel- +wort dargestellt. + +Als Operanden (also die Datenobjekte, auf die ein Operator "wirken" soll) +eines Operators darf ein VAR- oder CONST-Datenobjekt, aber auch ein Denoter +verwendet werden. Das Resultat eines Operators (also das Ergebnis einer +Berechnung) ist bei den obigen Ausdrücken wieder vom Datentyp INT mit dem +Accessrecht CONST. Darum ist es erlaubt, solch einen Ausdruck wiederum als +Operanden zu verwenden. Praktisch bedeutet dies, daß wir mehrere Operatoren +und Datenobjekte zusammen in einem Ausdruck haben dürfen. + + +Programm 7: + + INT CONST wert 1 :: 1, + wert 2 :: 2, + wert 3 :: 3; + + put (wert2 + 3 - wert2 * wert3); + put (- wert2 * wert3) + +Nun haben wir eine Schwierigkeit: Der Ausdruck in der ersten 'put'-Anweisung +ist mehrdeutig, d.h. kann - je nach Reihenfolge der Auswertung - unter- +schiedliche Ergebnisse als Resultat liefern. Beispiel: + + a) (wert2 + 3 = 5) - (wert2 * wert3 = 6) = -1 + b) ((wert2 + 3 = 5) - wert2 = 3) * 3 = 9 + +Es kommt also auf die Reihenfolge der Auswertung von Operatoren an. Diese +kann man durch die Angabe von Klammern steuern. Beispiel: + + (a + b) * (a + b) + +Es wird jeweils erst 'a + b' ausgewertet und dann erst die Multiplikation +durchgeführt. In ELAN ist es erlaubt, beliebig viel Klammernpaare zu ver- +wenden (Regel: die innerste Klammer wird zuerst ausgeführt). Es ist sogar +zulässig, Klammern zu verwenden, wo keine notwendig sind, denn überflüssige +Klammernpaare werden überlesen. Beispiel: + + ((a - b)) * 3 * ((c + d) * (c - d)) + +Somit können wir beliebig komplizierte Ausdrücke formulieren. (Was man aber +vermeiden sollte, weil sie leicht zu Fehlern führen. Stattdessen kann man +einen komplizierten Ausdrücke in mehrere (einfachere) zerlegen.) + +Um solche Ausdrücke einfacher zu behandeln und sie so ähnlich schreiben zu +können, wie man es in der Mathematik gewohnt ist, wird in Programmiersprachen +die Reihenfolge der Auswertung von Operatoren festgelegt. In ELAN wurden +neun Ebenen, Prioritäten genannt, festgelegt: + + +Priorität Operatoren + + 9 alle monadischen Operatoren + 8 ** + 7 *, /, DIV, MOD + 6 +, - + 5 =, <>, <, <=, >, >= + 4 AND + 3 OR + 2 alle übrigen, nicht in dieser Tabelle aufgeführten + dyadischen Operatoren + 1 := + + +(Die bis jetzt noch nicht erwähnten Operatoren in der Tabelle werden wir in +den weiteren Abschnitten besprechen.) + +Operatoren mit der höchsten Priorität werden zuerst ausgeführt, dann die mit +der nächst höheren Priorität usw. Operatoren mit gleicher Priorität werden +von links nach rechts ausgeführt. Dadurch ergibt sich die gewohnte Abarbei- +tungsfolge wie beim Rechnen. Beispiel: + + -2 + 3 * 2 ** 3 + + a) -2 + b) 2 ** 3 + c) 3 * (2 ** 3) + d) ((-2)) + (3 * (2 ** 3)) + +Wie bereits erwähnt, ist es immer erlaubt, Klammern zu setzen. Ist man sich +also über die genaue Abarbeitungsfolge nicht im Klaren, so kann man Klammern +verwenden. + + +Aufgabe (HSG): + + Welche INT-Werte ergeben sich? + + a) 14 DIV 4 e) -14 DIV -4 + b) + 14 DIV 4 f) 2 * 3 DIV 2 ** 2 * 4 + c) -14 DIV 4 g) 2 ** 3 ** 4 + d) 14 DIV -4 h) 3 + 4 * 2 + 3 + +Übungsziel: Arithmetische Ausdrücke + + +Aufgabe (HSG): + + Bilden Sie für folgende mathematische Formeln entsprechende ELAN- + Ausdrücke: + + a b a+b + a) - c d) a g) - --- + b c + + + a+b b a c + b) --- e) -a h) - * - + c+d b d + + + a+b -b c + c) --- e f) a i) (a*b) + c+d + +Übungsziel: Arithmetische Ausdrücke formulieren + + + +Generische Operatoren und Prozeduren + +Bis jetzt wurden nur Ausdrücke mit INT-Operanden verwendet. Wie sieht es +jetzt mit REALs aus? + + +Programm 8: + + put (1.0 + 2.0); + put (2.0 - 1.0); + put (2.0 * 3.0); + put (3.0 / 2.0); + put (2.0 ** 3.0) + +Man beachte die Unterschiede zum Programm 7: Wir müssen nun REAL-Denoter +verwenden (mit INT-Denotern zu arbeiten wäre ein Fehler). Der Divisions- +Operator hat sich nun von 'DIV' zu '/' gewandelt. Die Ergebnisse sind nun +nicht INT-, sondern REAL-Werte. Für die Reihenfolge der Auswertung der +Operatoren sowie die Verwendung von Klammern gilt das für INT-Ausdrücke +gesagte. + +Wir haben den '+'-Operator in zwei verschiedenen Formen gesehen: in Programm +7 mit Operanden vom Datentyp INT, ein INT-Resultat liefernd, und in Programm +8 das gleiche mit REALs. Es liegen also zwei verschiedene Operatoren vor, +die aber den gleichen Namen (Zeichen: '+') haben. + +In ELAN ist es somit möglich, unterschiedlichen Operatoren (aber auch Proze- +duren) gleiche Namen zu geben. Solche Operatoren werden generische Opera- +toren genannt. Ein ELAN-Compiler wählt den richtigen Operator aufgrund der +Datentypen der Operanden aus. Oft werden die verfügbaren Operatoren wie folgt +dokumentiert: + + INT OP + (INT CONST links, rechts) + +Diese Form nennt man einen "Operator-Kopf". Sie wird in ELAN-Programmen bei +der Definition von Operatoren benötigt. Dabei steht OP für "OPERATOR". Die +Angabe des Datentyps davor gibt den Datentyp des Resultats des Operators an. +Zwischen 'OP' und der öffnenden Klammer steht der Name des Operators (hier: +'+'). In den Klammern werden die Datentypen und das Accessrecht der +Operanden angegeben. CONST bedeutet hier: der Operand darf vom Operator +nicht verändert werden, während bei VAR (was normalerweise ja nicht sein +sollte!) ein Operand bei der Abarbeitung eines Operators verändert werden +kann. + +Damit wir solche Definitionen besser beherrschen, geben wir noch weitere +Beispiele an: + + INT OP - (INT CONST operand) + REAL OP / (INT CONST l, r) + +Bei dem ersten Operator handelt es sich um den monadischen Operator '-' für +INT-Operanden (z.B.: 'INT VAR a :: 1; put (-a)'), während es sich bei dem +zweiten Operator um eine Divisions-Operator handelt, der jedoch ein REAL- +Resultat liefert (z.B.: 'put (3 / 2)' liefert 1.5). Der MOD-Operator liefert +den Rest einer Division: + + INT OP MOD (INT CONST l, r) + REAL OP MOD (REAL CONST l, r) + +Die Beschreibung von generischen Prozeduren verläuft analog. Beispiele: + + PROC put (INT CONST wert) + PROC put (REAL CONST wert) + +Hier wird das Wort 'OP' durch 'PROC' (für 'PROCEDURE') ersetzt. Die Angaben +in Klammern bezeichnen nun nicht Operanden, sondern Parameter. + +Über die verfügbaren Operatoren und Prozeduren für INT- und REAL-Datenob- +jekte kann man sich im ELAN-Handbuch oder im EUMEL-Benutzerhandbuch infor- +mieren. Einige - aber nicht alle - der Operatoren und Prozeduren (auch für +andere Datentypen) werden wir erklären, wenn wir sie in Programmen benötigen. + + + +Die Zuweisung + +Ein spezieller Operator ist die Zuweisung (Zeichen: ':='). Dieser Operator +hat immer die geringste Priorität, wird also immer als letzter eines Aus- +drucks ausgeführt. Die Zuweisung wird verwendet, um einer Variablen einen +neuen Wert zu geben. Beispiel: + + a := b + +Hier wird der Wert von 'b' der Variablen 'a' zugewiesen. Der vorher vor- +handene Wert von 'a' geht dabei verloren. Man sagt auch, der Wert wird über- +schrieben. Auf der rechten Seite (also als rechter Operand) des ':=' +Operators darf auch ein Ausdruck stehen. Beispiel: + + a := b + c + +Hier wird das Resultat von 'b + c' an die Variable 'a' zugewiesen. Man be- +achte dabei die Prioritäten der Operatoren '+' (Priorität 6) und ':=' (Pri- +orität 1): die Addition wird vor der Zuweisung ausgeführt. Die Auswertung +von Zuweisungen mit Ausdrücken muß immer so verlaufen, da die Zuweisung +stets die niedrigste Priorität aller Operatoren hat. + +Schauen wir uns zum besseren Verständnis die Definitionen des (natürlich +auch generischen) Operators ':=' an: + + OP := (INT VAR ziel, INT CONST quelle) + OP := (REAL VAR ziel, REAL CONST quelle) + OP := (TEXT VAR ziel, TEXT CONST quelle) + OP := (BOOL VAR ziel, BOOL CONST quelle) + +Der Operator ':=' liefert also kein Resultat (man sagt auch, er liefert +keinen Wert) und verlangt als linken Operanden ein VAR-Datenobjekt (an den +der Wert der rechten Seite zugewiesen werden soll). Der Wert des linken +Operanden wird also verändert. Für den rechten Operanden ist durch CONST +sichergestellt, daß er nur gelesen wird. + +Oft kommt es vor, daß ein Objekt auf der linken und rechten Seite des Zuwei- +sungsoperators erscheint, z.B. wenn ein Wert erhöht werden soll. Beispiele: + + a := a + 1; + a := a + 17 + +Hier wird der "alte", aktuelle Wert von 'a' genommen, um '1' erhöht und dem +Objekt 'a' zugewiesen. Man beachte, daß hier in einer Anweisung ein Datenob- +jekt unterschiedliche Werte zu unterschiedlichen Zeitpunkten haben kann. + +In solchen Fällen darf man den Operator INCR verwenden: + + a INCR 1; + a INCR 17 + +Analoges gilt für den Operator DECR, bei dem ein Wert von einer Variable +subtrahiert wird. Also: + + OP INCR (INT VAR ziel, INT CONST dazu) + OP INCR (REAL VAR ziel, REAL CONST dazu) + + OP DECR (INT VAR ziel, INT CONST abzug) + OP DECR (REAL VAR ziel, REAL CONST abzug) + +Schauen wir uns folgendes Programm an, bei dem zwei Werte vertauscht werden: + + +Programm 9: + + INT VAR a, b, x; + + get (a); + get (b); + x := a; + a := b; + b := x; + put (a); + put (b) + +Wie wir an diesem Beispiel sehen, existieren nicht nur 'put'-Prozeduren, +sondern auch 'get'-Prozeduren, die einen Wert vom Eingabemedium einlesen. +Es gibt folgende 'get'- Prozeduren (die 'put'-Prozeduren führen wir der +Vollständigkeit halber auch mit auf): + + PROC get (INT VAR wert) + PROC get (REAL VAR wert) + PROC get (TEXT VAR wert) + + PROC put (INT CONST wert) + PROC put (REAL CONST wert) + PROC put (TEXT CONST wert) + + +Aufgabe (HSG): + + Was versteht man unter Generizität? + Übungsziel: Generizitäts-Begriff + + + +Refinements + +Bevor wir die Operationen für TEXTe und BOOLs besprechen, wollen wir eine +weitere wichtige Eigenschaft von ELAN diskutieren, nämlich die Namensgebung. +Namen für Datenobjekte haben wir bereits kennengelernt. In ELAN ist es eben- +falls möglich, Namen für Ausdrücke oder eine bzw. mehrere Anweisungen zu +vergeben. + + +Programm 10: + + INT VAR a, b, x; + einlesen von a und b; + vertauschen von a und b; + vertauschte werte ausgeben. + + einlesen von a und b: + get (a); + get (b). + + vertauschen von a und b: + x := a; + a := b; + b := x. + + vertauschte werte ausgeben: + put (a); + put (b). + +Dies ist das gleiche Programm wie das 9. Beispielprogramm. Für den Namen +'einlesen von a und b' werden die Anweisungen 'get (a); get (b)' vom +ELAN-Übersetzer eingesetzt. Man kann also die ersten vier Zeilen des +Programms als eigentliches Programm ansehen, wobei die Namen durch die +betreffenden Anweisungen ersetzt werden. Eine solche Konstruktion wird in +ELAN Refinement genannt. Was wird dadurch erreicht? + +Durch die sinnvolle Verwendung von Refinements wird ein Programm im Programm +und nicht in einer separaten Beschreibung dokumentiert. Weiterhin kann ein +Programm "von oben nach unten" ("top down") entwickelt werden: wir haben das +obige - zugegeben einfache - Beispielprogramm in drei Teile zerlegt und +diese durch Namen beschrieben. Bei der Beschreibung von Aktionen durch Namen +sagen wir, was wir machen wollen und nicht wie, denn wir brauchen uns auf +dieser Stufe der Programmentwicklung um die Realisierung der Refinements +(noch) keine Sorgen zu machen. Das erfolgt erst, wenn wir genauer definieren +müssen, wie das Refinement programmiert werden muß. Dabei können wir +wiederum Refinements verwenden usw., bis wir auf eine Ebene "herunterge- +stiegen" sind, bei dem eine (jetzt: Teil-) Problemlösung sehr einfach ist +und wir sie direkt hinschreiben können. Wir beschäftigen uns also an jedem +Punkt der Problemlösung nur mit einem Teilaspekt des gesamten Problems. +Zudem sieht man - wenn die Refinements einigermaßen vernünftig verwendet +werden - dem Programm an, wie die Problemlösung entstanden ist. + +Die Verwendung von Refinements hat also eine Anzahl von Vorteilen. Schauen +wir uns deshalb an, wie die Refinements formal verwandt werden müssen. Das +"Hauptprogramm" wird durch einen Punkt abgeschlossen, falls ein Refinement +folgt. Ein Refinement besteht aus der Nennung des Refinement-Namens, der +von einem Doppelpunkt gefolgt sein muß. In einem Refinement kann eine +Anweisung oder mehrere - durch Semikolon getrennt - stehen. Das Refinement +wird durch einen Punkt abgeschlossen. + +Refinements können auch dort verwendet werden, wo ein Wert erwartet wird, +z.B. in einem Ausdruck oder einer 'put'-Anweisung. In diesem Fall muß das +Refinement natürlich einen Wert liefern. Wie macht man das? Eine Möglichkeit +ist, daß im Refinement ein Ausdruck geschrieben wird, der einen Wert als +Resultat liefert. + + +Programm 11: + + INT VAR a :: 1, b :: 2, c :: 3; + put (resultat). + + resultat: + (a * b + c) ** 3. + +Eine Zuweisung liefert - wie bereits erwähnt - kein Resultat. Es ist auch +erlaubt, ein Refinement mit mehreren Anweisungen zu schreiben, das einen Wert +liefert. Allgemeine Regel: die letzte Anweisung eines Refinements bestimmt, +ob ein Refinement einen Wert liefert - und wenn ja, von welchen Datentyp. + + + +BOOLesche Operationen + +Für BOOLesche Datenobjekte gibt es einige Operatoren: + + BOOL OP AND (BOOL CONST links, rechts) + BOOL OP OR (BOOL CONST links, rechts) + BOOL OP NOT (BOOL CONST operand) + +Der Operator AND liefert als Resultat die logische "und"-Verknüpfung (nur +wenn beide Operanden den Wert TRUE haben ist das Resultat TRUE, sonst FALSE), +OR ist das logische "oder" (nur wenn beide Operanden FALSE liefern, ist das +Resultat FALSE, sonst TRUE) und die logische Negation NOT (als Resultat wird +das "Gegenteil" geliefert). + +Ebenfalls wichtig sind die Vergleichs-Operatoren, die zwar keine BOOLeschen +Operanden erwarten, aber ein BOOLesches Resultat liefern: + + BOOL OP = (INT CONST links, rechts) + BOOL OP <> (INT CONST links, rechts) + BOOL OP < (INT CONST links, rechts) + BOOL OP <= (INT CONST links, rechts) + BOOL OP > (INT CONST links, rechts) + BOOL OP >= (INT CONST links, rechts) + +Diese Operatoren: = (gleich), <> (ungleich), < (kleiner), <= (kleiner +gleich), > (größer), >= (größer gleich) gibt es auch noch für Operanden vom +Datentyp REAL und TEXT. Da die Vergleichs-Operatoren ein BOOLesches Resultat +liefern, kann man sie in BOOLeschen Ausdrücken verwenden. Zu beachten ist +dabei die Priorität der Operatoren: die Vergleiche werden immer vor den +Operatoren AND bzw. OR ausgeführt. + + +Programm 12: + + BOOL CONST kaufen; + kaufen := will ich AND NOT zu teuer. + + will ich: + TEXT VAR produktname; + get (produktname); + produktname = "muesli" OR produktname = "vollkornbrot". + + zu teuer: + INT VAR preis; + get (preis); + preis > 20. + + + +Aufgabe (HSG): + + Welche BOOL-Werte ergeben sich? + + a) TRUE AND FALSE e) TRUE AND TRUE OR TRUE + b) TRUE OR FALSE f) 10 < 3 AND 17 > 4 + c) TRUE AND NOT FALSE g) 17 + 4 = 21 OR TRUE + d) NOT TRUE AND FALSE h) TRUE AND FALSE OR TRUE + + Übungsziel: Boolesche Ausdrücke + + + +Abfragen + +BOOLesche Ausdrücke werden in einer speziellen Anweisung verwandt, der +Abfrage: + + +Programm 13: + + INT VAR a, b; + get (a); get (b); + IF a > b + THEN vertausche a und b + END IF; + put (a); put (b). + + vertausche a und b: + INT CONST x :: a; + a := b; + b := x. + +Das Refinement im THEN-Teil der bedingten Anweisung wird nur durchgeführt, +wenn der BOOLesche Ausdruck ('a > b') den Wert TRUE liefert. Liefert er den +Wert FALSE, wird die Anweisung, die der bedingten Anweisung folgt (nach END +IF), ausgeführt. Programm 13 kann etwas anders geschrieben werden: + + +Programm 14: + + INT VAR a, b; + get (a); get (b); + IF a > b + THEN put (a); + put (b) + ELSE put (b); + put (a) + END IF. + +Der THEN-Teil wird wiederum ausgeführt, wenn die BOOLesche Bedingung +erfüllt ist. Liefert sie dagegen FALSE, wird der ELSE-Teil ausgeführt. + +Die bedingte Anweisung gibt uns also die Möglichkeit, abhängig von einer +Bedingung eine oder mehrere Anweisungen ausführen zu lassen. Dabei können +im THEN- bzw. ELSE-Teil wiederum bedingte Anweisungen enthalten sein usw. +Solche geschachtelten bedingten Anweisungen sollte man jedoch vermeiden, +weil sie leicht zu Fehlern führen können (statt dessen durch Refinements +realisieren). Man beachte auch die Einrückungen, die man machen sollte, um +die "Zweige" besonders kenntlich zu machen. + + +Aufgabe (HSG): + + a) In welcher Reihenfolge werden Operatoren ausgewertet? + b) Reihenfolge der Auswertung von: a + b + c + c) INT VAR a, b, c; + ... + IF NOT a = 0 AND b = 0 THEN... + ergibt einen syntaktischen Fehler. Welchen? + d) Wie wird der BOOLesche Ausdruck ausgewertet? + INT VAR a :: 0, b :: 4; + ... + IF a = 0 AND b DIV a > 0 + e) Warum ist + BOOL VAR ende :: TRUE; + ... + IF ende = TRUE + THEN... + Unsinn? + + Übungsziel: Reihenfolge der Auswertung von Ausdrücken + +Bei Abfrageketten kann das ELIF-Konstrukt eingesetzt werden. (ELIF ist eine +Zusammenziehung der Worte ELSE und IF). Anstatt + + ... + IF bedingung1 + THEN aktion1 + ELSE IF bedingung2 + THEN aktion2 + ELSE aktion3 + END IF + END IF; + ... + +kann man besser + + ... + IF bedingung1 + THEN aktion1 + ELIF bedingung2 + THEN aktion2 + ELSE aktion3 END IF; + ... + +schreiben. + +Die bedingte Anweisung kann auch einen Wert liefern. In diesem Fall muß der +ELSE-Teil vorhanden sein und jeder Zweig den gleichen Datentyp liefern +(jeweils die letzte Anweisung muß einen Wert liefern). + + +Aufgabe (HSG): + + Was berechnen folgende (Teil-) Programme? + + a) INT VAR a; + get (a); + put (wert). + + wert: + IF a < 0 + THEN -a + ELSE a + END IF. + + b) INT VAR brutto, netto; + get (brutto); + berechne gehalt; + put ("mein gehalt:"); + put (netto). + + berechne gehalt: + IF jahresverdienst > 30 000 (* zu wenig? *) + THEN sonderabgabe + END IF; + netto := brutto - brutto DIV 100 * 20. + + jahresverdienst: + brutto * 12. + + sonderabgabe: + brutto := brutto - brutto DIV 100 * 30 + + c) INT VAR x; + ... + put (signum). + + signum: + IF x > 0 + THEN 1 + ELSE kleiner gleich + END IF. + + kleiner gleich: + IF x = 0 + THEN 0 + ELSE -1 + END IF. + + + +TEXTe + +TEXT-Denoter haben wir bereits kennengelernt. Im folgenden Programm stellen +wir die Wirkung einiger TEXT-Operationen vor. + + +Programm 15: + + TEXT VAR a, b, c; + a := "ELAN"; + b := "-Programm"; + c := a + b; + put (c) + +Der Operator + + TEXT OP + (TEXT CONST links, rechts) + +liefert als Ergebnis einen TEXT, bei dem an den linken der rechte Operand +angefügt wurde (Fachausdruck: "Konkatenation"). Weitere Operatoren: + + TEXT OP CAT (TEXT VAR ziel, TEXT CONST dazu) + TEXT OP * (INT CONST i, TEXT CONST a) + TEXT OP SUB (TEXT CONST t, INT CONST pos) + +Der Operator CAT fügt an einen TEXT einen zweiten an ('a CAT b' wirkt wie +'a := a + b'). Mit dem '*'-Operator kann man einen TEXT vervielfältigen +(Beispiel: 17 * "--"), während man mit SUB ein Zeichen aus einem TEXT her- +ausholen kann (Beispiel: "ELAN" SUB 3 liefert "A"). + +Die meisten TEXT-Operationen sind als Prozeduren realisiert, weil mehr als +zwei Operanden benötigt werden. Die Wirkung einiger Operationen geben wir in +kurzen Kommentaren an: + + TEXT PROC subtext (TEXT CONST t, INT CONST von) + (* rechter Teiltext von 't' von der Position 'von' bis Ende *) + + TEXT PROC subtext (TEXT CONST t, INT CONST von, bis) + (* Teiltext von 't' von der Position 'von' bis 'bis' *) + + PROC change (TEXT VAR t, TEXT CONST old, new) + (* Ersetzung von 'old' in 'new' im TEXT 't' *) + + INT PROC length (TEXT CONST t) + (* Anzahl Zeichen von 't' *) + + INT PROC pos (TEXT CONST t, muster) + (* Die Position des ersten Auftretens von 'muster' in 't' *) + +Die Vergleichs-Operatoren für TEXTe arbeiten bei dem Vergleich nach der +alphabetischen Reihenfolge ('"a" < "b"' liefert TRUE). Dabei definiert ELAN +nur die Reihenfolge innerhalb der kleinen und großen Buchstaben und Ziffern. +Das Leerzeichen ("#ib#blank#ie#") ist jedoch stets das "kleinste" Zeichen. +Wie diese "Zeichenblöcke" und die restlichen Zeichen angeordnet sind, wurde +nicht spezifiziert. Ob '"a" < "Z"' TRUE oder FALSE liefert, wurde also nicht +festgelegt und ist somit rechnerspezifisch. Anmerkung: Im EUMEL-Betriebs- +system wird der ASCII-Zeichencode, DIN 66 003 mit Erweiterungen verwandt. +Die folgenden Vergleiche sind alle TRUE: + + "otto" = "otto" + "a" < "z" + "Adam" < "Eva" + "hallo" < "hallu" + "hallo" < "hallo " + length ("ha") = 2 + subtext ("ELAN-Programmierung", 14) = "ierung" + + +Aufgabe (HSG): + + Gib die Realisierung von folgenden vorgegebenen Prozeduren und Opera- + toren an: + a) TEXT PROC subtext (TEXT CONST t, INT CONST von) durch + TEXT PROC subtext (TEXT CONST t, INT CONST von, bis) + b) OP CAT (TEXT VAR a, TEXT CONST b) durch ':=' und '+' + c) TEXT OP SUB (TEXT CONST t, INT CONST p) durch 'subtext' + + Übungsziel: Lernen einiger vorgegebener TEXT-Operationen + + + +Die Wiederholungs-Anweisung + +Wiederholungs-Anweisungen ermöglichen es uns, Anweisungen wiederholt - meist +in Abhängigkeit von einer Bedingung - ausführen zu lassen. Darum wird die +Wiederholungs-Anweisung oft auch #ib#Schleife#ie# genannt, die in ihr ent- +haltenen Anweisungen #ib#Schleifenrumpf#ie#. Die Schleife von ELAN baut auf +einem Basis-Konstrukt auf: + + REP + anweisungen + END REP + +Diese Anweisungsfolge realisiert eine sogenannte "Endlosschleife", weil nicht +spezifiziert wird, wann die Schleife beendet werden soll. + +Bei der abweisenden Schleife wird die Abbruchbedingung an den Anfang der +Schleife geschrieben: + + WHILE boolesche bedingung REP + anweisungen + END REP + +Bei jedem erneuten Durchlauf durch die Schleife wird überprüft, ob der +BOOLesche Ausdruck den Wert TRUE liefert. Ist das nicht der Fall, wird mit +der nächsten, auf die Schleife folgenden Anweisung mit der Bearbeitung fort- +gefahren. Die Schleife wird abweisende Schleife genannt, weil der Schleifen- +rumpf nicht ausgeführt wird, wenn die Bedingung vor Eintritt in die Schleife +bereits FALSE liefert. + +Anders verhält es bei der nicht abweisenden Schleife: + + REP + anweisungen + UNTIL boolesche Bedingung END REP + +Hier wird der Schleifenrumpf auf jeden Fall einmal bearbeitet. Am Ende des +Rumpfes wird die BOOLesche Bedingung abgefragt. Liefert diese den Wert FALSE, +wird die Schleife erneut abgearbeitet. Liefert die Bedingung den Wert TRUE, +wird die Schleife abgebrochen und mit der ersten Anweisung hinter der +Schleife in der Bearbeitung fortgefahren. + +Bei beiden Arten der Wiederholungs-Anweisung ist es wichtig, daß Elemente +der BOOLeschen Bedingung in der Schleife verändert werden, damit das +Programm terminieren kann, d.h. die Schleife abgebrochen wird. + +Eine Endlos-Schleife wird bei der Zählschleife meist nicht vorkommen: + + FOR i FROM anfangswert UPTO endwert REP + anweisungen + END REP + +Zählschleifen werden eingesetzt, wenn die genaue Anzahl der Schleifendurch- +läufe bekannt ist. Hier wird eine Laufvariable verwendet (in unserem Bei- +spiel 'i': sie muß mit INT VAR deklariert werden), die die INT-Werte von +'anfangswert' bis 'endwert' in Schritten von '1' durchläuft. Diese Schleife +zählt "aufwärts". Wird anstatt UPTO das Schlüsselwort DOWNTO verwendet, wird +mit Schritten von -1 "abwärts" gezählt. Beispiel: + + FOR i FROM endwert DOWNTO anfangswert REP + ... + +Für ein Beispielprogramm stellen wir uns die Aufgabe, aus TEXTen das Auf- +treten des Buchstabens "e" herauszufinden. Die TEXTe sollen vom Eingabe- +medium solange eingelesen werden, bis wir den TEXT "00" eingeben. + + +Programm 16: + + INT VAR anzahl e :: 0; + TEXT VAR wort; + REP + get (wort); + zaehle e im wort + UNTIL wort = "00" END REP; + put (anzahl e). + + zaehle e im wort: + INT VAR i; + FOR i FROM 1 UPTO length (wort) REP + IF das i te zeichen ist e + THEN anzahl e INCR 1 + END IF + END REP. + + das i te zeichen ist e: + (wort SUB i) = "e". + + +Aufgabe (HSG): + + Die Klammern in dem letzten Refinement sind notwendig. Warum? + +Bevor wir ein Programm einem Rechner zur Bearbeitung übergeben, sollten wir +uns davon überzeugen, daß das Programm wirklich das leistet, was es soll. +Eine der wichtigsten Bedingungen ist die Terminierung eines Programms, d.h. +das Programm darf nicht in eine Endlosschleife geraten. Unser Beispielpro- +gramm terminiert, wenn beide Schleifen terminieren: die obere Schleife +terminiert durch das Endekriterium, während die zweite Schleife automatisch +durch die Zählschleife begrenzt wird. Das Programm wird also auf jeden Fall +beendet (kann in keine Endlosschleife geraten), falls das Endekriterium ein- +gegeben wird. +Interessant sind dabei immer "Grenzfälle", wie z.B. die Eingabe eines +"leeren Textes", sehr lange TEXTe usw. + + +Aufgabe (HSG): + + Welche Fehler befinden sich in den folgenden Programmteilen? + a) INT VAR i; + FOR i FROM 1 UPTO i REP + tue irgendwas + END REP + + b) BOOL CONST noch werte :: TRUE; + INT VAR i; + WHILE noch werte REP + get (i); + ... + IF i = O + THEN noch werte := FALSE + END IF + END REP + + c) INT VAR anz berechnungen :: 1; + REP + lies eingabe wert; + berechnung; + drucke ausgabewert + UNTIL anz berechnungen > 10 END REP. + + d) INT VAR anz berechnungen; + WHILE anz berechnungen <= 10 REP + lies eingabewert; + berechnung; + drucke ausgabewert; + anz berechnungen INCR 1 + END REP. + + e) INT VAR n := 1, summe; + summe der ersten 100 zahlen. + + summe der ersten 100 zahlen: + WHILE n < 100 REP + summe := summe + n; + n INCR 1 + END REP. + (* Achtung: 2 Fehler! (Vorwarnen ist feige) *) + + f) INT VAR n := 1; + REP + INT VAR summe := 0; + summe := summe + n; + n INCR 1 + UNTIL n = 100 END REP + (* Achtung: 2 Fehler! *) + + Übungsziel: Arbeiten mit Schleifen + + +Das Programm 16 können wir etwas besser formulieren. Dazu wollen wir uns +aber eine etwas andere Aufgabe stellen: wie viele Leerzeichen sind in einem +Text? Zur Lösung dieser Aufgabe sollten wir den Text nicht wortweise ein- +lesen, sondern zeilenweise. Dazu verwenden wir die Prozedur + + PROC get (TEXT VAR t, INT CONST max length) + +die einen TEXT 't' mit maximal 'max length' Zeichen einliest. Auf dem +EUMEL-System gibt es dafür auch die Prozedur 'getline'. + + +Programm 17: + + INT VAR anzahl blanks :: 0; + REP + lies zeile ein; + zaehle blanks + UNTIL zeile hat endekriterium END REP. + + lies zeile ein: + TEXT VAR zeile; + get (zeile, 80). + + zaehle blanks: + INT VAR von :: 1; + WHILE zeile hat ab von ein blank REP + anzahl blanks INCR 1; + von auf blank position setzen + END REP. + + zeile hat ab von ein blank: + pos (zeile, " ", von) > 0. + + von auf blank position setzen: + von := pos (zeile, " ", von). + + zeile hat endekriterium: + pos (zeile, "00") > 0. + + +Aufgabe (TSW): + + Das Programm 17 enthält (mindestens) zwei Fehler. Finden Sie diese bitte + heraus. + + Übungsziel: Finden von Programmierfehlern. + + +Aufgabe (HSG): + + a) Welche Werte liefern folgende Ausdrücke für die Textvariable + TEXT VAR t :: "Das ist mein Text" + a1) pos (t, "ist") + a2) pos (t, "ist", 5) + a3) length (t) + a4) subtext (t, 14) + a5) subtext (t, 14, 17) + + b) Welche Werte liefern folgende Ausdrücke für die Textkonstanten + TEXT CONST text :: "ELAN-Programm", + alphabet :: "abcde...xyz" + b1) 3 * text + b2) length ("mein" + text + 3 * "ha") + b3) 3 * "ha" < text + b4) pos (text, alphabet SUB 1) + b5) pos (text, subtext (alphabet, 7, 7)) + + c) Schreibe in anderer Form: + c1) subtext (text, 7, 7) + c2) change (text, "alt", "neu") + c3) INT VAR laenge :: length (text); + IF subtext (text, laenge, laenge) =... + c4) IF NOT (text = "aha") + THEN aktion 1 + ELSE aktion 2 + END IF + + Übungsziel: TEXT-Ausdrücke und Prozeduren + + + +Die Repräsentation von Datentypen + +Wie bereits erwähnt, sind Datentypen Klassen von Objekten der realen Umwelt. +Die Objekte eines Datentyps müssen in den Speicher eines Rechners abgebildet +werden. Die Darstellung eines Objekts im Rechner wird Repräsentation genannt. +Aus organisatorischen Gründen versucht man, immer feste, gleich große Ein- +heiten für die Objekte eines Datentyps zu verwenden. Durch die Begrenzung auf +feste Speicherplatzeinheiten ist der Wertebereich beschränkt. Diese Grenzen +hat man beim Programmieren zu beachten. + +Beim Datentyp BOOL spielt die Repräsentation nur insoweit eine Rolle, daß +man die zwei möglichen Werte mehr oder weniger speicheraufwendig realisieren +kann. Eine Einschränkung des Wertebereichs gibt es nicht. + +Bei INTs ist jedoch eine Einschränkung des Wertebereichs gegeben. Für die +Repräsentation von INTs sind Einheiten von 16, 32 Bit u.a.m. gebräuchlich. +Es existiert die Möglichkeit, den größten INT-Wert mit Hilfe von + + maxint + +zu erfragen. Z.B. ist 'maxint' für EUMEL-Systeme z.Zt. 32 767. Der kleinste +INT-Wert ist oft nicht ' - maxint' (im EUMEL-System kann er unter 'minint' +angesprochen werden). Übersteigt ein Wert 'maxint', gibt es eine Fehler- +meldung 'overflow', im andern Fall 'underflow'. + +REALs sind noch schwieriger. Durch die endliche Darstellung der Mantisse +treten "Lücken" zwischen zwei benachbarten REALs auf. Deshalb ist bei Ver- +wendung von REALs immer mit Repräsentationsfehlern zu rechnen. Dieses Thema +der "Rundungsfehler" wollen wir hier jedoch nicht weiter vertiefen. Auf +jeden Fall gibt es aber auch einen größten REAL-Wert + + maxreal + +Bei TEXTen gibt es zwei Repräsentations-Schwierigkeiten. Einerseits werden +TEXTe durch "irgendeinen" Code im Rechner repräsentiert, der z.B. bei Ver- +gleichen verwendet wird. ELAN-Compiler auf Rechenanlagen mit unterschied- +lichen Zeichencodes können daher unterschiedliche Ergebnisse liefern. +Andererseits ist in ELAN nicht definiert, wie viele Zeichen maximal in einen +TEXT passen, was ebenfalls vom Rechner bzw. von einem ELAN-Compiler abhängt. +Auf dem EUMEL-System kann die maximale Anzahl Zeichen eines TEXTs durch +'maxtext length' erfragt werden. Sie ist z.Z. '32 000'. + + + +Ein- und Ausgabe + +Wie Datenobjekte - auf einfache Weise - auf einem Ausgabemedium ausgegeben +werden können, haben wir bereits geschildert (Prozedur 'put'). Die Ausgabe +erfolgt solange auf einer Zeile, bis ein auszugebender Wert nicht mehr auf +eine Zeile paßt. In diesem Fall wird die Ausgabe in die nächste Zeile pla- +ziert. Zwischen den einzelnen Werten auf einer Zeile wird jeweils ein Blank +Zwischenraum gelassen, um die Ausgaben voneinander zu trennen. Mit folgenden +Prozeduren kann man die Ausgabe flexibel gestalten: + + PROC line (* bewirkt einen Zeilenvorschub *) + + PROC line (INT CONST anzahl) (* bewirkt 'anzahl' Zeilenvorschübe *) + + PROC page (* bewirkt einen Seitenvorschub auf + einem Drucker oder löscht den Bild- + schirm und positioniert in die linke + obere Ecke *) + + PROC putline (TEXT CONST zeile) (* gibt 'zeile' auf dem Bildschirm aus + und positioniert auf die nächste + neue Zeile *) + + PROC cursor (INT CONST reihe, spalte) (* Positioniert die Schreibmarke + auf dem Bildschirm in die an- + gegebene Position *) + +Die Prozedur 'get' holt Eingaben vom Eingabemedium. Ein Element der Eingabe +wird dabei durch ein Blank vom nächsten getrennt. Einige weitere Eingabe- +Prozeduren: + + PROC get (TEXT VAR t, TEXT CONST delimiter) (* die nächste Eingabe wird + nicht von einem Blank + begrenzt, sondern durch + 'delimiter' *) + + TEXT PROC get (* dient zum Initialisieren *) + + PROC inchar (TEXT VAR zeichen) (* wartet solange, bis ein Zeichen vom + Bildschirm eingegeben wird *) + + TEXT PROC incharety (* Versucht ein Zeichen vom Bildschirm + zu lesen. Ist kein Zeichen vor- + handen, wird "" geliefert *) + + PROC editget (TEXT VAR line) (* Bei der Eingabe kann 'line' editiert + werden *) + + PROC get cursor (INT VAR zeile, spalte) (* Informationsprozedur, wo die + Schreibmarke aktuell steht *) + + + +Konvertierungen + +Manchmal ist es notwendig, eine Datentyp-Wandlung für ein Objekt vorzunehmen. +Die Wandlungen von einem INT- bzw. einen REAL-Wert in einen TEXT und umge- +kehrt sind relativ unkritisch: + + TEXT PROC text (INT CONST value) + TEXT PROC text (REAL CONST value) + INT PROC int (TEXT CONST number) + REAL PROC real (TEXT CONST number) + +Aber bei der folgenden Prozedur 'int' gehen im allgemeinen Fall Informationen +verloren (es wird abgeschnitten): + + INT PROC int (REAL CONST value) + REAL PROC real (INT CONST value) + +Zusätzlich steht eine Informationsprozedur 'last conversion ok' zur Ver- +fügung, die den Wert TRUE liefert, falls die letzte Konversion fehlerfrei +war: + + BOOL PROC last conversion ok + +Solche Abfragen sind notwendig, weil die Konversionsroutinen bei falschen +Parameterwerten (z.B. 'int (maxreal)') nicht mit einer Fehlermeldung ab- +brechen. Als Beispiel zeigen wir ein Programm zum Einlesen von Werten, von +denen man nicht weiß, ob sie INT oder REAL sind. Darum kann auch nicht die +'get'-Prozedur für INT oder REAL verwandt werden: + + +Programm 18: + + TEXT VAR eingabe element; + REP + get (eingabe element); + wert nach intwert oder realwert bringen; + berechnung + UNTIL ende ENDREP. + + wert nach intwert oder realwert bringen: + IF pos (eingabe element, ".") > 0 + THEN REAL VAR realwert :: real (eingabe element) + ELSE INT VAR intwert :: int (eingabe element) + END IF; + IF NOT last conversion ok + THEN put ("Fehler bei Konvertierung:" + eingabe element); + line + END IF. + + berechnung: + ... + + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6b b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6b new file mode 100644 index 0000000..7fdaf39 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil6b @@ -0,0 +1,1425 @@ + EUMEL-Benutzerhandbuch + + + TEIL 6: Erste Hilfe in ELAN + +Prozeduren + +Prozeduren werden verwendet, wenn + +- Anweisungen und Datenobjekte unter einem Namen zusammengefaßt werden + sollen ("Abstraktion"). + +- gleiche Anweisungen von mehreren Stellen eines Programms verwandt werden + sollen (Codereduktion) u.U. mit verschieden Datenobjekten (Parameter); + +- wenn Datenobjekte nur kurzfristig benötigt werden (dynamische Speicherver- + waltung) und diese nicht von dem gesamten Programm angesprochen werden + sollen (lokale, globale Datenobjekte); + +Im folgenden Programm stellen wir ein Fragment vor, in dem zwei Werte ver- +tauscht werden. In der einen (linken) Lösung wird ein Refinement, in der +anderen eine Prozedur verwandt. + +Programm 19: + + ... PROC vertausche a und b: + IF a > b INT CONST x :: a; + THEN vertausche a und b a := b; + END IF; b := x + ... END PROC vertausche a und b; + vertausche a und b; ... + ... IF a > b + THEN vertausche a und b + vertausche a und b: END IF; + INT CONST x :: a; ... + a := b; vertausche a und b; + b := x. ... + +Beim ersten Hinsehen leisten beide Programme das Gleiche. Es gibt jedoch +drei wichtige Unterschiede: + +1) Das Refinement 'vertausche a und b' wird zweimal (vom ELAN-Compiler) + eingesetzt, d.h. der Code ist zweimal vorhanden. Die Prozedur dagegen ist + vom Code nur einmal vorhanden, wird aber zweimal - durch das Aufführen + des Prozedurnamens - aufgerufen. + +2) Die Variable 'x' ist in der linken Programmversion während des gesamten + Ablauf des Programms vorhanden. Solche Datenobjekte nennt man statische + Datenobjekte oder auch (aus Gründen, die erst etwas später offensichtlich + werden) Paket-Objekte. Das Datenobjekt 'x' der rechten Version dagegen + ist nur während der Bearbeitung der Prozedur vorhanden. Solche Daten- + objekte, die nur kurzfristig Speicher belegen, werden dynamische Daten- + objekte genannt. + + Prozeduren sind also ein Mittel, um die Speicherbelegung zu beeinflussen, + was besonders bei großen Datenobjekten notwendig ist. + +3) 'x' kann in der linken Programmversion - obwohl sie in einem Refinement + deklariert wurde - von jeder Stelle des Programms angesprochen werden. + Solche Datenobjekte werden globale Datenobjekte genannt. Das Datenobjekt + 'x' der Prozedur dagegen kann nur innerhalb der Prozedur angesprochen + werden, sie ist also ein lokales Datenobjekt hinsichtlich der Prozedur. + Innerhalb der Prozedur dürfen globale Datenobjekte (also Objekte, die + außerhalb von Prozeduren deklariert wurden) angesprochen werden. + + Eine Prozedur in ELAN bildet im Gegensatz zu Refinements einen eigenen + Gültigkeitsbereich hinsichtlich Datenobjekten und Refinements, die inner- + halb der Prozedur deklariert werden. Prozeduren sind somit ein Mittel, um + die in ihr deklarierten Datenobjekte hinsichtlich der Ansprechbarkeit + nach Außen "abzuschotten". + +Prozeduren wie die in Programm 19 werden mit dem Schlüsselwort PROC, dem +Namen der Prozedur und einem Doppelpunkt eingeleitet. Dies nennt man den +Prozedurkopf. Der Prozedurkopf entspricht den Definitionen, die wir bereits +in vorigen Abschnitten dieses Skripts gegeben haben. Nach dem Prozedurkopf +folgt der Prozedurrumpf, der Datenobjekt-Deklarationen, Anweisungen und +Refinements enthalten kann. Abgeschlossen wird die Prozedur durch END PROC +und dem Prozedurnamen. + + +Aufgabe (HSG): + + a) Erkläre den Unterschied zwischen einer Prozedur und einem Refinement. + b) Was sind globale bzw. lokale Datenobjekte? +Übungsziel: Begriffe, die mit Prozeduren zusammenhängen + + +Aufgabe (TSW): + + Gegeben sei folgendes Programmfragment: + INT VAR a, b; + ... (*1*) + PROC x: + INT VAR x1; + ... (*2*) + END PROC x; + TEXT VAR t; + PROC y: + REAL VAR y1 + ... (*3*) + END PROC y; + ... (*4*) + + 1.) Welche Objekte (einschließlich Prozeduren) sind an den Punkten + (*1*) : + (*2*) : + (*3*) : + (*4*) : + ansprechbar? + + 2.) Welche Datenobjekte sind in der Prozedur 'y' + global: + lokal: +Übungsziel: Globale und lokale Objekte + + +Prozeduren mit Parametern erlauben es, gleiche Anweisungen mit unterschied- +lichen Datenobjekten auszuführen: + + +Programm 20: + + PROC vertausche (INT VAR a, b): + INT VAR x :: a; + a := b; + b := x + END PROC vertausche; + + INT VAR eins :: 1, + zwei :: 2, + drei :: 3; + vertausche (eins, zwei); + vertausche (zwei, drei); + vertausche (eins, zwei); + put (eins); put (zwei); put (drei) + +Die Datenobjekte 'a' und 'b' der Prozedur 'vertausche' werden formale Para- +meter genannt. Sie stehen als Platzhalter für die bei einem Prozeduraufruf +einzusetzenden aktuellen Parameter (in unserem Beispiel die Datenobjekte +'eins', 'zwei' und 'drei'). + + +Aufgabe (HSG): + + Welche Werte werden in dem Programm 20 ausgedruckt? +Übungsziel: Arbeiten mit Prozeduren und Parameter-Mechanismus. + + +Parameter werden im Prozedurkopf nach dem Prozedurnamen in Klammern mit +Datentyp und Accessrecht angegeben. Dabei bedeutet CONST, daß auf den +Parameter nur lesend zugegriffen wird, während auf einen VAR-Parameter auch +z.B. eine Zuweisung angewandt werden kann. CONST-Parameter sind also +Eingabe-Parameter, während VAR-Parameter Ein-/Ausgabe-Parameter realisieren. + +Bei den aktuellen Parametern ist folgendes zu beachten: + +a) Wird ein VAR-Parameter in der Definition der Prozedur vorgeschrieben (wie + z.B. im Programm 20), darf kein Ausdruck als aktueller Parameter "überge- + ben" werden, weil an einen Ausdruck nichts zugewiesen werden kann. + Gegenbeispiel: + + vertausche ( eins * zwei, drei) + + Ausdrücke haben - wie bereits erwähnt - das Accessrecht CONST. + +b) Wird ein CONST-Parameter verlangt, dann darf in diesem Fall ein Ausdruck + als aktueller Parameter geschrieben werden. Aber auch ein VAR-Datenobjekt + darf angegeben werden. In diesem Fall wird eine Wandlung des Accessrechts + (CONSTing) vorgenommen: der aktuelle Parameter erhält sozusagen für die + Zeit der Abarbeitung der Prozedur das Accessrecht CONST. + +Es ist auch möglich, Prozeduren als Parameter zu definieren, worauf wir aber +hier nicht eingehen wollen. + +Eine Werte liefernde Prozedur erhält man, wenn der Prozedurrumpf einen Wert +liefert, d.h. die letzte ausführbare Anweisung des Prozedurrumpfes muß einen +Wert liefern (analog Werte liefernde Refinements) und der zu liefernde +Datentyp vor den Prozedurkopf geschrieben wird. + + +Programm 21: + + INT PROC max (INT CONST a, b): + IF a > b + THEN a + ELSE b + END IF + END PROC max; + + put (max (3, 4)) + +(In unserem Beispiel liefert die IF-Anweisung einen Wert. Das erfolgt da- +durch, daß beide Zweige der Anweisung einen Wert liefern.) + + + +Neudefinierte Operatoren + +Neue, zusätzliche Operatoren können in ELAN wie Prozeduren definiert werden. +Es ist nur notwendig, bei der Definition das Wort PROC gegen OP zu vertau- +schen. Es sind aber auch nur 1 oder 2 Parameter bei Operatoren erlaubt. + + +Programm 22a: + + TEXT OP * (INT CONST mal, TEXT CONST t): + INT VAR zaehler :: mal; + TEXT VAR ergebnis :: ""; + WHILE zaehler > 0 REP + ergebnis := ergebnis + t; + zaehler := zaehler - 1 + END REP; + ergebnis + END OP *; + +Dieser Operator vervielfältigt TEXTe ( 2 * "ha" liefert "haha"). Der Name +des Operators ist '*'. Man kann als Operatornamen die vorhandenen, bereits +benutzten Sonderzeichen verwenden. In diesem Fall bekommt der neudefinierte +Operator die gleiche Priorität wie der bereits vorhandene oder ein Schlüssel- +wort. + +Der "Aufruf" eines Operators unterscheidet sich von einer Prozedur durch die +infix-Schreibweise. Im übrigen gilt das für Prozeduren Gesagte. + + + +Optimierungen + +Optimierungen werden vorgenommen, wenn man mit den Laufzeiten bzw. Speicher- +bedarf eines Programms nicht zufrieden ist. Kleinere, lokale Optimierungen +sind meist nicht sinnvoll und notwendig und bringen mehr Fehler, als Ver- +besserungen: + + +Programm 22b: + + TEXT OP * (INT CONST mal, TEXT CONST t): + INT VAR i; + TEXT VAR ergebnis :: ""; + FOR i FROM 1 UPTO mal REP + ergebnis CAT t + END REP; + ergebnis + END OP *; + +Wir haben hier die WHILE-Schleife durch eine Zählschleife und 'ergebnis := +ergebnis + t' durch 'ergebnis CAT t' ersetzt. Dies ist nur eine minimale +Optimierung (wenn sie überhaupt etwas einbringt). Leider sind solche +"Optimierungen" sehr häufig anzutreffen. Besser ist es, eine Lösung zu +finden, die algorithmisch oder von den Datenstrukturen her prinzipiell +besser ist. Wir haben dies für das Programm 22 getan. Lösungsidee: jeweilige +Verdopplung eines Zwischentextes ("Russische Multiplikation"). + + +Programm 22c: + + TEXT OP * (INT CONST mal, TEXT CONST t): + INT VAR zaehler :: mal; + TEXT VAR einer :: "", + dopplung :: t; + IF fehlerhafter aufruf + THEN LEAVE * WITH "" + ELSE verdopplung + END IF; + dopplung + einer. + + fehlerhafter aufruf: + zaehler < 1. + + verdopplung: + WHILE zaehler > 1 REP + IF zaehler ist ungerade + THEN einer CAT t + END IF; + dopplung CAT dopplung; + zaehler := zaehler DIV 2 + END REP. + + zaehler ist ungerade: + zaehler MOD 2 = 1. + + END OP *; + + +In diesem Programm wurde eine Anweisung verwendet (LEAVE), die wir im +folgenden Abschnitt erklären wollen. + + + +Das LEAVE-Konstrukt + +Das LEAVE-Konstrukt wird verwendet, um eine benannte Anweisung (Refinement, +Prozedur oder Operator) vorzeitig zu verlassen. Es ist auch möglich, mehr- +fach geschachtelte Refinements zu verlassen. Durch eine (optionale) +WITH-Angabe kann auch ein wertelieferndes Refinement verlassen werden. + + + +Reihungen + +Wir haben bis jetzt bereits zusammengesetzte algorithmische Objekte kennen- +gelernt, die man unter einem Namen als Ganzes ansprechen kann (Prozeduren). +Die gleiche Möglichkeit gibt es auch bei Datenobjekten, wobei wir gleich- +artige oder ungleichartige Objekte zu einem Objekt zusammenfassen können. +Zuerst zu der Zusammenfassung gleichartiger Datenobjekte, die in ELAN eine +Reihung (ROW) genannt wird. Die einzelnen Objekte einer Reihung werden +Elemente genannt. Beispiel (Deklaration einer Reihung von 10 INT-Elementen): + + ROW 10 INT VAR feld + +Die Angabe hinter dem Schlüsselwort ROW muß ein INT-Denoter sein (oder +durch ein LET definierter Name). Dabei ist ROW 10 INT ein (neuer, von den +elementaren unterschiedlicher) Datentyp, für den keine Operationen definiert +sind, außer der Zuweisung. Das Accessrecht (VAR in unserem Beispiel) und der +Name ('feld') gilt - wie bei den elementaren Datentypen - für diesen neuen +Datentyp, also für alle 10 Elemente. + +Warum gibt es keine Operationen außer der Zuweisung? Das wird uns sehr +schnell einsichtig, wenn wir uns vorstellen, daß es ja sehr viele Datentypen +(zusätzlich zu den elementaren) gibt, weil Reihungen von jedem Datentyp +gebildet werden können: + + ROW 1 INT ROW 1 REAL + ROW 2 INT ROW 2 REAL + : : + ROW maxint INT ROW maxint REAL + + ROW 1 TEXT ROW 1 BOOL + ROW 2 TEXT ROW 2 BOOL + : : + ROW maxint TEXT ROW maxint BOOL + +Für die elementaren INT-, REAL-, BOOL- und TEXT-Datentypen sind +unterschiedliche Operationen definiert. Man müßte nun für jeden dieser +zusammengesetzten Datentypen z.B. auch 'get'- und 'put'-Prozeduren +schreiben, was allein vom Schreibaufwand sehr aufwendig wäre. Das ist der +Grund dafür, daß es keine vorgegebene Operationen auf zusammengesetzte +Datentypen gibt. + +Zugegebenermaßen könnte man mit solchen Datentypen, die nur über eine Opera- +tion verfügen (Zuweisung), nicht sehr viel anfangen, wenn es nicht eine wei- +tere vorgegebene Operation gäbe, die #ib#Subskription#ie#. Sie erlaubt es, +auf die Elemente einer Reihung zuzugreifen und den Datentyp der Elemente +"aufzudecken". Beispiel: + + feld [3] + +bezieht sich auf das dritte Element der Reihung 'feld' und hat den Datentyp +INT. Für INT-Objekte haben wir aber einige Operationen, mit denen wir +arbeiten können. Beispiele: + + feld [3] := 7; + feld [4] := feld [3] + 4; + ... + +Eine Subskription "schält" also vom Datentyp ein ROW ab und liefert ein +Element der Reihung. Die Angabe der Nummer des Elements in der Reihung nennt +man Subskript (in unserem Fall '3'). Der Subskript wird in ELAN in eckigen +Klammern angegeben, um eine bessere Unterscheidung zu den runden Klammern in +Ausdrücken zu erreichen. Ein subskribiertes ROW-Datenobjekt kann also über- +all da verwendet werden, wo ein entsprechender Datentyp benötigt wird (Aus- +nahme: Schleifenvariable). Als Beispiel zeigen wir zwei Prozeduren, die eine +Reihung einlesen bzw. ausgeben: + + +Programm 23: + + PROC get (ROW 10 INT VAR feld): + INT VAR i; + FOR i FROM 1 UPTO 10 REP + put (i); put ("tes Element bitte:"); + get (feld [i]); + line + END REP + END PROC get; + + PROC put (ROW 10 INT CONST feld): + INT VAR i; + FOR i FROM 1 UPTO 10 REP + put (i); put ("tes Element ist:"); + put (feld [i]); + line + END REP + END PROC put + + +Wie bereits erwähnt, ist es erlaubt, Reihungen überall dort zu verwenden, wo +auch die elementaren Datentypen verwandt werden können, also auch als +Parameter. Zudem haben wir die generischen Eigenschaften von Prozeduren in +ELAN bei der Benennung der Prozeduren benutzt. + +Diese beiden Prozeduren benutzen wir gleich im nächsten Programm, welches +10 Werte einliest und die Summe berechnet: + + +Programm 24: + + ROW 10 INT VAR werte; + lies werte ein; + summiere sie; + drucke die summe und einzelwerte. + + lies werte ein: + get (werte). + + summiere sie: + INT VAR summe :: 0, i; + FOR i FROM 1 UPTO 10 REP + summe INCR werte [i] + END REP. + + drucke die summe und einzelwerte: + put (werte); + line; + put ("Summe:"); put (summe). + + +Aufgabe (HSG): + + Wie kann man vermeiden, daß 'summe > maxint' ("overflow"-Bedingung) + wird? + + +Oft benötigt man die Werte einer Reihung sortiert. Das Programm 25 zeigt +einen (sehr dummen und ineffizienten) Sortieralgorithmus: + + +Programm 25: + + ROW 10 INT VAR wert; + lies die werte ein; + sortiere in eine zweite liste; + drucke die zweite liste. + + lies die werte ein: + get (wert). + + sortiere in eine zweite liste: + INT VAR i; + FOR i FROM 1 UPTO 10 REP + suche kleinstes element aus der werte liste; + bringe dieses in die zweite liste; + entferne es aus der werte liste + END REP. + + suche kleinstes element aus der werte liste: + INT VAR kleinstes element :: maxint, position kleinstes element :: 0, k; + FOR k FROM 1 UPTO 10 REP + IF wert [k] < kleinstes element + THEN kleinstes element := wert [k]; + position kleinstes element := k + END IF + END REP. + + bringe dieses in die zweite liste: + ROW 10 INT VAR liste2; + liste2 [i] := kleinstes element. + + entferne es aus der werte liste: + wert [position kleinstes element] := maxint. + + drucke die zweite liste: + put (liste2). + +Anmerkung: Bei diesem einfachen Sortieralgorithmus (der übrigens "lineare +Auswahl" heißt), wurde der Wert 'maxint' als zulässiger Wert ausgeschlossen. +Der Algorithmus ist ziemlich der schlechteste, den wir uns ausdenken können. +Einmal braucht er den doppelten Speicherplatz für die zu sortierende Liste, +andererseits sind für N Werte N*N Durchläufe durch die Liste notwendig (man +sagt, der Algorithmus ist von der Ordnung N Quadrat). + +Da es möglich ist, von jedem Datentyp eine Reihung zu bilden, kann man +natürlich auch von einer Reihung eine Reihung bilden: + + ROW 5 ROW 10 INT VAR matrix + +Für eine "doppelte" Reihung gilt das für "einfache" Reihungen gesagte. +Wiederum existieren keine Operationen für dieses Datenobjekt (außer der +Zuweisung), jedoch ist es durch Subskription möglich, auf die Elemente zuzu- +greifen: + + matrix [3] + +liefert ein Datenobjekt mit dem Datentyp ROW 10 INT, für den wir bereits in +Programm 23 die Prozeduren 'get' und 'put' geschrieben haben, die wir +verwenden können: + + get (matrix [4]) + +Subskribieren wir jedoch 'matrix' nochmals, so erhalten wir ein INT: + + matrix [2] [8] + +(jede Subskription "schält" von Außen ein ROW vom Datentyp ab). + + +Aufgabe (HSG): + + a) Geben Sie Datentyp, Accessrecht und Name der folgenden Datenobjekte + an: + ROW 17 INT CONST alpha; + ROW 3 ROW 4 TEXT VAR matrix; + ... + beta [3] := 7; + gamma [4] := gamma [5] + + b) Was führt zu Fehlern? Wenn ja, warum? + ROW 17 INT VAR alpha; + ROW 3 ROW 4 TEXT VAR beta, gamma; + ROW 4 ROW 3 TEXT CONST delta; + INT VAR x :: 7; + ROW x BOOL VAR y; + get (alpha); + get (beta [7]); + FOR x FROM 1 UPTO 3 REP + get (beta [x]) + END REP; + beta := delta; + delta [1] [2] := "mist"; + beta := gamma; + beta [3] := gamma [3]; + get (beta [1] [1]); + gamma [1] [5] := beta [1] [1] + "ELAN" + x := alpha [3]; + x := 20; + alpha [x] := alpha [3] + 7 +Übungsziel: Umgang mit Reihungen + + + +Strukturen + +Strukturen sind Datenverbunde wie Reihungen, aber die Komponenten können +ungleichartige Datentypen haben. Die Komponenten von Strukturen heißen +Felder (bei Reihungen: Elemente) und der Zugriff auf ein Feld Selektion +(Reihungen: Subskription). Eine Struktur ist - genauso wie bei Reihungen - +ein eigener Datentyp, der in einer Deklaration angegeben werden muß. +Beispiel: + + STRUCT (TEXT name, INT alter) VAR ich + +Wiederum existieren keine Operationen auf Strukturen außer der Zuweisung und +der Selektion, die es erlaubt, Komponenten aus einer Struktur herauszulösen: + + ich . name + ich . alter + +Die erste Selektion liefert einen TEXT-, die zweite ein INT-Datenobjekt. Mit +diesen (selektierten) Datenobjekten kann - wie gewohnt - gearbeitet werden +(Ausnahme: nicht als Schleifenvariable). + +Zum Datentyp einer Struktur gehören auch die Feldnamen: + + STRUCT (TEXT produkt name, INT artikel nr) VAR erzeugnis + +ist ein anderer Datentyp als im ersten Beispiel dieses Abschnitts. Für +Strukturen - genauso wie bei Reihungen - kann man sich neue Operationen +definieren. Im folgenden Programm definieren wir für eine Struktur, die +Personen beschreibt, die Operationen 'put', 'get' und den dyadischen +Operator HEIRATET. Anschließend werden drei Paare verHEIRATET. + + +Programm 26a: + + PROC get (STRUCT (TEXT name, vorname, INT alter) VAR p): + put ("bitte Nachname:"); get ( p.name); + put ("bitte Vorname:"); get ( p.vorname); + put ("bitte Alter:"); get ( p.alter); + line + END PROC get; + + PROC put (STRUCT (TEXT name, vorname, INT alter) CONST p): + put (p.vorname); put (p.name); + put ("ist"); + put (p.alter); + put ("Jahre alt"); + line + END PROC put; + + OP HEIRATET + (STRUCT (TEXT name, vorname, INT alter) VAR w, + STRUCT (TEXT name, vorname, INT alter) CONST m): + w.name := m.name + END OP HEIRATET; + + ROW 3 STRUCT (TEXT name, vorname, INT alter) VAR frau, mann; + + personendaten einlesen; + heiraten lassen; + paardaten ausgeben. + + personendaten einlesen: + INT VAR i; + FOR i FROM 1 UPTO 3 REP + get (frau [i]); + get (mann [i]) + END REP. + + heiraten lassen: + FOR i FROM 1 UPTO 3 REP + frau [i] HEIRATET mann [i] + END REP. + + paardaten ausgeben: + FOR i FROM 1 UPTO 3 REP + put (frau [i]); + put ("hat geheiratet:"); line; + put (mann [i]); line + END REP. + +Reihungen und Strukturen dürfen miteinander kombiniert werden, d.h. es darf +eine Reihung in einer Struktur erscheinen oder es darf eine Reihung von einer +Struktur vorgenommen werden. Selektion und Subskription sind in diesen Fällen +in der Reihenfolge vorzunehmen, wie die Datentypen aufgebaut wurden (von +außen nach innen). + + +Aufgabe (HSG): + + In ELAN heissen + a1) Datenverbunde gleichartiger Komponenten: + a2) Datenverbunde ungleichartiger Komponenten: + b1) die Komponenten eines ROWs: + b2) die Komponenten eines STRUCTs: + c1) die Zugriffe auf die Komponenten eines ROWs: + c2) die Zugriffe auf die Komponenten eines STRUCTs: +Übungsziel: Begriffe von ROWs und STRUCTs kennenlernen + + + +LET-Konstrukt + +Wie wir in Programm 26 gesehen haben, ist die Verwendung von Strukturen +oder auch Reihungen manchmal schreibaufwendig. Mit dem LET-Konstrukt darf +man Datentypen (und Denotern) einen Namen geben. Dieser Name steht als +Abkürzung und verringert so die Schreibarbeit. Zusätzlich wird durch die +Namensgebung die Lesbarkeit des Programms erhöht. Beispiel: + + +Programm 26b: + + LET PERSON = STRUCT (TEXT name, vorname, INT alter); + + PROC get (PERSON VAR p): + put ("bitte Nachname:"); get ( p.name); + put ("bitte Vorname:"); get ( p.vorname); + put ("bitte Alter:"); get ( p.alter); + line + END PROC get; + + PROC put (PERSON CONST p): + put (p.vorname); put (p.name); put ("ist"); + put (p.alter); put ("Jahre alt"); line + END PROC put; + + OP HEIRATET (PERSON VAR f, PERSON CONST m): + f.name := m.name + END OP HEIRATET; + + ROW 3 PERSON VAR mann, frau; + ... + +Überall wo der abzukürzende Datentyp verwandt werden kann, kann PERSON +benutzt werden. Wohlgemerkt: PERSON ist kein neuer Datentyp, sondern nur ein +Name, der für STRUCT (....) steht. Der Zugriff auf die Komponenten des +abgekürzten Datentyps bleibt erhalten (was bei abstrakten Datentypen, die wir +etwas später erklären, nicht mehr der Fall ist). + +Neben der Funktion der Abkürzung von Datentypen kann das LET-Konstrukt +auch für die Namensgebung für die Denoter verwandt werden. Beispiele: + + LET pi = 3.14159; + LET blank = " "; + LET anzahl = 27 + +Der Einsatz von LET-Namen für INT-Denoter macht es möglich, Programme +leicht zu ändern: + + +Programm 26c: + + LET anzahl paare = 3; + ROW anzahl paare PERSON VAR frau, mann; + + personendaten einlesen; + heiraten lassen; + paardaten ausgeben. + + personendaten einlesen: + INT VAR i; + FOR i FROM 1 UPTO anzahl paare REP + get (frau [i]); + get (mann [i]) + END REP. + ... + +Ebenso wie die Abkürzung von Datentypen (LET PERSON = STRUCT (...)) wird +im obigen Beispiel für den Namen 'anzahl paare' bei jedem Auftreten der +Denoter '3' vom ELAN-Compiler eingesetzt. Um nun (z.B.) 27 Paare "heiraten" +zu lassen, brauchen wir nur die LET-Anweisung in '27' zu verändern... +(Scheidungen erfordern etwas mehr Aufwand). + + +Aufgabe (HSG): + + Was ist falsch? + LET anz = 5, + max = 5*5, + MAT = ROW anz ROW anz TEXT; + + PROC get (MAT CONST m): + FOR i FROM 1 UPTO max REP + get (m [i]) + END REP + END PROC get; + + MAT VAR x,y; + get (x); + x := y + 1 + + +Aufgabe (HSG): + + Schreibe ein Programm, das mit den Deklarationen + LET anz = 5, + VEC = ROW anz INT, + MAT = ROW anz VEC; + folgende Prozeduren realisiert: + PROC get (VEC VAR v) + PROC get (MAT VAR m) + PROC put (VEC CONST v) + PROC put (MAT CONST m) + INT PROC reihensumme (VEC CONST v) +Übungsziel: Reihungen als Parameter + + + +Denoter für Datenverbunde: Konstruktoren + +Denoter für die elementaren Datentypen haben wir kennengelernt. Oft ergibt +sich auch die Notwendigkeit (z.B. bei Initialisierungen), Datenverbunde in +einem Programm Werte zu geben. Das kann durch normale Zuweisungen erfolgen. +Beispiel: + + LET PERSON = STRUCT (TEXT name, vorname, INT alter); + + PERSON VAR mann; + + mann.name := "meier"; + mann.vorname := "egon"; + mann.alter := 27 + +Aber man möchte auch Denoter für Datenverbunde z.B. in Ausdrücken verwenden, +was durch die Konstruktoren ermöglicht wird. Beispiel: + + LET PERSON = STRUCT (TEXT name, vorname, INT alter); + + PERSON VAR mann, frau; + + frau := PERSON : ( "niemeyer", "einfalt", 65); + frau HEIRATET PERSON : ( "meier", "egon", 27) + +Ein Konstruktor ist also ein Mechanismus, um ein Datenobjekt eines Datenver- +bundes in einem Programm zu notieren. Ein Konstruktor besteht aus der Angabe +des Datentyps (der auch durch einen LET-Namen abgekürzt sein darf), einem +Doppelpunkt und den in Klammern eingefaßten Komponenten (hier Denoter). +Besteht eine der Komponenten wiederum aus einem Datenverbund, muß inner- +halb des Konstruktors wiederum ein Konstruktor eingesetzt werden usw. Kon- +struktoren sind natürlich für Reihungen auch möglich: + + ROW 7 INT VAR feld; + feld := ROW 7 INT : ( 1, 2, 3, 4, 5, 6, 7); + + +Aufgabe (HSG): + + Geben Sie Datentyp, Accessrecht und Name der folgenden Datenobjekte an: + STRUCT (INT alter, TEXT name) VAR mensch; + STRUCT (INT jahrgang, ROW 2 TEXT lage) CONST wein; + ROW 100 STRUCT (PERSON p, NUMMER n) VAR betriebsangehoeriger; + STRUCT (INT anz terminals, STRUCT (TEXT systemname, INT version) art) + CONST betriebsystem; + mensch := ...; + betriebsangehoeriger [2] := ...; + betriebsangehoeriger [2]. n := NUMMER: (...); + betriebsystem.art.systemname := "EUMEL"; + wein.lage := ROW 2 TEXT: ("Loire", "Frankreich"); + wein.lage [1] := "Kroever Nacktarsch"; +Übungsziel: Umgang mit Strukturen. + + + +Rekursive Prozeduren und Operatoren + +Alle Prozeduren und Operatoren dürfen in ELAN rekursiv sein. + + +Programm 27: + + INT PROC fakultaet (INT CONST n): + IF n > 0 + THEN fakultaet (n-1) * n + ELSE 1 + END IF + END PROC fakultaet + +Dieses Beispiel ist aber (leider) kein gutes Beispiel für eine Rekursion, +denn das Programm kann leicht in eine iterative Version umgewandelt werden: + + +Programm 28: + + INT PROC fakultaet (INT CONST n): + INT VAR prod :: 1, i; + FOR i FROM 2 UPTO n REP + prod := prod * i + END REP; + prod + END PROC fakultaet + +Die Umwandlung von einem rekursiven Programm in ein iteratives ist übrigens +immer möglich, jedoch oft nicht so einfach wie in diesem Fall. Beispiel +(Ackermann-Funktion): + + +Programm 29: + + INT PROC acker (INT CONST m, n): + IF m = 0 + THEN n + 1 + ELIF n = 0 + THEN acker (m-1, 0) + ELSE acker (m - 1, acker (m, n - 1)) + ENDIF + END PROC acker + + +Aufgabe (HSG): + + a) Beschreibe die Unterschiede zwischen Iteration und Rekursion. Worauf + muß man bei Rekursionen achten? + b) Wie groß ist der Wert von 'acker (2, 2)'? Hilfreicher Tip: stelle + dabei eine Tabelle auf! + c) Zudem enthält die Programmierung der Ackermann-Funktion (mindestens) + einen Fehler. Welchen? +Übungsziel: Umgang mit Rekursion + + +Das eigentliche Einsatzgebiet von rekursiven Algorithmen liegt aber bei den +'backtrack'-Verfahren. Diese werden eingesetzt, wenn eine exakte algorithmi- +sche Lösung nicht bekannt ist oder nicht gefunden werden kann und man ver- +schiedene Versuche machen muß, um zu einem Ziel (oder Lösung) zu gelangen. + +Als Beispielprogramm zeigen wir das Spiel "Maus sucht Käse". In einem Laby- +rinth (realisiert durch eine Reihung von einer Reihung), das mit Hindernis- +sen bestückt ist, wurde ein Käse versteckt. Eine sehr dumme Maus sucht +systematisch die umliegenden Felder (in allen vier Himmelsrichtungen) nach +dem Käse ab. Ist sie auf einem neuen Feld und ist das Feld frei, sucht sie +erneut. Felder, auf denen sie bereits war, werden von ihr markiert. Da die +Maus sehr kurzsichtig ist und nicht richtig riechen kann, bemerkt sie den +Käse erst, wenn sie sozusagen mit allen vier Pfoten in ihm gelandet ist +(analog bei Hindernissen, die nicht überklettert werden können). Damit die +Maus nicht aus dem Labyrinth entfliehen kann, wird der Rand als Hindernis +angesehen. + + +(Teil-) Programm 30: + + PROC suche weg (INT CONST x, y): + IF labyrinth [x] [y] = kaese + THEN kaese gefunden + ELIF labyrinth [x] [y] = frei + THEN suche weiter + END IF. + + suche weiter: + labyrinth [x] [y] := markiert; + INT VAR richtung; + FOR richtung FROM osten UPTO sueden REP + versuche diese richtung + END REP; + labyrinth [x] [y] := frei. + + versuche diese richtung: + IF richtung = osten + THEN suche weg (x + 1, y) + ELIF richtung = norden + THEN suche weg (x, y + 1) + ... + + + +Dateien + +Dateien werden benötigt, wenn + +- Daten über die Abarbeitungszeit eines Programms aufbewahrt werden sollen; +- der Zeitpunkt oder Ort der Datenerfassung nicht mit dem Zeitpunkt oder Ort + der Datenverarbeitung übereinstimmt; +- die gesamte Datenmenge nicht auf einmal in den Zentralspeicher eines + Rechners paßt; +- die Anzahl und/oder Art der Daten nicht von vornherein bekannt sind. + +Eine Datei ("file") ist eine Zusammenfassung von Daten, die auf Massenspei- +chern aufbewahrt wird. Dateien sind in bestimmten Informationsmengen, den +Sätzen ("records") organisiert. + +In ELAN gibt es zwei Arten von Dateien: + +a) FILE: sequentielle Dateien. Die Sätze können nur sequentiell gelesen bzw. + geschrieben werden. Eine Positionierung ist nur zum nächsten Satz möglich. +b) DIRFILE: indexsequentielle Dateien. Die Positionierung erfolgt direkt mit + Hilfe eines Schlüssels ("key") oder Index, kann aber auch sequentiell + vorgenommen werden. + + Wichtig: + DIRFILEs sind auf dem EUMEL-System nicht implementiert! Deswegen wird + auf diesen Dateityp hier nicht weiter eingegangen. + +Dateien werden normalerweise von dem #ib#Betriebsystem#ie# eines Rechners +aufbewahrt und verwaltet. Somit ist eine Verbindung von einem ELAN-Programm, +in dem eine Datei unter einem Namen - wie jedes andere Datenobjekt auch - +angesprochen werden soll, und dem Betriebsystem notwendig. Dies erfolgt durch +sogenannte Assoziierungsprozeduren. Beispiele: + + FILE VAR meine datei :: sequential file (output, "xyz"); + FILE CONST eine andere datei :: sequential file (input, "abc") + +Die Assoziierungsprozedur heißt 'sequential file' für FILEs. Der erste +Parameter einer Assoziierungsprozedur gibt immer die sogenannte Betriebs- +richtung ("TRANSPUTDIRECTION") an. Es gibt folgende Betriebsrichtungen: + + input nur Lesen der Datei + output nur Schreiben der Datei + + Anmerkung: + Im EUMEL-System gibt es noch die Betriebsrichtung 'modify', die es er- + laubt, beliebig zu positionieren, Sätze zu löschen und/oder einzufügen + usw. Dafür gibt es keine DIRFILEs. Siehe dazu auch das Kapitel über + Dateien in diesem Benutzerhandbuch. + +Der zweite Parameter einer Assoziierungsprozedur gibt an, unter welchem +Namen die Datei in dem Betriebsystem bekannt ist. Mit Hilfe dieses Namens +wird die Datei an das Datenobjekt gekoppelt, das bei der FILE-Deklaration im +Programm erzeugt wurde. + +Welche Operationen sind nun für Dateien zugelassen? Wir beschreiben die +wichtigsten für die beiden Dateiarten und Betriebsrichtungen getrennt: + +a) FILE mit 'input' (nur lesen): + + PROC getline (FILE CONST f, TEXT VAR zeile) + PROC get (FILE CONST f, TEXT VAR t) + PROC get (FILE CONST f, REAL VAR r) + PROC get (FILE CONST f, INT VAR i) + BOOL PROC eof (FILE CONST f) + (* Abfrageprozedur auf das Ende eines FILEs (letzter Satz) *) + + Als Beispiel zeigen wir ein Programm, welches eine Datei liest und auf + dem Ausgabemedium ausgibt. + + + Programm 31: + + FILE CONST f :: sequential file (input, "datei1"); + TEXT VAR satz; + WHILE NOT eof (f) REP + getline (f, satz); + put (satz); line + END REP. + +b) FILE mit 'output' (nur schreiben): + + PROC putline (FILE VAR f, TEXT CONST zeile) + PROC put (FILE VAR f, TEXT CONST t) + PROC put (FILE VAR f, REAL CONST r) + PROC put (FILE VAR f, INT CONST i) + PROC line (FILE VAR f, INT CONST zeilenzahl) + + +Aufgabe (HSG): + + a) Das Arbeiten mit Dateien ist manchmal notwendig, weil ... + b) Wenn man mit Dateien in ELAN arbeitet, sind Assoziierungsprozeduren + notwendig. + b1) Wie heißen diese? + b2) Was gibt man in diesen an? + c) Welche Betriebsrichtungen gibt es bei FILES und was bewirken sie? +Übungsziel: Datei-Begriffe + + +Aufgabe (TSW): + + Welche Fehler befinden sich in den folgenden Programmfragmenten? + a) FILE VAR f :: sequential file (input, "MIST"); + TEXT VAR zeile; + REP + getline (f, zeile); + ... + UNTIL eof (f) END REP + + b) FILE VAR f :: sequential file (output, "NOCHMAL"); + TEXT VAR zeile; + REP + getline (f, zeile); + put (zeile) + UNTIL eof (f) END REP + + c) FILE VAR f :: sequential file (input, "VERDAMMT"), + g :: sequential file (input, "DAEMLICH"); + TEXT VAR zeile; + kopiere g in f. + + kopiere g in f: + FOR i FROM 1 UPTO 100 REP + getline (g, zeile); + putline (f, zeile) + UNTIL eof (g) END REP. +Übungsziel: Arbeiten mit Dateien + + + +Programmstruktur 1 + +Bis jetzt haben wir noch nicht vollständig erklärt, wie ein ELAN-Programm +formal als Ganzes aufgebaut sein muß, d.h. wie und in welcher Reihenfolge +die Anweisungen, Refinements, Prozeduren und Deklarationen geschrieben +werden müssen. + +Ein ELAN-Programm kann aus mehreren Moduln (Bausteinen) aufgebaut sein, +die in ELAN PACKETs genannt werden. Das letzte PACKET wird "main packet" +genannt, weil in diesem das eigentliche Benutzerprogramm (Hauptprogramm) +enthalten ist. In diesem Abschnitt wollen wir uns nur mit dem Aufbau eines +solchen PACKETs beschäftigen. Wir werden dabei nicht alle Möglichkeiten +besprechen, sondern nur die wichtigsten Anwendungen beschreiben, mit einer +Empfehlung, in welcher Reihenfolge die Elemente geschrieben werden sollten. + +Ein "main packet" kann aus folgenden Elementen bestehen: + +a) Deklarationen und Anweisungen. Diese müssen nicht in einer bestimmten + Reihenfolge im Programm erscheinen, sondern es ist möglich, erst in dem + Augenblick zu deklarieren, wenn z.B. eine neue Variable benötigt wird. Es + ist jedoch gute Programmierpraxis, die meisten Deklarationen an den + Anfang eines Programms (außer z.B. Datenobjekte, die nur lokal oder + kurzfristig benötigt werden, wie Hilfsvariablen oder Laufvariablen) zu + plazieren. + + ; + + +b) Deklarationen, Refinements und Anweisungen. In diesem Fall ist es notwen- + dig, die Refinements hintereinander zu plazieren. Refinement-Aufrufe + und/oder Anweisungen sollten textuell vorher erscheinen. Die Refinements + werden durch einen Punkt von den Aufrufen getrennt: + + ; + . + + + Innerhalb der Refinements sind Anweisungen und/oder Deklarationen möglich. + +c) Deklarationen, Prozeduren und Anweisungen. Werden Prozeduren vereinbart, + sollte man sie nach den Deklarationen plazieren. Danach sollten die + Anweisungen folgen: + + ; + ; + + + Mehrere (parallele) Prozeduren werden durch ";" voneinander getrennt. In + diesem Fall sind die Datenobjekte aus den Deklarationen außerhalb von + Prozeduren statisch, d.h. während der gesamten Laufzeit des Programm + vorhanden. Solche Datenobjekte werden auch PACKET-Daten genannt.Im + Gegensatz dazu sind die Datenobjekte aus Deklarationen in Prozeduren + dynamische Datenobjekte, die nur während der Bearbeitungszeit der + Prozedur existieren. Innerhalb einer Prozedur dürfen wiederum Refinements + verwendet werden. Ein Prozedur-Rumpf hat also den formalen Aufbau wie + unter a) oder b) geschildert. + + Die Refinements und Datenobjekte, die innerhalb einer Prozedur deklariert + wurden, sind lokal zu dieser Prozedur, d.h. können von außerhalb nicht + angesprochen werden. + +d) Deklarationen, Prozeduren, Anweisungen und PACKET-Refinements. + Zusätzlich zu der Möglichkeit c) ist es erlaubt, neben den Anweisungen + außerhalb einer Prozedur auch Refinements zu verwenden: + + ; + ; + . + + + Diese Refinements können nun in Anweisungen außerhalb der Prozeduren + benutzt werden oder auch durch die Prozeduren (im letzteren Fall spricht + man analog zu globalen PACKET-Daten auch von PACKET-Refinements oder + globalen Refinements). In PACKET-Refinements dürfen natürlich keine + Datenobjekte verwandt werden, die lokal zu einer Prozedur sind. + + + +Moduln (PACKETs) + +PACKETs sind in ELAN eine Zusammenfassung von Datenobjekten, Prozeduren/ +Operatoren und Datentypen. Man kann sich ein PACKET als ein 'main packet' +mit Zusätzen vorstellen. PACKETs können separat übersetzt werden, so +daß der "Zusammenbau" eines umfangreichen Programms aus mehreren PACKETs +möglich ist. + +Elemente eines PACKETs (Prozeduren/Operatoren, Datentypen) können außerhalb +des PACKETs nur angesprochen werden, wenn sie in der Schnittstelle des +PACKETs, die auch "interface" genannt wird, aufgeführt wird. Mit anderen +Worten: es können alle Elemente eines PACKETs von außen nicht angesprochen +werden, sofern sie nicht über die Schnittstelle "nach außen gereicht" wird. +Damit wird gewährleistet, daß mehrere Programmierer an einem gemeinsamen +Projekt arbeiten können und daß eine gemeinsame Benutzung (oder Störung) von +Programmteilen nur über die in den Schnittstellen von PACKETs aufgeführten +Objekte erfolgen kann. + +Im Gegensatz zu einer Prozedur kann ein PACKET nicht aufgerufen werden (nur +die Elemente der Schnittstelle können benutzt werden). Beispiel: + + +Programm 32: + + PACKET fuer eine prozedur DEFINES swap: + + PROC swap (INT VAR a, b): + INT CONST x :: a; + b := a; + a := x + END PROC swap + + END PACKET fuer eine prozedur + +Dies ist ein PACKET, das eine Tausch-Prozedur für INT-Datenobjekte bereit- +stellt. Das PACKET kann übersetzt werden und dem ELAN-Compiler bekannt +gemacht werden (EUMEL: "insertieren"). Ist das geschehen, kann man 'swap' +wie alle anderen Prozeduren (z.B. 'put', 'get') in einem Programm verwenden. +Tatsächlich werden die meisten Prozeduren und Operatoren (aber auch einige +Datentypen), die in ELAN zur Verfügung stehen, nicht durch den ELAN-Compiler +realisiert, sondern durch solche PACKETs. Um solche Objekte einigermaßen +zu standardisieren, wurde in der ELAN-Sprachbeschreibung festgelegt, welche +Datentypen, Prozeduren und Operatoren in jedem ELAN-System vorhanden +sein müssen. Solche PACKETs werden Standard-Pakete genannt. Jeder Installa- +tion - aber auch jedem Benutzer - steht es jedoch frei, zu den Standard- +Paketen zusätzliche PACKETs mit in den Compiler aufzunehmen und damit den +ELAN-Sprachumfang zu erweitern. + +Ein ELAN-PACKET beginnt mit dem PACKET-Schlüsselwort. Danach folgt der Name +des PACKETs (der am Ende des PACKETs hinter END PACKET wieder erscheinen +muß), gefolgt von der DEFINES-Liste. In dieser Schnittstelle werden die Ob- +jekte angegeben, die nachfolgenden PACKETs zur Verfügung gestellt werden +sollen. + +In der Schnittstelle werden Prozeduren/Operatoren nur mit ihrem Namen ange- +geben. Weiterhin können Datentypen und mit CONST vereinbarte Datenobjekte +in der Schnittstelle aufgeführt werden, aber keine VAR-Datenobjekte, weil +diese sonst über PACKET-Grenzen hinweg verändert werden könnten. + +Im obigen Programm 32 haben wir ein PACKET in der Funktion als spracher- +weiterndes Instrument gezeigt. Im folgenden Beispiel zeigen wir ein Programm, +in dem das PACKET-Konzept verwandt wird, um Datenobjekte vor unbefugten +Zugriff zu schützen. + + +Programm 33: + + PACKET stack handling DEFINES push, pop, init stack: + + LET max = 1000; + ROW max INT VAR stack; + INT VAR stack pointer; + + PROC init stack: + stack pointer := 0 + END PROC init stack; + + PROC push (INT CONST dazu wert): + stack pointer INCR 1; + IF stack pointer > max + THEN errorstop ("stack overflow") + ELSE stack [stack pointer] := dazu wert + END IF + END PROC push; + + PROC pop (INT VAR von wert): + IF stack pointer = 0 + THEN errorstop ("stack empty") + ELSE von wert := stack [stack pointer]; + stack pointer DECR 1 + END IF + END PROC pop + + END PACKET stack handling; + +Nun kann man den Stack über die Prozeduren 'init stack', 'push' und 'pop' +benutzen (in einem 'main packet'). + + +Programm 34: + + init stack; + werte einlesen und pushen; + werte poppen und ausgeben. + + werte einlesen und pushen: + INT VAR anzahl :: 0, wert; + REP + get (wert); + push (wert); + anzahl INCR 1 + UNTIL ende kriterium END REP. + + werte poppen und ausgeben: + INT VAR i; + FOR i FROM 1 UPTO anzahl REP + pop (wert); + put (wert) + END REP. + +Die Datenobjekte 'stack' und 'stack pointer' haben nur Gültigkeit innerhalb +des PACKETs 'stack handling'. Anweisungen wie z.B. + + put (stack [3]); + stack [27] := 5 + +außerhalb des PACKETs 'stack handling' sind also verboten und werden vom +ELAN-Compiler entdeckt. + +Ein PACKET bietet also auch einen gewissen Schutz vor fehlerhafter Verwen- +dung von Programmen und Datenobjekten. Wichtig ist weiterhin, daß die Reali- +sierung des Stacks ohne weiteres geändert werden kann, ohne daß Benutzer- +programme im 'main packet' geändert werden müssen, sofern die Schnittstelle +nicht verändert wird. Beispielsweise kann man sich entschließen, den Stack +nicht durch eine Reihung, sondern durch eine gekettete Liste zu realisieren. +Davon bleibt ein Benutzerprogramm unberührt. + +Die letzte Funktion von PACKETs ist die Realisierung von abstrakten Daten- +typen. Dazu müssen wir uns aber zuvor die Möglichkeiten anschauen, neue +Datentypen zu definieren. + + + +Die Definition neuer Datentypen + +Im Gegensatz zur LET-Vereinbarung, bei der lediglich ein neuer Name für +einen bereits vorhandenen Datentyp eingeführt wurde und bei der somit auch +keine neuen Operationen definiert werden müssen (weil die Operationen für +den abzukürzenden Datentyp verwandt werden können), wird durch eine TYPE- +Vereinbarung ein gänzlich neuer Datentyp eingeführt. Im Gegensatz zu +Strukturen und Reihungen stehen für solche Datentypen noch nicht einmal die +Zuweisung zur Verfügung. Beispiel: + + TYPE PERSON = STRUCT (TEXT name, vorname, INT alter) + +Ein solcher Datentyp kann wie auch alle anderen Datentypen verwandt werden +(Deklarationen, Parameter, Werte liefernde Prozeduren, als Komponenten in +Reihungen und Strukturen usw.). + +Der neudefinierte Datentyp wird abstrakter Datentyp genannt. Er kann mit +Hilfe eines PACKETs (vergl. nächsten Abschnitt) anderen Programmteilen zur +Verfügung gestellt werden. Die rechte Seite der TYPE-Vereinbarung wird +"konkreter Typ", "Realisierung des Datentyps" oder Feinstruktur genannt. + +Um neue Operatoren und/oder Prozeduren für einen abstrakten Datentyp zu +schreiben, ist es möglich, auf die Komponenten des Datentyps (also auf die +Feinstruktur) mit Hilfe des Konkretisierers zuzugreifen. Der Konkretisierer +arbeitet ähnlich wie die Subskription oder Selektion: er ermöglicht eine +typmäßige Umbetrachtung vom abstrakten Typ zum Datentyp der Feinstruktur. +Beispiel: + + TYPE MONAT = INT; + + PROC put (MONAT CONST m): + put ( CONCR (m)) + END PROC put; + +Der Konkretisierer ist bei Feinstrukturen notwendig, die von elementarem +Datentyp sind. Besteht dagegen die Feinstruktur aus Reihungen oder Struk- +turen, dann wird durch eine Selektion oder Subskription eine implizite Kon- +kretisierung vorgenommen. Beispiel: + + TYPE LISTE = ROW 100 INT; + + LISTE VAR personal nummer; + ... + personal nummer [3] := ... + (* das gleiche wie *) + CONCR (personal nummer) [3] := ... + +Denoter für neudefinierte Datentypen werden mit Hilfe des Konstruktors +gebildet: + + TYPE GEHALT = INT; + + GEHALT VAR meins :: GEHALT : (1 000 000); + +Besteht die Feinstruktur aus einem Datenverbund, muß der Konstruktor u.U. +mehrfach geschachtelt angewandt werden: + + TYPE KOMPLEX = ROW 2 REAL; + + KOMPLEX CONST x :: KOMPLEX : ( ROW 2 REAL : ( 1.0, 2.0)); + + + +Abstrakte Datentypen + +Auf die Feinstruktur über den Konkretisierer eines neudefinierten Datentyps +darf nur in dem PACKET zugegriffen werden, in dem der Datentyp definiert +wurde. Der Konstruktor kann ebenfalls nur in dem typdefinierenden PACKET +verwandt werden. + +Wird der Datentyp über die Schnittstelle des PACKETs anderen Programmteilen +zur Benutzung zur Verfügung gestellt, so müssen Operatoren und/oder Proze- +duren für den Datentyp ebenfalls "herausgereicht" werden. Da dann der neude- +finierte Datentyp genauso wie alle anderen Datentypen verwandt werden kann, +aber die Komponenten nicht zugänglich sind, spricht man von abstrakten +Datentypen. + +Welche Operationen sollten für einen abstrakten Datentyp zur Verfügung +stehen? Obwohl das vom Einzelfall abhängt, werden meistens folgende +Operationen und Prozeduren definiert: + +- 'get'- und 'put'-Prozeduren. +- Zuweisung (auch für die Initialisierung notwendig). +- Denotierungs-Prozedur (weil kein Konstruktor für den abstrakten Datentyp + außerhalb des definierenden PACKETs zur Verfügung steht) + + +Programm 35: + + PACKET widerstaende DEFINES WIDERSTAND, REIHE, PARALLEL, :=, get, put: + + TYPE WIDERSTAND = INT; + + OP := (WIDERSTAND VAR l, WIDERSTAND CONST r): + CONCR (l) := CONCR (r) + END OP :=; + + PROC get (WIDERSTAND VAR w): + INT VAR i; + get (i); + w := WIDERSTAND : (i) + END PROC get; + + PROC put (WIDERSTAND CONST w): + put (CONCR (w)) + END PROC put; + + WIDERSTAND OP REIHE (WIDERSTAND CONST l, r): + WIDERSTAND : ( CONCR (l) + CONCR (r)) + END OP REIHE; + + WIDERSTAND OP PARALLEL (WIDERSTAND CONST l, r): + WIDERSTAND : + ((CONCR (l) * CONCR (r)) DIV (CONCR (l) + CONCR (r))) + END OP PARALLEL + + END PACKET widerstaende + +Dieses Programm realisiert den Datentyp WIDERSTAND und mit den Operationen +eine Fachsprache, mit dem man nun leicht WIDERSTANDs-Netzwerke berechnen +kann, wie z.B. folgendes: + + + +--- R4 ---+ + | | + +--- R1 ---+ +--- R5 ---+ + | | | | + ---+ +--- R3 ---+ +--- + | | | | + +--- R2 ---+ +--- R6 ---+ + | | + +--- R7 ---+ + +Zur Berechnung des Gesamtwiderstandes kann nun folgendes Programm +geschrieben werden: + + ROW 7 WIDERSTAND VAR r; + widerstaende einlesen; + gesamtwiderstand berechnen; + ergebnis ausgeben. + + widerstaende einlesen: + INT VAR i; + FOR i FROM 1 UPTO 7 REP + put ("bitte widerstand R"); put (i); put (":"); + get (r [i]); + END REP. + + gesamtwiderstand berechnen: + WIDERSTAND CONST rgesamt :: (r [1] PARALLEL r [2]) REIHE + r [3] REIHE (r [4] PARALLEL r [5] PARALLEL r [6] + PARALLEL r [7]). + + ergebnis ausgeben: + line; + put (rgesamt). + + +Aufgabe (HSG): + + Was ist ein Modul? Was ist ein Interface? Was ist der Unterschied + zwischen einem PACKET und einer Prozedur? + Die Realisierung von WIDERSTAND durch INTs ist nicht in allen Fällen + befriedigend. Warum? (Beachte besonders die Realisierung des OP + PARALLEL). + Wenn man bei der Typ-Vereinbarung von WIDERSTAND INT gegen REAL + austauschen würde, wo müßte man noch Änderungen vornehmen? Sind + insbesondere Änderungen im Benutzer-Programm (hier im 'main packet') + notwendig? +Übungsziel: PACKET-Begriff + + + +Programmstruktur 2 + +Nun können wir auch erklären, wie ein ELAN-Programm mit mehreren PACKETs +aussieht. Ein Programm besteht aus einer Folge von PACKETs, dem ein 'main +packet' folgt. Es ist auch möglich, PACKETs vorübersetzen zu lassen, so daß +es für einen Nutzer so aussieht, als ob er nur ein 'main packet' übersetzen +läßt. Tatsächlich sind zumindest die Standard-Packets vorübersetzt vorhanden. + + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil7 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil7 new file mode 100644 index 0000000..1aadc5f --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil7 @@ -0,0 +1,2469 @@ + EUMEL-Benutzerhandbuch + + TEIL 7: Dateien, Datei-Verwaltung und Datenräume + +1. Übersicht + +Dateien dienen zur Aufnahme von Informationen, die auch über die Bearbei- +tungszeit eines Programms erhalten bleiben (können). Dateien werden als +Objekte in einer Task gehalten. Sie bleiben solange erhalten, bis sie expli- +zit gelöscht ('forget'-Kommando) oder die Task beendet wird ('end'-Kommando). + +Dateien kann man an andere Tasks schicken ('save'-Kommando) oder von anderen +Tasks holen ('fetch'-Kommando). Mit diesen (hier vorgestellten) Kommandos +ist der Transport von Dateien jedoch nur in direkter Linie des Task-Baums +möglich, also an einen "Vater" oder einen "Sohn". Damit ist automatisch eine +Datei-Hierarchie im EUMEL-System realisiert. + +Alle Datei-Arten des EUMEL-Systems basieren auf Datenräumen. Ein Datenraum +ist ein Speicherplatz, der 1 MByte Daten speichern kann und vom EUMEL-System +verwaltet wird. Datenräume können gelöscht, kopiert usw. werden. Mit Hilfe +Mit Hilfe von Datenräumen werden alle Datei-Arten des EUMEL-Systems reali- +siert, indem einem Datenraum eine Struktur (Datentyp) aufgeprägt wird. Da- +durch wird es Benutzern des EUMEL-Systems ermöglicht, auf einfache Weise +neben den bereits vorhandenen Datei-Arten (FILEs für die Speicherung von +Texten, PICFILEs für die Speicherung von Bildinformationen, u.a.m.) +spezielle Dateien zu konstruieren. + +Die wichtigste Datei-Art, mit der ein Benutzer in Berührung kommt, ist die +sequentielle Datei, genannt FILE. Ein FILE kann nur TEXTe aufnehmen und hat +z.Zt. ein Fassungsvermögen von 4000 Zeilen (Sätze). Insgesamt darf ein FILE +1 MByte aufnehmen. Eine Datei-Zeile (Satz) kann bis zu 32 000 Zeichen auf- +nehmen. + +FILEs können in einer von drei Betriebsrichtungen bearbeitet werden: +- "input": nur Lesen. +- "output": nur Schreiben. +- "modify": Lesen/Schreiben und zusätzlich beliebiges Positionieren, Ein- + fügen und Löschen von Sätzen. + +'input'-Dateien sind also Eingabedateien, 'output'- sind Ausgabedateien und +'modify'-Dateien kann man verändern. Insbesondere die 'modify'-Dateien eig- +nen sich, um andere Datei-Arten leicht zu realisieren (z.B. indexsequentiel- +le Dateien). + +Eine Datei kann auf einen bestimmten Zeilenbereich eingeschränkt werden. Ein +solches Segment kann selbst wie eine Datei von einem Programm behandelt +werden. + + + +2. Datei-Kommandos + +Dateien werden in der Regel in einer Benutzer-Task gehalten. Die Kommandos +für die Behandlung von Dateien in einer Benutzer-Task werden hier vorge- +stellt. Dann wird erklärt, wie Dateien zu einer übergeordneten Task ge- +schickt oder geholt werden können. + + + +Datei-Kommandos für Benutzer-Tasks + +Im Monitor-Dialog kann man Dateien kopieren, löschen und einen anderen Namen +geben. + +Mit dem Kommando + + edit ("dateiname") + +wird eine Text-Datei im Monitor-Dialog (implizit) eingerichtet, wenn es sich +um einen noch nicht vorhandenen 'dateiname' handelt (vergl. auch die Editor- +Beschreibung). + +Welche Dateien in der Benutzer-Task vorhanden sind, kann mit dem Kommando + + list + +erfragt werden. 'list' zeigt auf dem Bildschirm die Dateinamen der Benutzer- +Task. Vor jedem Namen steht ein Datum, welches anzeigt, an welchem Tag die +Datei zuletzt von einem Programm bearbeitet wurde. Ein 'a' hinter dem Datum +kennzeichnet Dateien, die nach einer Archivierung nicht bearbeitet wurden. + +Ein Duplizieren einer Datei kann mit + + copy ("alte datei", "neue datei") + +erreicht werden, wobei eine Kopie von 'alter datei' angelegt wird, die den +Namen 'neue datei' erhält. Man beachte, daß es sich um eine logische (und +vorerst um keine physikalische) Kopie handelt. Erst bei Schreibzugriffen +werden Seiten " entshared" ("copy-on-write"). Ein Umbenennen einer Datei +kann mit + + rename ("alter datei name", "neuer datei name") + +erfolgen. Mit + + forget ("dateiname") + +kann eine Datei gelöscht werden. + +Wurde in einer Datei editiert, kann durch Löschen oder Einfügen von Zeilen +der interne Verwaltungsaufwand hoch werden, so daß Positionierungen nicht +mehr effizient vor sich gehen. Mit dem Kommando + + reorganize ("dateiname") + +wird die Datei so organisiert, als wenn sie neu erstellt wäre (gilt nur für +Text-Dateien). Sie braucht dann in der Regel auch etwas weniger Speicher- +platz. + + +Merke: Das Kommando 'rename' gibt einer Datei einen anderen Namen, 'copy' +dupliziert eine Datei. Mit 'list' kann man sich anzeigen lassen, welche +Dateien in der Task vorhanden sind. + + + +Datei-Kommandos für Vater-Tasks + +Man kann Dateien von einer Vater-Task holen oder an eine Vater-Task schicken, +um sie dort längerfristig zu speichern. Auch wenn die Benutzer-Task gelöscht +wird, bleiben alle Dateien, die bei einer Vater-Task gespeichert (also +"gerettet") sind, erhalten. Andere Sohn-Tasks können sich Dateien bei einer +Vater-Task abholen. + +Auf Dateien einer Benutzer-Task können andere Nutzer aus anderen Tasks in +der Regel nicht zugreifen. Manchmal ist es jedoch notwendig, daß mehrere +Nutzer Dateien gemeinsam benutzen oder eine Datei eine Task "überleben" soll. +In solchen Fällen muß man Dateien bei einem Vater aufbewahren. + +Mit der Prozedur + + global manager + +kann die Benutzer-Task zu einem Datei-Manager gemacht werden. Erst nach +Aufruf dieser Prozedur können Söhne dieser Task eingerichtet werden. + +Von einer Benutzer-Task kann eine Datei mit + + save ("Buch 1") + +der direkten Vater-Task übergeben werden, wobei 'buch 1' in der Benutzer- +Task erhalten bleibt. 'save' wirkt also wie ein Transport einer Kopie der +angegebenen Datei in die Vater-Task. Achtung: ist eine Datei 'Buch 1' in der +Vater-Task bereits vorhanden, wird diese ohne Warnung überschrieben. + +Analog zu der 'forget'-Prozedur für Dateien einer Benutzer-Task können +Dateien einer unmittelbaren Vater-Task mit + + erase ("datei name") + +gelöscht werden. Soll eine Datei von einer Vater-Task in eine Benutzer-Task +geholt werden, so benutzt man die Prozedur + + fetch ("datei") + +Nach Aufruf dieser Prozedur wird eine Kopie der angegebenen Datei in der +Benutzer-Task angelegt. Ist bereits eine Datei 'datei' in der Benutzer-Task +vorhanden, so erfolgt eine Fehlermeldung. + +Mit 'save', 'fetch' und 'erase' ist es möglich, daß zwei oder mehr Benutzer +eine Datei alternierend bearbeiten. In diesem Fall müssen sich die Benutzer +als Söhne einer gemeinsamen Vater-Task einrichten und die Datei mit 'fetch' +jeweils in die Benutzer-Task holen. Um zu verhindern, daß ein anderer Be- +nutzer zur gleichen Zeit mit der Datei arbeitet, wird sie jeweils mit 'erase' +bei der Vater-Task gelöscht. Nach Beendigung der Arbeiten muß die Datei dann +wieder mit 'save' in die Vater-Task transportiert werden. Dann steht sie +wieder anderen Benutzern zur Verarbeitung zur Verfügung. Beispiel: + + fetch ("datei"); erase ("datei"); (* Datei vom Vater holen und dort + loeschen *) + edit ("datei"); (* Datei bearbeiten *) + save ("datei"); (* Datei zur Vater-Task bringen *) + forget ("datei") (* Datei in Benutzer-Task + loeschen *) + +Mit den Prozeduren + + save all + fetch all + +kann man alle Dateien einer Benutzer-Task in die direkte Vater-Task schicken +oder von dort holen. + +Merke: + * * * * * * * * * * + * * + * <-+ * Vater-Task + * | | * + * * * | * * | * * * + | | + fetch save + | | + * * * | * * | * * * + * | | * + * ->edit| * Benutzer-Task + * * + * * * * * * * * * * + + + +Ansprechen von anderen Tasks + +Sollen Dateien in andere als die direkte Vater-Task transportiert oder von +anderen Tasks geholt werden, muß man den internen Task-Bezeichner angeben. + +Es gibt einige Prozeduren, mit denen man den internen Task-Bezeichner einer +Task bekommt. Solch eine Prozedur ist + + father + +Prozeduren, mit denen man Dateien transportieren kann, liegen auch in einer +Version vor, bei denen man den internen Task-Bezeichner angeben kann. +Beispiel: + + save ("datei", father) (* wie: save ("datei") *) + erase ("datei", father) (* wie: erase ("datei") *) + fetch ("datei", father) (* wie: fetch ("datei") *) + +Weitere Prozeduren, die einen internen Task-Bezeichner liefern, sind: + + myself + printer + public + archive + +Anmerkung: Zur Prozedur 'archive' siehe auch das nächste Kapitel; zu 'print' +siehe auch SPOOLER. Dadurch kann man Dateien auch zu anderen als der +Vater-Task transportieren, holen oder löschen. Beispiele: + + erase ("datei", public) (* Loescht 'datei' in Task 'PUBLIC' *) + fetch ("datei", public) (* Holt 'datei' aus der Task "PUBLIC" *) + save ("datei", public) (* Kopiert 'datei' in die Task 'PUBLIC' *) + save ("datei", printer) (* Uebergibt 'datei' dem Spooler und + druckt die Datei *) + list (father) (* Listet Dateien der Vater-Task *) + +Bei komplizierten "Verwandschafts-Verhältnisse" von Tasks ist es einfacher, +eine Task mit Hilfe des Task-Namens anzusprechen. Das erfolgt mit Hilfe der +Prozedur 'task'. Beispiel: + + save ("datei", task ("hugo")) + +'task' liefert den internen Task-Bezeichner von 'hugo'. Die Umkehr-Prozedur +zu 'task' ist 'name': + + put (name (myself)) + +schreibt den Namen der Task, in der man sich gerade befindet, auf den Bild- +schirm. + +Durch die Prozedur 'father', die einen internen Task-Bezeichner als +Parameter erwartet, kann man an die Vater-Task einer Task gelangen. +Beispiel: + + save ("datei", father (father)) + +Hier wird die Datei 'datei' an die Vater-Task der Vater-Task geschickt (also +zur "Großvater-Task"). + +Mit dem Operator / + +kann man aus einem Tasknamen den internen Tasknamen erhalten. '/' kann über- +all dort eingesetzt werden, wo ein interner Taskname verlangt wird. Beispiel: + + task status (/"meine task") + + +Merke: Mit den internen Task-Bezeichner kann man mit anderen Tasks als der +Vater-Task kommunizieren. + + + +Kommandos für mehrere Dateien + +Durch die vom EUMEL-System bereitgestellten Task-Variablen und Datei-Ver- +zeichnisse (Thesaurus, Plural: Thesauren) ist es möglich, mehrere Dateien +mit einem Kommando zu behandeln. + +Sollen alle Dateien einer Task zu einer anderen transportiert werden (mit +'save') oder alle Dateien geholt werden, kann man 'save all' und 'fetch all' +auch mit einem internen Task-Bezeichner versehen. Beispiele: + + save all (public) + fetch all (public) + +Damit werden alle Dateien der Benutzer-Task zu der Task 'PUBLIC' geschickt +oder von dort geholt. + +Die internen Tasknamen wie z.B. 'myself', 'father', 'public' usw. werden +auch bei dem Einsatz eines Thesaurus benutzt. Was ist ein "Thesaurus"? + +Das EUMEL-System hält sich die Dateinamen einer Task des Taskbaums in einer +internen Liste. Die Namens-Liste wird Thesaurus (laut Duden: ein +"systematisch geordnetes Verzeichnis") genannt. + +Der Operator ALL liefert den Thesaurus einer Task. Beispiel: + + ALL father + ALL myself + +liefert jeweils den Thesaurus der Vater- oder der eigenen Task. Solche +Thesauren kann man als Parameter der meisten der oben erwähnten Kommandos +verwenden: + + save (ALL myself) (* kopiert alle Dateien in die Vater-Task; + arbeitet wie 'save all' *) + forget (ALL myself) (* loescht alle Dateien der Benutzer-Task *) + fetch (ALL father) (* holt alle Dateien der Vater-Task; + arbeitet wie 'fetch all' *) + +Der Operator SOME dagegen bietet einen Thesaurus vorher zum Editieren an, +um Dateinamen zu streichen (HOP RUBOUT). Beispiele: + + fetch (SOME father) (* holt die nicht gestrichenen Dateien *) + save (SOME myself) (* kopiert die nicht gestrichenen Dateien *) + forget (SOME myself) (* loescht die nicht gestrichenen Dateien *) + +Es ist auch möglich, aus den Thesauren mehrerer Tasks einen neuen Thesaurus +zu bilden: + + - (* Differenzmenge *) + / (* Schnittmenge *) + + (* Vereinigungsmenge *) + +Beispiel: + + fetch (ALL father - ALL myself) + +holt alle Dateien der Vater-Task, die nicht bereits in der Benutzer-Task +sind. + + +Merke: Mit den Operatoren 'ALL' und 'SOME' kann man mehrere Dateien mit +einem Kommando behandeln. + + + +Datei-Schutz durch Paßworte und Verschlüsselung + +Dateien können vor unbefugtem Zugriff mit Hilfe von Paßworten und/oder der +Verschlüsselung der Informationen geschützt werden. + + + +Paßworte + +Paßworte für Dateien dienen zur Verhinderung von unbefugtem Zugriff auf +Dateien, die bei einer Vater-Task gespeichert werden. (Die Dateien der +Benutzer-Task können durch ein Task-Paßwort geschützt werden). Dabei sollte +man bedenken, daß Paßworte bekannt werden können. + +Der Paßwort-Schutz ist im EUMEL-System etwas sicherer als in anderen +Betriebssystemen, weil Paßworte nur selten angegeben werden müssen und +daher nicht so leicht bekannt werden können (z.B. durch "über die Schulter +schauen"). Die Kommandozeile wird zudem bei der Angabe eines Paßworts nach +dem Betätigen der RETURN-Taste gelöscht. + +Paßworte werden nur im Verkehr mit Vater-Tasks eingesetzt. Lokale Benutzer- +Dateien brauchen nicht gesondert gesichert zu werden, da man ein Paßwort +auf die Benutzer-Task legen kann oder die zu sichernden Dateien aus dem +System nehmen kann. Ein Paßwort kann mit der Prozedur + + enter password ("schreibpasswort / lesepasswort") + +angegeben oder ein bereits eingestelltes Paßwort kann mit dieser Prozedur +überschrieben werden. Voreingestellt ist kein Paßwort. Nachdem ein Benutzer +die 'enter password'-Prozedur angegeben hat, wird jeder Datei-Verkehr mit +einer Vater-Task mit Hilfe dieses Paßworts überprüft. Unzulässige Zugriffe +durch Benutzer anderer Tasks auf Dateien einer Vater-Task werden abgewiesen. + +Ein Paßwort hat eine eigene Syntax. Es besteht aus zwei Teilen, die leer +sein können und die durch ein "/"-Zeichen voneinander getrennt sind. Der +erste Teil ist das Schreib-Paßwort, der zweite das Lese-Paßwort. Wird kein +Lese-Paßwort angegeben, gilt das Schreib-Paßwort auch für das Lesen. Ist +also kein "/"-Zeichen im Paßwort-String vorhanden, so wird das Schreib- +Paßwort sozusagen gedoppelt. Beispiele: + + enter password ("") (* kein Paßwort *) + enter password ("hugo") (* 'hugo' gilt fuer das Schreiben und + Lesen *) + enter password ("egon/meier") (* 'egon' fuers Schreiben, 'meier' fuers + Lesen *) + +Zusätzlich kann das "-"-Zeichen in dem Teil des Paßworts angegeben werden, +für den ein Zugriff nicht erlaubt sein soll. Beispiel: + + enter password ("-/nurlesen") (* Schreibzugriff nicht erlaubt, + Lese-Passwort ist 'nurlesen' *) + +Das Lese-Paßwort gilt für die Prozedur + + fetch + +während das Schreib-Paßwort für die Prozeduren + + save + erase + +gilt. Sofern die betreffende Datei durch ein Paßwort geschützt ist, ist +folgendes zu beachten: + +a) fetch: + Will ein Benutzer mit der Prozedur 'fetch' eine Datei in seine Benutzer- + Task holen, so wird sein aktuell eingestelltes Paßwort (nur Lese-Teil) + und das Paßwort der Datei überprüft. Stimmen diese nicht überein, so wird + der 'fetch'-Zugriff auf eine Datei der Vater-Task abgewiesen. + +b) save: + Bei einem Transport in eine Vater-Task mit Hilfe der Prozedur 'save' sind + zwei Fälle zu unterscheiden: + + - Datei ist in der Vater-Task noch nicht vorhanden: Diese Datei wird + in der Vater-Task mit dem aktuellen Paßwort des Benutzers einge- + tragen. + + - Datei ist in der Vater-Task bereits vorhanden und soll durch die + neue Datei ersetzt werden: Es wird überprüft, ob das aktuelle + Schreib-Paßwort des Benutzers mit dem der gleichnamigen Datei in der + Vater-Task übereinstimmt. Ist dies nicht der Fall, wird die Datei + nicht in der Vater-Task eingetragen. + +c) erase: + Soll eine Datei der Vater-Task gelöscht werden, wird überprüft, ob das + aktuelle Schreib-Paßwort mit dem der zu löschenden Datei in der Vater- + Task übereinstimmt. Ist dies nicht der Fall, wird die Lösch-Operation + abgewiesen. + + +Merke: Dateien können bei der Sicherung in einer Vater-Task vor unbefugtem +Zugriff durch Paßworte geschützt werden. + + + +Dateien verschlüsseln + +Zusätzlich zu einem Paßwort kann man eine Datei vor unbefugtem Zugriff +schützen, indem sie verschlüsselt wird. + +Mit den Prozeduren + + crypt + decrypt + +kann eine Datei ver- oder entschlüsselt werden (Datenschutz für einzelne +Dateien). Dabei ist es möglich, eine Datei mehrfach zu verschlüsseln (man +muß die Verschlüsselung dann allerdings auch mehrfach rückgängig machen). +Beispiel: + + crypt ("datei", "schluessel") + +verschlüsselt 'datei' mit 'schluessel'. Die Entschlüsselung erfolgt, indem +man die Prozedur 'decrypt' auf 'datei' anwendet und den gleichen Schlüssel +zur Entschlüsselung benutzt. Beispiel: + + decrypt ("datei", "schluessel") + +Den Text des Schlüssels (hier: 'schluessel') sollte man sich also unbedingt +merken, sonst kann die Datei nicht mehr entschluesselt werden. + +Merke: Dateien werden durch 'crypt' und 'decrypt' ver- und entschlüsselt. + + + +3. Das Archiv + +Dateien werden im EUMEL-System auf Systemträgern gespeichert. Mit dem Archiv +können Dateien vom System auf externe Speichermedien (normalerweise +Disketten) gebracht und von diesen ins System geholt werden. + +Das EUMEL-Archiv hat folgende Aufgaben: + +a) Das Archiv wird als Sicherheitsbereich benutzt, indem man von wichtigen + Dateien Kopien anlegt und diese außerhalb des EUMEL-Systems speichert. + +b) Man kann das Archiv-System aber auch benutzen, um Dateien, die nur selten + oder in größeren Zeitabständen benötigt werden, zu kopieren ("archi- + vieren") und im EUMEL-System zu löschen. Falls diese Dateien wieder + gebraucht werden, können sie wieder in das EUMEL-System geholt werden. + Damit wird erreicht, daß im EUMEL-System nur die wirklich notwendigen + Dateien stehen. + +c) Sollen Dateien von einer EUMEL-Installation auf eine andere übertragen + werden, so kann man ebenfalls Archive verwenden. + +d) Bei Versionswechsel des EUMEL-Systems sind Archive die einzige Möglich- + keit, Dateien in die neue Systemversion einzuspielen. Dabei wird garan- + tiert, daß zumindest Archive der letzten Version gelesen werden können. + +Merke: Durch das Archiv können Dateien außerhalb des Systems gesichert +werden. + + + +Das Archiv reservieren + +Soll archiviert werden, muß man das dem Archiv-System mitteilen, damit nicht +ein anderer Benutzer zur gleichen Zeit auf das Archiv zugreift. Dieser +Vorgang wird "reservieren" genannt. + +Archiv-Disketten haben aus Sicherheitsgründen einen Namen. Dieser Name muß +bei der Anmeldung einer Archivierung angegeben werden. Die Anmeldung einer +Archivierung und gleichzeitige Reservierung erfolgt mit + + archive ("name") + +Der Archiv-Name wird bei folgenden Archiv-Operationen zur Überprüfung mit +dem eingelegten Archiv verwandt. + +Wichtig: Eine Diskette sollte erst nach dem 'archive'-Kommando in das +Laufwerk geschoben werden, d.h. erst dann, wenn das Archiv-System reserviert +ist. Sonst kann es geschehen, daß ein anderer Benutzer auf dieser Diskette +archiviert. + +Archivierungen erfolgen durch die schon beschriebenen Transportkommandos +'save' und 'fetch'. Dabei wird als Zieltask 'archive' angegeben. Beispiel: + + save ("mein buch", archive) + fetch ("kapitel 1", archive) + save all (archive) + fetch all (archive) + +Das Archiv bleibt für den Nutzer solange reserviert, wie er Archivierungs- +operationen vollzieht. Dann sollte er das Archiv wieder für andere Benutzer +mit der Prozedur + + release (archive) + +freigeben. + +Leitet ein Nutzer innerhalb von fünf Minuten nach der letzten Archiv- +Operation keine neue ein und meldet sich ein anderer Nutzer mit 'archive' +bei dem Archiv-System an, so wird dem ersten Nutzer die Archiv-Berechtigung +entzogen, um Blockaden zu verhindern. Wenn der erste Nutzer eine erneute +Archiv-Operation versucht, erhält er eine Fehlermeldung. Dadurch kann ein +Nutzer das Archiv längere Zeit (ohne 'release') benutzen, ohne den Betrieb +zu stören, da andere Nutzer bei Bedarf jederzeit eingeschoben werden. + +Wichtig: Muß die Archiv-Floppy gewechselt werden (weil etwa von einer +Diskette eine Datei gelesen wurde und diese auf eine andere geschrieben +werden soll), muß erneut das 'archive'-Kommando gegeben werden. Dies ist +notwendig, um das Verzeichnis aller auf der Diskette befindlichen Dateien +der neuen Diskette zu lesen. + +Merke: Mit 'archive' wird die Archiv-Verwaltung für einen Nutzer reserviert, mit 'release' wieder freigegeben. Mit 'archive' wird +gleichzeitig ein Archiv-Name eingestellt, der bei Archiv-Operationen mit dem +auf der Diskette gespeicherten Archiv-Namen verglichen wird. + + + +Archiv löschen und einen Namen geben + +Bevor ein Archiv-Diskette benutzt werden kann, muß sie den mit 'archive' +eingestellten Namen bekommen. + +Bei der Erstbenutzung eines Archivs muß dieses mit einem Namen versehen +werden. Als Archiv-Name wird der mit 'archive' eingestellte Name verwandt. +Dies erfolgt mit der Prozedur + + clear (archive) + +Gleichzeitig werden alle Dateien, die sich eventuell vorher auf dem Archiv- +Träger befanden, gelöscht. Somit wird 'clear' auch für das Löschen von +Archiven verwendet. + + +Merke: Mit 'clear' wird die Archiv-Diskette gelöscht und gleichzeitig der +mit 'archive' eingestellte Name gegeben. + + + +Einfache Archiv-Operationen + +In diesem Abschnitt werden einfache Archiv-Operationen beschrieben. + +Mit den Prozeduren + + save ("datei", archive) + fetch ("datei", archive) + erase ("datei", archive) + +kann jeweils eine Datei auf die Archiv-Diskette ('save') und von dem Archiv +in das EUMEL-System kopiert ('fetch') oder auf dem Archiv gelöscht ('erase') +werden. Dabei bedeutet 'datei' die zu kopierende Datei und 'archive' der +interne Task-Name für die Archiv-Verwaltung. Bei den ersten zwei Kommandos +ist zu beachten, daß die Datei, die auf das Archiv geschrieben (bei 'save') +oder die in die Benutzer-Task geholt werden soll (bei 'fetch'), immer +kopiert wird. Dateien bleiben also im "Ursprung" immer erhalten. + +Ist eine Datei gleichen Namens bereits auf der Archiv-Diskette (bei 'save') +oder in der Benutzer-Task (bei 'fetch') vorhanden, wird von der Archiv-Ver- +waltung angefragt, ob diese Datei überschrieben werden darf. Es kann somit +nicht zu einem unbeabsichtigten Löschen von Dateien kommen. + +Mit dem Kommando + + list (archive) + +erhält man (wie bei dem "normalen" 'list'-Kommando) ein Namens-Verzeichnis +aller Dateien, die sich auf der eingelegten Archiv-Diskette befinden. + + +Merke: Nachdem ein Archiv mit 'archive' reserviert wurde, kann mit 'save' +eine Datei auf das Archiv geschrieben und mit 'fetch' eine Datei von dem +Archiv in die Benutzer-Task kopiert werden. + + + +Archiv-Operationen für mehrere Dateien + +Hier wird beschrieben, wie man mehrere Dateien auf einmal auf ein Archiv +schreibt oder von einem Archiv liest. + +Mit den Kommandos + + save all (archive) + fetch all (archive) + +werden alle Dateien der Benutzer-Task auf das Archiv geschrieben bzw. von +dort geholt. + +Zusätzlich ist es möglich, die Operatoren 'ALL' und 'SOME' auf ein Archiv +anzuwenden. Wie bereits geschildert, liefern diese Operatoren einen +Thesaurus der angegebenen Task: 'ALL' liefert alle Dateinamen, während man +bei 'SOME' eine Auswahl treffen kann. Damit ist es möglich, alle oder einige +Dateien der Benutzer-Task auf eine Archiv-Diskette zu kopieren oder von der +Archiv-Diskette in die Benutzer-Task zu holen: + + fetch (SOME archive, archive) (* zeigt die Namen der Dateien der + Archiv-Diskette. Die nicht ge- + strichenen Dateien werden in die + Benutzer-Task geholt *) + save (SOME myself, archive) (* zeigt die Namen der Dateien der + Benutzer-Task. Die nicht ge- + strichenen Dateien werden auf die + Archiv-Diskette kopiert *) + save (ALL archive, archive) (* sichert alle Dateien der Benutzer- + Task, die sich schon auf dem Archiv + befinden (alte Version). Das + Kommando ist für Sicherungs- + Disketten gedacht, bei dem man immer + die gleichen Dateien auf dem Archiv + haben will *) + +Durch die Thesaurus-Operatoren '-' (Differenzmenge), '/' (Schnittmenge) und +'+' (Vereinigungsmenge) kann man kompliziertere Wirkungen erzielen. +Beispiele: + + save (ALL myself - ALL archive, archive) (* Schreibt alle Dateien der + Benutzer-Task auf das Archiv, + die nicht bereits auf dem + Archiv stehen *) + save (ALL myself - ALL father - ALL archive, archive) + (* Schreibt alle Dateien der + Benutzer-Task auf das Archiv, + mit Ausnahme der Dateien, die + längerfristig in der Vater- + Task gespeichert sind und die + nicht bereits auf dem Archiv + stehen *) + fetch (ALL archive - ALL myself) (* Holt alle Dateien vom Archiv, + die sich nicht bereits in der + Benutzer-Task befinden *) + +Werden mehrere Dateien mittels eines Thesaurus bearbeitet, kann man nach +einer Unterbrechung der Bearbeitung (d.h. Fehlermeldung) die Operation wieder +aufsetzen. Dazu liefert das Kommando + + remainder + +den "Rest"-Thesaurus. Er enthält alle nicht bearbeiteten Dateinamen. +Beispiel: + + save (SOME myself, archive) (* Unterbrechung, z.B. durch einen vom + Programm erzeugten 'errorstop' oder SV + und 'halt' *) + save (remainder, archive) (* bearbeitet die restlichen Dateien *) + + +Merke: Mit 'save all' bzw. 'fetch all' kann man alle Dateien einer Benutzer- +Task archivieren bzw. alle Dateien eines Archivs in die Benutzer-Task holen. +Mit den Operatoren SOME und ALL sind weitere Operationen möglich. + + + +Fehlermeldungen des Archivs + +Bei Archiv-Operationen kann es zu Fehlersituationen kommen. + +Versucht man eine Datei vom Archiv zu lesen, kann es vorkommen, daß das +Archiv-System + + Lese-Fehler (Archiv) + +meldet und den Lese-Vorgang abbricht. Dies kann auftreten, wenn die Floppy +beschädigt oder aus anderen Gründen nicht lesbar ist (z.B. nicht justierte +Disketten-Geräte). In einem solchen Fall vermerkt das Archiv-System intern, +daß die Datei nicht korrekt gelesen werden kann. Das sieht man z.B. beim +'list (archive)'. Dort ist der betreffende Datei-Name mit dem Zusatz 'mit +Lese-Fehler' gekennzeichnet. Um diese Datei trotzdem zu lesen, muß man sie +im Datei-Namen mit dem Zusatz 'mit Lese-Fehler' versehen. Beispiel: + + fetch ("dateiname mit Lese-Fehler") + +Die Datei wird in diesem Fall trotz Lese-Fehler (Informationsverlust!) vom +Archiv gelesen. + +Um solche Fälle möglichst zu vermeiden, sieht das EUMEL-System die +Möglichkeit vor, Archive bzw. Archiv-Dateien nach beschreiben zu prüfen. Das +erfolgt mit dem Kommando + + check ("dateiname", archive) (* oder *) + check (ALL archive, archive) (* fuer alle Archiv-Dateien *) + +Durch dieses Kommando werden eventuelle Lese-Fehler gemeldet. + +Weitere Fehlermeldungen des Archivs: + +* Lesen unmöglich (Archiv) Archiv-Floppy nicht eingelegt oder die Tür + des Laufwerks ist nicht geschlossen. + +* Schreiben unmöglich (Archiv) Floppy ist schreibgeschützt. + +* Archiv nicht angemeldet Archiv wurde nicht angemeldet + ('archive ("name")' geben). + +* Lese-Fehler (Archiv) Siehe obige Beschreibung. + +* Schreibfehler (Archiv) Die Floppy kann nicht (mehr) beschrieben + werden. Andere Floppy verwenden. + +* Speicherengpass Im System ist nicht mehr genügend Platz, um + eine Datei vom Archiv zu laden. + Ggf. Dateien löschen. + +* RERUN beim Archiv-Zugriff Das System wurde bei einer Archiv-Operation + durch Ausschalten bzw. Reset unterbrochen. + +* ... gibt es nicht Die Datei ... gibt es nicht auf dem Archiv. + +* Archiv heißt ... Die eingelegte Floppy hat einen anderen als + den eingestellten Archiv-Namen. + +* Archiv wird von Task ... benutzt Das Archiv wurde von einem anderen + Benutzer reserviert. + +* ... kann nicht geschrieben werden (Archive voll) Das Archiv ist voll. + Neue Archiv-Floppy + benutzen. + +* Archiv inkonsistent Die eingelegte Floppy hat nicht die Struk- + tur einer Archiv-Floppy ('clear (archive)' + vergessen). + +* save/erase wegen Lese-Fehler verboten Bei Archiven mit Lese-Fehler sind + Schreiboperationen verboten, weil + ein Erfolg nicht garantiert + werden kann. + + + +4. FILEs in Programmen + +Die bisher geschilderten Kommandos gelten für alle Datei-Arten. In diesem +Kapitel wird der Standard Datei-Typ FILE beschrieben. Eine Datei von Daten- +typ FILE ist eine sequentielle Datei, die das Lesen und Schreiben von Daten +in strikter Aufeinanderfolge von Sätzen erlaubt (Betriebsrichtungen 'input' +und 'output'). Die Betriebsrichtung 'modify' erlaubt das gleichzeitige Lesen +und Schreiben sowie beliebiges Positionieren. + + + +Deklaration, Assoziierung und Betriebsrichtungen + +Für ELAN-Programme gibt es standardmäßig den Datentyp FILE. FILEs müssen +deklariert werden. Die Kopplung einer FILE VAR im Programm mit einer Datei +erfolgt durch eine Assoziierungsprozedur. Bei der Assoziierung muß man an- +geben, wie die Datei bearbeitet werden soll. + +Dateien müssen in einem ELAN-Programm - wie alle anderen Objekte auch - +deklariert werden. Beispiel: + + FILE VAR f :: ... + +Mit der Deklaration wird dem ELAN-Compiler der Name der Datei-Variablen +bekannt gemacht. Dabei ist zu beachten, daß im EUMEL-System alle FILEs mit +VAR deklariert werden müssen, denn jede Lese/Schreib-Operation verändert +einen FILE. FILE CONST Objekte sind also nicht erlaubt. Ähnlich wie bei +anderen Datenobjekten werden FILEs initialisiert. In der Regel erfolgt dies +mit einer Assoziierungsprozedur. Beispiele: + + FILE VAR meine datei :: sequential file (output, "daten") + ... + (* oder: *) + TEXT VAR datei name; + put ("Dateiname bitte:"); get (datei name); + FILE VAR f :: sequential file (input, datei name); + +Die Assoziierungsprozedur 'sequential file' hat die Aufgabe, eine in einem +Programm deklarierte FILE VAR mit einer bereits vorhandenen oder noch einzu- +richtenden Datei (abhängig von der Betriebsrichtung, siehe unten) des +EUMEL-Systems zu koppeln. Den Dateinamen gibt man als zweiten Parameter +an. Dadurch können ELAN-Programme geschrieben werden, die Dateien +bearbeiten, deren Namen man beim Erstellen des Programms noch nicht kennt. + +Der erste Parameter gibt die sog. Betriebsrichtung an. Sie bestimmt, in +welcher Weise die assoziierte Datei bearbeitet wird. Es gibt folgende drei +Betriebsarten: + +a) input: + Die Datei kann vom Programm nur gelesen werden. Durch 'input' wird bei + der Assoziierung automatisch auf den ersten Satz der Datei positioniert. + Ist die zu lesende Datei nicht vorhanden, wird ein Fehler gemeldet. + +b) output: + Die Datei kann vom Programm nur beschrieben werden. Durch 'output' wird + bei der Assoziierung automatisch hinter den letzten Satz der Datei + positioniert (bei einer leeren Datei also auf den ersten Satz). Ist die + Datei vor der Assoziierung nicht vorhanden, wird sie automatisch einge- + richtet. + +c) modify: + Die Datei kann vom Programm in beliebiger Weise gelesen und beschrieben + werden. Im Gegensatz zu den Betriebsrichtungen 'input' und 'output', bei + denen ausschließlich ein rein sequentielles Lesen oder Schreiben erlaubt + ist, kann bei 'modify' beliebig positioniert, gelöscht, eingefügt und neu + geschrieben werden. Hier ist nicht definiert, auf welchen Satz der Datei + man nach erfolgter Assoziierung steht. Die Datei wird automatisch einge- + richtet, wenn sie vor der Assoziierung nicht vorhanden war. + +Anmerkung: +In jeder Betriebsrichtung sind nur bestimmte Operationen zugelassen. Z.B. +sind bei 'input' keine Schreib-Prozeduren erlaubt. Vergl. dazu die nächsten +Abschnitte. + +Neben der Betriebsrichtung 'input', 'output' oder 'modify' muß bei +'sequential file' als zweiter Parameter der Name der zu bearbeitenden Datei +angegeben werden. Beispiel: + + TEXT VAR datei name, zeile; + put ("Bitte Name der zu bearbeitenden Datei eingeben:"); + get (datei name); + FILE VAR f :: sequential file (input, dateiname); + ... + getline (f, zeile); + ... + +Hier wird der Name der zu bearbeitenden Datei zuerst eingelesen. Diese Datei +wird mit 'f' in der Betriebsrichtung 'input' assoziiert, d.h. würde man z.B. +die Prozedur + + putline (f, irgendein text) + +an einer Stelle im Programm verwenden, wird ein Fehler gemeldet. Die Be- +triebsrichtung hilft also, Fehler bei der Programmierung zu vermeiden. + +Mit den Prozeduren + + modify (f) + input (f) + output (f) + +kann die Betriebsrichtung von Dateien geändert werden. + +Dateien brauchen im EUMEL-System vor Programmende nicht geschlossen zu +werden, da sie vom System immer konsistent gehalten werden. + +Merke: Die Betriebsrichtung gibt an, wie man eine Datei bearbeiten will. +'input' steht für Lesen, 'output' für Schreiben und 'modify' für Verändern. +Jede Datei muß vor einer Benutzung mit 'sequential file' assoziiert werden. +Die Assoziierungsprozedur stellt die Kopplung zwischen dem Programm und dem +EUMEL-Betriebssystem her. + + + +Operationen der Betriebsrichtung 'output' + +In der Betriebsrichtung 'output' sind nur Schreib-Operationen gestattet. +'output' ist also für das Bearbeiten von Ausgabedateien vorgesehen. + +Mit den Prozeduren + + put + +können INT-, REAL- und TEXT-Werte in eine Datei geschrieben werden. Die +Prozedur + + line + +sorgt dafür, daß eine neue Zeile in der Datei begonnen wird. Beispiel: + + FILE VAR f :: sequential file (output, "daten"); + put (f, "Daten:"); + line (f); + schreibe daten. + + schreibe daten: + INT VAR intwert; + REAL VAR textwert; + put ("bitte Daten eingeben (INT, REAL):"); + REP + get (intwert); + put (f, intwert); + get (realwert); + put (f, realwert); + line (f); + UNTIL yes ("fertig") END REP. + +Durch die Assoziierungsprozedur mit der Betriebsrichtung 'output' wird +hinter den letzten Satz der Datei positioniert, bei einer leeren Datei also +auf den ersten Satz. In dem ersten Satz in unserem Beispiel wird also +'Daten:' geschrieben. Durch die Prozedur 'line' geht man auf den nächsten +Satz. Dann werden jeweils ein INT- und ein REAL-Wert in eine Datei-Zeile +geschrieben, bis die Frage 'fertig' mit 'j' beantwortet wird. + +Die 'put'-Prozeduren schreiben die Werte jeweils in die aktuelle Datei-Zeile. +Zwischen den Werten wird von den 'put'-Prozeduren jeweils ein Leerzeichen +eingefügt. Im Gegensatz zu den 'put'-Prozeduren schreibt die Prozedur 'write' +einen TEXT ohne ein anschließendes Leerzeichen in die aktuelle Datei-Zeile. +Beispiel: + + ... + write (f, "meine Daten:"); + write (f, " "); + write (f, text (17 + 4)); + (* das Gleiche wie: put (f, "meine Daten:"); put (f, 17 + 4) *) + +Auf eine neue Datei-Zeile kann auf zwei verschiedene Arten positioniert +werden: + +a) Prozedur 'line': + Diese darf auch mit einem Parameter angegeben werden, der die Anzahl + Zeilen angibt. Beispiel: + + line (f); (* positioniert auf die naechste Zeile *) + line (f, 1) (* das Gleiche *) + line (f, 4) (* Vier Zeilen weiter; dazwischen sind 3 Leerzeilen *) + +b) Überschreiten der Zeilengrenze: + Eine Datei-Zeile kann (voreingestellt) 77 Zeichen aufnehmen. Wird bei + einer Schreib-Operation diese Grenze überschritten, wird der auszugebende + Wert auf die nächste Zeile plaziert. Mit der Prozedur 'max line length' + kann die eingestellte Datei-Zeilenlänge gelesen oder verändert werden. + Beispiel: + + FILE VAR f :: sequential file (output, "meine daten"); + put (max line length (f)); (* ergibt 77 *) + max line length (f, 132); + put (max line length (f)) (* ergibt 132 *) + + Ist die Länge des auszugebenden Textes größer als die verbleibende + Zeilenbreite, wird der Text auf der nächsten Zeile ausgegeben. + +Die 'putline'-Prozedur bietet die Möglichkeit, eine ganze Datei-Zeile auf +einmal auszugeben. Eine Positionierung auf die nächste Datei-Zeile ('line') +braucht dabei nicht vorgenommen werden. Beispiel: + + TEXT VAR zeile :: ""; + ... + zeile := ...; + putline (f, zeile); + ... + +Merke: In der Betriebsrichtung 'output' kann in eine Datei geschrieben +werden. Dazu stehen die Prozeduren 'put', 'write' und 'putline' zur Verfü- +gung. Die Prozedur 'line' positioniert auf die nächste Zeile der Ausgabe- +datei. Mit 'max line length' kann die Länge einer Datei-Zeile verändert oder +erfragt werden. + + + +Operationen der Betriebsrichtung 'input' + +In der Betriebsrichtung 'input' sind nur Lese-Operationen gestattet. 'input' +ist also für das Bearbeiten von Eingabedateien vorgesehen. + +Analog der Betriebsrichtung 'output' sind bei 'input' 'get'-Prozeduren vor- +handen, die INT-, REAL- oder TEXT-Werte aus einer Datei lesen. Beispiel: + + FILE VAR f :: sequential file (input, "Betriebszeiten"); + REAL VAR zeiten; + zeiten einlesen und berechnen. + + zeiten einlesen und berechnen: + REP + get (f, zeiten); + IF zeiten = 0.0 + THEN LEAVE zeiten einlesen und berechnen + FI; (* siehe auch 'eof'-Prozedur *) + berechne + END REP. + + berechne: + ... + +Die 'get'-Prozeduren positionieren automatisch auf die nächste Zeile, sofern +keine Werte mehr in der aktuellen Zeile vorhanden sind. Mit der Prozedur +'line' kann explizit auf die nächste Zeile positioniert werden. Damit können +die restlichen Daten einer Zeile überschlagen werden. Für die 'get'-Proze- +duren gilt, daß jeder zu lesende Wert entweder beim nächsten Leerzeichen +oder beim Zeilenende aufhört. Beispiel: + + FILE VAR f :: sequential file (input, "text"); + TEXT VAR wort; + lese worte. + + lese worte: + REP + get (f, wort); (* Lesen eines Worts ohne Leerzeichen *) + put (wort); (* Schreiben eines Worts mit Leerzeichen *) + IF wort = "Ende" + THEN LEAVE lese worte + FI + END REP. + + +Trennzeichen ("separator") zwischen den Worten sind also Leerzeichen, welche +nicht eingelesen werden. Manchmal sollen jedoch Daten eingelesen werden, die +durch andere Zeichen als dem Leerzeichen voneinander getrennt sind. Eine +Möglichkeit, solche Daten zu behandeln, bietet die 'getline'-Prozedur. Sie +liest (analog 'putline') eine ganze Zeile und positioniert auf die nächste +Zeile. Dann kann man mit Hilfe von TEXT-Prozeduren solche Zeilen 'per Hand' +auseinandernehmen. Als Beispiel zeigen wir ein Programm, welches den zweiten +Wert einer Zeile lesen soll. Die Werte werden durch Kommata voneinander +getrennt: + + FILE VAR eingabe datei :: sequential file (input, "daten"); + TEXT VAR zeile, wert; + lese jeweils zweiten wert; + verarbeite wert. + + lese jeweils zweiten wert: + REP + getline (f, zeile); + IF zeile = "Ende" + THEN LEAVE lese jeweils zweiten wert + FI; + extrahiere zweiten wert + END REP. + + extrahiere zweiten wert: + wert := subtext (zeile, anfang, ende). + + anfang: + pos (zeile, ",") + 1. + + ende: + pos (zeile, ",", anfang) + 1. + + verarbeite wert: + ... + +Diese (etwas umständliche) Methode ist immer dann angebracht, wenn Zeilen +unterschiedlich untersucht werden müssen. Eine einfachere Möglichkeit, die +in vielen Fällen angewandt werden kann, bietet eine andere Form der 'get'- +Prozedur, bei der man das oder die Trennzeichen angeben kann. Beispiel: + + ... + extrahiere zweiten wert: + get (f, wert, ","); (* ersten Wert der Zeile ueberlesen *) + get (f, wert, ","). (* hier der richtige zweite Wert *) + +Hier wird also das Trennzeichen mit angegeben (dritter Parameter). Eine +andere Methode müssen wir anwenden, wenn Daten nicht durch ein Trennzeichen +unterschieden werden, sondern nur durch ihre Länge definiert sind. Beispiel: + + ... + lese fuenfstellige werte: + REP + get (f, wort, 5); + verarbeite wert + ... + END REP. + +Bei dieser 'get'-Prozedur wird die Länge des einzulesenden Textes als +dritter Parameter angegeben. Man beachte, daß die letzten zwei 'get'-Proze- +duren nur TEXTe einlesen. Entsprechende Typwandlungen hat der Programmierer +vorzunehmen. + +Merke: Die Betriebsrichtung 'input' erlaubt nur Lesen aus einer Eingabedatei. +Für diesen Zweck gibt es die Prozeduren 'get', 'getline' und 'line'. + + + +Operationen der Betriebsrichtung 'modify' + +Die Betriebsrichtung 'modify' erlaubt das Lesen und Schreiben von Informa- +tionen auf Dateien. Zusätzlich ist beliebiges Positionieren auf Dateien +erlaubt. 'modify' ist also für Dateien gedacht, die man gleichzeitig als +Ausgabe- und Eingabedateien behandeln will. + +Die Betriebsrichtung 'modify' erlaubt ein Ändern einer Datei ("updating"), +wobei die sequentielle Natur der Datei erhalten bleibt. + +Eine Datei der Betriebsrichtung 'modify' muß ebenso mit 'sequential file' +assoziiert werden, wie bei den zwei anderen Betriebsrichtungen. Während bei +'input' auf den ersten bzw. bei 'output' auf den letzten Satz der Datei +positioniert wird, ist bei 'modify' nicht definiert, auf welchem Satz der +Datei nach erfolgter Assoziierung positioniert wird. Man muß also die erste +Positionierung explizit vornehmen. Für die Zwecke der Positionierung gibt es +die Prozeduren + + to line (* auf eine bestimmte Zeile *) + col (* auf eine Spalte innerhalb der Zeile *) + down (* eine Zeile vorwaerts *) + up (* eine Zeile zurueck *) + +Neben diesen Positionierungsprozeduren gibt es die Informationsprozeduren: + + lines (* Anzahl Zeilen in der Datei *) + line no (* aktuelle Zeilennummer *) + eof (* Dateiende? *) + +Beispiele: + + down (f); (* wie: to line (f, line no (f) + 1) *) + (* Nicht über eof *) + up (f); (* wie: to line (f, line no (f) - 1) *) + (* Nicht über Zeile 1 *) + +Mit der Prozedur + + read record + +kann der Satz, auf den aktuell positioniert wurde, gelesen werden. Mit + + write record + +kann sein Inhalt geschrieben werden (also auch "überschreiben"). Mit den +Prozeduren + + insert record + delete record + +kann eine Zeile vor der aktuellen eingefügt (Position ist dann die einge- +fügte Zeile) oder der aktuelle Satz gelöscht werden (Position ist dann der +nächste Satz). Beispiele: + + FILE VAR f :: sequential file (modify, "meine daten") + TEXT VAR zeile, neue zeile; + to line (f, 1); + read record (f, zeile); (* erste Zeile lesen *) + ... + insert record (f); (* neue erste Zeile *) + write record (f, neue zeile); + down (f); (* auf die 2. Zeile, die vorher die 1. war *) + delete record (f); (* diese loeschen, so dass die + Zeilenzahl wieder stimmt *) + +Das nächste Beispiel zeigt, wie hinter den letzten Satz einer Datei eine +Zeile eingefügt werden kann (hier wird ausgenutzt, daß man in der Betriebs- +richtung 'modify' hinter den letzten Satz der Datei positioniert werden +kann): + + FILE VAR f :: sequential file (modify, "test"); + to line (f, lines (f)); (* auf die letzte Zeile *) + down (f); + insert record (f); + write record (f, "neue letzte Zeile"); + ... + +Mit 'down' bzw. 'up' kann man auch um einige Zeilen auf einmal vorwärts oder +rückwärts positionieren. Beispiele: + + down (f, 17) (* 17 Zeilen vorwaerts *) + up (f, 13) (* 13 zeilen rueckwaerts *) + +Merke: In der Betriebsrichtung 'modify' können Dateien gelesen und/oder ge- +schrieben werden ('read record' oder 'write record'). Positionierungen kön- +nen mit 'down', 'up' oder 'to line' vorgenommen werden. + + + +Manipulationen von FILEs + +FILEs können im EUMEL-System auch als Einheiten behandelt werden. Dazu +stehen die bereits erläuterten Prozeduren zur Verfügung, die wir hier der +Vollständigkeit halber nochmals aufführen. + +Mit der Prozedur + + exists + +kann erfragt werden, ob eine Datei bereits existiert. Beispiel: + + TEXT VAR name; + REP + erfrage name; + UNTIL exists (name) END REP; + ... + + erfrage name: + put ("Dateiname bitte:"); + get (name); + line. + +Weitere Prozeduren: + + forget (* Datei löschen *) + rename (* umbenennen *) + copy (* kopieren *) + +Für Programmierer ist eine Version der 'forget'-Prozedur interessant, die +eine Datei ohne Kontroll-Anfrage löscht. Beispiel: + + forget ("meine scratch datei", quiet) + +Merke: Mit 'exists' kann erfragt werden, ob ein FILE bereits existiert. + + + +Texte Suchen + +Mit den Prozeduren 'down' und 'up' kann man (ebenso wie im Editor) auch nach +Texten suchen. + +Die Prozeduren 'down' bzw. 'up' suchen einen Text in der Datei. Beispiele: + + down (f, "dieser text") + up (f, "noch'n text") + +Diese Prozeduren suchen direkt auf der Dateistruktur. Wird der gesuchte Text +gefunden, steht man direkt auf dem gesuchten Text. Wird der Text nicht +gefunden, steht man auf dem ersten (bei 'up') oder hinter dem letzten (bei +'down') Zeichen der Datei. Die Position innerhalb der Zeile nach einer Suche +kann mit + + col (f) + +abgefragt werden. Um die Suche auf einen Bereich zu beschränken, kann man +'down' bzw. 'up' mit einem weiterem Parameter versehen, der die max. Anzahl +von Zeilen angibt. Beispiel: + + FILE VAR f :: ... + ... + INT VAR akt zeilennr :: line no (f); + down (f, "pattern", 100); + (* sucht in den naechsten 100 Zeilen nach 'pattern' *) + IF line no (f) <> akt zeilen nr + 100 + THEN gefunden + ELSE nicht gefunden + FI; + ... + +Achtung: 'down' bzw. 'up' beginnen die Suche immer mit dem nächsten Zeichen +in Suchrichtung, so daß man mehrmals hintereinander suchen kann, ohne in +eine Endlosschleife zu geraten (Erinnerung: wird ein Text gefunden, ist die +Position innerhalb der Zeile das erste Zeichen des gesuchten Begriffs). + +Mit den Prozeduren (gleiche Parameterversorgung wie 'down' und 'up') + + downety + uppety + +beginnt man mit der Suche immer auf der aktuellen Position. Darum sollte man +diese Prozeduren mit Vorsicht verwenden. Mit der Prozedur + + pattern found + +kann man anfragen, ob die letzte Suchoperation erfolgreich war oder nicht. +Beispiel: + + FILE VAR f :: ... + ... + INT VAR akt zeilennr :: line no (f); + down (f, "pattern", 100); + (* sucht in den naechsten 100 Zeilen nach 'pattern' *) + IF pattern found THEN gefunden + ELSE nicht gefunden + FI; + ... + +Mit der Prozedur + + at + +kann man anfragen, ob man auf einem gewünschten Wort steht. Beispiel: + + IF at (f, "pattern") + THEN .. + FI + +Die Prozedur + + word + +liefert das aktuelle Wort der aktuellen Position einer Zeile. Beispiele: + + TEXT VAR dieses wort :: word (f); + (* Zeichenkette von der aktuellen Position bis zum nächsten Blank oder + Zeilenende *) + dieses wort := word (f, "<"); + (* Zeichenkette (Wort) von der aktuellen Position bis zum Zeichen '<' + oder Zeilenende *) + dieses wort := word (f, 13); + (* Zeichenkette (Wort) mit der Laenge 13 *) + +Merke: Die Prozeduren 'down' und 'up' suchen einen Text innerhalb einer +Datei. Mit 'at' kann man anfragen, ob man auf dem gesuchten Begriff steht. +'word' liefert das aktuelle Wort. + + + +FILE-Ausschnitte + +Hier wird erklärt, wie man mehrere Zeilen aus einer Datei auf einmal löschen +und/oder verschieben und wie man nur einen Ausschnitt einer Datei zugänglich +machen kann. + +Den einfachsten Zugang zu Datei-Abschnitten erhält ein Programmierer durch +einige Anwendungsprozeduren, die u.a. auch im Editor verwandt werden. Dort +gibt es die Möglichkeit, einen markierten Bereich "vorsichtig" zu löschen +und u.U. an anderer Stelle wieder einzufügen (ESC RUBOUT und ESC RUBIN). +Solche Prozeduren stehen auch einem Programmierer zur Verfügung. Beispiel: + + FILE VAR f :: .... + .... + remove (f, 100); (* entfernt 100 Zeilen von der aktuellen + Position rueckwaerts (!) aus der Datei 'f' *) + to line (27); (* zum Beispiel *) + re insert (f) (* fuegt die "vorsichtig" geloeschten Zeilen vor + (!) die Zeile 27 ein *) + +Die Prozedur + + remove + +löscht also eine angebbare Anzahl von Zeilen in der Datei (rückwärts von der +aktuellen Zeilennummer ab) und schreibt diesen Datei-Abschnitt in einen +internen Puffer. Man beachte, daß sich dabei natürlich die Zeilennummer der +Datei ändert. Die entfernten Zeilen können aus dem internen Puffer an einer +anderen Stelle durch + + reinsert + +genau einmal wieder eingefügt werden. Sollen jedoch die mit 'remove' ent- +fernten Zeilen wirklich gelöscht und nicht mehr an anderer Stelle eingesetzt +werden, dann kann man die Prozedur + + clear removed + +verwenden. Beispiel: + + ... + remove (f, 50); (* loescht vorsichtig *) + clear removed (f); (* und endgueltig *) + ... + +Durch solche Löschungen oder Einfügungen entstehen Datei-Segmente. +Innerhalb eines Segments kann direkt positioniert werden. Werden jedoch +Löschungen oder Einfügungen vorgenommen (Sätze werden ein- oder ausgekettet), +muß erst zu einem entsprechenden Segment positioniert und dann innerhalb des +Segments auf den entsprechenden Satz positioniert werden. Das kann - je nach +Anzahl der Segmente - zeitaufwendig sein. Deshalb existiert die Prozedur + + segments + +mit der man feststellen kann, wieviel Datei-Segmente in der Datei existieren. +(Sind es "zu viele", kann man die Datei "reorganisieren"). + +Diese und die folgenden Prozeduren nutzen eine vom EUMEL-System bereitge- +stellte Möglichkeit, Ausschnitte aus Dateien wie eigenständige Dateien zu +behandeln. Beispiel: + + FILE VAR f :: ... + ... + FRANGE VAR alter bereich; + set range (f, 200, 1, alter bereich); + (* Datei mit 200 Zeilen von der Spalte 1 der aktuellen Zeile *) + edit (f); (* Zeilen 1-200 editieren *) + set range (f, alter bereich); (* Datei zuruecksetzen *) + ... + +Von dem Beispiel-Programm wird die Datei 'f' bearbeitet. Die FRANGE-Variable +dient hier dazu, sich den ursprünglichen Bereich der Datei 'f' (der auch +schon eingeschränkt sein kann), zu merken. Mit der Prozedur 'set range' wird +die Datei 'f' auf 200 Zeilen eingeschränkt (von der aktuellen Zeile 200 +Zeilen rückwärts). Mit der Prozedur 'edit' kann nun der Benutzer unseres +Programms die (eingeschränkte) Datei beliebig editieren. Ihm steht am Anfang +Zeilen 1 bis 200 zur Verfügung; die "ausgeblendeten" Datei-Teile kann er +nicht verändern. Mit dem zweiten Aufruf von 'set range' wird der einge- +schränkte (und u.U. veränderte) Datei-Bereich aufgehoben, so daß hier wieder +alle ursprünglichen Datei-Zeilen zur Verfügung stehen. + +Solche Beschränkungen können natürlich mehrmals geschachtelt vorgenommen +werden. Um nach Ablauf solcher Programmteile sicher wieder die ursprüngliche +Datei (mit allen ihren Zeilen) zur Verfügung zu haben, gibt es die Prozedur + + reset range (f) + +Sie setzt die Datei 'f' auf den größtmöglichen Bereich zurück. + +Merke: Mit 'remove' und 'reinsert' können Zeilen gelöscht und/oder ver- +schoben werden. Mit dem Datentyp FRANGE und den Prozeduren 'set range' +können Dateien eingeschränkt werden. + + + +5. Datenräume + +Die bis jetzt behandelten Dateien können nur TEXTe aufnehmen (bei einigen +Schreib-/Lese-Operationen werden Daten in Texte umgewandelt, z.B. bei 'get' +und 'put'). Damit ist gewährleistet, daß alle Programme im EUMEL-System +(Editor, Drucker, Compiler, Benutzer-Programme usw.) auf gleiche Art und +Weise auf Dateien zugreifen können, unabhängig davon, welche Daten wirklich +gespeichert sind. Der folgende Abschnitt zeigt, wie man mit Dateien umgeht, +die nicht vom Standardtyp FILE sind. + + + +Konzept des Datenraums + +Standarddateien (FILEs) können nur Texte aufnehmen, da sie ja hauptsächlich +für die Kommunikation mit dem Menschen (vorwiegend mit Hilfe des Editors bzw. +Ein-/Ausgabe) gedacht sind. Will man Zahlen in einen FILE ausgeben, so +müssen diese zuvor in Texte umgewandelt werden. Hierfür stehen Standard- +prozeduren zur Verfügung (z.B. 'put (f, 17)'). + +Will man aber Dateien zur Kommunikation zwischen Programmen verwenden, die +große Zahlenmengen austauschen, verursachen die Umwandlungen von Zahlen +in TEXTe und umgekehrt unnötigen Rechenaufwand. Daher wurden in EUMEL� die +Datenräume eingef�hrt, die es gestatten, beliebige Strukturen (Typen) in +Dateien zu speichern. Solche Datenräume kann man weder mit dem Editor noch +mit dem Standarddruckprogramm (print) bearbeiten, da diese ja den Typ des in +der Datei gespeicherten Objektes nicht kennen. + +Einen Datenraum kann man sich als eine Sammlung von Daten vorstellen (u.U. +leer), die ausschließlich von einem Programm her behandelt wird. Man kann +einem Datenraum durch ein Programm einen Datentyp "aufprägen". Meist handelt +es sich um Reihungen, weil die Benutzung von Datenräumen erst bei größeren +Datenmengen lohnt. Nach einem solchen "Aufpräge"-Vorgang kann der Datenraum +wie ein "normaler" Datentyp behandelt werden, mit dem Unterschied, daß die +Daten in einem Datenraum (d.h. Datei) gespeichert werden. Somit können nach- +folgende Programme auf die im Datenraum gespeicherten Daten zugreifen, so- +fern sie den gleichen Datentyp auf den Datenraum aufprägen. + +Merke: Ein Datenraum ist eine Sammlung von Daten. Er kann ausschließlich +durch ein Programm (und z.B. nicht durch den Editor) behandelt werden. +Programme können Datenräumen Datentypen aufprägen und sie dann mit den ver- +fügbaren Operationen dieses Datentyps manipulieren. + + +Ein Beispiel + +Diesen etwas komplizierten Vorgang wollen wir an Hand eines Beispiels +Schritt für Schritt erklären. + +Angenommen, Programmierer Meier hat ein Gehaltsprogramm zu erstellen. Er +überlegt sich, das Programm in (mindestens) zwei Moduln (PACKETs) zu er- +stellen: + +a) Berechnung der Gehaltssumme aus den Arbeitszeiten (also Bruttogehalt) und + dann +b) Endgültige Berechnung der Gehälter durch Abzug von Steuern usw. + +Das Programm aus a) erstellt also eine Gehaltsliste für alle Beschäftigten +des Betriebs. Die Gehaltsliste soll ebenfalls von Modul b) genutzt werden. + +Meier entschließt sich, die Gehaltsliste in einem Datenraum zu speichern. +Das hat neben der effizienteren Bearbeitung noch den Vorteil, daß man die +Gehaltsliste - ohne Programmierkenntnisse zu besitzen - nicht mit dem Editor +bearbeiten kann (Datenschutz). + +Dem ELAN-Compiler muß Meier also mitteilen, daß die Reihung für die +Gehaltsliste (oder irgendein anderer Datentyp) nicht im Speicherbereich des +Programms, sondern in einem Datenraum gespeichert werden soll. Dies erfolgt +mit dem Schlüsselwort BOUND, welches dem Datentyp bei der Deklaration +vorangestellt wird. Beispiel: + + BOUND ROW 1000 REAL VAR gehaltsliste + +Dieses BOUND-Objekt muß Meier noch mit einer Datei verbinden, man spricht +von "ankoppeln". Die Ankopplung erfolgt durch den Operator ':='. Dies kann +man gleich bei der Initialisierung vornehmen. Beispiel: + + BOUND ROW 1000 REAL VAR gehaltsliste := new ("hugo") + +Die Prozedur 'new' kreiert dabei einen leeren Datenraum (hier mit dem Namen +'hugo'), der mit Hilfe der Zuweisung (hier: Initialisierung) an die Variable +'gehaltsliste' gekoppelt wird. + +Nun kann Meier mit der 'gehaltsliste' arbeiten wie mit allen anderen Feldern +auch, mit dem Unterschied, daß die Daten, die er in 'gehaltsliste' speichert, +eigentlich im Datenraum 'hugo' gespeichert sind. Beispiele: + + gehaltsliste [5] := 10 000.0; (* Traumgehalt *) + gehaltsliste [index] INCR 200.0; (* usw. *) + +Meier kann auch Prozeduren schreiben, die auf der Gehaltsliste arbeiten. +Beispiel: + + PROC sort (ROW 1000 REAL VAR liste): + ... + END PROC sort; + ... + sort (gehaltsliste); + ... + +Man beachte, daß der formale Parameter der Prozedur 'sort' nicht mit BOUND +spezifiziert werden darf (BOUND wird nur bei der Deklaration des Objekts +angegeben). Das ist übrigens ein weiterer wichtiger Vorteil von BOUND-Objek- +ten: man kann alle Prozeduren des EUMEL-Systems auch für BOUND-Objekte +verwenden, nur die Datentypen müssen natürlich übereinstimmen. + +Nach der Bearbeitung des Moduls a) ist Meier nun sicher, daß seine Brutto- +daten in dem Datenraum 'hugo' stehen. Meier braucht (genauso wie bei FILEs) +den Datenraum nicht zu schließen. Im zweiten Modul muß Meier nun erneut ein +BOUND-Objekt deklarieren. +Deshalb deklariert Meier nun + + BOUND ROW 1000 REAL VAR nettoliste :: old ("hugo"); + +Hier muß Meier nun die Prozedur 'old' verwenden, weil der Datenraum bereits +aus dem ersten Modul existiert. Nun kann Meier weiter programmieren, bis er +letztendlich den Datenraum löscht: + + forget ("hugo") + +Merke: Ein Datenobjekt eines beliebigen Datentyps kann mit einem vorange- +stellten BOUND deklariert werden und an einen Datenraum gekoppelt werden. +Der Datentyp ist dann auf den Datenraum aufgeprägt und man kann mit ihm +arbeiten wie mit allen anderen Objekten dieses Datentyps. + + + +Datenräume als Datentyp + +Datenräume können auch als eigener Datentyp (DATASPACE) in einem Programm +behandelt werden. Somit können Datenräume (als Ganzes) ohne Kenntnis eines +eventuell (vorher oder später) aufgeprägten Typs verwandt werden. + +Als Operationen auf DATASPACE-Objekten sind nur Transporte, Löschen und +Initialisieren zugelassen. + + DATASPACE VAR ds :: old ("daten"); + +Der Zuweisungsoperator bewirkt eine Kopie des Datenraums vom rechten auf +den linken Operanden. Des weiteren gibt es eine DATASPACE Konstante 'nil- +space', die eine leere Datenraum repräsentiert. Mit diesem Wert initialisiert +der Datei-Manager Dateien, die neu kreiert werden. + +Eine neuer Datenraum kann durch + + new ("name") + +eingerichtet werden. 'new' liefert gleichzeitig einen Datenraum und wird +deshalb für Initialisierungen verwandt. Beispiel: + + DATASPACE VAR datenraum :: new ("name1"); (* Kopie ! *) + +Ein bereits vorhandener Datenraum in der Benutzer-Task kann mit + + old ("datei") + +erneut benutzt werden. 'old' liefert (wie 'new') einen DATASPACE, so daß +'old' ebenfalls zur Initialisierung benutzt werden kann. Die Prozedur + + nilspace + +liefert einen leeren Datenraum. + +Für Datenräume gelten zusätzlich einige der Prozeduren wie für FILEs, u.a.: + + forget + fetch + save + rename + +Ausgenommen davon sind Prozeduren, die einen TEXT-File voraussetzen, wie +z.B. 'crypt' und 'decrypt', 'put', 'putline' usw. + +Abschließend soll hier noch auf häufig gemachte Fehler hingewiesen werden: + +Wenn man an ein DATASPACE-Objekt zuweist (z.B.: DATASPACE VAR ds := +new ("mein datenraum")) so erhält man, wie oben erwähnt, eine Kopie des +Datenraums in 'ds'. Koppelt man jetzt 'ds' an ein BOUND-Objekt an und führt +Änderungen durch, so wirken diese nur auf die Kopie und nicht auf die Quelle +(d.h. im Beispiel, daß die Datenraum 'hugo' nicht verändert wird, hier also +leer bleibt). Für Änderungen in den vom Datei-Manager verwalteten Dateien +ist also stets direkt anzukoppeln, wie es im Beispiel gezeigt wurde. + +Wenn man ein DATASPACE-Objekt benutzt, ohne den Datei-Manager zu verwenden, +so muß man selbst dafür sorgen, daß dieses Objekt nach seiner Benutzung +wieder gelöscht wird. Das Löschen geschieht durch die Prozedur 'forget'. +Ferner ist zu beachten, daß vor der Ankopplung an ein BOUND-Objekt das +DATASPACE-Objekt initialisiert wird (im Normalfall mit 'nilspace'). Beispiel: + + DATASPACE VAR ds := nilspace; + BOUND ROW 1000 REAL VAR real feld := ds; + .... + real feld [index] := wert; + .... + forget (ds) (* Datei löschen, damit der Platz wieder verwendet wird *) + +Ein automatisches Löschen von DATASPACE-Objekten erfolgt auch nicht bei +Programmende (sonst könnten sie ihre Funktion als Datei nicht erfüllen). +Erst beim Löschen einer Task werden alle ihr gehörenden DATASPACE-Objekte +freigegeben. Verboten ist weiterhin folgendes: + + BOUND X ...; + +wobei 'X' mit BOUND deklariert wurde oder ein DATASPACE ist. + +Merke: Datenräume können durch 'new' erschaffen werden. Mit 'old' kann ein +bereits vorhandener Datenraum angesprochen werden. Im Übrigen gelten auch +einige der für FILEs vorhandenen Operationen. + + + +Datei-Typen definieren + +Durch die Datenräume und die Datentyp-Definition von ELAN ist es für +Programmierer relativ einfach, neue Datei-Datentypen zu definieren. + +In der Regel reicht der Datentyp FILE für "normale" Anwendungen aus, jedoch +kann es manchmal sinnvoll und notwendig sein, neue Datei-Typen für spezielle +Aufgaben zu definieren. + +In diesem Abschnitt zeigen wir an dem Beispiel DIRFILE (welcher zwar im +ELAN-Standard definiert, aber nicht im EUMEL-System realisiert ist), wie ein +neuer Datei-Datentyp definiert wird: + + PACKET dirfiles DEFINES DIRFILE, :=, dirfile, getline, ...: + + LET maxsize = 1000; + + TYPE DIRFILE = BOUND ROW maxsize TEXT; + (* DIRFILE besteht aus TEXTen; Zugriff erfolgt ueber einen + Schluessel, der den Index auf die Reihung darstellt *) + + OP := (DIRFILE VAR dest, DATASPACE CONST space): + CONCR (dest) := space + END OP :=; + + DATASPACE PROC dirfile (TEXT CONST name): + IF exists (name) + THEN old (name) + ELSE new (name) + FI + END PROC dirfile; + + PROC getline (DIRFILE CONST df, INT CONST index, TEXT VAR record): + IF index <= 0 + THEN errorstop ("access before first record") + ELIF index > maxsize + THEN errorstop ("access after last record") + ELSE record := df [index] + FI + END PROC getline; + + PROC putline (DIRFILE CONST df, INT CONST index, TEXT VAR record): + ... + END PROC putline; + + ... + END PACKET dirfiles; + +Die Prozedur 'dirfile' ist die Assoziierungsprozedur für DIRFILEs (analog +'sequential file' bei FILEs). 'dirfile' liefert entweder einen bereits vor- +handenen Datenraum oder richtet einen neuen ein. Um eine Initialisierung mit +der 'dirfile'-Prozedur vornehmen zu können, braucht man auch einen Zu- +weisungsoperator, der den Datenraum an den DIRFILE-Datentyp koppelt. + +Zugriffe auf einen DIRFILE sind nun relativ einfach zu schreiben. Im obigen +Beispiel wird nur die Prozedur 'getline' gezeigt. + +Nun ist es möglich, Programme zu schreiben, die den DIRFILE-Datentyp +benutzen. Beispiel: + + DIRFILE VAR laeufer :: + dirfile ("Nacht von Borgholzhausen"); + INT VAR nummer; + TEXT VAR name; + + REP + put ("Startnummer bitte:"); + get (nummer); + line; + put ("Name des Laeufers:"); + get (name); + putline (laeufer, nummer, name); + line + UNTIL no ("weiter") END REP; + ... + +Merke: Neue Datei-Typen für spezielle Anwendungen kann man leicht selbst +programmieren. + + + +6. Beschreibung der Prozeduren + +In diesem Abschnitt werden alle Operationen, die für Dateien zur Verfügung +stehen, aufgeführt. Dabei werden die Operationen für FILEs und Datenräume +mit (F) gekennzeichnet. + ++ + THESAURUS OP + (THESAURUS CONST left, right) + Zweck: Vereinigungsmenge von 'left' und 'right'. + + THESAURUS OP + (THESAURUS VAR left, TEXT CONST name) + Zweck: Nimmt den TEXT 'name' in den Thesaurus 'left' auf. Beispiel: + + save (SOME father + "hugo", archive) + +- + THESAURUS OP - (THESAURUS CONST left, right) + Zweck: Differenzmenge von 'left' und 'right'. + + THESAURUS OP - (THESAURUS VAR left, TEXT CONST name) + Zweck: Liefert einen Thesaurus aus left, aber ohne den Eintrag 'name'. + Beispiel: + + save (ALL myself - "hugo", archive) + +/ + THESAURUS OP / (THESAURUS CONST left, right) + Zweck: Schnittmenge von 'left' und 'right'. + + TASK OP / (TEXT CONST task name) + Zweck: Liefert aus einem Tasknamen den internen Tasknamen. '/' kann über- + all dort eingesetzt werden, wo ein interner Taskname verlangt wird. + +ALL + THESAURUS OP ALL (TASK CONST task) + Zweck: Liefert einen Thesaurus, der alle Dateinamen der angegebenen Task + enthält (auch der Benutzer-Task: 'myself'). + + THESAURUS OP ALL (TEXT CONST file name) + Zweck: Liefert einen Thesaurus, der die in 'file name' vorhandenen Datei- + namen (jede Zeile ein Name) enthält. + +at (F) + BOOL PROC at (FILE VAR f, TEXT CONST word) + Zweck: Abfrage, ob man auf 'word' in der Datei 'f' positioniert ist. + Beispiel: + + ... + down (f, "muster") + IF at (f, "muster") + THEN gefunden + ELSE nicht gefunden + FI; + ... + +archive + PROC archive (TEXT CONST archive name) + Zweck: Anmeldung von Archiv-Operationen. 'archive name' wird zur Über- + prüfung für alle folgenden Archiv-Operationen verwandt, um die + unberechtigte Benutzung eines Archivs zu verhindern. Die Anmeldung + wird abgelehnt, wenn ein anderer Nutzer das Archiv belegt hat. + + TASK PROC archive + Zweck: Liefert den internen Task-Bezeichner für die Verwendung in + Datei-Kommandos. Beispiel: + + save ("datei", archive) + +brother + TASK PROC brother (TASK CONST task) + Zweck: Liefert den internen Task-Bezeichner der angegebenen "Bruder"- + Task. + +check + PROC check (TEXT CONST dateiname, TASK CONST task) + Zweck: Überprüft, ob die Datei 'dateiname' auf dem Archiv lesbar ist. + Beispiel: + + check ("meine datei", archive) + + PROC check (THESAURUS CONST t, TASK CONST task) + Zweck: Überprüft, ob die in dem Thesaurus 't' enthaltenen Dateien auf dem + Archiv lesbar sind. Beispiel: + + check (ALL archive, archive) + +clear + PROC clear (TASK CONST task) + Zweck: Löscht alle Dateien der Task 'task'. Ist z.Z. nur für die Task + 'ARCHIVE' implementiert. + +clear removed (F) + PROC clear removed (FILE VAR f) + Zweck: Löscht die mit 'remove' "vorsichtig" gelöschten Zeilen aus der + Datei 'f' endgültig. + +close (F) + PROC close (FILE VAR file) + Zweck: Schließen der Datei 'file'. Im EUMEL-System ist der Aufruf von + 'close' nicht notwendig. 'close' wurde nur aufgenommen, um die + Kompatibilität zu Standard zu wahren. + +col (F) + PROC col (FILE VAR f, INT CONST position) + Zweck: Positionierung auf die Spalte 'position' innerhalb der aktuellen + Zeile. + + INT PROC col (FILE CONST f) + Zweck: Liefert die aktuelle Position innerhalb der aktuellen Zeile. + +copy (F) + PROC copy (TEXT CONST source, destination) + Zweck: Kopiert die Datei 'source' in eine neue Datei mit dem Namen + 'destination' in der Benutzer-Task. + Fehlerfälle: + * destination file already exists + Eine Datei mit dem Namen 'destination' existiert bereits. + * source file does not exist + Die Ursprungsdatei mit dem Namen 'source' ist nicht vorhanden. + * directory overflow + Die Anzahl der zulässigen Dateien der Benutzer-Task ist über- + schritten. + + PROC copy (DATASPACE CONST ds, TEXT CONST destination) + Zweck: Eintragen eines unbenannten DATASPACE in die Datei-Verwaltung. + Fehlerfälle: + * destination file already exists + Eine Datei mit dem Namen 'destination' existiert bereits. + * directory overflow + Die Anzahl der zulässigen Dateien der Benutzer-Task ist über- + schritten. + +create + PROC create (TEXT CONST name) + Zweck: Erschafft einen neuen Datenraum in der Benutzer-Task. + Fehlerfälle: + * file already exists + Eine Datei mit dem Namen 'name' existiert bereits in der Benutzer- + Task. + * directory overflow + Die Anzahl der zulässigen Dateien der Benutzer-Task ist über- + schritten. + +crypt (F) + PROC crypt (TEXT CONST name, parole) + Zweck: Verschlüsseln des Inhaltes der Datei 'name' mit Hilfe des Textes + 'parole' für Zwecke des Datenschutzes. Die Verschlüsselung ist + umso besser (bzw. umso schwieriger zu "knacken"), je länger der + Text 'parole' ist. Die Datei kann mit der Prozedur 'decrypt' + wieder entschlüsselt werden. + + Eine Datei kann mehrfach verschlüsselt werden. Dabei gilt bei + einer Entschlüsselung das Klammerungsprinzip. Es muß also genau so + oft entschlüsselt werden, wie anfangs verschlüsselt wurde. Dabei + ist auf die richtige Angabe der 'parole'n zu achten. Beispiel: + + crypt ("hugo", "verschluesselung1"); + crypt ("hugo", "verschluesselung2"); + ... + decrypt ("hugo", "verschluesselung2"); + decrypt ("hugo", "verschluesselung1") + + Achtung: 'crypt' und 'decrypt' sind nicht standardmäßig insertiert. + +decrypt (F) + PROC decrypt (TEXT CONST name, parole) + Zweck: Entschlüsselt die Datei 'name' mit Hilfe der angegebenen 'parole'. + Dabei ist darauf zu achten, daß die gleiche 'parole' anzugeben + ist, die verwendet wurde, um die Datei zu verschlüsseln (sonst + wirkt 'decrypt' wie ein erneuter Aufruf von 'crypt').Beim mehr- + fachen Ver- und Entschlüsseln ist das Klammerungsprinzip zu be- + achten (dazu vergl. 'crypt'). + +delete record (F) + PROC delete record (FILE VAR file) + Zweck: Der aktuelle Satz der Datei 'file' wird gelöscht. Der folgende + Satz wird der aktuelle Satz. Die Datei 'file' muß mit der Verar- + beitungsart 'modify' assoziiert worden sein. + +do + PROC do (PROC (TEXT CONST) operate, THESAURUS CONST thesaurus) + Zweck: Ruft 'operate' mit allen im 'thesaurus' enthaltenen Dateinamen + nacheinander auf. Man beachte, daß bei Prozedur-Parametern der + Name der Prozedur hinter dessen Parametern geschrieben wird. + Beispiel: + + do (PROC (TEXT CONST) reorganize, ALL myself) + + PROC do (PROC (TEXT CONST, TASK CONST) operate, + THESAURUS CONST thesaurus, TASK CONST task) + Zweck: S.o.. Dabei ist zu beachten, daß 'task' als zweiter Parameter in + der Prozedur 'operate' eingesetzt wird. Beispiel: + + do (PROC (TEXT CONST, TASK CONST) save, + SOME myself, father) + (* enspricht: *) + save (SOME myself, father) + +down (F) + PROC down (FILE VAR f) + Zweck: Positionieren um eine Zeile vorwärts in der Datei 'f'. + + PROC down (FILE VAR f, INT CONST number) + Zweck: Positionieren um 'number' Zeilen vorwärts in der Datei 'f'. + + PROC down (FILE VAR f, TEXT CONST pattern) + Zweck: Suche nach 'pattern' in der Datei 'f'. Wird 'pattern' gefunden, + ist die Position das erste Zeichen von 'pattern'. Andernfalls + steht man hinter dem letzten Zeichen der Datei. Achtung: 'down' + sucht vom nächsten Zeichen rechts ab, so daß wiederholtes Suchen + keine Endlosschleife ergibt. + + PROC down (FILE VAR f, TEXT CONST pattern, INT CONST number) + Zweck: Wie obiges 'down', aber maximal nur 'number'-Zeilen weit. + +downety (F) + PROC downety (FILE VAR f, TEXT CONST pattern) + Zweck: Suche nach 'pattern' in der Datei 'f'. Wird 'pattern' gefunden, + ist die Position das erste Zeichen von 'pattern'. Andernfalls + steht man auf dem letzten Zeichen der Datei. Achtung: 'downety' + sucht (im Gegensatz zu 'down') vom aktuellen Zeichen. + + PROC downety (FILE VAR f, TEXT CONST pattern, INT CONST number) + Zweck: Wie obiges 'downety', aber maximal nur 'number'-Zeilen weit. + +enter password + PROC enter password (TEXT CONST password) + Zweck: Einstellen eines Paßwortes in der Benutzer-Task für den Datei- + Verkehr mit einer Vater-Task. Der Parameter 'password' kann dabei + aus zwei Teilen bestehen, die durch ein "/"-Zeichen getrennt + werden müssen. Der erste Teil bedeutet das schreib-Passwort, + während der TEXT nach dem "/"-Zeichen das Lese-Paßwort beinhaltet. + Enthält der Parameter 'password' kein "/"-Zeichen, gilt der ange- + gebene TEXT sowohl für das Schreib- wie auch für das Lese-Paßwort. + Im Schreib- bzw. Lese-Teil des Paßworts kann man das "-"-Zeichen + angeben, um eine Datei vor überschreibendem oder lesendem Zugriff + zu schützen. + + Die Paßwort-Überprüfung findet statt bei + + - fetch (Überprüfung der Lese-Berechtigung) + - save (Überprüfung der Schreib-Berechtigung) + - erase (Überprüfung der Schreib-Berechtigung) + +eof (F) + BOOL PROC eof (FILE CONST file) + Zweck: Informationsprozedur auf das Ende eines FILEs. Liefert den Wert + TRUE, sofern hinter den letzten Satz eines FILEs positioniert + wurde. + +erase + PROC erase (TEXT CONST name) + Zweck: Löscht eine Datei mit dem Namen 'name' in der unmittelbaren + Vater-Task. + Fehlerfälle: + * ... gibt es nicht + Eine Datei mit dem Namen 'name' existiert in der unmittelbaren + Vater-Task nicht. + * wrong password + Es wurde mit der Prozedur 'enter password' nicht das richtige + Paßwort angegeben. + + PROC erase (TEXT CONST name, TASK CONST task) + Zweck: Löscht eine Datei mit dem Namen 'name' in der Task 'task'. Bei- + spiel: + + erase ("meine datei", father) + + PROC erase (THESAURUS CONST thesaurus) + Zweck: Löscht die im 'thesaurus' angegebenen Dateien in der Vater-Task. + Beispiel (löscht alle Dateien in der Vater-Task, die in der Benut- + zer-Task vorhanden sind): + + erase (ALL myself) + + PROC erase (THESAURUS CONST thesaurus, TASK CONST manager) + Zweck: S.o.. + +exists (F) + BOOL PROC exists (TEXT CONST name) + Zweck: Informationsprozedur zur Abfrage der Existenz einer Datei in der + Benutzer-Task. Beispiel: + + IF exists ("dateiname") + THEN FILE VAR f :: sequential file ...; + ELSE errorstop ("Datei existiert nicht") + FI + +father + TASK PROC father + Zweck: Liefert den internen Task-Bezeichner der Vater-Task der Benutzer- + Task. Beispiel: + + save ("datei", father) + + TASK PROC father (TASK CONST task) + Zweck: Liefert den internen Task-Bezeichner von 'task'. Beispiel: + + save ("datei", father (father)) (* Kopiert 'datei' zum "Opa" *) + +fetch + PROC fetch (TEXT CONST name) + Zweck: Einbringen einer Datei in die Benutzer-Task von dem "direkten" + Vater im Taskbaum. + Fehlerfälle: + * ... gibt es nicht + Die Datei existiert bei dem Vater nicht. + * directory overflow + Die Anzahl der zulässigen Dateien der Benutzer-Task ist über- + schritten. + * wrong password + Es wurde mit der Prozedur 'enter password' nicht das richtige + Paßwort angegeben. + + PROC fetch (TEXT CONST name, TASK CONST task) + Zweck: Kopieren einer Datei in die Benutzer-Task von 'task'. Beispiel: + + fetch ("datei", public) + + PROC fetch (THESAURUS CONST thesaurus) + Zweck: Holt alle im 'thesaurus' enthaltenen Dateien von der Vater-Task. + + PROC fetch (THESAURUS CONST thesaurus, TASK CONST manager) + Zweck: Holt alle im 'thesaurus' enthaltenen Dateien von der 'manager'- + Task. + +forget (F) + PROC forget (TEXT CONST name) + Zweck: Löschen einer Datei mit dem Namen 'name' in der Benutzer-Task. + Fehlerfälle: + * ... gibt es nicht + Die Datei mit dem Namen 'name' existiert nicht in der Benutzer- + Task. + + PROC forget (DATASPACE VAR ds) + Zweck: Löschen des Datenraums 'ds'. + + PROC forget (THESAURUS CONST thesaurus) + Zweck: Löscht die im 'thesaurus' enthaltenen Dateinamen in der Benutzer- + Task. Beispiel: + + forget (SOME myself) + + PROC forget (TEXT CONST file name, QUIET CONST q) + Zweck: Löschen der Datei 'file name' ohne Anfrage. Als zweiter Parameter + muß 'quiet' übergeben werden. Beispiel: + + forget ("hugo", quiet) + +get (F) + PROC get (FILE VAR f, INT VAR number) + Zweck: Lesen eines INT-Wertes 'number' von der Datei 'f'. + + PROC get (FILE VAR f, REAL VAR number) + Zweck: Lesen eines REAL-Wertes 'number' von der Datei 'f'. + + PROC get (FILE VAR f, TEXT VAR text) + Zweck: Lesen eines TEXT-Wertes 'text' von der Datei 'f'. + + PROC get (FILE VAR f, TEXT VAR text, TEXT CONST delimiter) + Zweck: Lesen eines TEXT-Wertes 'text' von der Datei 'f', bis das Zeichen + 'delimiter' angetroffen wird. Ein eventueller Zeilenwechsel in der + Datei wird dabei nicht übergangen. + + PROC get (FILE VAR f, TEXT VAR text, INT CONST maxlength) + Zweck: Lesen eines TEXT-Wertes 'text' von der Datei 'f' mit 'maxlength' + Zeichen. Ein eventueller Zeilenwechsel in der Datei wird dabei + nicht übergangen. + +getline (F) + PROC get line (FILE VAR file, TEXT VAR record) + Zweck: Lesen einer Zeile 'record' von einer sequentiellen Datei 'file'. + Die Datei muß mit 'input' assoziiert sein (vergl. 'sequential + file'). + Fehlerfälle: + * file not open + Die Datei 'file' ist gegenwärtig nicht assoziiert. + * input after end of file + Es wurde versucht, über die letzte Zeile einer Datei zu lesen. + * input access to output file + Es wurde versucht, von einem mit 'output' assoziierten FILE zu + lesen. + +global manager + PROC global manager + Zweck: Durch den Aufruf der Prozedur wird die Benutzer-Task zu einem + Datei-Manager. Danach können Söhne dieser Task eingerichtet + werden. + +input (F) + PROC input (FILE VAR f) + Zweck: Ändern der Verarbeitungsart von 'modify' oder 'output' in 'input'. + Dabei wird auf den ersten Satz der Datei positioniert. + + TRANSPUTDIRECTION CONST input + Zweck: Assoziierung in Zusammenhang mit der Prozedur 'sequential file' + einer sequentiellen Datei mit der 'TRANSPUTDIRECTION' 'input' (nur + lesen). + +insert record (F) + PROC insert record (FILE VAR file) + Zweck: Es wird ein leerer Satz in die Datei 'file' vor die aktuelle + Position eingefügt. Dieser Satz kann anschließend mit 'write + record' beschrieben werden (d.h. der neue Satz ist jetzt der + aktuelle Satz). Die Datei 'file' muß mit der Verarbeitungsart + 'modify' assoziiert worden sein. + +line no (F) + INT PROC line no (FILE CONST file) + Zweck: Liefert die aktuelle Zeilennummer. + +line (F) + PROC line (FILE VAR file) + Zweck: Positionierung auf die nähhste Zeile der Datei 'file'. Die Datei + 'file' darf mit 'output' oder 'input' assoziiert sein. Wird ver- + sucht, über das Ende eines mit 'input' assoziierten FILEs zu + positionieren, wird keine Aktion vorgenommen. + + PROC line (FILE VAR file, INT CONST lines) + Zweck: Positionierung auf 'lines' nächste Zeilen der Datei 'file'. Die + Datei 'file' darf mit 'output' oder 'input' assoziiert sein. Wird + versucht, über das Ende eines mit 'input' assoziierten FILEs zu + positionieren, wird keine Aktion vorgenommen. Ist 'lines' <= 0, + wird keine Aktion durchgeführt. + +lines (F) + PROC lines (FILE VAR f) + Zweck: Liefert die Anzahl der Zeilen der Datei 'f'. + +list + PROC list + Zweck: Listet alle Dateien der Benutzer-Task mit Namen und Datum des + letzten Zugriffs auf dem Terminal auf. + + PROC list (FILE VAR f) + Zweck: Schreibt alle Dateien der Benutzer-Task mit Namen und Datum der + letzten Änderung in die Datei 'f'. + + PROC list (TASK CONST task) + Zweck: Listet alle Dateien der angegebenen 'task' mit Namen und Datum der + letzten Änderung auf dem Terminal auf. Beispiel: + + list (father) + +max line length (F) + INT PROC max line length (FILE CONST file) + Zweck: Informationsprozedur über die Anzahl von Zeichen in einer Zeile + der Datei 'file'. Standardmäßig sind die Anzahl der Zeichen einer + Zeile wie beim Editor 77 Zeichen. + + PROC max line length (FILE VAR file, INT CONST number) + Zweck: Setzen der Anzahl von Zeichen einer Zeile in dem FILE 'file'. + +modify (F) + TRANSPUTDIRECTION CONST modify + Zweck: Diese Betriebsrichtung erlaubt das Vorwärts- und Rückwärts-Posi- + tionieren und das beliebige Einfügen und Löschen von Sätzen. + 'modify' wird für die Assoziierungsprozedur 'sequential file' + benötigt. + + PROC modify (FILE VAR f) + Zweck: Ändern der Betriebsrichtung von 'input' oder 'output' in die Be- + triebsrichtung 'modify'. + +myself + TASK PROC myself + Zweck: Liefert den internen Task-Bezeichner der Benutzer-Task. Beispiel: + + save (ALL myself, father) + +name + TEXT PROC name (TASK CONST task) + Zweck: Liefert den TEXT-Namen von 'task'. Beispiel: + + put (name (myself)) + +new (F) + DATASPACE PROC new (TEXT CONST name) + Zweck: Richtet eine neue Datei in der Benutzer-Task ein. + Fehlerfälle: + * file already exists + Die Datei mit dem Namen 'name' existiert bereits in der Benutzer- + Task. + * directory overflow + Die Anzahl der zulässigen Dateien in der Benutzer-Task ist über- + schritten. + +nilspace (F) + DATASPACE CONST nilspace + Zweck: Liefert einen leeren Datenraum. + +old (F) + DATASPACE PROC old (TEXT CONST name) + Zweck: Eine bereits vorhandene Datei der Benutzer-Task wird erneut zur + Bearbeitung angemeldet. + Fehlerfälle: + * ... gibt es nicht + Die Datei mit dem Namen 'name' ist nicht in der Benutzer-Task + vorhanden. + +output (F) + PROC output (FILE VAR file) + Zweck: Ändern der Verarbeitungsart von 'input' oder 'modify' in 'output'. + Dabei wird hinter den letzten Satz der Datei positioniert. + + TRANSPUTDIRECTION CONST output + Zweck: In Verbindung mit der Prozedur 'sequential file' kann eine Datei + assoziiert werden mit der Betriebsrichtung 'output' (nur + schreiben). + +pattern found + BOOL PROC pattern found + Zweck: Liefert TRUE, sofern die letzte Suchoperation (siehe 'down' und + 'up') erfolgreich war, sonst FALSE. + +printer + TASK PROC printer + Zweck: Liefert den internen TASK-Bezeichner der SPOOLer-Task für den + Drucker. Beispiel: + + save ("datei", printer) + +public + TASK PROC public + Zweck: Liefert den internen Task-Bezeichner von "PUBLIC". Beispiel: + + fetch ("datei", public) + +put (F) + PROC put (FILE VAR f, INT CONST number) + Zweck: Ausgabe eines INT-Wertes 'number' in die Datei 'f'. Dabei wird ein + Leerzeichen an die Ausgabe angefügt. + + PROC put (FILE VAR f, REAL CONST number) + Zweck: Ausgabe eines REAL-Wertes 'number' in die Datei 'f'. Dabei wird + ein Leerzeichen an die Ausgabe angefügt. + + PROC put (FILE VAR f, TEXT CONST text) + Zweck: Ausgabe eines TEXT-Wertes 'text' in die Datei 'f'. Dabei wird ein + Leerzeichen an die Ausgabe angefügt. + +putline (F) + PROC putline (FILE VAR file, TEXT CONST record) + Zweck: Ausgabe eines TEXTes 'record' in die Datei 'file'. 'file' muß mit + 'output' assoziiert sein. + Fehlerfälle: + * file not open + Die Datei 'file' ist gegenwärtig nicht assoziiert. + * output access to input file + Es wurde versucht, auf einen mit 'input' assoziierten FILE zu + schreiben. + +read record (F) + PROC read record (FILE CONST file, TEXT VAR record) + Zweck: Liest den aktuellen Satz der Datei 'file' in den TEXT 'record'. + Die Position wird dabei nicht verändert. Die Datei 'file' muß mit + der Verarbeitungsart 'modify' assoziiert worden sein. + +reinsert (F) + PROC reinsert (FILE VAR f) + Zweck: Einfügen von "vorsichtig gelöschten" Zeilen (vergl. 'remove') an + der aktuellen Position. + +release + PROC release (TASK CONST task) + Zweck: Aufgabe der Reservierung des Archivs. Ein implizites 'release' + wird automatisch fünf Minuten nach der letzten Archiv-Operation + gegeben, sofern ein 'archive' eines anderen Nutzers vorliegt. + Beispiel: + + release (archive) + +rename (F) + PROC rename (TEXT CONST oldname, newname) + Zweck: Umbenennen einer Datei von 'oldname' in 'newname'. + +remainder + THESAURUS PROC remainder + Zweck: Liefert nach der Unterbrechung einer Thesaurus-Operation den + "Rest"-Thesaurus. + +reorganize (F) + PROC reorganize (TEXT CONST filename) + Zweck: Reorganisiert eine Datei. Die durch eventuelles Einfügen und + Löschen entstandene Lücken werden eliminiert und die Anordung der + Sätze der Datei wird linearisiert. + +reset (F) + PROC reset (FILE VAR file) + Zweck: Positionieren in einem FILE auf den Anfang (bei mit 'input' asso- + ziierten FILEs) oder auf das Ende (bei mit 'output' assoziierten + FILEs). + +reset range (F) + PROC reset range (FILE VAR file) + Zweck: Setzt alle Einschränkungen auf 'file' zurück. Siehe auch 'set + range'. + +remove (F) + PROC remove (FILE VAR f, INT CONST anzahl) + Zweck: Löscht eine 'anzahl' von Zeilen "vorsichtig" aus der Datei 'f', + die mit 'reinsert' an anderer Stelle wieder eingesetzt werden + können. + +save + PROC save (TEXT CONST datei) + Zweck: Datei 'datei' wird an die unmittelbare Vater-Task übertragen. + Fehlerfälle: + * ... gibt es nicht + Eine Datei mit dem Namen 'datei' existiert nicht in der Benutzer- + Task. + * directory overflow + Die Anzahl der zulässigen Dateien in 'task' ist überschritten. + * wrong password + Es wurde mit der Prozedur 'enter password' nicht das richtige + Paßwort angegeben. + + PROC save (TEXT CONST name, TASK CONST task) + Zweck: Datei mit dem Namen 'name' in Task 'task' kopieren. Beispiel: + + save ("meine datei", father) + + Fehlerfälle: + * ... gibt es nicht + Eine Datei mit dem Namen 'name' existiert nicht in der Benutzer- + Task. + * directory overflow + Die Anzahl der zulässigen Dateien in der angegebenen task ist + überschritten. + * wrong password + Es wurde mit der Prozedur 'enter password' nicht das richtige + Paßwort angegeben. + + PROC save (THESAURUS CONST thesaurus) + Zweck: Kopiert die Dateien, die in 'thesaurus' enthalten sind, in die + Vater-Task. Beispiel: + + save (SOME myself) + + PROC save (THESAURUS CONST thesaurus, TASK CONST manager) + Zweck: Kopiert die Dateien, die in 'thesaurus' enthalten sind, in Task + 'manager'. + +segments (F) + INT PROC segments (FILE CONST f) + Zweck: Liefert die Anzahl der Datei-Segmente von 'f'. Nach 'reorganize' + besteht 'f' aus einem Segment. Einfügungen oder Löschungen + erhöhen die Segmentanzahl. + +sequential file (F) + FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, DATASPACE VAR ds) + Zweck: Assoziierung einer sequentiellen Datei mit dem Dataspace 'ds' und + der Betriebsrichtung 'TRANSPUTDIRECTION' (vergl. 'modify', 'input' + bzw. 'output'). Diese Prozedur dient zur Assoziierung eines tempo- + rären Datenraums in der Benutzer-Task, der nach der Beendigung + des Programmlaufs nicht mehr zugriffsfähig ist (weil der Name des + Datenraums nicht mehr ansprechbar ist). Somit muß der Datenraum + explizit vom Programm gelöscht werden. + + FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, TEXT CONST name) + Zweck: Assoziierung einer sequentiellen Datei mit dem Namen 'name' und + der Betriebsrichtung 'TRANSPUTDIRECTION' (vergl. 'input' bzw. + 'output'). Existiert der FILE bereits, dann wird mit 'input' auf + den Anfang des FILEs, bei 'output' hinter den letzten Satz der + Datei positioniert. Existiert dagegen der FILE noch nicht und ist + die TRANSPUTDIRECTION 'output', wird ein neuer FILE eingerichtet. + Fehlerfall: + * input file not existing + Es wurde versucht, einen nicht vorhandenen FILE mit 'input' zu + assoziieren. + +set range (F) + PROC set range (FILE VAR f, INT CONST anz, INT CONST column, FRANGE VAR b) + Zweck: Schränkt die Datei 'f' auf 'anz' Zeilen beginnend bei der Position + 'column' der aktuellen Zeile. Der "alte" Datei-Bereich wird in 'b' + gespeichert. + + PROC set range (FILE VAR f, FRANGE VAR b) + Zweck: Setzt die Datei 'f' auf die in 'b' gespeicherten Bereich zurück. + +son + TASK PROC son (TASK CONST task) + Zweck: Liefert den internen Task-Bezeichner der Sohn-Task. Beispiel: + + put (name (son (myself))) + +SOME + THESAURUS OP SOME (THESAURUS CONST thesaurus) + Zweck: Bietet den angegebenen 'thesaurus' zum Editieren an. Dabei können + nicht erwünschte Namen gestrichen werden. + + THESAURUS OP SOME (TASK CONST task) + Zweck: Bietet einen THESAURUS von 'task' zum Editieren an. + + THESAURUS OP SOME (TEXT CONST file name) + Zweck: Bietet einen 'thesaurus', der aus 'file name' gebildet wird, zum + editieren an. + +to line (F) + PROC to line (FILE VAR f, INT CONST number) + Zweck: Positionierung auf die Zeile 'number'. Nur erlaubt in der + Betriebsrichtung 'modify'. + +task + TASK PROC task (TEXT CONST task name) + Zweck: Liefert den internen Task-Bezeichner von 'task name'. Beispiel: + + save ("datei", task ("PUBLIC")) + + (* das gleiche wie: *) + + save ("datei", public) + +type (F) + INT PROC type (DATASPACE CONST ds) + Zweck: Liefert den frei wählbaren (INT-) Schlüssel des Datenraums 'ds'. + Wurde der Datenraum noch nie angekoppelt, so liefert die Prozedur + 'type' einen Wert < 0, erfolgte eine Ankopplung und hat ein + Programmierer für den Datenraum 'ds' noch keinen anderen Schlüssel + festgelegt, so liefert 'type' den Wert '0'. + + PROC type (DATASPACE CONST ds, INT CONST type) + Zweck: Setzt den frei wählbaren Schlüssel 'type' für den Datenraum 'ds' + (vergl. obige Prozedur 'type'). + +up (F) + PROC up (FILE VAR f) + Zweck: Positionieren um eine Zeile rückwärts in der Datei 'f'. + + PROC up (FILE VAR f, INT CONST number) + Zweck: Positionieren um 'number' Zeilen rückwärts in der Datei 'f'. + + PROC up (FILE VAR f, TEXT CONST pattern) + Zweck: Suche nach 'pattern' rückwärts in der Datei 'f'. Wird 'pattern' + gefunden, ist die Position das erste Zeichen von 'pattern'. + Andernfalls steht man auf dem ersten Zeichen der Datei. Achtung: + 'down' sucht vom nächsten Zeichen links ab, so daß wiederholtes + Suchen keine Endlosschleife ergibt. + + PROC up (FILE VAR f, TEXT CONST pattern, INT CONST number) + Zweck: Wie obiges 'up', aber maximal nur 'number'-Zeilen weit. + +uppety (F) + PROC uppety (FILE VAR f, TEXT CONST pattern) + Zweck: Suche nach 'pattern' rückwärts in der Datei 'f'. Wird 'pattern' + gefunden, ist die Position das erste Zeichen von 'pattern'. + Andernfalls steht man auf dem ersten Zeichen der Datei. Achtung: + 'uppety' sucht (im Gegensatz zu 'up') vom aktuellen Zeichen. + + PROC uppety (FILE VAR f, TEXT CONST pattern, INT CONST number) + Zweck: Wie obiges 'uppety', aber maximal nur 'number'-Zeilen weit. + +word (F) + TEXT PROC word (FILE CONST f) + Zweck: Liefert das aktuelle Wort (bis zum nächsten Leerzeichen oder + Zeilenende). + + TEXT PROC word (FILE CONST f, TEXT CONST sep) + Zweck: Liefert einen Text von der aktuellen Position bis zum nächsten + 'sep-Zeichen oder Zeilenende. + + TEXT CONST word (FILE CONST f, INT CONST len) + Zweck: Liefert einen Text von der aktuellen Position mit der Länge 'len' + bzw. bis zum Zeilenende. + +write (F) + PROC write (FILE VAR f, TEXT CONST text) + Zweck: Schreibt 'text' in die Datei 'f' (analog 'put (f, text)'), aber + ohne Trennblank. + +write record (F) + PROC write record (FILE VAR file, TEXT CONST record) + Zweck: Schreibt einen Satz in die Datei 'file' an die aktuelle Position. + Dieser Satz muß bereits vorhanden sein, d.h. mit 'write record' + kann keine leere Datei beschrieben werden, sondern es wird der + Satz an der aktuellen Position überschrieben. Die Position in der + Datei wird nicht verändert. Die Datei 'file' muß mit der Verar- + beitungsart 'modify' assoziiert worden sein. + + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil8 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil8 new file mode 100644 index 0000000..16e4d07 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil8 @@ -0,0 +1,1345 @@ + EUMEL-Benutzerhandbuch + + TEIL 8: Standardpakete + + +1. Übersicht + +Hier werden die im EUMEL-System verfügbaren Prozeduren und Operatoren aufge- +führt, die nicht bereits in anderen Teilen des Benutzerhandbuchs beschrieben +wurden. + +Die meisten der hier beschriebenen Objekte werden nicht vom ELAN-Compiler, +sondern von vorübersetzten Moduln (PACKETs) realisiert (vergl. dazu auch den +Quellcode). Die in diesem Teil beschriebenen Prozeduren und Operatoren +weisen einige wenige Modifikationen, aber beträchtliche Erweiterungen gegen- +über dem Standard auf, um sie für die Zwecke des EUMEL-Systems anzupassen. +Hier werden nur diejenigen Objekte aufgeführt, die bei einer System-Aus- +lieferung dem EUMEL-System beigefügt sind. Jeder Installation ist es frei- +gestellt, diesen "EUMEL-Standard" zu erweitern oder zu modifizieren. + +Die Operationen des EUMEL-Standards lassen sich in verschiedene Klassen - +je nach Aufgabenbereich - ordnen. + + + +Ein-/Ausgabe + +Die Ein-/Ausgabe erfolgt im EUMEL-System in der Regel auf dem Terminal des +Benutzers. Sie kann aber auch in einen File umgeleitet werden. + +Die Ein-/Ausgabe eines Programms erfolgt in der Regel auf dem Terminal des +Benutzers, welches einem Prozeß zugeordnet ist. Die Eingabe vom Bildschirm +kann man mit den Prozeduren + + get + +programmieren, welche INT, REAL und TEXT-Werte einlesen. Bei der Eingabe +kann der Eingabetext editiert werden (Zeichen löschen, einfügen, über- +schreiben oder Lernsequenzen abrufen). Die Ausgabe erfolgt mit den Proze- +duren + + put + +(für INT-, REAL- und TEXT-Werte). Von den 'put'-Prozeduren wird ein Leer- +zeichen an eine Ausgabe angefügt, um diese von der vorhergehenden zu trennen. +Zusätzlich existiert die + + write + +Prozedur, welche an die Ausgabe kein Leerzeichen anfügt. Mit + + line + +kann man eine Positionierung auf eine neue Zeile bei der Ein-/Ausgabe er- +wirken. Mit + + getline + putline + +kann eine ganze Zeile eingelesen bzw. ausgegeben werden. + +Wie bereits erwähnt, erfolgt die Ein-/Ausgabe in der Regel auf dem Terminal +des Benutzers. Es ist jedoch möglich, die Ein-/Ausgabe dieser Prozeduren +"umzuleiten". Diese Umleitung erfolgt in eine oder von einer Datei. Dazu +gibt es die Prozeduren + + online (* liefert TRUE, wenn die Task an ein Terminal + gekoppelt ist *) + sysout ("name") (* Ausgabe erfolgt in die Datei 'name'. 'sysout + ("")' schaltet auf das Terminal zurück *) + sysout (* Liefert den Namen der eingestellten 'sysout'- + Datei. Wird "" geliefert, ist man an ein + Terminal gekoppelt *) + sysin ("name") (* Umschaltung der Eingabe vom Terminal auf die + Datei 'name'. sysin ("")' schaltet auf das + Terminal zurück *) + sysin (* Liefert den Namen der eingestellten 'sysin'- + Datei. Wird "" geliefert, ist man an ein + Terminal gekoppelt *) + +Wie bereits erwähnt, ist die Umschaltung nur für die Prozeduren 'get' und +'put'/'write', sowie 'getline' und 'putline' und die Prozedur 'line' möglich. +(Die folgenden Prozeduren haben immer eine Wirkung auf das Benutzer- +Terminal). Die Prozedur + + out + +schreibt wie 'write' einen Text auf den Bildschirm (läßt sich aber nicht +"umleiten"). + + cout + +schreibt einen INT-Wert an die aktuelle Cursor-Position auf den Bildschirm +und positioniert anschließend auf diese Position wieder zurück. Diese +Prozedur wird vorwiegend für Kontroll-Ausgaben (z.B. Zeilennummern) benutzt. +Ist die Task nicht angekoppelt, geht die Ausgabe ins "Leere"; das Programm +der Task läuft also weiter (im Gegensatz zu 'put' auf den Bildschirm). Mit +der Prozedur + + cursor + +kann - neben der Möglichkeit des Arbeitens mit Steuerzeichen - auf eine +bestimmte Position des Bildschirms positioniert werden. Mit + + get cursor + +kann die aktuelle Position des Cursors auf dem Terminal des Benutzers er- +fragt werden. Mit Hilfe der Prozedur + + inchar + +kann ein Zeichen vom Bildschirm gelesen werden. Der Prozeß wartet solange, +bis ein Zeichen eingegeben wird. Dagegen wird bei + + incharety + +niltext geliefert, wenn kein Zeichen eingegeben wurde. Eine weitere 'inchare- +ty'-Prozedur wartet zusätzlich noch eine angebbare Zeitdauer, ob ein Zeichen +eingegeben wird. Der Operator + + TIMESOUT + +stellt einen TEXT mehrfach auf dem Bildschirm dar. Die Prozedur + + page + +positioniert auf einen "neuen Bildschirm": der Bildschirm wird gelöscht und +der Cursor befindet sich anschließend in der linken oberen Ecke des Bild- +schirms. + + + +Manipulation von Texten + +Ein Text kann im EUMEL-System bis zu 32 000 Zeichen haben. Für TEXTe +stehen neben der Zuweisung die Vergleichsoperatoren + + = , < , <= , > , >= , <> + +zur Verfügung. Dabei ist die lexikographische Reihenfolge der Zeichen (vergl. +EUMEL-Zeichensatz) zu beachten. Zur Verkettung zweier TEXTe ist der + + + + +Operator vorhanden. Der Operator + + * + +nimmt eine Vervielfachung eines TEXTes vor. Der Operator + + CAT + +konkateniert den linken mit dem rechten Operanden und weist das Resultat dem +linken Operanden zu. Die Prozeduren + + pos + +liefern die Position des ersten Auftretens eines TEXTes oder einer +Zeichenklasse in einem anderen TEXT. Die Prozeduren + + code + +konvertieren ein Zeichen in einen INT-Wert und umgekehrt (vergl. dazu den +EUMEL-Zeichensatz) und dienen z.B. zur Behandlung von Zeichen, die nicht +auf einer Tastatur zu finden sind. Die Prozedur + + compress + +schneidet führende und nachfolgende Leerzeichen eines TEXTs ab, während + + delete char (* ein Zeichen loeschen *) + insert char (* ein Zeichen einfuegen *) + +ein Zeichen einfügt bzw. löscht. Mit + + change + +kann bei dem erstmaligen Auftreten eines Teiltextes in einem TEXT dieser +ersetzt werden. Mit + + change all + +kann jedesmal, wenn ein Teiltext in einem TEXT auftritt, dieser durch einen +anderen Text ersetzt werden. + + LENGTH (* oder *) + length + +liefert die Länge (d.h. die Anzahl der Zeichen in einem TEXT einschließlich +der Leerzeichen) eines TEXTes. Mit + + replace + +kann eine Ersetzung eines Teiltextes erzielt werden. Im Gegensatz zu +'replace' kann sich bei 'change' die Länge des Textes ändern. Mit + + SUB + subtext + +kann ein Zeichen ('SUB') oder ein Teiltext ('subtext') aus einem Text geholt +werden. + +TEXTe werden im EUMEL-System über einen Heap realisiert, d.h. nicht wie +andere Objekte auf einem Stack. Das hat u.a. zur Folge, daß TEXT-"Leichen" +auf dem Heap nicht automatisch beseitigt werden. Darum kann der benötigte +Speicherplatz durch TEXT-Operationen anwachsen. Der Heap kann nun von +unnötigem Speicherplatz durch die Prozedur + + collect heap garbage + +bereinigt werden. Die Größe des Heaps (in KB) kann durch die Prozedur + + heap size + +erfragt werden. Übrigens überprüft der Standard-Monitor nach jedem Kommando +die Heap-Größe und veranlaßt eine Bereinigung des Heaps, wenn dieser um +mindestens 4 KB gewachsen ist. + + + +Mathematische Operationen + +Folgende mathematische Prozeduren bzw. Operatoren stehen im EUMEL zur Zeit +zur Verfügung (manche Prozeduren stehen in mehr als einer Version zur +Verfügung, z.B. die sin-Prozedur für Radiant und Winkelgrad): + + ** (* Exponentiation *) + abs (* Absolutbetrag *) + arctan (* Arcus Tangens-Funktion *) + cos (* Kosinus-Funktion *) + e (* Eulersche Zahl (2.718282) *) + pi (* Die Zahl pi (3.141593) *) + exp (* Exponential-Funktion *) + floor (* REAL mit abgeschnittenen Nachkommastellen *) + frac (* Nachkommastellen eines REALs *) + random, + initialize random (* Zufallszahlen *) + ln, log2, log10 (* Logarithmus-Funktionen *) + max, min (* Minimum bzw. Maximum zweier Werte *) + MOD (* Modulo-Funktion *) + round (* Rundung *) + sign (* Vorzeichen feststellen *) + sin (* Sinus-Funktion *) + sqrt (* Wurzel-Funktion *) + tan (* Tangens-Funktion *) + + + +Konvertierungs-Operationen + +Mit den Prozeduren + + text + +kann aus einem INT- bzw. REAL-Wert ein TEXT, während mit + + int + +aus einem REAL- bzw. TEXT-Wert ein INT und mit + + real + +aus einem INT- bzw. TEXT-Wert ein REAL gemacht werden kann. Mit + + last conversion ok + +kann abgefragt werden, ob die letzte Umwandlung ohne Fehler bzw. fehlerhaft +vorgenommen wurde. Mit + + decimal exponent + +kann der Exponent eines REAL-Wertes ausgeblendet werden. + + + +Kommando-Dialog + +Die Prozeduren für den Kommando-Dialog dienen zur bequemen Programmierung +von interaktiven Anfragen an einen Benutzer eines Programms. (Diese +Prozeduren werden u.a. auch vom Monitor verwendet). Der Kommando-Dialog +ist im Normalfall eingeschaltet. Mit der Prozedur + + command dialogue + +kann man den Kommando-Dialog ein- bzw. ausschalten. Mit der Prozedur + + say + +kann - sofern der Kommando-Dialog eingeschaltet ist - ein Text auf dem +Bildschirm ausgegeben werden. Sofern der Kommando-Dialog eingeschaltet ist, +schreibt die Prozedur + + yes + +einen Text auf den Bildschirm des Benutzers. An den Text wird '(j/n) ?' +angefügt. Die Prozedur 'yes' liefert den Wert TRUE, sofern der Benutzer auf +die Frage mit dem Zeichen "j" antwortet und den Wert FALSE, sofern die +Antwort "n" lautete. Die Prozedur + + no + +arbeitet wie 'NOT yes'. + + + +Verschiedenes + +Mit den Prozeduren + + stop + errorstop + +kann ein Abbruch (letztere mit Meldung; vergl. Fehlerbehandlung im System- +handbuch) erreicht werden. Die Prozedur + + clock + +liefert Zeitwerte als REAL-Wert, nämlich die verbrauchte CPU-Zeit einer Task +oder die aktuelle Uhrzeit (inklusive Datum). Die Prozedur + + time of day + +liefert die aktuelle Uhrzeit. Mit den Konvertierungsprozeduren + + date + time + +können die Werte der Prozedur 'clock' in eine lesbare Form gebracht werden. +Mit der Prozedur + + pause + +kann eine bestimmte Zeitdauer gewartet werden, ohne den Prozessor zu be- +lasten. Die Wartezeit wird abgebrochen, wenn die Zeitgrenze erreicht ist +oder sobald ein Zeichen am Terminal des Benutzers eingegeben wurde. Dieses +Zeichen wird nicht verarbeitet. + + + +2. Die EUMEL-Standardpakete + +Die elementaren Datentypen BOOL, INT, REAL, TEXT und die entsprechenden Zu- +weisungsoperatoren werden hier nicht angegeben. + += + BOOL OP = (INT CONST a, b) + Zweck: Vergleich. + + BOOL OP = (REAL CONST a, b) + Zweck: Vergleich. + + BOOL OP = (TEXT CONST left, right) + Zweck: Vergleich von zwei Texten auf Gleichheit (Texte mit ungleichen + Längen sind immer ungleich). + +< + BOOL OP < (INT CONST a, b) + Zweck: Vergleich auf kleiner. + + BOOL OP < (REAL CONST a, b) + Zweck: Vergleich auf kleiner. + + BOOL OP < (TEXT CONST left, right) + Zweck: Vergleich zweier Texte auf kleiner ('left' kommt lexikographisch + vor 'right'). + +> + BOOL OP > (INT CONST a, b) + Zweck: Vergleich auf größer. + + BOOL OP > (REAL CONST a, b) + Zweck: Vergleich auf größer. + + BOOL OP > (TEXT CONST left, right) + Zweck: Vergleich zweier Texte auf größer ('left' kommt lexikographisch + nach 'right'). + +<= + BOOL OP <= (INT CONST a, b) + Zweck: Vergleich auf kleiner gleich. + + BOOL OP <= (REAL CONST a, b) + Zweck: Vergleich auf kleiner gleich. + + BOOL OP <= (TEXT CONST left, right) + Zweck: Vergleich von zwei Texten auf kleiner gleich ('left' kommt + lexikographisch vor oder ist gleich 'right'). + +>= + BOOL OP >= (INT CONST a, b) + Zweck: Vergleich auf größer gleich. + + BOOL OP >= (REAL CONST a, b) + Zweck: Vergleich auf größer gleich. + + BOOL OP >= (TEXT CONST left, right) + Zweck: Vergleich zweier Texte auf größer gleich ('left' kommt lexiko- + graphisch nach oder ist gleich 'right'). + +<> + BOOL OP <> (INT CONST a, b) + Zweck: Vergleich auf Ungleichheit. + + BOOL OP <> (REAL CONST a, b) + Zweck: Vergleich auf Ungleichheit. + + BOOL OP <> (TEXT CONST left, right) + Zweck: Vergleich von zwei Texten auf Ungleichheit (Texte mit ungleichen + Längen sind stets ungleich). + ++ + INT OP + (INT CONST a) + Zweck: Monadischer Operator (Vorzeichen, ohne Wirkung). + + REAL OP + (REAL CONST a) + Zweck: Monadischer Operator (Vorzeichen, ohne Wirkung). + + INT OP + (INT CONST a, b) + Zweck: Addition. + + REAL OP + (REAL CONST a, b) + Zweck: Addition. + + TEXT OP + (TEXT CONST left, right) + Zweck: Verkettung der Texte 'left' und 'right' in dieser Reihenfolge. Die + Länge des Resultats ergibt sich aus der Addition der Längen der + Operanden. + +- + INT OP - (INT CONST a) + Zweck: Vorzeichen-Umkehrung. + + REAL OP - (REAL CONST a) + Zweck: Vorzeichen-Umkehrung. + + INT OP - (INT CONST a, b) + Zweck: Subtraktion. + + REAL OP - (REAL CONST a, b) + Zweck: Subtraktion. + +* + INT OP * (INT CONST a, b) + Zweck: Multiplikation. + + REAL OP * (REAL CONST a, b) + Zweck: Multiplikation. + + TEXT OP * (INT CONST times, TEXT CONST source) + Zweck: 'times' fache Erstellung von 'source' und Verkettung. Dabei muß + + times >= 0 + + sein, sonst wird 'niltext' geliefert. + +/ + REAL OP / (REAL CONST a, b) + Zweck: Division. + Fehlerfall: + * Division durch 0 + +** + INT OP ** (INT CONST arg, exp) + Zweck: Exponentiation mit 'exp' >= 0 + Fehlerfälle: + * INT OP ** : negative exponent + Ein negativer Exponent ist nicht zugelassen. + * 0 ** 0 is not defined + 'arg' und 'exp' dürfen nicht beide 0 sein. + + REAL OP ** (REAL CONST arg, exp) + Zweck: Exponentiation. + Fehlerfälle: + * hoch mit negativer basis + Der 'exp' muß >= 0.0 sein. + * 0**0 geht nicht + 'arg' und 'exp' dürfen nicht gleichzeitig 0.0 sein. + + REAL OP ** (REAL CONST arg, INT CONST exp) + Zweck: Exponentiation. + Fehlerfall: + * 0.0 ** 0 geht nicht + +abs + INT PROC abs (INT CONST argument) + Zweck: Absolutbetrag eines INT-Wertes. + + INT OP ABS (INT CONST argument) + Zweck: Absolutbetrag eines INT-Wertes. + + REAL PROC abs (REAL CONST value) + Zweck: Absolutbetrag eines REAL-Wertes. + + REAL OP ABS (REAL CONST value) + Zweck: Absolutbetrag eines REAL-Wertes. + +AND + BOOL OP AND (BOOL CONST a, b) + Zweck: Logisches und. + +arctan + REAL PROC arctan (REAL CONST x) + Zweck: Arcus Tangens-Funktion. Liefert einen Wert in Radiant. + +arctand + REAL PROC arctand (REAL CONST x) + Zweck: Arcus Tangens-Funktion. Liefert einen Wert in Grad. + +CAT + OP CAT (TEXT VAR left, TEXT CONST right) + Zweck: Hat die gleiche Wirkung wie + + left := left + right + + Hinweis: Der Operator 'CAT' hat eine geringere Heap-Belastung als + die Operation mit expliziter Zuweisung. + +change + PROC change (TEXT VAR destination, TEXT CONST old, new) + Zweck: Ersetzung des (Teil-) TEXTes 'old' in 'destination' durch 'new' bei + dem erstmaligen Auftreten. Ist 'old' nicht in 'source' vorhanden, + so wird keine Meldung abgesetzt (Abweichung vom Standard). Beachte, + daß sich dabei die Länge von 'destination' verändern kann. + Beispiel: + + TEXT VAR mein text :: "EUMEL-Benutzerhandbuch"; + change (mein text, "Ben", "N"); (* EUMEL-Nutzerhandbuch *) + +PROC change (TEXT VAR destination, INT CONST from, to, TEXT CONST new) + Zweck: Der TEXT 'new' wird in den TEXT 'destination' anstatt des TEXTes, + der zwischen 'from' und 'to' steht, eingesetzt. Beachte, daß sich + dabei die Länge von 'destination' ändern kann. Beispiel: + + TEXT VAR mein text :: "EUMEL-Benutzerhandbuch"; + change (mein text, 7, 9, "N"); (* wie oben *) + +change all + PROC change all (TEXT VAR destination, TEXT CONST old, new) + Zweck: Der Teiltext 'old' wird durch 'new' in 'destination' ersetzt. Im + Unterschied zur 'change'-Prozedur findet die Ersetzung nicht nur + bei dem erstmaligen Auftreten von 'old' statt, sondern so oft, wie + 'old' in 'destination' vorhanden ist. Beispiel: + + + TEXT VAR x :: "Das ist ein Satz"; + change all (x, " ", ""); (* DasisteinSatz *) + +clock + REAL PROC clock (INT CONST index) + Zweck: Datum und Uhrzeit werden vom EUMEL-System für alle Tasks geführt. + Neben einer Uhr ('Realzeituhr'), die das Datum und die aktuelle + Uhrzeit enthält, wird eine Uhr für die von der Task verbrauchte + CPU-Zeit geführt ('CPU-Zeituhr'). Beide Zeiten werden vom System + als REALs realisiert. Die Prozedur 'clock' liefert die aktuellen + Werte dieser Uhren. Bei 'index = 0' wird die akkumulierte CPU-Zeit + der Task, bei 'index = 1' der Wert der Realzeituhr geliefert. + + Mit den REAL-Werten der Uhren kann ohne weiteres gerechnet werden, + jedoch sind nur Werte > 0 definiert. Die REAL-Werte der Realzeit- + uhr beginnen beim 1.1.1900 um 0 Uhr. Es sind nur Werte für dieses + Jahrhundert zugelassen. Werte der Realzeituhr in lesbarer Form + kann man durch die Konvertierungsprozeduren 'date' (für den + aktuellen Tag) und 'time of day' (Uhrzeit) erhalten. + + Um die benötigte CPU-Zeit eines Programms zu berechnen, muß man + die CPU-Zeituhr zweimal abfragen. Um solche Zeiten in lesbarer + Form zu erhalten, kann man die Konvertierungsprozedur 'time' + verwenden. Beispiel: + + REAL CONST anfang :: clock (0); + berechnungen; + REAL CONST ende :: clock (0); + put ("benoetigte CPU-Zeit:"); + put (time (ende - anfang)) + +code + TEXT PROC code (INT CONST code) + Zweck: Wandelt einen INT-Wert 'code' in ein Zeichen um. 'code' muß + + 1 <= code <= 254 + + sein. + + INT PROC code (TEXT CONST text) + Zweck: Wandelt ein Zeichen 'text' in einen INT-Wert um. Ist + + LENGTH text <> 1 + + dann wird der Wert -1 geliefert (also bei mehr als ein Zeichen + oder niltext). + +collect heap garbage + PROC collect heap garbage + Zweck: Bereinigung des Heaps von nicht mehr benötigten TEXTen. + +command dialogue + PROC command dialogue (BOOL CONST status) + Zweck: Ein- bzw. Ausschalten des Kommando-Dialogs. Ist der Kommando- + dialog eingeschaltet, dann funktionieren z.B. die Prozeduren 'yes' + bzw. 'no' und ein Aufruf der Prozedur 'errorstop' liefert eine + Fehlermeldung auf dem Terminal. Ist der Kommandodialog ausge- + schaltet, wird z.B. durch die Prozedur 'yes' kein Text ausgegeben + (es wird TRUE geliefert) und errorstop erzeugt keine Fehler- + meldungen. + + BOOL PROC command dialogue + Zweck: Liefert den Wert TRUE, wenn der Kommando-Dialog eingeschaltet + ist, andernfalls FALSE. + +compress + TEXT PROC compress (TEXT CONST text) + Zweck: Liefert den TEXT 'text' ohne führende und nachfolgende Leerzeichen. + +cos + REAL PROC cos (REAL CONST x) + Zweck: Kosinus-Funktion. 'x' muß in Radiant angegeben werden. + +cosd + REAL PROC cosd (REAL CONST x) + Zweck: Cosinus-Funktion. 'x' muß in Winkelgrad angegeben werden. + +cout + PROC cout (INT CONST number) + Zweck: Schreibt 'number' an die aktuelle Cursor-Position auf den Bild- + schirm. Anschließend wird an diese Position wieder zurück positio- + niert. 'number' muß > 0 sein. Paßt 'number' nicht mehr auf die + Zeile, so ist die Wirkung von 'cout' nicht definiert. 'cout' gibt + den Wert von 'number' nur aus, wenn genügend freie Kanal-Kapazität + für diese Ausgabe vorhanden ist. Das hat zur Folge, daß Programme + nicht auf die Beendigung einer Ausgabe von 'number' warten müssen + und ggf. Ausgaben überschlagen werden. + +cursor + PROC cursor (INT CONST column, row) + Zweck: Positioniert den Cursor auf dem Bildschirm, wobei 'column' die + Spalte und 'row' die Zeile angibt. Die zulässigen Bereiche von + 'column' und 'row' sind geräteabhängig. Zur Zeit gilt auf allen + EUMEL-Geräten + + 1 <= column <= 80 + 1 <= row <= 24 + +date + TEXT PROC date (REAL CONST time) + Zweck: Konvertierungsprozedur für das Datum, welches sich aus dem Aufruf + der Prozedur 'clock (1)' ergibt. Das Datum wird in der Form + 'tt.mm.jj' geliefert. Beispiel: + + put (date (clock (1))) (* z.B.: 24.12.82 *) + + + REAL PROC date (TEXT CONST datum) + Zweck: Konvertierungsprozedur für ein Datum in der Form 'tt.mm.jj'. + Liefert einen REAL-Wert, wie ihn die Prozedur 'clock (1)' liefern + würde. Beispiel: + + put (date ("24.12.82")) (* 6.270670e10 *) + + TEXT PROC date + Zweck: Liefert das Tagesdatum. Wirkt wie 'date (clock (1))', ist jedoch + erheblich schneller. + +day + REAL CONST day + Zweck: Liefert die Anzahl der Sekunden eines Tages (86 400.0). + +decimal exponent + INT PROC decimal exponent (REAL CONST mantisse) + Zweck: Liefert aus einem REAL-Wert den dezimalen Exponenten als INT-Wert. + +DECR + OP DECR (INT VAR left, INT CONST right) + Zweck: Wirkt wie left := left - right + + OP DECR (REAL VAR left, REAL CONST right) + Zweck: Wirkt wie left := left - right + +delete char + PROC delete char (TEXT VAR string, INT CONST delete pos) + Zweck: Löscht ein Zeichen aus dem Text 'string' an der Position 'delete + pos'. Für + + delete pos <= 0 + + oder + + delete pos > LENGTH string + + wird keine Aktion vorgenommen. + +DIV + INT OP DIV (INT CONST a, b) + Zweck: INT-Division. + Fehlerfall: + * DIV by 0 + Division durch Null. + +e + REAL CONST e + Zweck: Eulersche Zahl (2.718282). + +errorstop + PROC errorstop (TEXT CONST error message) + Zweck: Abbruch unter Ausgabe einer Fehlermeldung (vergl. Fehlerbehand- + lung). + +exp + REAL PROC exp (REAL CONST z) + Zweck: Exponentialfunktion. + +floor + REAL PROC floor (REAL CONST real) + Zweck: Schneidet die Nachkommastellen des REAL-Wertes 'real' ab. + +frac + REAL PROC frac (REAL CONST z) + Zweck: Liefert die Stellen eines REAL-Wertes hinter dem Dezimalpunkt. + +get + PROC get (INT VAR number) + Zweck: Einlesen eines INT-Wertes vom Bildschirm. Der einzulesende INT- + Wert kann bei der Eingabe vom Terminal editiert werden. Die + Eingabe kann vom Benutzer-Terminal so umgeleitet werden, daß sie + von einer Datei aus erfolgt (vergl. 'sysin'). + + PROC get (REAL VAR value) + Zweck: Einlesen eines REAL-Wertes vom Bildschirm. Der einzulesende + REAL-Wert kann bei der Eingabe vom Terminal editiert werden. Die + Eingabe kann vom Benutzer-Terminal so umgeleitet werden, daß sie + von einer Datei aus erfolgt (vergl. 'sysin'). + + PROC get (TEXT VAR word) + Zweck: Liest einen Text in die Variable 'word' mit maximal 255 Zeichen. + Es werden solange Zeichen vom Terminal gelesen, bis ein Leer- + zeichen oder ein Positionierungszeichen eingegeben wird. Dabei + werden führende Leerzeichen übergeben. Der einzulesende Text kann + bei der Eingabe editiert werden. Eine leere Eingabe ist nicht + erlaubt. Die Eingabe kann vom Benutzer-Terminal so umgeleitet + werden, daß sie von einer Datei aus erfolgt (vergl. 'sysin'). + + PROC get (TEXT VAR word, INT CONST laenge) + Zweck: Liest einen Text vom Bildschirm mit der Länge 'laenge' oder bis + ein Positionierungszeichen angetroffen wird. Der einzulesende Wert + kann bei der Eingabe editiert werden. Dabei gilt: + + 1 <= laenge <= 255 + + PROC get (TEXT VAR word, TEXT CONST separator) + Zweck: Liest einen Text vom Bildschirm, bis ein Zeichen 'separator' ange- + troffen oder ein Positionierungszeichen eingegeben wird. Der ein- + zulesende Text kann bei der Eingabe editiert werden. + +get cursor + PROC get cursor (INT VAR x, y) + Zweck: Erfragung der aktuellen Cursor-Position. Die Koordinaten des Cur- + sors werden in 'x' und 'y' geliefert. Die aktuelle Cursor-Position + ist nach Ausgabe von 'HOME' (Code = 1) oder einer Positionierung + des Cursors mit der Prozedur 'cursor' stets definiert. Die Proze- + dur 'get cursor' liefert jedoch undefinierte Werte, wenn über den + rechten Rand einer Zeile hinausgeschrieben wurde (die Wirkung + einer solchen Operation hängt von der Hardware eines Terminals ab). + +getline + PROC get line (TEXT VAR line) + Zweck: Das System wartet auf eine Zeile vom Bildschirm (max. 255 Zeichen). + Eine leere Eingabe ist nicht möglich. Die Eingabe kann vom Benut- + zer-Terminal so umgeleitet werden, daß sie von einer Datei aus + erfolgt (vergl. 'sysin'). + +heap size + INT PROC heap size + Zweck: Informationsprozedur für die Größe (in KB) des TEXT-Heaps. + +hour + REAL CONST hour + Zweck: Liefert die Anzahl der Sekunden einer Stunde (3600.0). + +inchar + PROC inchar (TEXT VAR character) + Zweck: Wartet solange, bis ein Zeichen von der Tastatur eingegeben wird, + und schreibt dieses Zeichen in die Variable 'character'. + +incharety + TEXT PROC incharety + Zweck: Versucht, ein Zeichen von der Tastatur zu lesen. Wurde kein + Zeichen eingegeben, wird niltext geliefert. + + TEXT PROC incharety (INT CONST time limit) + Zweck: Versucht, ein Zeichen vom Bildschirm zu lesen. Dabei wird maximal + eine 'time limit' lange Zeit auf das Zeichen gewartet (gemessen in + Zehntel-Sekunden). + +INCR + OP INCR (INT VAR left, INT CONST right) + Zweck: Wirkt wie left := left + right + + OP INCR (REAL VAR left, REAL CONST right) + Zweck: Wirkt wie left := left + right + +initialize random + PROC initialize random (INT CONST value) + Zweck: Initialisieren der 'random'-Prozedur, um nicht reproduzierbare + Zufallszahlen zu bekommen. Diese 'init random'-Prozedur gilt für + den "INT-Random Generator". + + PROC initialize random (REAL CONST z) + Zweck: Initialisieren der 'random'-Prozedur mit verschiedenen Werten für + 'z', um nicht reproduzierbare Zufallszahlen zu bekommen. Diese + Prozedur gilt für den "REAL-Random Generator". + +insert char + PROC insert char (TEXT VAR string, TEXT CONST char, INT CONST insert pos) + Zweck: Fügt ein Zeichen 'char' in den Text 'string' an der Position + 'insert pos' ein. Für + + insert pos > LENGTH string + 1 + + wird keine Aktion vorgenommen. Daher ist es möglich, mit dieser + Prozedur auch am Ende eines Textes (Position: LENGTH string + 1) + ein Zeichen anzufügen. + +int + INT PROC int (REAL CONST a) + Zweck: Konvertierungsprozedur. + + INT PROC int (TEXT CONST number) + Zweck: Umwandlung eines Textes in einen INT-Wert. Der Text 'number' darf + ein "+"- oder "-"-Zeichen vor den Ziffern enthalten. Führende + Blanks werden überlesen. Enthält 'number' an einer Position ein + Zeichen, das nicht umgewandelt werden kann, so wird die Umwand- + lung gestoppt und der bis dahin umgewandelte Wert (bzw. der Wert 0) + geliefert. + +last conversion ok + BOOL PROC last conversion ok + Zweck: Liefert den Wert TRUE, sofern die letzte Konvertierungsprozedur + nicht auf einen Fehler bei der Umwandlung gestoßen ist, andernfalls + FALSE. + +length + INT PROC length (TEXT CONST text) + Zweck: Anzahl von Zeichen ("Länge") von 'text' einschließlich Leerzeichen. + +LENGTH + INT OP LENGTH (TEXT CONST text) + Zweck: Anzahl von Zeichen ("Länge") von 'text' einschließlich Leerzeichen. + +line + PROC line + Zweck: Es wird zum Anfang einer neuen Zeile positioniert. + + PROC line (INT CONST number) + Zweck: Es werden 'number' Zeilenwechsel vorgenommen. + +ln + REAL PROC ln (REAL CONST x) + Zweck: Natürlicher Logarithmus. + Fehlerfall: + * ln mit nicht positiver Zahl + Nur echt positive Argumente sind zulässig. + +log2 + REAL PROC log2 (REAL CONST z) + Zweck: Logarithmus zur Basis 2. + Fehlerfall: + * log2 mit negativer zahl + Nur echt positive Argumente sind zulässig. + +log10 + REAL PROC log10 (REAL CONST x) + Zweck: Logarithmus zur Basis 10. + Fehlerfall: + * log10 mit negativer zahl + Nur echt positive Argumente sind zulässig. + +max + INT PROC max (INT CONST first, second) + Zweck: Liefert den Größten der beiden INT-Werte. + + REAL PROC max (REAL CONST first, second) + Zweck: Liefert den Größten der beiden REAL-Werte. + +maxint + INT CONST maxint + Zweck: Größter INT-Wert im EUMEL-System (32 767). + +maxreal + REAL CONST maxreal + Zweck: Größter REAL-Wert im EUMEL-System (9.999999999999e126). + +max text length + INT CONST max text length + Zweck: Maximale Anzahl von Zeichen in einem TEXT (32 000). + +min + INT PROC min (INT CONST first, second) + Zweck: Liefert den Kleinsten der beiden INT-Werte. Beispiele: + + min (3.0, 2.0) ==> 2.0 + min (-2.0, 3.0) ==> -2.0 + + REAL PROC min (REAL CONST first, second) + Zweck: Liefert den Kleinsten der beiden REAL-Werte. + +MOD + INT OP MOD (INT CONST left, right) + Zweck: Liefert den Rest einer INT-Division. Beispiele: + + 3 MOD 2 ==> 1 + -3 MOD 2 ==> 1 + + Fehlerfall: + * DIV by 0 + Division durch 0 ist verboten. + + REAL OP MOD (REAL CONST left, right) + Zweck: Modulo-Funktion für REALs (liefert den Rest). Beispiele: + + 5.0 MOD 2.0 ==> 1.0 + 4.5 MOD 4.0 ==> 0.5 + +no + BOOL PROC no (TEXT CONST question) + Zweck: Wirkt wie + + NOT yes + +NOT + BOOL OP NOT (BOOL CONST a) + Zweck: Logische Negation. + +online + BOOL PROC online + Zweck: Liefert TRUE, wenn die Task mit einem Terminal gekoppelt ist. + +OR + BOOL OP OR (BOOL CONST a, b) + Zweck: Logisches oder. + +out + PROC out (TEXT CONST text) + Zweck: Ausgabe eines Textes auf dem Bildschirm. Im Unterschied zu 'put' + wird kein Blank an den ausgegebenen Text angefügt. 'out' kann + nicht umgeleitet werden (vergl. 'sysout'). + +out subtext + PROC out subtext (TEXT CONST source, INT CONST from) + Zweck: Ausgabe eines Teiltextes von 'source' von der Position 'from' bis + Textende. Es wird keine Aktion vorgenommen für + + from > LENGTH source + + PROC out subtext (TEXT CONST source, INT CONST from, to) + Zweck: Ausgabe eines Teiltextes von 'source' von der Position 'from' bis + zur Position 'to'. Für + + to > LENGTH source + + wird für die fehlenden Zeichen Leerzeichen (blanks) ausgegeben. + +page + PROC page + Zweck: Es wird zum Anfang einer neuen Seite positioniert (hier: linke + obere Ecke des Bildschirms, wobei der Bildschirm gelöscht wird). + +pause + PROC pause (INT CONST time limit) + Zweck: Wartet 'time limit' in Zehntel-Sekunden. Bei negativen Werten ist + die Wirkung nicht definiert. Die Wartezeit wird nicht nur durch + das Erreichen der Grenze abgebrochen, sondern auch durch die + Eingabe eines beliebigen Zeichens. + +pi + REAL CONST pi + Zweck: Die Zahl pi (3.141593). + +pos + INT PROC pos (TEXT CONST source, pattern) + Zweck: Liefert die erste Position des ersten Zeichens von 'pattern' in + 'source', falls 'pattern' gefunden wird. Wird 'pattern' nicht + gefunden oder ist 'pattern' niltext, so wird der Wert '0' ge- + liefert. Beispiel: + + TEXT VAR t1 :: "abcdefghijk...xyz", + t2 :: "cd"; + ... pos (t1, t2) ... (* liefert 3 *) + ... pos (t2, t1) ... (* liefert 0 *) + + INT PROC pos (TEXT CONST source, pattern, INT CONST from) + Zweck: Wie obige Prozedur, jedoch wird erst ab der Position 'from' ab + gesucht. Dabei gilt folgende Einschränkung: + + length (pattern) < 255 + +INT PROC pos (TEXT CONST source, low char, high char, INT CONST from) + Zweck: Liefert die Position des ersten Zeichens 'x' in 'source' ab der + Position 'from', so daß + + low char <= x <= high char + + 'low char' und 'high char' müssen TEXTe der Länge 1 sein. Wird + kein Zeichen in 'source' in dem Bereich zwischen 'low char' und + 'high char' gefunden, wird der Wert '0' geliefert. Beispiel: + + (* Suche nach dem ersten Zeichen <> blank nach einer Leerspalte *) + TEXT VAR zeile :: "BlaBla Hier gehts weiter"; + INT VAR pos erstes blank :: pos (zeile, " "), + ende leerspalte :: pos (zeile, ""33"", ""254"", pos erstes blank); + +put + PROC put (INT CONST number) + Zweck: Ausgabe eines INT-Wertes auf dem Bildschirm. Anschließend wird + ein Leerzeichen ausgegeben. Die Ausgabe kann umgeleitet werden + (vergl. 'sysout'). + + PROC put (REAL CONST real) + Zweck: Ausgabe eines REAL-Wertes auf dem Bildschirm. Anschließend wird + ein Leerzeichen ausgegeben. Die Ausgabe kann umgeleitet werden + (vergl. 'sysout') + + PROC put (TEXT CONST text) + Zweck: Ausgabe eines Textes auf dem Bildschirm. Nach der Ausgabe von + 'text' wird ein Blank ausgegeben, um nachfolgenden Ausgaben auf + der gleichen Zeile voneinander zu trennen. Hardwareabhängig sind + die Aktionen, wenn eine Ausgabe über eine Zeilengrenze (hier: + Bildschirmzeile) vorgenommen wird. Meist wird die Ausgabe auf der + nächsten Zeile fortgesetzt. Die Ausgabe kann umgeleitet werden + (vergl. 'sysout'). + +putline + PROC putline (TEXT CONST text) + Zweck: Ausgabe von 'text' auf dem Bildschirm. Nach der Ausgabe wird auf + den Anfang der nächsten Zeile positioniert. Gibt man TEXTe nur mit + 'putline' aus, so ist gesichert, daß jede Ausgabe auf einer neuen + Zeile beginnt. Hardwareabhängig sind die Aktionen, wenn eine Aus- + gabe über eine Zeilengrenze (hier: Bildschirmzeile) vorgenommen + wird. Meist wird die Ausgabe auf der nächsten Zeile fortgesetzt. + Die Ausgabe kann umgeleitet werden (vergl. 'sysout'). + +random + INT PROC random (INT CONST lower bound, upper bound) + Zweck: Pseudo-Zufallszahlen-Generator im Intervall 'upper bound' und + 'lower bound' einschließlich. Es handelt sich hier um den "INT + Random Generator". + + REAL PROC random + Zweck: Pseudo-Zufallszahlen-Generator im Intervall 0 und 1. Es handelt + sich hier um den "REAL Random Generator". + +real + REAL PROC real (INT CONST a) + Zweck: Konvertierungsprozedur. + + REAL PROC real (TEXT CONST text) + Zweck: Konvertierung eines TEXTes 'text' in einen REAL-Wert. Achtung: Zur + Zeit werden keine Überprüfungen vorgenommen, d.h. in dem TEXT + muß ein REAL-Wert stehen. + +replace + PROC replace (TEXT VAR destination, INT CONST position, TEXT CONST source) + Zweck: Ersetzung eines Teiltextes in 'destination' durch 'source' an der + Position 'position' in 'destination'. Es muß gelten + + 1 <= position <= LENGTH destination + + d.h. 'position' muß innerhalb von 'destination' liegen und 'source' + muß von der Position 'position' ab in 'destination' einsetzbar + sein. Dabei bleibt die Länge von 'destination' unverändert. + +round + REAL PROC round (REAL CONST real, INT CONST digits) + Zweck: Runden eines REAL-Wertes auf 'digits' Stellen. Für positive Werte + wird auf Nachkommastellen gerundet. Beispiel: + + round (3.14159, 3) + + liefert '3.142'. Für negative 'digits'-Werte wird auf Vorkomma- + stellen gerundet. Beispiel: + + round (123.456, -2) + + liefert '100.0'. Abweichung vom Standard: Es wird mit 'digits'- + Ziffern gerundet. + +say + PROC say (TEXT CONST message) + Zweck: Sofern der Kommando-Dialog eingeschaltet ist (vergl. 'command + dialogue'), wird der TEXT 'message' an die augenblickliche Cursor- + Position geschrieben. + +sign + INT PROC sign (INT CONST argument) + Zweck: Feststellen des Vorzeichens eines INT-Wertes. Folgende Werte + werden geliefert: + + argument > 0 ==> 1 + argument = 0 ==> 0 + argument < 0 ==> -1 + + INT OP SIGN (INT CONST argument) + Zweck: Feststellen des Vorzeichens eines INT-Wertes. + + INT PROC sign (REAL CONST number) + Zweck: Feststellen des Vorzeichens eines REAL-Wertes. + + INT OP SIGN (REAL CONST number) + Zweck: Feststellen des Vorzeichens eines REAL-Wertes. + +sin + REAL PROC sin (REAL CONST x) + Zweck: Sinus-Funktion. 'x' muß in Radiant (Bogenmaß) angegeben werden. + +sind + REAL PROC sind (REAL CONST x) + Zweck: Sinus-Funktion. 'x' muß im Winkelgrad angegeben werden. + +smallreal + REAL PROC smallreal + Zweck: Kleinster darstellbarer REAL-Wert im EUMEL-System für den + + 1.0 - smallreal <> 1.0 + 1.0 + smallreal <> 1.0 + + gilt (1.0E-12). + +sqrt + REAL PROC sqrt (REAL CONST z) + Zweck: Wurzel-Funktion. + Fehlerfall: + * sqrt von negativer Zahl + Das Argument muß größer gleich 0.0 sein. + +stop + PROC stop + Zweck: Abbruch (vergl. Fehlerbehandlung). + +SUB + TEXT OP SUB (TEXT CONST text, INT CONST pos) + Zweck: Liefert ein Zeichen aus 'text' an der Position 'pos'. Entspricht + + subtext (text, pos, pos) + + Anmerkung: Effizienter als obiger Prozedur-Aufruf. Für + + pos <= 0 + pos > LENGTH text + + wird niltext geliefert. + +subtext + TEXT PROC subtext (TEXT CONST source, INT CONST from) + Zweck: Teiltext von 'source', der bei der Position 'from' anfängt. Die + Länge des Resultats ergibt sich also zu + + LENGTH source - from + 1 + + d.h. von der Position 'from' bis zum Ende von 'source'. 'from' muß + innerhalb von 'source' liegen. Ist from < 1, dann wird 'source' + geliefert. Falls from > LENGTH source ist, wird niltext geliefert. + + TEXT PROC subtext (TEXT CONST source, ITT CONST from, to) + Zweck: Teiltext von 'source' von der Position 'from' bis einschließlich + der Position 'to'. Die Länge des Resultats ist also + + from - to + 1 + + Dabei muß gelten + + 1 <= from <= to <= LENGTH source + + d.h. die Positionen 'from' und 'to' müssen in dieser Reihenfolge + innerhalb von 'source' liegen. Ist + + to >= LENGTH source + + wird 'subtext (source, from)' ausgeführt. Für die Bedingungen für + 'from' siehe vorstehende Beschreibung von 'subtext'. + +sysin + PROC sysin (TEXT CONST file name) + Zweck: Eingabe-Routinen ('get', 'getline' und 'line') lesen nicht mehr + vom Benutzer-Terminal, sondern aus der Datei 'file name'. + + TEXT PROC sysin + Zweck: Liefert den Namen der eingestellten 'sysin'-Datei. "" bezeichnet + das Benutzer-Terminal. + +sysout + PROC sysout (TEXT CONST file name) + Zweck: Ausgabe-Routinen ('put', 'putline', 'write', 'line') gehen nicht + mehr zum Benutzer-Terminal, sondern in die Datei 'file name'. + + TEXT PROC sysout + Zweck: Liefert den Namen der eingestellten 'sysout'-Datei. "" bezeichnet + das Benutzer-Terminal. + +tan + REAL PROC tan (REAL CONST x) + Zweck: Tangens-Funktion. 'x' muß in Radiant angegeben werden. + +tand + REAL PROC tand (REAL CONST x) + Zweck: Tangens-Funktion. 'x' muß in Winkelgrad angegeben werden. + +text + TEXT PROC text (INT CONST number) + Zweck: Umwandlung eines INT-Wertes in einen Text. Negative Werte werden + mit einem "-"-Zeichen geliefert. + + TEXT PROC text (INT CONST number, laenge) + Zweck: Umwandlung eines INT-Wertes 'number' in einen Text mit der Länge + 'laenge'. Für + + LENGTH (text (number)) < laenge + + werden die Ziffern rechtsbündig in einen Text mit der Länge + 'laenge' eingetragen. Fehlende Ziffern der gewünschten 'laenge' + werden im TEXT vorne mit Leerzeichen aufgefüllt. Für + + LENGTH (text (number)) > laenge + + wird ein Text mit der Länge 'laenge' geliefert, der mit + "*"-Zeichen gefüllt ist. + + TEXT PROC text (REAL CONST real) + Zweck: Konvertierung eines REAL-Wertes in einen TEXT. Ggf. wird der TEXT + in Exponenten-Darstellung geliefert. + + TEXT PROC text (REAL CONST real, laenge) + Zweck: Siehe oben. 'laenge' gibt die Anzahl von Zeichen an. + + TEXT PROC text (REAL CONST real, INT CONST laenge, fracs) + Zweck: Konvertierung eines REAL-Wertes in einen TEXT. Dabei gibt 'laenge' + die Länge des Resultats einschließlich des Dezimalpunktes und + 'fracs' die Anzahl der Dezimalstellen an. Kann der REAL-Wert nicht + wie gewünscht dargestellt werden, wird + + laenge * "*" + + geliefert. + + TEXT PROC text (TEXT CONST source, INT CONST laenge) + Zweck: Teiltext aus 'source' mit der Länge 'laenge', beginnend bei der + Position 1 von 'source'. Es muß gelten + + 1 <= laenge <= LENGTH source + + d.h. der gewünschte Teiltext muß aus 'source' ausblendbar sein. + Wenn + + laenge > LENGTH source + + die Länge des gewünschten Resultats ist größer als die Länge von + 'source' ist, wird der zu liefernde TEXT mit der an 'laenge' + fehlenden Zeichen mit Leerzeichen aufgefüllt. + + TEXT PROC text (TEXT CONST source, INT CONST laenge, from) + Zweck: Teiltext aus 'source' mit der Länge 'laenge', beginnend an der + Position 'from' in dem TEXT 'source'. Entspricht + + text (subtext (source, from, LENGTH source), laenge) + + Es muß + + laenge >= 0 + 1 <= from <= LENGTH source + + gelten, d.h. 'from' muß eine Position angeben, die innerhalb von + 'source' liegt. Für + + laenge > LENGTH source - from + 1 + + also wenn die angegebene Länge 'laenge' größer ist als der auszu- + blendende Text, wird das Resultat rechts mit Leerzeichen aufge- + füllt. Wenn + + laenge < LENGTH source - from + 1 + + d.h. wenn die angegebene Länge kleiner ist als der Teiltext von + 'from' bis zum letzten Zeichen von 'source', wird das Resultat mit + der Länge + + LENGTH source - from + 1 + + geliefert. + +time + TEXT PROC time (REAL CONST time) + Zweck: Konvertierungsprozedur für die Zeiten der CPU-Zeituhr. Liefert die + Zeiten in der Form 'hh:mm:ss.s'. Vergl. dazu 'clock'. + + TEXT PROC time (REAL CONST value, INT CONST laenge) + Zweck: Konvertiert die Zeit in externe Darstellung. Für die 'laenge'- + Werte ergibt sich: + + laenge = 10 (* hh:mm:ss.s *) + laenge = 12 (* hhh:mm:ss.s *) + +REAL PROC time (TEXT CONST time) + Zweck: Konvertierungsprozedur für Texte der CPU-Zeituhr in REAL-Werte. + +time of day + TEXT PROC time of day (REAL CONST time) + Zweck: Konvertierungsprozedur für REALs, wie sie die Realzeituhr + liefert. Es wird die Tageszeit in der Form 'hh:mm' geliefert. + Beispiel: + + put (time of day (clock (1))) (* z.B.: 17:25 *) + + + TEXT PROC time of day + Zweck: Liefert die aktuelle Tageszeit. Entspricht + + time of day (clock (1)) + +TIMESOUT + OP TIMESOUT (INT CONST times, TEXT CONST text) + Zweck: Ausgabe eines TEXTes 'text' 'times'mal. An die Ausgabe wird im + Gegensatz zu 'put' kein Leerzeichen angefügt. Es wird kein Text + ausgegeben für + + times < 1 + +write + PROC write (TEXT CONST text) + Zweck: Gibt 'text' ohne Trennblank aus ('put' mit Trennblank). Läßt sich + im Gegensatz zu 'out' in eine Datei umleiten (vergl. 'sysout'). + +XOR + BOOL OP XOR (BOOL CONST a, b) + Zweck: Exklusives oder. + +yes + BOOL PROC yes (TEXT CONST question) + Zweck: Sofern der Kommando-Dialog (vergl. 'command dialogue') einge- + schaltet ist, wird der TEXT 'question' auf dem Bildschirm des + Benutzers geschrieben. Der TEXT 'question' wird dabei mit einem + Fragezeichen ergänzt. Der Benutzer kann nun am Terminal mit den + Zeichen 'j' oder 'n' antworten (oder: 'J', 'N', 'y', 'n', 'Y', + 'N'). Nach Eingabe eines dieser Zeichen wird von der Prozedur + 'yes' auf eine neue Zeile positioniert. Die Prozedur 'yes' liefert + den Wert TRUE bei der Eingabe von 'j' und den Wert FALSE bei der + Eingabe von 'n'. Ist der Kommando-Dialog nicht eingeschaltet, + liefert die Prozedur 'yes' den Wert TRUE. + diff --git a/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil9 b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil9 new file mode 100644 index 0000000..318dd06 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/pd.Handbuch.Teil9 @@ -0,0 +1,936 @@ + EUMEL-Benutzerhandbuch + + TEIL 9: Standard-Datentypen + +1. VECTOR und MATRIX + +Vektoren und Matrizen enthalten Elemente vom Datentyp REAL. Für beide Daten- +typen sind die üblichen Operatoren definiert. Im Unterschied zu "normalen" +'ROW n REAL' bzw. 'ROW n ROW m REAL' brauchen die Anzahl der Elemente, die +sich in einem Vektor bzw. in einer Matrix befinden, nicht bereits zur Über- +setzungszeit deklariert, sondern können "dynamisch" zur Laufzeit eines ELAN- +Programms festgelegt werden. Somit ist es möglich, eine zur Übersetzungszeit +noch unbekannte Anzahl von REAL-Elementen zu bearbeiten und dabei nur soviel +Speicherplatz wie notwendig zu verwenden. Bei beiden Datentypen ist die +maximale Anzahl von Elementen jeweils 4 000. + +Bei VECTOR und MATRIX ist auf die üblichen Rundungsfehler bei der Verwendung +von REALs zu achten, die bei umfangreicheren Rechnungen unvermeidlich ent- +stehen. Rundungsfehler durch Ein- bzw. Ausgaberoutinen können z.Zt. im +EUMEL-System jedoch nicht vorkommen, weil REAL-Werte dezimal im Rechner +abgespeichert werden (13 Stellen, von denen jedoch nur 7 ausgegeben werden). + + + +VECTOR + +Folgende VECTOR-Operationen stehen zur Verfügung: + +vector Erzeugung eines VECTOR-Objekts +get Eingabe der Elemente vom Terminal +put Ausgabe der Elemente auf das Terminal +replace Ersetzung eines Elementes eines VECTORs +SUB Zugriff auf ein REAL-Element eines VECTORs +LENGTH Anzahl der Elemente eines VECTORs +length dito +NORM Euklidische Norm + + + - + * + / + := + = + <> + + + +Beschreibung der VECTOR-Operationen + +Aus Optimierungsgründen (Heapbelastung) wurde der Datentyp INITVECTOR ge- +schaffen. Dieser wird im VECTOR-Paket intern gehalten (wird nicht über das +Interface herausgereicht) und kann somit nicht in einer Deklaration benutzt +werden. INITVECTOR wird nur für die Operationen + + := + vector + +verwendet. Bei Verwendung eines Datenobjekts vom Datentyp INITVECTOR wird +nicht soviel Speicherplatz wie bei einem Objekt vom Datentyp VECTOR benötigt. + += + BOOL OP = (VECTOR CONST a, b) + Zweck: Vergleich zweier Vektoren. Der Operator liefert FALSE, wenn die + Anzahl der Elemente von 'a' und 'b' ungleich ist oder wenn zwei + Elemente mit gleichem Index ungleich sind. Beispiel: + + VECTOR VAR x :: vector (10, 1.0), + y :: vector (15, 2.0), + z :: vector (10, 1.0); + ... x = y ... (* FALSE *) + ... x = z ... (* TRUE *) + +<> + BOOL OP <> (VECTOR CONST a, b) + Zweck: Vergleich zweier Vektoren auf Ungleichheit (NOT (a = b)). + +:= + OP := (VECTOR VAR ziel, VECTOR CONST quelle) + Zweck: Zuweisung. Nach der Zuweisung gilt auch + + length (quelle) = length (ziel) + + d.h. der linke Operand besitzt nach der Zuweisung genauso viele + Elemente wie 'quelle', unabhängig davon, ob 'ziel' vor der Zu- + weisung mehr oder weniger Elemente als 'quelle' besaß. Beispiel: + + VECTOR VAR y :: vector (10, 1.0), + z :: vector (15, 2.0); + ... + y := z; (* length (y) liefert nun 15 ! *) + + OP := (VECTOR VAR ziel, INITVECTOR CONST quelle) + Zweck: Dient zur Initialisierung eines VECTORs. Beispiel: + + VECTOR VAR x :: vector (17); + + 'vector' erzeugt ein Objekt vom Datentyp INITVECTOR. Dieses + Objekt braucht nicht soviel Speicherplatz wie ein VECTOR-Objekt. + Dadurch wird vermieden, daß nach erfolgter Zuweisung nicht ein + durch 'vector' erzeugtes Objekt auf dem Heap unnötig Speicher- + platz verbraucht. + ++ + VECTOR OP + (VECTOR CONST a) + Zweck: Monadisches '+' für VECTOR. Keine Auswirkung. + + VECTOR OP + (VECTOR CONST a, b) + Zweck: Elementweise Addition der Vektoren 'a' und 'b'. Beispiel: + + VECTOR VAR x, (* 'x' hat undefinierte Laenge *) + a :: vector (10, 1.0), + b :: vector (10, 2.0); + ... + x := a + b; (* 'x' hat nun 10 Elemente mit Werten '3.0' *) + Fehlerfall: + * VECTOR OP + : LENGTH a <> LENGTH b + 'a' und 'b' haben nicht die gleiche Anzahl von Elementen. + +- + VECTOR OP - (VECTOR CONST a) + Zweck: Monadisches '-'. + + VECTOR OP - (VECTOR CONST a, b) + Zweck: Elementweise Subtraktion der Vektoren 'a' und 'b'. + Fehlerfall: + * VECTOR OP - : LENGTH a <> LENGTH b + 'a' und 'b' haben nicht die gleiche Anzahl von Elementen. + +* + REAL OP * (VECTOR CONST a, b) + Zweck: Skalarprodukt zweier Vektoren. Liefert die Summe der element- + weisen Multiplikation der Vektoren 'a' und 'b'. Beachte even- + tuelle Rundungsfehler! Beispiel: + + REAL VAR a; + VECTOR VAR b :: vector (10, 2.0), + c :: vector (10, 2.0); + ... + a := b * c; (* 40.0 *) + Fehlerfall: + * REAL OP * : LENGTH a <> LENGTH b + 'a' und 'b' haben nicht die gleiche Anzahl von Elementen. + + VECTOR OP * (VECTOR CONST a, REAL CONST s) + Zweck: Multiplikation des Vektors 'a' mit dem Skalar 's'. + + VECTOR OP * (REAL CONST s, VECTOR CONST a) + Zweck: Multiplikation des Skalars 's' mit dem Vektor 'a'. + +/ + VECTOR OP / (VECTOR CONST a, REAL CONST s) + Zweck: Division des Vektors 'a' durch den Skalar 's'. Beispiel: + + VECTOR VAR a, (* 'a' hat undefinierte Laenge *) + b :: vector (10, 4.0); + ... + a := b / 2.0; + (* 'a' hat nun 10 Elemente mit Werten '2.0' *) + +get + PROC get (VECTOR VAR a, INT CONST l) + Zweck: Einlesen der Elemente von 'a' vom Terminal, wobei 'l' die Anzahl + der Elemente angibt. + Fehlerfall: + * PROC get : size <= 0 + Die angeforderte Elementanzahl 'l' muß > 0 sein. + +length + INT PROC length (VECTOR CONST a) + Zweck: Liefert die Anzahl der Elemente von 'a'. Beispiel: + + VECTOR VAR a :: vector (10, 1.0), + b :: vector (15, 2.0); + ... + ... length (a) ... (* 10 *) + ... length (b) ... (* 15 *) + +LENGTH + INT OP LENGTH (VECTOR CONST a) + Zweck: Liefert die Anzahl der Elemente von 'a'. + +NORM + REAL OP NORM (VECTOR CONST v) + Zweck: Euklidische Norm (Wurzel aus der Summe der Quadrate der Elemente). + +put + PROC put (VECTOR CONST v) + Zweck: Ausgabe der Werte der Elemente von 'v' auf dem Terminal. + +replace + PROC replace (VECTOR VAR v, INT CONST i, REAL CONST r) + Zweck: Zuweisung des i-ten Elementes von 'v' mit dem Wert von 'r'. + Beispiel: + + VECTOR VAR v :: ...; + ... + replace (v, 13, 3.14); + (* Das 13. Element von 'v' bekommt den Wert '3.14' *) + Fehlerfälle: + * PROC replace : subscript overflow + Der Index 'i' mit dem Wert 'm' liegt außerhalb des Vektors (i > + LENGTH v). + * PROC replace : subscript underflow + Der Index 'i' mit dem Wert 'm' liegt außerhalb des Vektors + (i < 1). + +SUB + REAL OP SUB (VECTOR CONST v, INT CONST i) + Zweck: Liefert das 'i'-te Element von 'v'. + Fehlerfälle: + * OP SUB : subscript overflow + Der Index 'i' mit dem Wert 'm' liegt außerhalb des Vektors (i > + LENGTH v). + * OP SUB : subscript underflow + Der Index 'i' mit dem Wert 'm' liegt außerhalb des Vektors + (i < 1). + +vector + INITVECTOR PROC vector (INT CONST l) + Zweck: Erzeugen eines Vektors mit 'l' Elementen. Ein INITVECTOR-Objekt + benötigt nicht soviel Speicherplatz wie ein VECTOR-Objekt. Die + Elemente werden mit dem Wert '0.0' initialisiert. + Fehlerfall: + * PROC vector : size <= 0 + Die angeforderte Elementanzahl 'l' muß > 0 sein. + + INITVECTOR PROC vector (INT CONST l, REAL CONST value): + Zweck: Erzeugen eines Vektors mit 'l' Elementen. Ein INITVECTOR-Objekt + benötigt nicht soviel Speicherplatz wie ein VECTOR-Objekt. Die + Elemente werden mit dem Wert 'value' initialisiert. Beispiel: + + VECTOR VAR v := vector (17, 3.14159); + (* 'v' hat 17 Elemente mit den Wert '3.14159' *) + Fehlerfall: + * PROC vector : size <= 0 + Die angeforderte Elementanzahl 'l' muß > 0 sein. + + + +MATRIX + +Folgende Operationen stehen für MATRIX zur Verfügung: + +matrix Erzeugung eines MATRIX-Objekts +idn Erzeugung einer Einheitsmatrix +put Ausgabe der MATRIX auf dem Terminal +get Eingabe der Matrix vom Terminal +replace row Ersetzung einer Zeile +replace column Ersetzung einer Spalte +replace element Ersetzung eines Elements +row Liefert einen VECTOR (Zeile einer MATRIX) +column Liefert einen VECTOR (Spalte einer MATRIX) +sub Liefert ein REAL-Elemement +COLUMNS Anzahl Spalten +ROWS Anzahl Zeilen +INV Inverse +DET Determinante +TRANSP Transponierte +transp Transponierte (speicherfreundlich) + + + - + * + := + = + <> + + + +Beschreibung der MATRIX-Operationen + +Aus Optimierungsgründen (Heapbelastung) wurde der Datentyp INITMATRIX +geschaffen. Dieser wird im MATRIX-Paket intern gehalten (wird nicht über das +Interface herausgereicht) und kann somit nicht in einer Deklaration benutzt +werden. INITMATRIX wird nur für die Operationen + + := + idn + matrix + +verwendet. Bei Verwendung eines Objekts vom Datentyp INITMATRIX wird nicht +der Speicherplatz für eine MATRIX benötigt. + ++ + MATRIX OP + (MATRIX CONST m) + Zweck: Monadisches '+'. Keine Auswirkungen. + + MATRIX OP + (MATRIX CONST l, r) + Zweck: Addition zweier Matrizen. Die Anzahl der Reihen und der Spalten + muß gleich sein. Beispiel: + + MATRIX VAR a :: matrix (3, 43, 1.0), + b :: matrix (3, 43, 2.0), + summe; + summe := a + b; + (* Alle Elemente haben den Wert '3.0' *) + Fehlerfälle: + * MATRIX OP + : COLUMNS l <> COLUMNS r + Die Anzahl der Spalten von 'l' und 'r' sind nicht gleich. + * MATRIX OP + : ROWS l <> ROWS r + Die Anzahl der Zeilen von 'l' und 'r' sind nicht gleich. + +- + MATRIX OP - (MATRIX CONST m) + Zweck: Monadisches Minus. Beispiel: + + MATRIX VAR a :: matrix (3, 4, 10.0) + a := - a; (* Alle Elemente haben den Wert '-10.0' *) + + MATRIX OP - (MATRIX CONST l, r) + Zweck: Subtraktion zweier Matrizen. Die Anzahl der Reihen und Spalten + muß gleich sein. + Fehlerfälle: + * MATRIX OP - : COLUMNS l <> COLUMNS r + Die Anzahl der Spalten von 'l' und 'r' sind nicht gleich. + * MATRIX OP - : ROWS l <> ROWS r + Die Anzahl der Zeilen von 'l' und 'r' sind nicht gleich. + +* + MATRIX OP * (REAL CONST r, MATRIX CONST m) + Zweck: Multiplikation einer Matrix 'm' mit einem Skalar 'r'. Beispiel: + + MATRIX VAR a :: matrix (3, 4, 2.0); + ... + a := 3 * a; (* Alle Elemente haben den Wert '6.0' *) + + MATRIX OP * (MATRIX CONST m, REAL CONST r) + Zweck: Multiplikation einer Matrix 'm' mit einem Skalar 'r'. + + MATRIX OP * (MATRIX CONST l, r) + Zweck: Multiplikation zweier Matrizen. Die Anzahl der Spalten von 'l' + und die Anzahl der Zeilen von 'r' müssen gleich sein. Beispiel: + + MATRIX VAR a :: matrix (3, 4, 2.0), + b :: matrix (4, 2, 3.0), + produkt; + produkt := a * b; + (* Alle Elemente haben den Wert '24.0' *) + Fehlerfall: + * MATRIX OP * : COLUMNS l <> ROWS r + Die Anzahl der Spalten von 'l' muß mit der Anzahl der Zeilen + von 'r' übereinstimmen. + + VECTOR OP * (VECTOR CONST v, MATRIX CONST m) + Zweck: Multiplikation des Vektors 'v' mit der Matrix 'm'. + Fehlerfall: + * VECTOR OP * : LENGTH v <> ROWS m + Die Anzahl der Elemente von 'v' stimmt nicht mit den Anzahl der + Zeilen von 'm' überein. + + VECTOR OP * (MATRIX CONST m, VECTOR CONST v) + Zweck: Multiplikation der Matrix 'm' mit dem Vektor 'v'. + Fehlerfall: + * VECTOR OP * : COLUMNS m <> LENGTH v + Die Anzahl der Spalten von 'm' stimmt nicht mit der Anzahl der + Elementen von 'v' überein. + += + BOOL OP = (MATRIX CONST l, r) + Zweck: Vergleich zweier Matrizen. Der Operator '=' liefert FALSE, wenn + die Anzahl Spalten oder Reihen der Matrizen 'l' und 'r' ungleich + ist und wenn mindestens ein Element mit gleichen Indizes der zwei + Matrizen ungleiche Werte haben. Beispiel: + + MATRIX VAR a :: matrix (3, 3), + b :: matrix (3, 3, 1.0), + c :: matrix (4, 4); + ... a = b ... + (* FALSE wegen ungleicher Werte *) + ... a = c ... + (* FALSE wegen ungleicher Groesse *) + ... b = c ... + (* FALSE wegen ungleicher Groesse *) + +<> + BOOL OP <> (MATRIX CONST l, r) + Zweck: Vergleich der Matrizen 'l' und 'r' auf Ungleichheit. + +:= + OP := (MATRIX VAR l, MATRIX CONST r) + Zweck: Zuweisung von 'r' auf 'l'. Die MATRIX 'l' bekommt u.U. eine neue + Anzahl von Elementen. Beispiel: + + MATRIX VAR a :: matrix (3, 4, 0.0), + b :: matrix (5, 5, 3.0); + ... + a := b; (* 'a' hat jetzt 5 x 5 Elemente *) + + OP := (MATRIX VAR l, INITMATRIX CONST r) + Zweck: Dient zur Initialisierung einer Matrix. Beispiel: + + MATRIX VAR x :: matrix (17, 4); + + 'matrix' erzeugt ein Objekt vom Datentyp INITMATRIX. Dieses + Objekt braucht nicht soviel Speicherplatz wie ein MATRIX-Objekt. + Dadurch wird vermieden, daß nach erfolgter Zuweisung nicht ein + durch 'matrix' erzeugtes Objekt auf dem Heap unnötig Speicher- + platz verbraucht. + +column + VECTOR PROC column (MATRIX CONST m, INT CONST i) + Zweck: Die 'i'-te Spalte von 'm' wird als VECTOR mit 'ROWS m' Elementen + geliefert. Beispiel: + + MATRIX CONST a :: matrix (3, 4); + VECTOR VAR b :: column (a, 1); + (* 'b' hat drei Elemente mit den Werten '0.0' *) + Fehlerfälle: + * PROC column : subscript overflow + Der Index 'i' liegt außerhalb der Matrix 'm' (i > COLUMNS m). + * PROC column : subscript underflow + Der Index 'i' liegt außerhalb der Matrix 'm' (i < 1). + +COLUMNS + INT OP COLUMNS (MATRIX CONST m) + Zweck: Liefert die Anzahl der Spalten von 'm'. Beispiel: + + MATRIX VAR a :: matrix (3, 4), + b :: matrix (7, 10); + put (COLUMNS a); (* 4 *) + put (COLUMNS b); (* 10 *) + +DET + REAL OP DET (MATRIX CONST m) + Zweck: Es wird der Wert der Determinanten von 'm' geliefert. + Fehlerfall: + * OP DET : no square matrix + Die Matrix ist nicht quadratisch, d.h. ROWS m <> COLUMNS m + +get + PROC get (MATRIX VAR m, INT CONST rows, columns) + Zweck: Einlesen von Werten für die Matrix 'm' vom Terminal mit 'rows'- + Zeilen und 'columns'-Spalten. + +idn + INITMATRIX PROC idn (INT CONST size) + Zweck: Erzeugen einer Einheitsmatrix vom Datentyp INITMATRIX. Beispiel: + + MATRIX VAR a :: idn (10); + (* Erzeugt eine Matrix mit 10 x 10 Elementen, + deren Werte '0.0' sind, mit der Ausnahme der + Diagonalelemente, die den Wert '1.0' haben. *) + Fehlerfall: + * PROC idn : size <= 0 + Die angeforderte 'size' Anzahl Spalten oder Zeilen muß > 0 sein. + +INV + MATRIX OP INV (MATRIX CONST m) + Zweck: Liefert als Ergebnis die Inverse von 'm' (Achtung: starke Run- + dungsfehler möglich). + Fehlerfälle: + * OP INV : no square matrix + Die Matrix 'm' ist nicht quadratisch, d.h. ROWS m <> COLUMNS m + * OP INV : singular matrix + Die Matrix ist singulär. + +matrix + INITMATRIX PROC matrix (INT CONST rows, columns) + Zweck: Erzeugen eines Datenobjekts vom Datentyp INITMATRIX mit 'rows' + Zeilen und 'columns' Spalten. Alle Elemente werden mit dem Wert + '0.0' initialisiert. Beispiel: + + MATRIX CONST :: matrix (3, 3); + Fehlerfälle: + * PROC matrix : rows <= 0 + Die angeforderte Zeilenanzahl 'rows' muß > 0 sein. + * PROC matrix : columns <= 0 + Die angeforderte Spaltenanzahl 'columns' muß > 0 sein. + + INITMATRIX PROC matrix (INT CONST rows, columns, REAL CONST value) + Zweck: Erzeugen eines Datenobjekts vom Datentyp MATRIX mit 'rows' + Zeilen und 'columns' Spalten. Alle Elemente der erzeugten MATRIX + werden mit dem Wert 'value' initialisiert. Beispiel: + + MATRIX CONST :: matrix (3, 3, 3.14); + Fehlerfälle: + * PROC matrix : rows <= 0 + Die angeforderte Zeilenanzahl 'rows' muß > 0 sein. + * PROC matrix : columns <= 0 + Die angeforderte Spaltenanzahl 'columns' muß > 0 sein. + +put + PROC put (MATRIX CONST m) + Zweck: Ausgabe der Werte einer Matrix auf dem Terminal. + +replace column + PROC replace column (MATRIX VAR m, INT CONST column index, + VECTOR CONST column value) + Zweck: Ersetzung der durch 'column index' definierten Spalte in der + MATRIX 'm' durch den VECTOR 'column value'. Beispiel: + + MATRIX VAR a :: matrix (3, 5, 1.0); + VECTOR VAR b :: vector (3, 2.0); + ... + replace column (a, 2, b); + (* Die zweite Spalte von 'a' wird durch die Werte von 'b' + ersetzt *) + Fehlerfälle: + * PROC replace column : LENGTH columnvalue <> ROWS m + Die Anzahl der Zeilen der MATRIX 'm' stimmt nicht mit der Anzahl + der Elemente von 'columnvalue' überein. + * PROC replace column : column subscript overflow + Der Index 'columnindex' liegt außerhalb von 'm' + (columnindex > COLUMNS m). + * PROC sub : column subscript underflow + Der Index 'columnindex' liegt außerhalb von 'm' + (columnindex < 1). + +replace element + PROC replace element (MATRIX VAR m , INT CONST row, column, + REAL CONST value) + Zweck: Ersetzung eines Elementes von 'm' in der 'row'-ten Zeile und + 'column'-ten Spalte durch den Wert 'value'. Beispiel: + + MATRIX VAR a :: matrix (5, 5); + ... + replace element (1, 1, 3.14159); + Fehlerfälle: + * PROC replace element : row subscript overflow + Der Index 'row' liegt außerhalb von 'm' (row > ROWS m). + * PROC replace element : row subscript underflow + Der Index 'row' liegt außerhalb von 'm' (row < 1). + * PROC replace element : column subscript overflow + Der Index 'column' liegt außerhalb von 'm' (column > COLUMNS m). + * PROC replace element : row subscript underflow + Der Index 'column' liegt außerhalb von 'm' (column < 1). + +replace row + PROC replace row (MATRIX VAR m, INT CONST rowindex, + VECTOR CONST rowvalue) + Zweck: Ersetzung der Reihe 'rowindex' in der MATRIX 'm' durch den + VECTOR 'rowvalue'. Beispiel: + + MATRIX VAR a :: matrix (3, 5, 1.0); + VECTOR VAR b :: vector (5, 2.0); + ... + replace row (a, 2, b); + (* Die 2. Reihe von 'a' wird durch Werte von 'b' ersetzt *) + Fehlerfälle: + * PROC replace row : LENGTH rowvalue <> COLUMNS m + Die Anzahl der Spalten der MATRIX 'm' stimmt nicht mit der Anzahl + der Elemente von 'rowvalue' überein. + * PROC replace row : row subscript overflow + Der Index 'rowindex' liegt außerhalb von 'm' (rowindex > ROWS m). + * PROC sub : row subscript underflow + Der Index 'rowindex' liegt außerhalb von 'm' (rowindex < 1). + +row + VECTOR PROC row (MATRIX CONST m, INT CONST i) + Zweck: Die 'i'-te Reihe von 'm' wird als VECTOR mit 'COLUMNS m' + Elementen geliefert. Beispiel: + + MATRIX CONST a :: matrix (3, 4); + VECTOR VAR b :: row (a, 1); + (* 'b' hat vier Elemente mit den Werten '0.0'*) + Fehlerfälle: + * PROC row : subscript overflow + Der Index 'i' liegt außerhalb der Matrix 'm' (i > ROWS m). + * PROC row : subscript underflow + Der Index 'i' liegt außerhalb der Matrix 'm' (i < 1). + +ROWS + INT OP ROWS (MATRIX CONST m) + Zweck: Liefert die Anzahl der Zeilen von 'm'. Beispiel: + + MATRIX VAR a :: matrix (3, 4), + b :: matrix (7, 10); + ... + put (ROWS a); (* 3 *) + put (ROWS b); (* 7 *) + +sub + REAL PROC sub (MATRIX CONST m, INT CONST row, column) + Zweck: Liefert den Wert eines Elementes von 'm', welches durch die + Indizes 'row' und 'column' bestimmt wird. Beispiel: + + MATRIX VAR m :: matrix (5, 10, 1.0); + put (sub (m, 3, 7)); + Fehlerfälle: + * PROC sub : row subscript overflow + Der Index 'row' liegt außerhalb von 'm' (row > ROWS m). + * PROC sub : row subscript underflow + Der Index 'row' liegt außerhalb von 'm' (row < 1). + * PROC sub : column subscript overflow + Der Index 'column' liegt außerhalb von 'm' (column > ROWS m). + * PROC sub : row subscript underflow + Der Index 'column' liegt außerhalb von 'm' (column < 1). + +TRANSP + MATRIX OP TRANSP (MATRIX CONST m) + Zweck: Liefert als Ergebnis die transponierte Matrix 'm'. + +transp + PROC transp (MATRIX VAR m) + Zweck: Transponieren der Matrix 'm', wobei kaum zusätzlicher Speicher- + platz benötigt wird. + + + +2. COMPLEX + +Das COMPLEX-Paket ist im ausgelieferten Standard-System noch nicht vorüber- +setzt, sondern wird im Quellcode ausgeliefert und kann so bei Bedarf von +jeder EUMEL-Installation in die implementationsabhängigen Standard-Pakete +aufgenommen werden. + +Folgende Operationen stehen für COMPLEX zur Verfügung: + +put Ausgabe auf dem Terminal +get Eingabe auf dem Terminal +complex zero Denotierungsprozedur +complex one dito +complex i dito +complex dito +real part Realteil eines komplexen Werts +imag part Imaginärteil eines komplexen Werts +phi Winkel in der Polardarstellung (Radiant) +dphi dito, in Winkelgrad +CONJ Konjugiert komplexer Wert +sqrt Wurzelfunktion + + + - + * + / + := + = + <> + + + +Beschreibung der COMPLEX-Operationen + += + BOOL OP = (COMPLEX CONST a, b) + Zweck: Vergleich von 'a' und 'b' auf Gleichheit. + +:= + OP := (COMPLEX VAR a, COMPLEX CONST b) + Zweck: Zuweisung. + +<> + BOOL OP <> (COMPLEX CONST a, b) + Zweck: Vergleich von 'a' und 'b' auf Ungleichheit. + ++ + COMPLEX OP + (COMPLEX CONST a, b) + Zweck: Summe von 'a' und 'b'. + +- + COMPLEX OP - (COMPLEX CONST a, b) + Zweck: Differenz von 'a' und 'b'. + +* + COMPLEX OP * (COMPLEX CONST a, b) + Zweck: Multiplikation von 'a' mit 'b'. + +/ + COMPLEX OP / (COMPLEX CONST a, b) + Zweck: Division von 'a' mit 'b'. + +ABS + REAL OP ABS (COMPLEX CONST x) + Zweck: REAL-Betrag von 'x'. + +complex + COMPLEX PROC complex (REAL CONST re, im) + Zweck: Denotierungsprozedur. Angabe in kartesischen Koordinaten. + +complex i + COMPLEX PROC complex i + Zweck: Denotierungsprozedur für den komplexen Wert '0.0 + i 1.0'. + +complex one + COMPLEX PROC complex one + Zweck: Denotierungsprozedur für den komplexen Wert '1.0 + i 0.0'. + +complex zero + COMPLEX PROC complex zero + Zweck: Denotierungsprozedur für den komplexen Wert '0.0 + i 0.0'. + +CONJ + COMPLEX OP CONJ (COMPLEX CONST number) + Zweck: Liefert den konjugiert komplexen Wert von 'number'. + +dphi + REAL PROC dphi (COMPLEX CONST x) + Zweck: Winkel von 'x' (Polardarstellung). + +get + PROC get (COMPLEX VAR a) + Zweck: Einlesen eines komplexen Wertes vom Bildschirm in der Form + zweier REAL-Denoter. Die Eingabe kann editiert werden. + +imag part + REAL PROC imag part (COMPLEX CONST number) + Zweck: Liefert den Imaginärteil des komplexen Wertes 'number'. + +phi + REAL PROC phi (COMPLEX CONST x) + Zweck: Winkel von 'x' (Polardarstellung) in Radiant. + +put + PROC put (COMPLEX CONST a) + Zweck: Ausgabe eines komplexen Wertes auf dem Bildschirm in Form zweier + REAL-Werte. Hinter jedem REAL-Wert wird ein Leerzeichen angefügt. + +real part + REAL PROC real part (COMPLEX CONST number) + Zweck: Liefert den Real-Teil des komplexen Wertes 'number'. + +sqrt + COMPLEX PROC sqrt (COMPLEX CONST x) + Zweck: Wurzelfunktion für komplexe Werte. + + + +3. LONGINT + +LONGINT ist ein Datentyp, für den (fast) alle Prozeduren und Operatoren des +Datentyps INT implementiert wurden. LONGINT unterscheidet sich von INT +dadurch, daß erheblich größere Werte darstellbar sind. + +Für den Datentyp LONGINT stehen folgende Operationen zur Verfügung: + +get Eingabe vom Terminal +put Ausgabe vom Terminal +ABS, abs Absolutbetrag +INCR, DECR Addition und Zuweisung bzw. Subtraktion und Zuweisung +DIV Division ohne Rest +int, text Konvertierungen +longint dito +max, min Maximum bzw. Minimum zweier LONGINTs +MOD Modulo-Funktion +random Zufallszahlen +sign Vorzeichen + < + > + <= + <> + = + - + + + * + ** + + + +Beschreibung der LONGINT-Operationen + +< + BOOL OP < (LONGINT CONST left, right) + Zweck: Vergleichen zweier LONGINTs auf kleiner. + +> + BOOL OP > (LONGINT CONST left, right) + Zweck: Vergleichen zweier LONGINTs auf größer. + +<= + BOOL OP <= (LONGINT CONST left, right) + Zweck: Vergleichen zweier LONGINTs auf kleiner gleich. + +>= + BOOL OP >= (LONGINT CONST left, right) + Zweck: Vergleichen zweier LONGINTs auf größer gleich. + +<> + BOOL OP <> (LONGINT CONST left, right) + Zweck: Vergleichen zweier LONGINTs auf Ungleichheit. + += + BOOL OP = (LONGINT CONST left, right) + Zweck: Vergleichen zweier LONGINTs auf Gleichheit. + +- + LONGINT OP - (LONGINT CONST argument) + Zweck: Vorzeichenumkehrung. + + LONGINT OP - (LONGINT CONST left, right) + Zweck: Subtraktion zweier LONGINTs. + ++ + LONGINT OP + (LONGINT CONST argument) + Zweck: Monadischer Operator. Ohne Wirkung. + + LONGINT OP + (LONGINT CONST left, right) + Zweck: Addition zweier LONGINTs. + +* + LONGINT OP * (LONGINT CONST left, right) + Zweck: Multiplikation von zwei LONGINTs. + +** + LONGINT OP ** (LONGINT CONST argument, exponent) + Zweck: Exponentiation zweier LONGINTs mit positivem Exponenten. + Fehlerfälle : + * LONGINT OP ** : negative exponent + Der 'exponent' muß >= 0 sein. + * 0 ** 0 is not defined + 'argument' und 'exponent' dürfen nicht gleich 0 sein. + + + LONGINT OP ** (LONGINT CONST argument, INT CONST exponent) + Zweck: Exponentiation eines LONGINT mit positiven INT Exponenten. + Fehlerfälle : + * LONGINT OP ** : negative exponent + Der 'exponent' muß >= 0 sein. + * 0 ** 0 is not defined + 'argument' und 'exponent' dürfen nicht gleich 0 sein. + +ABS + LONGINT OP ABS (LONGINT CONST argument) + Zweck: Absolutbetrag eines LONGINT. + +abs + LONGINT PROC abs (LONGINT CONST argument) + Zweck: Absolutbetrag eines LONGINT. + +DECR + OP DECR (LONGINT VAR resultat, LONGINT CONST ab) + Zweck: resultat := resultat - ab + +DIV + LONGINT OP DIV (LONGINT CONST left, right) + Zweck: Division zweier LONGINTs. + Fehlerfall : + * divide by zero + 'right' muß <> 0 sein. + +get + PROC get (LONGINT VAR zahl) + Zweck: Eingabe eines LONGINTs vom Terminal. + + PROC get (FILE VAR file, LONGINT VAR zahl) + Zweck: Einlesen von 'zahl' aus der sequentiellen Datei 'file'. Die + Datei muß mit 'input' assoziiert sein (vergl. 'sequential file'). + Fehlerfälle : + * file not open + Die Datei 'file' ist gegenwärtig nicht assoziiert. + * input after end of file + Es wurde versucht, über die letzte Zeile einer Datei zu lesen. + * input access to output file + Es wurde versucht, von einem mit 'output' assoziierten FILE zu + lesen. + +INCR + LONGINT OP INCR (LONGINT VAR resultat, LONGINT CONST dazu) + Zweck: resultat := resultat + dazu + +int + INT PROC int (LONGINT CONST longint) + Zweck: Konvertierung von LONGINT nach INT. + Fehlerfall : + * integer overflow + 'longint' ist größer als 'maxint'. + +longint + LONGINT PROC longint (INT CONST int) + Zweck: Konvertierung von 'int' nach LONGINT. + + LONGINT PROC longint (TEXT CONST text) + Zweck: Konvertierung von 'text' nach LONGINT. + +max + LONGINT PROC max (LONGINT CONST left, right) + Zweck: Liefert das Maximum zweier LONGINTs. + +min + LONGINT PROC min (LONGINT CONST left, right) + Zweck: Liefert das Minimum zweier LONGINTs. + +MOD + LONGINT OP MOD (LONGINT CONST left, right) + Zweck: Modulo-Funktion für LONGINTs. Der Rest einer LONGINT-Division + wird ermittelt. + Fehlerfall : + * text (left) + 'MOD 0' + 'right' muß ungleich null sein. + +put + PROC put (LONGINT CONST longint) + Zweck: Ausgabe eines LONGINTs auf dem Bildschirm. Anschließend wird + ein Leerzeichen ausgegeben. Hardwareabhängig sind die Aktionen, + wenn eine Ausgabe über die Bildschirmzeilengrenze vorgenommen + wird. Meist wird jedoch die Ausgabe auf der nächsten Zeile fort- + gesetzt. + + PROC put (FILE VAR file, LONGINT CONST zahl) + Zweck: Ausgabe von 'zahl' in die sequentielle Datei 'file'. 'file' muß + mit 'output' assoziiert sein. + Fehlerfälle : + * file not open + Die Datei 'file' ist gegenwärtig nicht assoziiert. + * output access to input file + Es wurde versucht, auf einem mit 'input' assoziierten FILE zu + schreiben. + +random + LONGINT PROC random (LONGINT CONST lower bound, upper bound) + Zweck: Pseudo-Zufallszahlen-Generator im Intervall 'lower bound' und + 'upper bound' einschließlich. Es handelt sich hier um den + 'LONGINT Random Generator'. + +SIGN + INT OP SIGN (LONGINT CONST longint) + Zweck: Feststellen des Vorzeichens von 'longint'. Liefert: + + 0 wenn 'longint' = 0, + 1 wenn 'longint' > 0, + -1 wenn 'longint' < 0. + +sign + INT PROC sign (LONGINT CONST longint) + Zweck: Feststellen des Vorzeichens von 'longint'. Liefert: + + 0 wenn 'longitt' = 0, + 1 wenn 'longint' > 0, + -1 wenn 'longint' < 0. + +text + TEXT PROC text (LONGINT CONST longint) + Zweck: Konvertierung von 'longint' nach TEXT. + + TEXT PROC text (LONGINT CONST longint, INT CONST laenge) + Zweck: Konvertierung von 'longint' nach TEXT. Die Anzahl der Zeichen + soll 'laenge' betragen. Für + + LENGTH (text (longint)) < laenge + + werden die Zeichen rechtsbündig in einen Text mit der Länge + 'laenge' eingetragen. Ist der daraus entstehende TEXT kleiner + als 'laenge', werden die an 'laenge' fehlenden Zeichen im TEXT + mit Leerzeichen aufgefüllt. Für + + LENGTH (text (longint)) > length + + wird ein Text mit der Länge 'length' geliefert, der mit + '*'-Zeichen gefüllt ist. + diff --git a/doc/user-manual/1.7.3-pd/doc/source-disk b/doc/user-manual/1.7.3-pd/doc/source-disk new file mode 100644 index 0000000..f769920 --- /dev/null +++ b/doc/user-manual/1.7.3-pd/doc/source-disk @@ -0,0 +1 @@ +173_publicdomain/03_benutzerhandbuch.img diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.1 b/doc/user-manual/1.8.7/doc/benutzerhandbuch.1 new file mode 100644 index 0000000..7c8fec7 --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.1 @@ -0,0 +1,580 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#Benutzerhandbuch + + + + +#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# + +#start(5.0,1.5)##pagenr("%",1)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Teil 1: Einleitung +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +1 - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD 1 - % +#tableend##clearpos# +#end# +TEIL 1: Einleitung +#free(1.0)# + +1.1. Vorwort +#free(1.0)# + +Dieses Buch bietet Ihnen eine Anleitung zur Handhabung des Betriebssystems +EUMEL in Hinblick auf die Textverarbeitung. Das Buch wendet sich somit an alle, die +das leicht erlernbare EUMEL-System zur Erstellung von Texten jeglicher Art und +jeden Umfangs nutzen wollen. + +Die Anleitung erfordert keinerlei Vorkenntnisse, weder von Computern im allgemei­ +nen noch von EUMEL im besonderen. Neulingen auf dem Gebiet der Benutzung eines +Computers sei empfohlen, dieses erste Kapitel, das sich kurz mit der 'grauen Theorie' +beschäftigt, mindestens zweimal zu lesen: + +- Der erste Durchgang sollte nur einer groben Orientierung dienen. Die Begriffe, die + teilweise erst im routinierteren Umgang Sinn gewinnen, sollten Sie 'mal gehört' + haben, um die folgenden Kapitel leichter lesen zu können. + +- Der zweite Durchgang erscheint uns sinnvoll, wenn Sie sich 'freigeschwommen' + haben. Wenn der Umgang mit dem EUMEL-System Ihnen nach einigen Tagen + schon vertrauter erscheint, ist es zweckmäßig, sich auf dem Hintergrund der + gemachten Erfahrungen die Erklärungen noch einmal durchzulesen. Einige der + Begriffe werden erst dann wirklich verständlich und manche Unsicherheit wird + beseitigt werden. + +Die weiteren Teile des Buches geben dann Anleitung vom ersten Einstieg ins +EUMEL-System bis hin zur detaillierten Beschreibung der Textverarbeitung. Alle in +Teil 3 und 4 enthaltenen Beispiele sollten Sie sorgfältig durchgehen und am Bild­ +schirm nachvollziehen. Aus dem Teil 5 können Sie nach eigener Einschätzung zu­ +nächst die Bereiche auswählen, die Sie selbst für besonders wichtig halten. Sie wer­ +den feststellen, daß Sie durch den Umgang mit der EUMEL-Textverarbeitung mit +fortschreitender Routine immer mehr der gebotenen Möglichkeiten hinzunehmen +werden. +#free(1.0)# +Was ist ein Betriebssystem ? + +Ein #ib#Betriebssystem#ie# ist eine Sammlung von Programmen, die dem Benutzer eines +Computers die Arbeit mit diesem Gerät erst ermöglichen. Die Programme des Be­ +triebssystems stellen die Verbindung zwischen den Bausteinen eines Computers, der +Hardware, und den Anwendungsprogrammen eines Benutzers her. + +Alle Programme, die diese riesige Lücke schließen und z.B. dafür sorgen, daß der +Befehl: #on("i")#drucke ("diesen brief")#off("i")# tatsächlich dazu führt, daß der eben noch am Bild­ +schirm verfaßte Brief zum Drucker gesendet und dort ausgedruckt wird, sind soge­ +nannte Systemprogramme, Teile des Betriebssystems. + +Dieses Benutzerhandbuch zum Betriebssystem EUMEL wird Ihnen schrittweise die +Befehle erklären, die Sie zur Nutzung aller Möglichkeiten der Textverarbeitung mit +EUMEL verwenden können, und Ihnen somit einen Teil des Betriebssystems vorstel­ +len. +#free(1.0)# +Ist EUMEL anders als andere ? + +#on("b")#Ja.#off("b")# Das Betriebssystem EUMEL (#on("b")#E#off("b")#xtendable multi #on("b")#U#off("b")#ser #on("b")#M#off("b")#icroprocessor #on("b")#EL#off("b")#an Sy­ +stem) erklärt durch seinen voll ausgeschriebenen Namen einen wesentlichen Unter­ +schied zu anderen Systemen: "Erweiterbares Mehrbenutzer Mikroprozessor ELAN- +System." + +Während andere auf Mikroprozessoren (und damit auf sogenannte Personal Compu­ +ter) abgestimmte Betriebssysteme #on("u")#einen#off("u")# Benutzer bei seiner Arbeit unterstützen, ist +EUMEL fähig, #on("u")#mehreren#off("u")# Anwendern gleichzeitig die Benutzung eines Computers zu +ermöglichen. Natürlich funktioniert EUMEL ebensogut für einen einzigen Benutzer. Es +gibt aber bei EUMEL die Möglichkeit, durch Ankoppeln weiterer Bildschirme an den +Rechner und #on("b")#ohne#off("b")# Kosten für zusätzliche Software mehreren Benutzern gleichzeitig +die Arbeit an diesem Rechner zu ermöglichen. + +Zweitens ist EUMEL hardwareunabhängig, das heißt, gleichgültig von welchem Her­ +steller Ihr Computer stammt, die Bedienung und die Kommandosprache ist immer +gleich. Auch können Disketten, die mit einem XY-Rechner beschrieben wurden, von +einem ABC-Computer gelesen werden; durchaus keine Selbstverständlichkeit. + +Eine weitere Besonderheit des EUMEL-Systems macht alle froh, die damit arbeiten: +EUMEL ist durchgängig in der Programmiersprache ELAN gehalten. Auch wenn Sie +(noch) nicht programmieren möchten, erleichtert Ihnen ELAN das Leben dadurch, daß +Sie schreiben können, was Sie meinen: eine Datei, die einen Geschäftsbrief fix und +fertig und druckbereit enthält, heißt nicht etwa: + + $TXT.PRT + +sondern: + + Angebot an Fa.Müller 1.7.86 + + +Ein weiterer wichtiger Unterschied wird Ihnen bewußt werden, wenn Sie ein anderes +Betriebssystem kennen: Die EUMEL-Textverarbeitung ist kein zusätzliches Programm +mit eigener Kommandosprache, welches bei Bedarf geladen werden muß, sondern +steht jederzeit, im wahrsten Sinne des Wortes auf Knopfdruck, zu Ihrer Verfügung. +#free(1.5)# +1.2. Wichtige Begriffe +#free(1.0)# +- #on("b")#TASK#off("b")#. Eine #ib#Task#ie# ist ein eigenständiger Prozeß innerhalb eines EUMEL-Systems, + der entweder zur Verwaltung des EUMEL-Systems oder zu einem Benutzer + gehört. Indem jedem Benutzer ein eigener Arbeitsbereich zugewiesen ist, wird + verhindert, daß unkontrolliert auf fremde Daten zugegriffen wird. Eine Task hat + einen Namen, mit dem sie angesprochen werden kann. Ein EUMEL-System + besteht aus mehreren Tasks. + + Ein brauchbarer Vergleich mit einem EUMEL-Tasksystem ist ein Firmengebäude: + Es besteht aus vielen Räumen und jeder Raum ( = Task ) ist entweder ein nor­ + males Arbeitszimmer oder ein Chefzimmer oder eine Werkstatt, in der Dienst­ + leistungen für andere erledigt werden. + + Eine solche Ordnung zeigt folgendes Tasksystem; der #on("i")#kursiv#off("i")# gesetzte Kommentar + zeigt die Benennung der 'Dienstposten' eines vergleichbaren Büros: + + + SUPERVISOR #on("i")#(* Zimmerverwalter *)#off("i")# - + - + + SYSUR #on("i")#(* Werkstattmeister *)#off("i")# + + + ARCHIVE #on("i")#(* Archivar *)#off("i")# + + configurator #on("i")#(* Elektriker *)#off("i")# + + OPERATOR #on("i")#(* Hausmeister *)#off("i")# + + shutup #on("i")#(* Nachtwächter *)#off("i")# + + UR #on("i")#(* Aufsichtsrat *)#off("i")# + + PUBLIC #on("i")#(* Abteilungsleiter *)#off("i")# + + Meier #on("i")#(* Angestellter *)#off("i")# + Müller #on("i")#(* " *)#off("i")# + Schulze #on("i")#(* " *)#off("i")# + + + Bildlich gesprochen stellt eine Task also ein 'Arbeitszimmer' für einen EUMEL- + Benutzer dar. Als EUMEL Anwender richten Sie sich Ihre Task selbst ein, indem + Sie das Kommando 'begin ("taskname")' geben. + + Nachdem Sie dieses Kommando einmal gegeben haben, existiert diese Task unter + dem von Ihnen gewählten Namen. + + In der Task (also sinngemäß im Arbeitszimmer) arbeiten Sie - insbesondere legen + Sie Dateien (= Akten) an. Dateien existieren nur innerhalb einer Task. + + Tasks werden durch den SUPERVISOR verwaltet, er regelt den Zugriff auf Tasks. + Um Ihre Task zu verlassen, geben Sie das Kommando 'break' an den + SUPERVISOR, um sie wieder zu betreten, das Kommando 'continue ("taskna­ + me")'. + + +- #on("b")#DATEI#off("b")#. Eine #ib#Datei#ie# ist eine Menge von zusammengehörigen Daten. Eine Datei in + einer Task entspricht einer Akte in einem Arbeitszimmer. Eine Task kann bis zu + 200 Dateien enthalten. Jede Datei in einer Task hat einen eigenen Namen, in ver­ + schiedenen Tasks dürfen gleichnamige Dateien existieren. Eine Datei ist in Zeilen + unterteilt. + + Für die Arbeit in einer Datei am Bildschirm muß auf die Datei mit dem Editor + zugegriffen werden: 'edit ("dateiname")', danach kann der Inhalt der Datei am + Terminal bearbeitet werden (siehe Kapitel 4 und 5). + + +- #on("b")#KOMMANDO#off("b")#. Ein #ib#Kommando#ie# ist ein Befehl an den Rechner, eine Arbeit zu tun. + Welche Kommandos Sie dem Rechner zum jeweiligen Zeitpunkt geben können, + hängt davon ab, auf welcher 'Kommandoebene' Sie sich befinden. Als Anhalt gilt: + + - Kommandos auf Supervisor-Ebene betreffen das Tasksystem. + + - Kommandos auf Monitor-Ebene betreffen die eigene Task oder Dateien. + + - Kommandos auf Editor- Ebene betreffen Zeilen, Worte oder einzelne Zeichen + der aktuellen Datei. + + Auf welcher Ebene Sie sich befinden, werden Sie nach kurzer Gewöhnung leicht + am Bildschirm erkennen (siehe Teil 3). + + Bei manchen Kommandos muß nicht nur gesagt werden, was getan werden soll, + sondern auch, womit es getan werden soll. Eine solche Angabe zum Kommando + heißt #ib#Parameter#ie#. + Kommando Parameter + | | + Beispiel: Lege neue Task an = begin ("taskname") + Drucke Datei = print ("dateiname"). + Suche das Wort ENDE = down ("ENDE") + + Parameter werden in runde Klammern gesetzt und ggf. durch Kommata voneinan­ + der getrennt. Textparameter werden zusätzlich in Anführungsstriche gesetzt. + + Ein Kommando kann keinen, einen oder viele Parameter benötigen; die + Beschreibung der Kommandos in diesem Buch zeigt jeweils alle Möglichkeiten. + + +- #on("b")#SUPERVISOR#off("b")#. Spezielle Task zur Überwachung eines EUMEL-Systems. Ein + Benutzer kann durch die #ib#Supervisor#ie#-Kommandos Leistungen von dieser Task + fordern: neue Task einrichten, Task wiederaufnehmen und diverse Informationen. + + +- #on("b")#MONITOR#off("b")#. Befehlsempfänger in einer Task. Jede Arbeit im EUMEL-System + findet in einer Task statt. Die Arbeit mit einem Computer besteht in wesentlichen + Teilen im Aufruf von Programmen durch Kommandos. Der Empfänger dieser + Kommandos in einer Task ist der #ib#Monitor#ie#. Der Monitor ist sichtbar durch eine + Zeile, in der 'gib kommando' steht. In diese Zeile werden #ib#Kommando#ie#s und erfor­ + derliche Parameter eingegeben. + + +- #on("b")#ARCHIVE#off("b")#. Spezielle Task zur Verwaltung des Diskettenlaufwerks. Da für die + längerfristige Datenhaltung und zur zusätzlichen Datensicherung Dateien auf + Disketten geschrieben werden, besitzt das EUMEL-System für diese Aufgabe + eine besondere Task, die die Bedienung vereinfacht und exklusiven Zugriff auf das + Laufwerk garantiert. + + +- #on("b")#EDITOR#off("b")#. Programm zur Dateibearbeitung am Bildschirm. Das Programm wird + durch das ( Monitor- ) Kommando 'edit' und die Eingabe des Namens der ge­ + wünschten Datei als Parameter gestartet. + + Da ein Bildschirm normelerweise auf 80 Zeichen Zeilenbreite und 24 Zeilen be­ + schränkt ist, kann der Editor als Fenster betrachtet werden, das über die mögli­ + cherweise weitaus größere Datei bewegt wird und durch das der betrachtete Aus­ + schnitt der Datei bearbeitet werden kann. + + + +-------------------------------------------------------------------+ + i i + i i + +------------------------------------+ i + i i i + i Der Editor, Fenster zur i i + i Dateibearbeitung i i + i i i + +------------------------------------+ i + i i + +-------------------------------------------------------------------+ + + + + + + + + + + +1.3. Die Notation in diesem Buch +#free(1.0)# +Im weiteren Text werden Sie schrittweise in die Bedienung des Systems eingeführt. +Für alle Kommandos und Arbeiten haben wir Beispiele in dieses Buch aufgenommen, +die Sie direkt am Rechner nachvollziehen sollten. + +Beachten Sie dabei bitte folgende Regeln der Aufschreibung: + +- Es gibt eine Reihe von Tasten auf einer Computertastatur, die eine besondere + Bedeutung haben. Diese sogenannten Funktionstasten werden ebenso wie beson­ + dere Tastenkombinationen explizit als Tasten dargestellt: + + + + + + + + + +- Alles, was Sie am Bildschirm Ihres Rechners schreiben oder lesen sollen, ist in + Textbereiche, die einen Bildschirm darstellen, eingefaßt. + + Beispiel: + +____________________________________________________________________________ + +gib kommando: +edit ("meine datei") + +____________________________________________________________________________ + + +- Innerhalb des Handbuchs sind in der Aufschreibung die Konventionen der + Programmiersprache ELAN, in der alle Programme des Betriebssystems geschrie­ + ben sind, berücksichtigt. Dabei sind folgende Besonderheiten zu beachten: + + 1) Kommandos werden grundsätzlich klein geschrieben. + + 2) Dateinamen u.ä. werden in Klammern und Anführungsstriche gesetzt. In + diesem Buch steht an den Stellen, wo ein Dateiname auftaucht #on("i")# 'dateiname' #off("i")#; + den Namen, den Sie tatsächlich verwenden, können Sie frei wählen. + + 3) Falls besondere Begriffe oder Beispiele innerhalb eines normalen Textes + auftreten, werden sie in einfache Anführungsstriche gesetzt. + + +Also: Das Kommando 'edit' benötigt als Parameter einen Dateinamen. Wählen Sie + einen Namen und geben Sie 'edit ("dateiname")' ein. Falls Sie den Namen #on("i")# + "Geschäftsbrief" #off("i")# gewählt haben, müssen Sie am Bildschirm: + + +edit ("Geschäftsbrief") + + +tippen und das Kommando mit der Taste dem Monitor zur Bearbeitung überge­ +ben: + +____________________________________________________________________________ + +gib kommando : +edit ("Geschäftsbrief") + +____________________________________________________________________________ + + + + +#on("b")##on("i")#Die Eingabe von als 'Auslöser' für die Ausführung von +Kommandos wird im weiteren nicht besonders hervorgehoben.#off("b")##off("i")# +#page# +1.4. Voraussetzungen + +#free(1.0)# +Neben dem Computer an sich ist die vollständige Installation eines EUMEL-Systems +auf diesem Computer Voraussetzung für alle im folgenden beschriebenen Aktivitäten. + +Die Beschreibung einer Systeminstallation finden Sie im Anhang I. Im weiteren gehen +wir davon aus, daß Ihr Rechner sich in einem Zustand befindet, der durch Eingabe +von oder (gleichzeitig) die sogenannte EUMEL-Tapete zeigt und +Supervisor-Kommandos annimmt. + + +____________________________________________________________________________ + + Terminal 2 + + + EUMEL Version 1.8/M + + + gib supervisor kommando: + begin("meine erste task") + + + + ESC ? --> help + ESC b --> begin("") ESC h --> halt + ESC c --> continue("") ESC s --> storage info + ESC q --> break ESC t --> task info + + +____________________________________________________________________________ + + + +Weiterführende Information zum Aufbau eines EUMEL-Systems finden Sie im An­ +hang I. + +#page# +Die Funktionstasten des EUMEL-Systems + + + +Die Lage der EUMEL-Funktionstasten entnehmen Sie bitte der speziellen Installa­ +tionsanleitung zu dem von Ihnen benutzten Gerät. #l pos (0.0)##l pos(4.0)# + + +<,>,v,^ Positionierungstasten +#table# +#free(0.5)# + Umschalttaste +#free(0.5)# + Eingabe-/ Absatztaste +#free(0.5)# + Verstärkertaste +#free(0.5)# + Löschtaste +#free(0.5)# + Einfügetaste +#free(0.5)# + Tabulatortaste +#free(0.5)# + Markiertaste +#free(0.5)# + Kommandotaste +#free(0.5)# + Supervisortaste +#free(0.5)# + Stoptaste +#free(0.5)# + Weitertaste +#tableend##clear pos# + +Task-Organisation +#free(1.0)# + +Zum Verständnis der Handhabung des Systems sollten Sie versuchen, eine Vorstel­ +lung von der Organisation der Teile zu bekommen. + +Die einzelnen #ib#Task#ie#s eines EUMEL-Systems 'stehen nicht frei im Raum', sondern +sind in einer baumartigen Beziehung organisiert: + + + +SUPERVISOR + - + SYSUR + configurator + OPERATOR + + ARCHIVE +UR + PUBLIC + Meyer + Müller + Schulze + + + +Das System besteht aus zwei Zweigen, die nebeneinander liegen: + +Dem Systemzweig mit der Wurzel SUPERVISOR + + und + +dem Benutzerzweig mit der Wurzel UR. + +Der Systemzweig stellt Ihnen privilegierte Dienstleistungen zur Verfügung, der Benut­ +zerzweig stellt die normale Arbeitsumgebung dar. + +Alle unter diesen Wurzeln liegenden Tasks des EUMEL-Systems haben mindestens +einen Vorgänger, es besteht also eine 'Vater-Sohn Beziehung' zwischen allen Tasks +des Systems. + +Grundsätzlich können Dateien ohne besondere Kommandos zur Vater-Task geschickt +und von der Vater-Task geholt werden, aber nicht zu beliebigen anderen Tasks. + +'Müller' kann eine Datei an '#ib#PUBLIC#ie#' schicken und 'Schulze' kann sie dann dort +abholen, aber eine direkte Sendung von 'Müller' nach 'Schulze' ist in der Regel nicht +möglich. + +Zur Sprechweise: jede Task, über die diese Art von 'Dateivermittlung' abgewickelt +werden kann, heißt 'Manager-Task'. Jede Task kann zum '#ib#Manager#ie#' erklärt werden. +1.5. Eine Beispielsitzung +#free(1.0)# +Der Ablauf zur Erstellung eines Schreibens stellt sich im EUMEL-System wie folgt +dar: + + SUPERVISOR aufrufen + + + +____________________________________________________________________________ + + Terminal 2 + + + EUMEL Version 1.8/M + + + gib supervisor kommando: + begin("meine erste task") + + + + ESC ? --> help + ESC b --> begin("") ESC h --> halt + ESC c --> continue("") ESC s --> storage info + ESC q --> break ESC t --> task info + + +____________________________________________________________________________ + + +Durch das Kommando 'begin ("meine erste task")', welches durch abgeschlos­ +sen werden muß, wird eine Task mit dem Namen 'meine erste task' im Benutzer­ +zweig, also unterhalb von 'PUBLIC' angelegt. Würde diese Task bereits existieren, so +könnten Sie sie mit 'continue ("meine erste task")' an das Terminal holen. + +____________________________________________________________________________ + +gib kommando : +edit ("Rechnung zum 31.12.86") + +____________________________________________________________________________ + + +In der Task eröffnen Sie eine Datei mit dem Kommando 'edit ("dateiname")'. Falls +diese Datei neu ist, erfolgt eine Kontrollfrage (zur Kontrolle der gewünschten Schreib­ +weise des Dateinamens), die Sie durch bejahen. + +Die Datei ist in diesem Beispiel bereits mit etwas Text gefüllt. Tippen Sie einen belie­ +bigen Text ein und beenden Sie die Bearbeitung dieser ersten Datei durch Drücken +der Tasten (nacheinander!). + + +____________________________________________________________________________ +.................... Rechnung zum 31.12.86 ...................... Zeile 1 + G M D + Sankt Augustin + Schloß Birlinghoven + +Sehr geehrte Damen und Herren, +> + + +____________________________________________________________________________ + + + + +Um die Arbeit in der Task zu beenden, geben Sie auch an dieser Stelle +(nacheinander!) ein. + +Nach Verlassen der Task ist wiederum die EUMEL-Tapete auf dem Bildschirm. Jede +weitere Aktion wird wiederum von hier aus durch begonnen. Insbesondere zum +#ib#Ausschalten des Geräts#ie# muß nach die Task '#ib#shutup#ie#' angestoßen werden (siehe +auch Anhang I). + diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.2 b/doc/user-manual/1.8.7/doc/benutzerhandbuch.2 new file mode 100644 index 0000000..0153fae --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.2 @@ -0,0 +1,443 @@ +#start(5.0,1.5)##pagenr("%",1)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Teil 2: Der Supervisor +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +2 - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD 2 - % +#tableend##clearpos# +#end# + +TEIL 2: Der Supervisor +#free(1.0)# + +#ib(9)#2.1. Steuerkommandos#ie(9)# +#free(1.0)# + +Jegliche Aktivität im EUMEL-System beginnt mit dem Aufruf des SUPERVISOR +durch Drücken der Taste + + + + +Dieser Tastendruck koppelt Ihr Terminal an den Rechner an. Dieser Vorgang ist auch +dann nötig, wenn diese Geräte praktisch eine Einheit bilden. + + +____________________________________________________________________________ + + Terminal 2 + + + EUMEL Version 1.8/M + + + gib supervisor kommando: + + + + + ESC ? --> help + ESC b --> begin("") ESC h --> halt + ESC c --> continue("") ESC s --> storage info + ESC q --> break ESC t --> task info + + +____________________________________________________________________________ + + +Die auf den unteren Informationszeilen angezeigten Kommandos stehen nun zur +Auswahl. Für alle diese Kommandos gilt, daß sie entweder durch zwei aufeinander­ +folgende Tastendrücke und Kennzeichen oder auch durch vollständiges Eintip­ +pen eingegeben werden können und mit ausgelöst werden. + +Die Eingabe eines falschen Zeichens nach oder eines falschen Kommandos +wird abgewiesen. Die Eingabe ist dann zu wiederholen. + + +Bedeutung der Kommandos: + +#on("b")# +1) Steuerkommandos #off("b")# + + #ib#ESC b#ie# #ib#begin#ie# ("taskname") Task einrichten. + #ib#ESC c#ie# #ib#continue#ie# ("taskname") Task wieder ankoppeln. + #ib#ESC q#ie# #ib#break#ie# Terminal abkoppeln. + #ib#ESC h#ie# #ib#halt#ie# Programmlauf abbrechen. + + + +#on("b")# +2) Informationskommandos#off("b")# (nur Supervisor) + + #ib#ESC ?#ie# #ib#help#ie# Information. + #ib#ESC s#ie# #ib#storage info#ie# Belegten Speicherplatz anzeigen. + #ib#ESC t#ie# #ib#task info#ie# Im System befindliche Tasks anzeigen. + +#page# +2.2. Eine Task einrichten +#free(1.0)# + + + Mit dem Kommando 'begin' wird eine neue Task eingerichtet. + + +#free(1.0)# + +Zunächst koppeln Sie Terminal und Rechner, dann legen Sie eine neue Task an. + + Terminal ankoppeln: + + + +Die Tastenkombination 'ESC b' schaltet den Einfügemodus ein und positioniert +den Cursor passend für die Eingabe des Tasknamens. + +____________________________________________________________________________ + +gib supervisor kommando : +begin ("") + +____________________________________________________________________________ + + + +Dateinamen eintippen: + +____________________________________________________________________________ + + gib supervisor kommando: + begin ("taskname") + +____________________________________________________________________________ + + +Nachdem Sie den Namen eingegeben haben, betätigen Sie die Taste. Daraufhin +meldet sich der Monitor der neuen Task und Sie können beliebige Monitor- +Kommandos (siehe Teil 3) eingeben. + +Wird eine Task in dieser geschilderten Weise neu eingerichtet, so wird sie automa­ +tisch (von der Task SUPERVISOR) als Sohn der Task PUBLIC angelegt. + + +Soll eine Task nicht als Sohn von PUBLIC, sondern als Sohn einer anderen Task +angelegt werden, so ist das Kommando 'begin' mit zwei Parametern zu geben. Die +neue Task wird dann als Sohn einer anderen Manager-Task angelegt (siehe Teil 3). + + +____________________________________________________________________________ + + gib supervisor kommando: + begin ("taskname","name der vatertask") + +____________________________________________________________________________ + + + +ACHTUNG: Die Task, die als Vater-Task angegeben wird, muß + eine Manager-Task sein, sonst passiert überhaupt nichts! + (s. Kap. 3.1.2.) + +#page# +Task wiederankoppeln +#free(1.0)# + + + Mit dem Kommando 'continue' wird eine existierende Task an das + Terminal angekoppelt. + + +#free(1.0)# + +Wenn Sie die Arbeit in einer Task wiederaufnehmen wollen, holen Sie die Task mit +dem Kommando 'continue' an das Terminal. Dieser Vorgang ähnelt dem Einrichten +einer neuen Task: + + Terminal ankoppeln: + + + +Die Tastenkombination 'ESC c' schaltet den den Einfügemodus ein und positioniert +den Cursor passend für die Eingabe des Tasknamens. + + +____________________________________________________________________________ + + gib supervisor kommando: + continue ("taskname") + +____________________________________________________________________________ + + +Nach dieser Eingabe finden Sie die wiederaufgenommene Task so vor, wie Sie sie +verlassen haben. + +#page# +Terminal abkoppeln +#free(1.0)# + + + Mit dem Kommando 'break' wird das Terminal vom Rechner abgekoppelt. + + +#free(1.0)# + +Wenn Sie beispielsweise nach einem Informationskommando (siehe Teil 2.3.ff) das +Terminal sofort vom Rechner abkoppeln möchten, geben Sie das 'break'-Kommando. +Nach 'storage info' geht es jedoch nur mit weiter. + +____________________________________________________________________________ + + gib supervisor kommando: + break + +____________________________________________________________________________ + + +Nach dieser Eingabe ist das Terminal abgekoppelt. Jede neue Aktivität ist wiederum +mit einzuleiten. +#page# +Laufendes Programm stoppen +#free(1.0)# + + + Mit dem Kommando 'halt' wird ein Programm gestoppt, das am betreffenden Termi­ + nal läuft. + + +#free(1.0)# + +Dieses Kommando ist in besonderen Fehlersituationen von Wichtigkeit. Falls Sie ein +Programm abbrechen wollen, aber keine regulären Eingaben am Bildschirm mehr +möglich sind, so geben Sie zunächst ein. + +Sobald der Supervisor-Bildschirm erscheint, drücken Sie die Tasten + +#center# (oder tippen 'halt' und drücken 'CR'). + +____________________________________________________________________________ + + gib supervisor kommando: + halt + +____________________________________________________________________________ + + +Nach dieser Eingabe wird das an diesem Terminal laufende Programm unterbrochen. +Nach dem Abbruch kommen Sie wieder auf die Monitor-Ebene (s. Teil 3). +#page# +2.3. Informationskommandos +#free(1.0)# + + + Mit den Informationskommandos können Informationen zum System abgerufen + werden. + +#free(1.0)# + +Die folgenden Informationskommandos können direkt an den SUPERVISOR gegeben +werden. + + Terminal ankoppeln: + + + + +beziehungsweise + +____________________________________________________________________________ + + gib supervisor kommando : + storage info + +____________________________________________________________________________ + + +gibt Auskunft über den belegten Speicherplatz auf dem EUMEL-Hintergrundspeicher. + +Das Kommando: + + +____________________________________________________________________________ + + gib supervisor kommando : + task info + +____________________________________________________________________________ + + +gibt Auskunft über die Namen der im EUMEL-System befindlichen Tasks und die +Struktur des Taskbaums. Verzweigungen im Taskbaum sind durch Einrückungen in +den Ebenen des Taskbaums dargestellt. + + +Alle in dem Schema der Task-Organisation (siehe Teil 1) fettgedruckten Tasks sind +auch auf jedem Multi-User-Sysrtem zu finden, da sie zum Betrieb nötig sind. + +Die unterhalb von PUBLIC gelegenen Tasks werden, falls überhaupt schon vorhan­ +den, häufig nach ihrem 'Besitzer' oder der in ihnen erledigten Arbeit benannt sein. + +#page# +2.4. Übersicht über Supervisor-Kommandos +#free(1.0)# + + + In diesem Abschnitt werden alle Supervisor- und Task-Kommandos in der + ELAN-Notation dargestellt. + +#free(1.0)# + +Die Supervisor-Kommandos entsprechen - wie alle anderen Kommandos im +EUMEL-System - der ELAN-Syntax (Kommando-Namen werden klein geschrie­ +ben, Parameter in Klammern, mehrere Parameter durch Kommata getrennt, TEXT- +Parameter in Anführungsstrichen usw.). +#free(1.0)# +Die ELAN-Notation +#free(1.0)# + +Diese Notation dient der präzisen Beschreibung von Konstrukten der Programmier­ +sprache ELAN. Im Anschluß an die teilweise eher informelle Formulierung innerhalb +des Kapitels folgt jedem Teil eine Kurzbeschreibung der zu diesem Themenkreis +gehörigen Konstrukte. + +Eine solche Beschreibung hat z.B. die Form: + + PROC edit (TEXT CONST dateiname) + +Die klein geschriebenen Benennungen von Prozeduren, Parametern etc. sind hoffent­ +lich selbsterklärend, die groß geschriebenen Begriffe sind sogenannte Schlüsselworte +und haben folgende Bedeutung: + +OP Operator + Ein Operator bewirkt eine elementare Operation. Operatoren werden stets + durch Großbuchstaben oder Sonderzeichen dargestellt. + + Beispiel: + ( Addition zweier Zahlen) + + +PROC Prozedur + Programm, welches unter seinem Namen aufrufbar ist, ggf. unter Anfügung + von Parametern. beendet die Eingabe und läßt das Programm ablaufen. + + Beispiel: 'edit ("dateiname")' + + +CONST Konstante + Unveränderbarer Wert. + + +VAR Variable + Veränderbarer Wert. + + +BOOL Wahrheitswert + Typ, der nur die Werte TRUE oder FALSE annnehmen kann. + + +TEXT Text + Typ, der alle Buchstaben, Sonderzeichen, aber auch Ziffern umfaßt. Eine + TEXT CONST ist somit eine sogenannte Zeichenkette: + + "meine datei" + "$abc123(XYZ)" + "abrechnung vom 30.09.86" + + + Eine im Editor erstellte Datei besteht ausschließlich aus TEXTen. Ein Text + wird in Anführungszeichen " " eingeschlossen. + + +INT Integer + Ganze Zahl. Ein INT CONST ist also irgendeine ganze Zahl. Falls beschrie­ + ben ist: 'INT CONST zeilennr', so ist gemeint, daß an dieser Stelle die Zeilen­ + nummer der gewünschten Zeile der Datei anzugeben ist, also '25' oder '999'. + + +REAL Real + Reelle Zahl. Eine REAL CONST bezeichnet eine Zahl mit Dezimalpunkt. + + PROC sin (REAL CONST x) => sin (0.5) + + + +TASK Task + Eine TASK CONST bezeichnet eine existierende Task durch einen internen + Task-Bezeichner. + + + +THESAURUS + Ein THESAURUS ist eine Liste von Namen, z.B. eine Liste von Dateinamen. + + + +#page# +Folgende Supervisor-Kommandos stehen zur Verfügung: + + +#sy("begin + PROC begin (TEXT CONST task name) + Richtet eine neue Task als Sohn von PUBLIC ein. + + PROC begin (TEXT CONST task name, father task name) + Richtet eine neue Task als Sohn der 'fathertaskname'-Task ein. + + +break + PROC break + Das Terminal wird vom Rechner abgekoppelt. + + +continue + PROC continue (TEXT CONST task name) + Eine existierende Task wird an das Terminal des Benutzers angekoppelt. + +halt + PROC halt + Das laufende Programm der dem Terminal aktuell zugeordneten Task wird + abgebrochen. Natürlich wird die Task nicht gelöscht. + + Genauer: + Es wird der Fehler 'halt from terminal' induziert. Normalerweise wird das + Programm dadurch wie durch jeden anderen Fehler abgebrochen. Genaueres + findet man im Systemhandbuch unter Fehlerbehandlung. + +storage info + PROC storage info + Informationsprozedur über den Hintergrund-Speicher. + +task info + PROC task info + Informiert über alle Tasknamen im System unter gleichzeitiger Angabe der + Vater/Sohn-Beziehungen durch Einrückungen. + diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.3 b/doc/user-manual/1.8.7/doc/benutzerhandbuch.3 new file mode 100644 index 0000000..eb1c762 --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.3 @@ -0,0 +1,2019 @@ +#start(5.0,1.5)##pagenr("%",1)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Teil 3: Der Monitor +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +3 - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD 3 - % +#tableend##clearpos# +#end# + +TEIL 3: Der Monitor +#free(1.0)# +#ib(9)#3.1. Der Monitor#ie(9)# +#free(1.0)# + + + Der Monitor nimmt die Kommandos des Benutzers entgegen, die dieser innerhalb + seiner Task gibt. In diesem Kapitel sind die gebräuchlichen Kommandos zur Text­ + verarbeitung beschrieben. + + +#free(1.0)# + +Der #ib#Monitor#ie# ist der Empfänger der Kommandos in einer EUMEL-Task. Jede Task +und somit jeder aktive Benutzer eines EUMEL-Systems verfügt über einen eigenen +Monitor. Halten Sie sich an dieser Stelle vor Augen: +#on("i")##on("b")# + + +Der SUPERVISOR ist die Task, die die Aufsicht über +alle weiteren Tasks des EUMEL-Systems hat. + +Der Monitor ist der Befehlsempfänger in Ihrer Task. +Jede Task hat einen Monitor. + +#goalpage("Mon-kdo")# +Der Monitor in Ihrer Task macht sich direkt bemerkbar durch die Zeile: + +____________________________________________________________________________ + +#ib#gib kommando#ie# : +____________________________________________________________________________ + + +Die Kommandos der Monitor-Ebene, die Sie an dieser Stelle eingeben können, +lassen sich in Gruppen ordnen: +#on("b")# + + +Informationskommandos #off("b")# + + #ib#storage info#ie# Belegten Speicherplatz anzeigen. + #ib#task info#ie# Im System befindliche Tasks anzeigen. + #ib#task status#ie# Zustand der Task anzeigen. + + +#on("b")# +Kommandos zur Tasksteuerung #off("b")# + + #ib#break#ie# Task abkoppeln. + #ib#end#ie# Task löschen. + #ib#global manager#ie# Task zum Manager machen, d.h. + Sohn-Tasks können eingerichtet + werden. + + +#on("b")# +Kommandos zur Dateibearbeitung #off("b")# + + #ib#copy#ie# ("dateiname","kopie") Datei kopieren. + #ib#edit#ie# ("dateiname") Editor aufrufen. + #ib#forget#ie# ("dateiname") Datei löschen. + #ib#list#ie# Dateien auflisten. + #ib#rename#ie# ("dateiname","neu") Datei umbenennen. + +#on("b")# +Transport von Dateien#off("b")# + + #ib#fetch#ie# ("dateiname") Datei von Vater-Task holen. + #ib#erase#ie# ("dateiname") Datei in Vater-Task löschen. + #ib#save#ie# ("dateiname") Datei zu Vater-Task senden. + + +#on("b")# +Archiv-Kommandos#off("b")# + + #ib#archive#ie# ("name") Archivlaufwerk reservieren. + #ib#fetch#ie# ("dateiname",archive) Datei von Archiv holen. + #ib#save#ie# ("dateiname",archive) Datei auf Archiv schreiben. + #ib#list (archive)#ie# Inhalt des Archivs listen. + #ib#check#ie# ("dateiname",archive) Datei auf Lesbarkeit prüfen. + #ib#clear#ie# (archive) Archiv löschen/umbenennen. + #ib#format (archive)#ie# Archivdiskette für Benutzung + vorbereiten. + +#on("b")# +Textverarbeitung #off("b")# + + #ib#list fonts#ie# Nennt die eingestellten + Schrifttypen. + #ib#fonttable#ie# Stellt die gewünschte Fonttabelle ein. + #ib#lineform#ie# ("dateiname") Zeilenweise formatieren. + #ib#autoform#ie# ("dateiname") Automatische Zeilenformatierung. + #ib#pageform#ie# ("dateiname") Seitenweise formatieren. + #ib#autopageform#ie# ("dateiname") Automatische Seitenformatierung. + #ib#index#ie# ("dateiname.p") Stichwortverzeichnis erzeugen. + #ib#outline#ie# ("dateiname") Übersicht bzw. Kurzfassung eines + Textes erstellen. + #ib#print#ie# ("dateiname") Datei drucken. + + + +#on("b")# +Passwortschutz #off("b")# + + #ib#task password#ie# ("geheim") Passwort für existierende Task festlegen. + #ib#begin password#ie# ("geheim") Passwort für neue Task festlegen. + #ib#family password#ie# ("geheim") Passwort für mehrere Tasks + festlegen. + #ib#enter password#ie# ("geheim") Passwort für Datei festlegen. + +#page# +3.1.1. Informationskommandos +#free(1.0)# + + + Mit den Informationskommandos können Informationen zur eigenen Task bzw. zum + gesamten System abgerufen werden. + +#free(0.5)# + +Bereits von Teil 2 bekannt sind die Informationskommandos 'ESC s' und 'ESC t'. Auf +der Monitor-Ebene ist die abkürzende Schreibweise nicht voreingestellt. + +____________________________________________________________________________ + +gib kommando : +storage info + +____________________________________________________________________________ + + +gibt Auskunft über den belegten Speicherplatz auf dem EUMEL-Hintergrundspeicher. + +____________________________________________________________________________ + +gib kommando : +task info + +____________________________________________________________________________ + + +gibt Auskunft über die Namen der im EUMEL-System befindlichen Tasks und die +Struktur des Taskbaums. +#page# +Auf Monitor-Ebene kann durch zusätzliche Angabe einer Zahl zwischen 1 und 3 +Zusatzinformation angefordert werden. + +____________________________________________________________________________ + +gib kommando : +task info (2) + +____________________________________________________________________________ + +liefert: + +____________________________________________________________________________ +26.11.86 10:10 CPU PRIO CHAN STATUS +SUPERVISOR........................... 0001:08:50 0 - wait + -................................ 0000:00:08 0 2 i/o + -................................ 0000:01:45 0 - wait + SYSUR............................ 0000:01:48 0 - wait + configurator................. 0000:00:43 0 - wait + OPERATOR..................... 0000:00:03 0 - i/o + shutup dialog............ 0000:03:08 0 - i/o + ARCHIVE...................... 0000:03:03 0 31 wait +UR................................... 0000:00:43 0 - wait + PUBLIC........................... 0000:01:26 0 - i/o + agfa......................... 0000:00:11 0 - i/o + werner....................... 0000:06:00 0 - -busy- + + +____________________________________________________________________________ + + + + +'task info (1)' entspricht dabei dem Kommando ohne Parameterangabe, '(2)' liefert +zusätzlich die verbrauchte CPU-Zeit (=reine Rechenzeit), die Priorität, den Kanal +(siehe S.#topage("Kanal")#) und den Taskstatus für jede Task des Systems. '(3)' liefert neben diesen +Angaben auch noch den belegten Speicherplatz jeder Task. Die Ausführung von task +info (3) ist sehr zeitaufwendig! + +Um insbesondere den belegten Speicherplatz der eigenen Task anzusehen, aber auch +die übrigen der oben erwähnten Angaben, benutzt man das Kommando: + +____________________________________________________________________________ + + gib kommando : + task status + +24.12.86 18:30 TASK: wenni + +Speicher: 1000K +CPU-Zeit: 0000.01:11 +Zustand : -busy-, (Prio 1), Kanal 1 + + gib kommando : + +____________________________________________________________________________ +#page# +3.2. Tasksteuerung +#free(1.0)# +Task abkoppeln +#free(1.0)# + + + Mit dem Kommando 'break' wird eine Task vom Terminal abgekoppelt. + + +#free(1.0)# + +Durch die Eingabe des Kommandos 'break' auf Monitor-Ebene wird die Task vom +Terminal abgekoppelt. Dieses Kommando bewirkt ansonsten keine Veränderungen. + +____________________________________________________________________________ + +gib kommando : +break + +____________________________________________________________________________ + + + +Statt 'break' einzutippen, können Sie auch die Tastenkombination + +#center# + +benutzen. + +#page# + +Eine Manager-Task erzeugen +#free(1.0)# + + + Eine Task kann zum #ib#Manager#ie#, d.h. zum Kommunikationspartner anderer Tasks, + erklärt werden. Insbesondere zwischen Manager-Tasks und anderen, die + zueinander in Vater-Sohn-Beziehung stehen, ist ein einfacher Dateitransfer + möglich (siehe S.#topage("Dateitrans")#). + +#free(1.0)# + +Normalerweise werden Benutzertasks als Sohn der Task PUBLIC eingerichtet. Es +kann jedoch wünschenswert sein, selbst eine Task-Hierarchie aufzubauen und eine +vorhandene Task zum Vater einer oder mehrerer in Zukunft einzurichtender Tasks zu +machen, um somit auch eine Dateihierarchie mit den benötigten Operationen zu +erhalten. Dazu wird diese Task zum 'Manager' erklärt:#goalpage("globalmanager")# + +____________________________________________________________________________ + +gib kommando: +global manager + +____________________________________________________________________________ + + +Durch das '#ib#global manager#ie#'-Kommando wird implizit ein 'break'-Kommando gege­ +ben, so daß Sie nach Eingabe dieses Kommandos wieder ein Supervisor-Kommando +geben können. Wenn Sie nun zu irgendeinem Zeitpunkt diese (zunächst potentielle) +Vater-Task wieder ankoppeln ('continue'-Kommando), meldet sich die Task nicht +wie gewohnt mit 'gib kommando :', sondern mit: + +____________________________________________________________________________ + +maintenance : + +____________________________________________________________________________ + + +um anzudeuten, daß es sich um eine Manager-Task handelt. + +Um eine Sohn-Task unterhalb einer Manager-Task einzurichten, wird zur Erzeu­ +gung dieser neuen Task nicht nur der gewünschte Name, sondern auch der Name der +Vater-Task angegeben.#u#1)#e# +#foot# +#u#1)#e# Falls keine Vater-Task angegeben wird, so ist die neue Task Sohn der +Manager-Task 'PUBLIC'. +#end# + +____________________________________________________________________________ + + Terminal 2 + + + EUMEL Version 1.8/M + + + gib supervisor kommando: + begin("sohntask","vatertask") + + + + ESC ? --> help + ESC b --> begin("") ESC h --> halt + ESC c --> continue("") ESC s --> storage info + ESC q --> break ESC t --> task info + + +____________________________________________________________________________ + + + + +In dieser Sohn-Task können dann mit einfachen Kommandos Dateien von der +Vater-Task geholt und zur Vater-Task geschickt werden. + +Soll eine Task für alle anderen Tasks, nicht nur für Sohn-Tasks, des Gesamtsystems +als Kommunikationspartner erreichbar sein, so muß diese Task als freier Manager +deklariert werden: + +____________________________________________________________________________ + +gib kommando: +#ib#free global manager#ie# + +____________________________________________________________________________ + + +Auf eine solche Task kann von #on("u")#jeder#off("u")# anderen Task aus zugegriffen werden, ansonsten +gilt das für gewöhnliche Manager-Tasks gesagte. +#page# +Task löschen +#free(1.0)# + + + Eine Task kann mit dem '#ib#end#ie#' Kommando gelöscht werden (und mit ihr alle Daten). + + #free(0.5)# +Normale Benutzertasks werden meistens zweck- oder themengebunden eingerichtet. +Sind die Aufgaben im Zusammenhang mit einer solchen Task erledigt, so sollte die +Task gelöscht werden, nachdem alle Daten von Bedeutung auf Diskette gesichert +wurden. + +____________________________________________________________________________ + +gib kommando : +end + +____________________________________________________________________________ + +Wie bei allen Löschungen im EUMEL-System folgt eine Kontrollfrage durch den +Monitor: + +____________________________________________________________________________ + +gib kommando : +end +task "taskname" löschen (j/n) ? + + +____________________________________________________________________________ + + +Nur bei der positiven Antwort wird gelöscht, alle Dateien sind unwiderruflich verlo­ +ren. Als positive Antwort auf derartige Abfragen wirken: + +#center# + + bzw. unterdrücken die angebotene Aktion, andere Eingaben werden abgewie­ +sen. + +#on("b")# +ACHTUNG: Wird eine Manager-Task gelöscht, so werden alle Sohn- Enkel- etc. + Tasks ohne zusätzliche Nachfrage gelöscht, falls die Sicherheitsabfrage + mit 'j' beantwortet wurde. #off("b")# +#page# +3.3. Dateibearbeitung +#free(1.0)# +Datei einrichten +#free(1.0)# + + + Mit dem Editoraufruf 'edit' wird eine neue Datei eingerichtet, bzw. eine existierende + Datei zur Bearbeitung am Bildschirm gezeigt. + + + +#free(0.5)# + +Eine Datei enthält Texte, die logisch zusammengehören und sie wird über ihren +Namen eindeutig gekennzeichnet. + +Das EUMEL-System speichert einmal geschriebene Texte, bis sie vom Benutzer +gelöscht werden. In der Regel wird nicht nur ein (langer) Text oder ein Programm­ +text geschrieben, sondern mehrere und unterschiedliche. Um diese auseinanderhalten +zu können, versehen wir sie jeweils mit einem Namen, der frei gewählt werden kann. +Beispiele für Namen: + + + "Brief vom 1.12.86" + "1. Kapitel meines Buches" + + +Eine Sammlung von Zeichen (also im Normalfall unsere geschriebenen Texte), die mit +einem Namen versehen worden ist, nennt man eine #ib##on("b")#Datei#ie##off("b")#. Der Editor erstellt also eine +Datei, wenn wir einen Text schreiben. Eine Datei kann bis zu 4 000 Zeilen fassen, +wobei jede bis zu 32 000 Zeichen lang sein darf. + + +Einrichten der ersten #ib#Datei#ie# in Ihrer Task: + +Der erste Schritt sollte darin bestehen, daß Sie sich einen vernünftigen Dateinamen +ausdenken. Das EUMEL-System legt Ihnen praktisch keine Beschränkungen über +Länge oder Form des Dateinamens auf, deshalb sollten Sie sich angewöhnen, Ihre +Dateien so zu benennen, daß Sie anhand des Namens auch nach einer Woche oder +länger noch erahnen können, was diese Datei enthält. + +Ein guter Name für die erste Datei wäre zum Beispiel: "meine erste Datei" oder +"werners test vom 1.12.86". Im weiteren Text steht nur "dateiname" o. ä.. Setzen Sie +dafür den von Ihnen gewählten Namen ein. + +____________________________________________________________________________ + +gib kommando: +edit ("dateiname") + +____________________________________________________________________________ + +____________________________________________________________________________ + +gib kommando: +edit ("dateiname") + +"dateiname" neu einrichten (j/n)? + +____________________________________________________________________________ + +Drücken Sie 'j', so wird eine neue Datei unter dem von Ihnen eingegebenen Namen +eingerichtet. Die Datei ist zunächst leer: + +____________________________________________________________________________ + ................... dateiname .................... Zeile 1 + +____________________________________________________________________________ + + + +Welche Möglichkeiten Sie bei der Bedienung des Editors haben, können Sie in Teil 4 +nachschlagen. Schreiben Sie an dieser Stelle nur einige Worte in die Datei, anhand +derer der Dateiinhalt wiederzuerkennen ist. Sie können die Tastatur genauso benutzen +wie die einer Schreibmaschine. + +____________________________________________________________________________ + ................... dateiname .................... Zeile 1 +Inhalt der ersten Datei. 1234567890 + +____________________________________________________________________________ + + +Die Datei sollte an dieser Stelle wieder geschlossen werden. + +Drücken Sie dazu . + +Dabei ist gleichgültig, wo der Cursor steht. + +Wiederholen Sie das Neuanlegen einer Datei mit einer zweiten Datei "anderer datein­ +ame". Bitte schreiben Sie wiederum einige Zeichen in die Datei. + +____________________________________________________________________________ + +gib kommando : +edit ("anderer dateiname") + +____________________________________________________________________________ + + +Vorschlag zur Eingabe: + +____________________________________________________________________________ + + .............. anderer dateiname ................. Zeile 1 +Halten Sie irgendeine Taste gedrücktttttttttttttttt + +____________________________________________________________________________ + + +Beenden Sie die Arbeit ebenfalls mit . + + +#page# +Dateinamen auflisten +#free(1.0)# + + + Mit dem Kommando 'list' werden die Dateinamen der Dateien in der Task aus­ + gegeben. + + +#free(1.0)# + +Vor jedem Dateinamen wird das Datum der letzten Bearbeitung der Datei angezeigt. + +____________________________________________________________________________ + +gib kommando: +list + +____________________________________________________________________________ + +bewirkt: +____________________________________________________________________________ + + ..................... list ....................... Zeile 1 + +01.08.86 "dateiname" +01.08.86 "anderer dateiname" + +____________________________________________________________________________ + + + +Auch bei dieser Auflistung der Dateinamen handelt es sich um eine EUMEL-Datei + (allerdings um eine schreibgeschützte), die Ausgabe wird also wie gewohnt durch + das Kommando beendet. +#page# +Datei duplizieren +#free(1.0)# + + + Mit dem Kommando 'copy' wird eine existierende Datei dupliziert. + + +#free(1.0)# + +Eine existierende Datei kann dupliziert werden durch das Kommando : + +____________________________________________________________________________ + +gib kommando: +copy ("dateiname","kopiename") + +____________________________________________________________________________ + + +Durch dieses Kommando wird eine Kopie der Datei "dateiname" unter dem Namen +"kopiename" angelegt, der Inhalt der beiden Dateien ist zunächst identisch. Kontrol­ +lieren Sie die Richtigkeit dieser Behauptung, indem Sie nachsehen, ob der Inhalt der +kopierten Datei gleich dem Inhalt der Ursprungsdateiname ist: + +____________________________________________________________________________ + +gib kommando: +edit ("kopiename") + +____________________________________________________________________________ +#page# +Dateinamen ändern +#free(1.0)# + + + Mit dem Kommando 'rename' wird der Name einer Datei geändert. + + +#free(1.0)# + +Sollte Ihnen der Name einer Datei nicht gefallen, so besteht die Möglichkeit, den +Namen zu ändern: + +____________________________________________________________________________ + +gib kommando: +rename ("dateiname","neuer dateiname") + +____________________________________________________________________________ + + +#page# +Datei löschen +#free(1.0)# + + + Mit dem Kommando 'forget' wird eine Datei gelöscht. + + +#free(1.0)# + +Das Löschen einer Datei wird durch das Kommando: + +____________________________________________________________________________ + +gib kommando: +forget ("neuer dateiname") + +____________________________________________________________________________ + +eingeleitet. Aus Gründen der Sicherheit erfolgt vor der Ausführung des Kommandos +jedoch die Abfrage: + +____________________________________________________________________________ + +gib kommando: +forget ("neuer dateiname") + +"dateiname" löschen ? (j/n) + +____________________________________________________________________________ + +Als positive Antwort auf derartige Abfragen wirken: + + bzw. unterdrücken die angebotene Aktion, andere Eingaben werden abgewie­ +sen. + +#page# +Dateien verschicken +#free(1.0)# +#goalpage("Dateitrans")# + + + Dateien können zur Vater-Task geschickt und von der Vater-Task geholt werden. + +#free(1.0)# + +Die Vereinbarung, daß Dateien in einer Task lokal sind, d.h. daß nur in dieser Task +Zugriff auf die Daten möglich ist, ist häufig zu einschränkend. So kann es zweck­ +mäßig sein, von mehreren Arbeitsplätzen (= Tasks) aus die wesentlichen Ergebnisse +an einer zentralen Stelle zu sammeln oder Ergebnisse aus Tasks, die nur kurzzeitig +für eine spezielle Aufgabe eingerichtet wurden, länger aufzubewahren. + +Zu diesem Zweck wird eine Benutzertask zum Manager erklärt (siehe S.#topage("globalmanager")#) und es +werden Söhne dieser Task eingerichtet. +#page# +Datei zur Vater-Task schicken +#free(1.0)# + + + Mit dem Kommando 'save' wird die Kopie einer Datei zur Vater-Task geschickt. + + +#free(1.0)# + +____________________________________________________________________________ + +gib kommando: +save ("dateiname") + +____________________________________________________________________________ + +Wird eine Datei an die Vater-Task gesendet, wird eine Kopie der Ursprungsdateina­ +me unter dem Namen 'dateiname' in der Vater-Task eingerichtet. Danach sind diese +beiden, zunächst gleichen Dateien unabhängig voneinander. Änderungen, welcher Art +auch immer, haben keinen Einfluß auf die namensgleiche Kopie in der anderen Task. + +Falls in der Vater-Task bereits eine Datei mit dem Namen 'dateiname' existiert, sei +es durch Zufall oder weil bereits einmal eine 'save'-Operation durchgeführt worden +ist, erfolgt eine Abfrage: + +____________________________________________________________________________ + +gib kommando: +save ("dateiname") + +"dateiname" überschreiben ? (j/n) + +____________________________________________________________________________ + +Nur wenn die positive Eingabe 'j' erfolgt, wird die Datei in der Vater-Task durch die +eigene Datei überschrieben. +#page# +Datei von der Vater-Task holen +#free(1.0)# + + + Mit dem Kommando 'fetch' wird die Kopie einer Datei von der Vater-Task geholt. + + +#free(1.0)# + +Entsprechend dem Versenden einer Dateikopie können Sie eine Kopie von der Vater­ +Task holen und ggf., natürlich nach Abfrage, Ihre Datei dieses Namens überschrei­ +ben. + +____________________________________________________________________________ + +gib kommando: +fetch ("dateiname") + +____________________________________________________________________________ + +#page# +Datei in der Vater-Task löschen +#free(1.0)# + + + Mit dem Kommando 'erase' wird eine Datei in der Vater-Task gelöscht. + + +#free(1.0)# + +Soll eine Datei in der Vater-Task gelöscht werden, so kann dieses, dem 'forget'- +Kommando analoge Kommando, in der Sohn-Task gegeben werden: + +____________________________________________________________________________ + +gib kommando: +erase ("dateiname") + +____________________________________________________________________________ + +Falls die Datei in der Vater-Task existiert, wird sie nach Kontrollfrage gelöscht. + +____________________________________________________________________________ + +gib kommando: +erase ("dateiname") +"dateiname" loeschen (j/n) j + +gib kommando : + + +____________________________________________________________________________ + + + Anm: Die Task 'PUBLIC' ist grundsätzlich eine Manager-Task. Da Benut­ + zer-Tasks als Sohn von '#ib#PUBLIC#ie#' eingerichtet werden, falls Sie nicht als + Sohn einer besonderen Manager-Task eingerichtet wurden, beziehen sich + 'fetch'-, 'save'- und 'erase'-Kommandos auf 'PUBLIC'. +#page# +3.4. Das Archiv +#free(1.0)# + + + Das Archiv dient der Speicherung von Dateien auf Disketten (Sicherung). + +#free(1.0)# + +Das #ib#Archiv#ie# übernimmt im EUMEL-System die Verwaltung der langfristigen Daten­ +haltung. Das Archiv sollen Sie benutzen, um: + +- Sicherungskopien wichtiger Dateien außerhalb des Rechners zu besitzen; + +- nicht benötigte Dateien außerhalb einer Task zu halten (Speicherplatzersparnis!); + +- Dateien auf andere Rechner zu übertragen. + +Das Archiv wird im EUMEL-System durch die Task 'ARCHIVE', die das Disketten­ +laufwerk des Rechners verwaltet, realisiert. Die Steuerung durch eine Task hat für Sie +die erfreuliche Folge, daß die Handhabung des Archivs sich kaum von den schon +bekannten Dateioperationen unterscheidet. In den Kommandos wird zusätzlich ange­ +geben, daß das Archiv angesprochen werden soll. + +#page# +Archiv-Kommandos +#free(1.0)# + + + Der Arbeitsablauf bei Benutzung des Archivs besteht immer aus der Reservierung, + dem Lese- oder Schreibzugriff und der Freigabe des Archivs nach Ende der + Arbeit. Jede Arbeit mit dem Archiv beginnt mit dem Reservierungskommando. + + +#free(1.0)# + +Als ersten Schritt der Archivbenutzung müssen Sie das Archiv reservieren, das heißt +der Verwaltung Ihres EUMEL-Systems mitteilen, daß Sie die Task 'ARCHIVE', die +der Steuerung des Diskettenlaufwerks dient, für Ihre Task arbeiten lassen. Solange für +Ihre Task das Archiv reserviert ist, kann keine andere Task das Archivlaufwerk benut­ +zen. + +Für die Reservierung müssen Sie bei Benutzung einer schon vorbereiteten oder sogar +beschriebenen Diskette den Namen dieser Archivdiskette kennen (er sollte auf dem +Diskettenaufkleber stehen) oder vor Benutzung einer neuen Diskette einen Namen +festlegen (und auf dem Aufkleber vermerken). Wie gewohnt gibt es keine Vorschrif­ +ten für die Namensgebung. + +Erst nachdem Sie das Reservierungskommando gegeben haben: + +____________________________________________________________________________ + +gib kommando: +archive ("diskettenname") + +____________________________________________________________________________ + + +sollten Sie die Diskette in das Laufwerk einschieben, um zu verhindern, daß ein +anderer Benutzer, der das Archiv bereits für sich reserviert hat, auf Ihrer zufällig +gleichnamigen Datei arbeitet. + + +Eine Datei wird mit dem Kommando: + +____________________________________________________________________________ + +save ("dateiname",archive) + + +____________________________________________________________________________ + + +auf eine Diskette geschrieben und mit dem Kommando: + +____________________________________________________________________________ + +fetch ("dateiname",archive) + +____________________________________________________________________________ + + +von einer Diskette geholt. + +Das Inhaltsverzeichnis einer Diskette erhalten Sie durch: + +____________________________________________________________________________ + +list (archive) + +____________________________________________________________________________ + +#page# +Benutzung einer neuen Archivdiskette +#free(1.0)# + + + Eine neue Diskette muß für die Benutzung vorbereitet (formatiert) werden. + + + +#free(1.0)# +Vor der erstmaligen Benutzung einer Archivdiskette muß diese formatiert, d.h. in +Spuren und Sektoren für die Positionierung des Schreib-/Lesekopfes des Disketten­ +laufwerks eingeteilt werden, um überhaupt ein Beschreiben der Diskette zu ermög­ +lichen. Die Einteilung ist geräteabhängig, häufige Formate sind: + + 40 Spuren zu je 9 Sektoren (360 K) + 80 Spuren zu je 9 Sektoren (720 K). + +Die #on("b")#Erst#off("b")#benutzung einer #ib#Archivdiskette#ie# erfordert nach der Reservierung des Archivs +das Kommando: + +____________________________________________________________________________ + +gib kommando: +format (archive) + +____________________________________________________________________________ + + +Erst nach einer Kontrollabfrage: + +____________________________________________________________________________ + +gib kommando: +format (archive) + +Archiv "diskettenname" formatieren ? (j/n) + +____________________________________________________________________________ + +wird tatsächlich formatiert und die Diskette steht mit dem Namen "diskettenname" für +Archivoperationen zur Verfügung. + +#on("b")# +ACHTUNG: Wird eine bereits beschriebene Diskette noch einmal formatiert, so sind + alle Daten, die auf der Diskette waren, verloren.#off("b")# + + +Bei einigen Rechnern ist es möglich, die Formatierung zu variieren. Falls beim Forma­ +tieren auf einem solchen Rechner ein anderes als das Standardformat erzeugt werden +soll, so ist die Codierung des gewünschten Formats mitanzugeben. + + +Beispiel: Für ein Gerät mit 5μ Zoll Disketten wäre z.B. einstellbar: + code 0 : Standardformat + code 1 : 40 Spuren + code 2 : 80 Spuren + code 3 : High Density + + 'format (archive)' erzeugt ebenso wie 'format (0,archive)' eine standard­ + formatierte Diskette, 'format (3,archive)' erzeugt eine High Density + Formatierung. +#page# +Diskette löschen / umbenennen +#free(1.0)# + + + Bereits benutzte Disketten können wieder gelöscht und auch umbenannt werden. + + +#free(1.0)# + +Falls Sie den Inhalt einer beschriebenen Archivdiskette löschen oder den Namen einer +Diskette ändern wollen, müssen Sie das Archiv unter dem gewünschten Namen reser­ +vieren: Falls Sie den Inhalt löschen möchten, tun Sie das unter dem bisherigen und +bestehenden Namen. Falls Sie die Diskette umbenennen wollen, reservieren Sie das +Archiv unter dem neuen gewünschten Namen. Beachten Sie, daß durch das Umbe­ +nennen eines Archivs alle darauf befindlichen Dateien gelöscht werden. Anschließend +geben Sie das Kommando: + +____________________________________________________________________________ + +gib kommando: +#ib#clear#ie# (archive) + +____________________________________________________________________________ + +Durch die Ausführung des Kommandos erhält die eingelegte Diskette den in der +Reservierung angegebenen Namen. Das Inhaltsverzeichnis, das sich auf der Diskette +befindet, wird gelöscht. Damit sind die Daten, die sich eventuell auf dieser Diskette +befanden, nicht mehr auffindbar. Die Diskette entspricht einer neu formatierten Disket­ +te#u#1)#e#. #foot# +#u#1)#e# Das Kommando 'format' enthält implizit 'clear'. +#end# +Eine Neuformatierung ist demnach bei Wiederverwendung der Diskette nicht notwen­ +dig. + +#page# +Inhaltsverzeichnis der Diskette +#free(1.0)# + + + Mit 'list (archive)' werden die Dateien auf der Diskette angezeigt. + + +#free(1.0)# + +Eine formatierte Diskette kann nach der Archivanmeldung gelesen oder beschrieben +werden. Um zu sehen, welche Dateien auf der Diskette zu holen (= lesen) sind bzw. +wieviel Platz zum Beschreiben vorhanden ist, ist es zweckmäßig, zunächst das In­ +haltsverzeichnis der Diskette zu betrachten. + +____________________________________________________________________________ + +gib kommando: +list (archive) + +____________________________________________________________________________ + +Beispiel: + +____________________________________________________________________________ + + ............diskettenname (100 K belegt von 720 K).............. + +01.05.86 25 K "rechnungen april" +01.06.86 23 K "rechnungen mai" +01.07.86 20 K "rechnungen juni" +01.08.86 32 K "rechnungen juli" + +____________________________________________________________________________ +#page# +Lesen und Schreiben auf Diskette +#free(1.0)# + + + Lesen und Schreiben auf der Diskette entspricht den bekannten Operationen zum + Senden und Holen von Dateien. + + + +#free(1.0)# +Das Schreiben einer Datei auf Diskette entspricht dem Übersenden einer Datei an die +Vater-Task. Einziger Unterschied ist, daß Sie das Ziel explizit angeben müssen: + +____________________________________________________________________________ + +gib kommando: +#ib#save#ie# ("dateiname",archive) + +____________________________________________________________________________ + +Entsprechend funktioniert auch das Lesen einer Datei von der Diskette: + +____________________________________________________________________________ + +gib kommando: +fetch ("dateiname",archive) + +____________________________________________________________________________ + +Wie auch bei der Kommunikation zwischen Sohn- und Vater-Task werden nur +Kopien der Dateien geholt bzw. geschrieben. +#page# +Wechsel der Archivdiskette +#free(1.0)# +Bei Einlegen einer anderen Archivdiskette müssen Sie erneut das Kommando + +____________________________________________________________________________ + +gib kommando: +archive ("diskettenname") + +____________________________________________________________________________ + +geben, da mit der Archivreservierung zugleich die Prüfung von Diskettenname und +-Inhaltsverzeichnis vorbereitet wird. +#page# +Beenden der Archivreservierung +#free(1.0)# + + + Nach Benutzung Archiv freigeben! + + +#free(1.0)# + +Wenn Sie alle gewünschten Arbeiten mit dem Archiv fertiggestellt haben, geben Sie +das Archiv wieder frei. + +____________________________________________________________________________ + +gib kommando: +#ib#release#ie# (archive) + +____________________________________________________________________________ + +Durch dieses Kommando kann die Task 'ARCHIVE' mit ihren Leistungen von einer +anderen Task in Anspruch genommen werden. Falls Sie dieses Kommando nicht +gegeben haben aber seit 5 Minuten keine Archivoperation ausgelöst haben, kann eine +andere Task durch die Anforderung 'archive("diskettenname")' das Archiv reservieren. +Durch diese Maßnahme wird verhindert, daß ein vergeßlicher Benutzer bei einem +System mit mehreren Benutzern das Archiv blockiert. +#page# +Fehlermeldungen des Archivs +#free(1.0)# + + + Bei Archiv-Operationen kann es zu Fehlersituationen kommen. + +#free(1.0)# + +Versucht man, eine Datei vom Archiv zu holen, kann es vorkommen, daß das Ar­ +chiv-System + +____________________________________________________________________________ + +#ib#Lese-Fehler (Archiv)#ie# + +____________________________________________________________________________ + +meldet und den Lese-Vorgang abbricht. Dies kann auftreten, wenn die Floppy +beschädigt oder aus anderen Gründen nicht lesbar ist (z.B. nicht justierte Disket­ +ten-Geräte). In einem solchen Fall vermerkt das Archiv-System intern, daß die Datei +nicht korrekt gelesen werden kann. Das sieht man z.B. bei 'list (archive)'. Dort ist der +betreffende Datei-Name mit dem Zusatz 'mit Lese-Fehler' gekennzeichnet. Um +diese Datei trotzdem zu lesen, muß man sie unter ihrem Dateinamen mit dem Zusatz +'mit Lese-Fehler' lesen. + +____________________________________________________________________________ + +gib kommando: +fetch ("dateiname mit Lese-Fehler") + +____________________________________________________________________________ + +Die Datei wird in diesem Fall trotz Lese-Fehler (Informationsverlust!) vom Archiv +gelesen. + +Um solche Fälle möglichst zu vermeiden, sieht das EUMEL-System die Möglichkeit +vor, Archive bzw. Archiv-Dateien nach Beschreiben zu prüfen. Das erfolgt mit dem +Kommando + +____________________________________________________________________________ + +gib kommando : +#ib#check#ie# ("dateiname", archive) + +____________________________________________________________________________ + + +Durch dieses Kommando werden eventuelle Lese-Fehler gemeldet. + +Weitere Fehlermeldungen des Archivs: + +* Lesen unmöglich (Archiv) + Die Archiv-Diskette ist nicht eingelegt oder die Tür des Laufwerks ist nicht ge­ + schlossen. +=> Diskette einlegen bzw. Tür schließen. + +* Schreiben unmöglich (Archiv) + Die Diskette ist schreibgeschützt. +=> falls wirklich gewünscht, Schreibschutz entfernen. + +* Archiv nicht angemeldet + Das Archiv wurde nicht angemeldet +=> 'archive ("name")' geben. + +* Lese-Fehler (Archiv) + Siehe Lesen unmöglich + +* Schreibfehler (Archiv) + Die Diskette kann nicht (mehr) beschrieben werden. +=> Andere Diskette verwenden. + +* Speicherengpass + Im System ist nicht mehr genügend Platz, um eine Datei vom Archiv zu laden, ggf. +=> ggf. Dateien löschen. + +* RERUN bei Archiv-Zugriff Das System wurde bei einer Archiv-Operation durch + Ausschalten bzw. Reset unterbrochen. + +* "dateiname" gibt es nicht + Die Datei "dateiname" gibt es nicht auf dem Archiv. +=> mit 'list(archive)' Archiv prüfen. + +* Archiv heißt ... + Die eingelegte Diskette hat einen anderen als den eingegebenen Archivnamen. +=> Kommando 'archive' mit korrektem Namen geben. + +* Archiv wird von Task ... benutzt + Das Archiv wurde von einem anderen Benutzer reserviert. +=> Abwarten. + +* "dateiname" kann nicht geschrieben werden (Archiv voll) + Die Datei ist zu groß für die eingelegte Diskette. +=> Andere Diskette für diese Datei nehmen. + +* Archiv inkonsistent + Die eingelegte Diskette hat nicht die Struktur einer Archiv-Diskette. +=> 'format (archive)' vergessen. + +* save/erase wegen Lese-Fehler verboten + Bei Archiven mit Lese-Fehler sind Schreiboperationen verboten, weil ein Erfolg + nicht garantiert werden kann. + + + +3.5. Kommandos für mehrere Dateien +#free(1.0)# + + + Durch Anwendung der besonderen Operatoren 'ALL' und 'SOME' können Sie + mehrere Dateien mit einem Kommando behandeln. + + +#free(1.0)# +Oft ist es sehr zweckmäßig und erleichternd, einen Befehl für eine ganze Reihe von +Dateien wirken zu lassen, wie z.B. beim Archivieren, wenn Sie etwa alle während des +Tages veränderten Dateien mit deren neuen Stand auf Diskette schreiben möchten. + +Da Tasks einen Namen haben und jede Task ein Inhaltsverzeichnis ihrer Dateien +führt, ist es möglich, Listen von Dateien zu benennen. +#page# +Interne Tasknamen +#free(1.0)# +Wenn Sie eine andere als die eigene oder die Vater-Task ansprechen wollen, ist es +notwendig, den 'internen Tasknamen' anzugeben. Diese auf den ersten Blick etwas +undurchsichtige Forderung hat folgenden Hintergrund: + +Durch die in der Einleitung vorgestellte Baumstruktur des EUMEL-Systems ist es +ohne besondere Angaben nur möglich, Kommandos zu geben, die die eigene Task +('edit'..) oder die Vater-Task ('save'..) betreffen. Beim Archivieren zum Beispiel wäre +es demzufolge erforderlich, eine Datei über den Vater vom Vater vom Vater... an den +Sohn des Sohnes... zu schicken, damit die Datei endlich in der Task 'ARCHIVE' +landet. Statt dessen verwenden Sie eine Prozedur 'archive', die den internen Task­ +bezeichner liefert. Damit wird die gewünschte Task intern identifiziert, ohne daß Sie +sich darum kümmern müssen. + +Wichtige Prozeduren, die interne Taskbezeichner liefern, sind: + + myself Bezeichner der eigenen Task + public Bezeichner von PUBLIC + father Bezeichner der Vater-Task#u##count##e# + archive Bezeichner von ARCHIVE + printer Bezeichner von PRINTER #foot# +#u##value##e# Falls kein besonderer Manager eingerichtet wurde, liefern 'father' und 'public' + natürlich dieselbe Task: PUBLIC. #end# +#page# +Dateiverzeichnisse +#free(1.0)# +Jede Task verfügt über ein Verzeichnis der in ihr befindlichen Dateien. Das Verzeich­ +nis Ihrer eigenen Task können Sie mit dem 'list'-Kommando betrachten. Das Ver­ +zeichnis einer anderen Task sehen Sie beispielsweise durch das Kommando 'list +(archive)'. In diesem Fall müssen Sie dem eigentlichen Kommando den internen +Taskbezeichner der gewünschten Task hinzugeben, um das Verzeichnis zu sehen. + +Um ein Verzeichnis in Verbindung mit anderen Kommandos benutzen zu können, gibt +es besondere Operatoren: + + #ib#ALL#ie# liefert das gesamte Verzeichnis + #ib#SOME#ie# bietet das Verzeichnis zur Auswahl von Einträgen an. + + +In Verbindung mit einem internen Taskbezeichner wird einer der beiden Operatoren +einem Monitor-Kommando als Parameter nachgestellt. Das Kommando wirkt dann +nacheinander auf alle im Verzeichnis enthaltenen Dateien. + + +____________________________________________________________________________ + +gib kommando: +fetch (ALL father) + +____________________________________________________________________________ + +Alle Dateien der Vater-Task werden nacheinander geholt, bei Namensgleichheit +erfolgt die bekannte Kontrollfrage, ob die gleichnamige Datei in der eigenen Task +überschrieben werden soll. + +Falls nur einige Dateien des Verzeichnisses bearbeitet werden sollen, wird der Opera­ +tor 'SOME' dem Taskbezeichner vorangestellt: + +____________________________________________________________________________ + +gib kommando: +fetch (SOME father) + +____________________________________________________________________________ + + +Hier wird zunächst das Dateiverzeichnis der Task angeboten. Streichen Sie alle +Dateien, die auf der Diskette sind, aber nicht in Ihre Task geholt werden sollen, aus +dem Verzeichnis, indem Sie + +- den Dateinamen mit Blanks überschreiben + + oder: + +- die Zeile mit löschen + + oder: + +- mehrere Zeilen markieren, indem Sie zu Beginn des zu markierenden Bereichs + 'mark' betätigen und mit Hilfe der Cursor-Tasten den Beereich so weit wie benö­ + tigt ausdehnen. Im Anschluß daran können Sie diese Zeilen durch + + oder + +

+ + löschen. + + +____________________________________________________________________________ + + .............................. .......................... #markoff# +rechnungen april +rechnungen mai +rechnungen juni +rechnungen juli + + + +____________________________________________________________________________ + + + +In obigem Beispiel werden nach dem Kommando 'ESC RUBOUT' (=Löschen der +markierten Zeilen) und dem Kommando 'ESC q' (=editieren beenden) die Dateien +'rechnungen juni' und 'rechnungen juli' vom Archiv geholt. + +Als weitere Vereinfachung gibt es die Prozedur 'all' als Abkürzung für 'ALL myself'. + +Beispiel: alle Dateien auf Archivdiskette schreiben. + +____________________________________________________________________________ + +gib kommando: +save (all,archive) + +____________________________________________________________________________ + + +Für Fortgeschrittene: + +Sie können auch aus den Verzeichnissen mehrerer Tasks ein neues Verzeichnis +bilden. Zu diesem Zweck sind folgende Mengenoperationen auf Verzeichnisse mög­ +lich: + + #ib#-#ie# Differenzmenge + #ib#+#ie# Vereinigungsmenge + #ib#/#ie# Schnittmenge + +Beispiel: + + fetch (ALL father - ALL myself) + +Alle Dateien der Vater-Task, die noch nicht in der eigenen Task sind, werden geholt. + +3.7. Passwortschutz +#free(1.0)# + + + Das EUMEL- System ermöglicht Passwortschutz für Dateien, einzelne Tasks und + ganze Zweige des Taskbaumes. + +#free(1.0)# + +Falls Sie sicherstellen wollen (oder müssen), daß Teile Ihres EUMEL-Systems vor +unberechtigter Benutzung geschützt sind, können Sie den Zugriff mit einem Passwort +regeln. + +Als Passwort können Sie jeden beliebigen Text nehmen. Bedenken Sie jedoch, daß +ein wirklich wirksamer Schutz nur dann gewährleistet ist, wenn Sie weder ein triviales +Passwort (etwa den eigenen Vornamen) auswählen, noch eines, das Sie selbst nicht +behalten. #u##count("1")#)#e# #foot# +#u##value("1")#)#e# Man darf Passwörter nicht vergessen! Durch Passwörter geschützte Tasks kann +niemand - außer durch die Angabe des korrekten Passworts - wieder ankoppeln. +Hat man das Passwort vergessen, kann man nur noch die Task löschen. +#end# + +ACHTUNG: Es gibt ein besonderes Passwort im EUMEL-System: "-". Dieses + Passwort verhindert, daß die Task in der es gegeben wurde (z.B. UR), an + ein Terminal geholt wird, es darf folglich nicht für normale + Manager-Tasks gegeben werden. +#page# +Eine Task mit Passwort schützen +#free(1.0)# +Das Monitor-Kommando '#ib#task password#ie#' sorgt dafür, daß eine Task fortan nur wieder +mit einem 'continue'-Kommando 'betreten' werden kann, wenn man vorher das +richtige Passwort angibt. + +____________________________________________________________________________ + +gib kommando: +task password ("rosebud") + +____________________________________________________________________________ + +Versucht nun ein Benutzer, die mit dem Passwort geschützte Task mit dem 'conti­ +nue'-Kommando an sein Terminal anzukoppeln, wird er zunächst nach dem #ib#Pass­ +wort#ie# gefragt. Nur unter Angabe des Passworts wird die Task angekoppelt. + +Bei der Beantwortung des Passworts werden statt der eingegebenen Zeichen Punkte +auf den Bildschirm geschrieben. Durch Betätigen von ESC können die getippten +Zeichen lesbar gemacht werden. + +____________________________________________________________________________ + + gib supervisor kommando: + continue("taskname") + Passwort: ....... + + +____________________________________________________________________________ + + +Der Passwortschutz gewährleistet, daß kein unberechtigter Benutzer direkt an die +Dateien und Programme der Task gelangen kann. Es gibt jedoch noch zwei Situatio­ +nen, die einen unberechtigten Zugang zu Dateien erlauben: + +a) Dateien in die Vater-Task schicken: + Transportiert man Dateien in die Vater-Task ('save'-Kommando) können Benut­ + zer auf diese Dateien zugreifen (sofern sie Zugang zu dieser Task haben). Dies + kann man verhindern, indem man ein Datei-Passwort angibt. Man beachte, daß + das Passwort für Dateien und das oben beschriebene Passwort für Tasks nichts + miteinander zu tun haben. + +b) Dateien werden in eine Sohn-Task geholt: + Ist die Task als Vater-Task eingerichtet ('global manager'-Kommando), dann ist + es möglich, von der Sohn-Task Dateien ('fetch'-Kommando) aus der Vater- + Task zu holen, die mit einem Passwort geschützt ist. Darum muß man verhindern, + daß unberechtigte Benutzer Söhne einer mit Passwort geschützten Task einrich­ + ten können. Das kann man mit dem Kommando + +____________________________________________________________________________ + +maintenance : +#ib#begin password#ie# ("geheim") + +____________________________________________________________________________ + + + Wird dieses Kommando gegeben, wird man bei dem Versuch, eine Sohn-Task + einzurichten, nach einem Passwort gefragt. Beachten Sie, daß das 'begin pass­ + word' nichts mit dem Task-Passwort und Datei-Passwort zu tun hat. + + +Man kann einen ganzen Zweig eines EUMEL-Systems durch das Kommando 'family +password' vor unberechtigtem Zugriff schützen. Das Kommando: + +____________________________________________________________________________ + +maintenance: +family password ("geheim") + +____________________________________________________________________________ + +wird dazu (wie gewohnt als Monitor-Kommando) in der Vater-Task des zu schüt­ +zenden Zweigs des Taskbaumes gegeben. Damit ist das Passwort aller Söhne, Enkel +usw. dieser Task auf 'geheim' gesetzt, falls sie vorher kein Passwort oder das gleiche +Passwort wie die aufrufende Task haben. Eine Task in diesem Zweig, die bereits ein +eigenes, vom 'family password' verschiedenes Passwort besitzt, behält dieses eigene +Passwort. + +Bsp: Für 'PUBLIC' wird das Kommando '#ib#family password#ie# ("geheim")' gege­ + ben. Dann ist das Passwort von 'PUBLIC' und aller Tasks des Benutzerzweiges + auf 'geheim' gesetzt. + + +Es ist zu beachten, daß bei der Vergabe des 'family password' nur die aktuellen +Söhne der Task berücksichtigt werden. Söhne, die nach der Vergabe des 'family +password' eingerichtet werden, sind nicht durch dieses Passwort geschützt. + +Passwort löschen + + +Um ein Passwort zu löschen, geben Sie das Passwort-Kommando mit "" als Para­ +meter: + +____________________________________________________________________________ + +maintenance: +begin password("") + +____________________________________________________________________________ + + +Durch diese Angabe haben Sie den Passwort einen leeren Text als Parameter gege­ +ben, der das bisherige Passwort 'überschreibt'. + +#page# +Dateipasswort + + +Etwas komplizierter gestaltet sich der Passwortschutz für einzelne Dateien einer +Manager-Task, da in dieser Anwendung eine Unterscheidung nach Schreib- und +Leseschutz vorgenommen wird. + +Da in dieser Anwendung nur einige Dateien der Vater-Task vor Lesen ('fetch'), +Schreiben ('save','erase') oder beidem geschützt werden sollen, benötigt diese Proze­ +dur Angaben über Dateinamen, Schreibpasswort und Lesepasswort. + +____________________________________________________________________________ + +maintenance : +enter password ("dateiname","schreibschutz","leseschutz") + +____________________________________________________________________________ + +Falls die Datei nicht gegen Lesen geschützt werden soll, wird (wie beim Löschen +eines Passworts) '""' als Lesepasswort angegeben. + +Falls Schreiben und/oder Lesen für eine Datei gänzlich verboten#u#1)#e# sein soll, so ist +"-" als entsprechendes Passwort anzugeben. +#foot# +1) Natürlich kann die Datei in der Manager-Task, der sie gehört, normal editiert + werden. +#end# + +Um von einer Sohn-Task eine Datei mit Passwortschutz in der Vater-Task zu lesen +oder zu schreiben muß vor dem 'fetch', 'save' oder 'erase' Kommando das 'enter +password' Kommando eineggeben werden: + +____________________________________________________________________________ + +gib kommando: +enter password ("schreibpasswort/lesepasswort") + +____________________________________________________________________________ + +In der Sohn-Task wird also nur ein Passwort eingegeben. Falls wie oben ein '/' in +diesem Passwort enthalten ist, wird der erste Teil vor dem '/' als Schreibpasswort und +der zweite Teil als Lesepasswort geprüft. Falls kein '/' in dem Passwort enthalten ist, +wird das Wort sowohl als Schreib- als auch als Lesepasswort interpretiert. + +Beispiel: +In einer Manager-Task wird eine Datei "texte" eingerichtet, die Textvorlagen enthält. +In einigen Sohn-Tasks soll diese Datei geholt (= gelesen) werden können. Die +bearbeitete, somit veränderte Datei darf aber nicht zurück in die Vater-Task ge­ +schrieben werden. + +In der Vater-Task: enter password ("texte","-","psw") + + +In der Sohn-Task : enter password ("psw") + + +Falls das Passwort in einer Sohn-Task fehlerhaft oder gar nicht eingegeben wurde, +erscheint die Meldung : + +____________________________________________________________________________ + + gib kommando : + fetch ("geschützte datei") +FEHLER : Passwort falsch + +____________________________________________________________________________ + + +Somit kann diese Datei nur von Benutzern, die das Lesepasswort kennen, geholt +werden. Ein Überschreiben der Datei ist nicht möglich, da das Schreibpasswort nicht +gegeben werden kann ("-" !). +#page# +3.8. Monitor-Kommandos +#free(1.0)# +ALL + THESAURUS OP ALL (TASK CONST task) + Liefert einen Thesaurus#u#1)#e#, der alle Dateinamen der angegebenen Task enthält + (auch der Benutzer-Task 'myself'). +#foot# +1) Ein Thesaurus ist eine Liste, in diesem Zusammenhang eine Liste von Dateien. + (Siehe auch 2.4. Die ELAN-Notation +#end# + fetch (ALL father) + + THESAURUS OP ALL (TEXT CONST datei) + Liefert einen Thesaurus, der die in 'datei' vorhandenen Dateinamen (jede Zeile ein + Name) enthält. + + fetch (ALL "dateiliste") + +archive + PROC archive (TEXT CONST archivname) + Anmeldung von Archiv-Operationen. 'archivname' wird zur Überprüfung für alle + folgenden Archiv-Operationen verwandt, um die unberechtigte Benutzung eines + Archivs zu verhindern. Die Anmeldung wird abgelehnt, wenn ein anderer Nutzer + das Archiv belegt hat. + + + archive ("textdiskette") + + + TASK PROC archive + Liefert den internen Task-Bezeichner für die Verwendung in Dateikommandos. + + + save ("dateiname", archive) + + + +begin password + PROC begin password (TEXT CONST geheim) + Verhindert das unberechtigte Einrichten einer Sohn-Task. + + + begin password("gmd") + + +break + PROC break + Die zum Terminal aktuell zugeordnete Task wird abgekoppelt. Sie wird damit zu + einer Hintergrund-Task. + + +brother + TASK PROC brother (TASK CONST task) + Liefert den internen Task-Bezeichner der angegebenen "Bruder"-Task. + + + list(brother) + + +check + PROC check (TEXT CONST dateiname, TASK CONST task) + Überprüft, ob die Datei 'dateiname' auf dem Archiv lesbar ist. + + + check ("meine datei", archive) + + + PROC check (THESAURUS CONST t, TASK CONST task) + Überprüft, ob die in dem Thesaurus 't' enthaltenen Dateien auf dem Archiv lesbar + sind. + + + check (ALL archive, archive) + + + +clear + PROC clear (TASK CONST task) + Löscht alle Dateien der Task 'ARCHIVE'und benennt die Diskette um, falls ein + anderer als der bisherige Diskettenname bei der Reservierung angegeben wurde. + + + archive("disk1"); clear(archive) + + +copy + PROC copy (TEXT CONST quelle, ziel) + Kopiert die Datei 'quelle' in eine neue Datei mit dem Namen 'ziel' in der + Benutzer-Task. + + + copy("datei","neue datei") + + Fehlerfälle: "ziel" existiert bereits + "quelle" gibt es nicht + zu viele Dateien + + +edit + PROC edit + a) Im Monitor: + Ruft den Editor mit den zuletzt verwandten Dateinamen auf. + b) Im Editor: + Der Dateiname wird erfragt. + Für jedes 'edit' gilt: + Wurde 'edit' zum ersten Mal aufgerufen, nimmt das Fenster den gesamten + Bildschirm ein. Bei erneutem 'edit'-Aufruf wird ein Fenster nach rechts unten ab + der aktuellen Cursor-Position eröffnet. + + PROC edit (TEXT CONST dateiname) + Ruft den Editor mit 'dateiname' auf. + + + edit("handbuch teil3") + + + + PROC edit (TEXT CONST dateiname, x, y, xbreite, yhöhe) + Wie obiger 'edit'-Aufruf, jedoch kann das Fenster, in dem 'dateiname' editierbar + ist, gesetzt werden. Die Parameter definieren ein Editor-Fenster mit der linken + oberen Ecke auf den Bildschirmkoordinaten 'x' und 'y' und einer Zeilenbreite + 'xbreite' und 'yhöhe' Zeilen. Wird der Editor mit 'edit ("dateiname")' aufgerufen, + wird implizit 'edit ("dateiname", 1, 1, 79, 24)' aufgerufen. + + + edit("notiz",5,5,44,12) + + + PROC edit (THESAURUS CONST t) + Editieren aller in dem Thesaurus 't' enthaltenen Dateien nacheinander. + + + edit (ALL father) + + + +end + PROC end + Die zum Terminal aktuell gehörende Task wird abgebrochen und gelöscht. + +enter password + PROC enter password (TEXT CONST datei, schreibpass, lesepass) + Die angegebene Datei wird mit Schreib- und Lesepassword versehen. Die + Passwörter werden in der eigenen Task nicht berücksichtigt. + Falls der Schutz total sein soll, so ist für die verbotene Operation "-" als + Passwort anzugeben. + + + enter password ("daten","sicher","heit") + + + PROC enter password (TEXT CONST password) + Gibt Schreib- und Lesepasswort für den Austausch mit Manager-Task an. Falls + zwei verschiedene Passwörter für Lesen und Schreiben vereinbart sind, so sind + sie als ein Text durch "/" getrennt einzugeben. + + + enter password ("lese/schreibpasswort") + + +erase + PROC erase (TEXT CONST datei) + Löscht eine Datei mit dem Namen 'name' in der unmittelbaren Vater-Task. + + + erase("alte datei") + + + Fehlerfälle: + "datei" gibt es nicht + Passwort falsch + + PROC erase (TEXT CONST name, TASK CONST manager) + Löscht eine Datei mit dem Namen 'name' in der Task 'manager'. + + + erase ("dateiname", father) + + + PROC erase (THESAURUS CONST thesaurus) + Löscht die im 'thesaurus' angegebenen Dateien in der Vater-Task. + + + erase (ALL myself) + (* löscht alle Dateien in der Vater-Task, die in der + Benutzer-Task vorhanden sind *) + + + PROC erase (THESAURUS CONST thesaurus, TASK CONST manager) + + + erase (all,father) + (* löscht alle Dateien in der Vater-Task, die in der + Benutzer-Task vorhanden sind *) + + + +father + TASK PROC father + Liefert den internen Task-Bezeichner der Vater-Task der Benutzer-Task. + + + list(father) + + + TASK PROC father (TASK CONST task) + Liefert den internen Task-Bezeichner von 'task'. + + + save ("dateiname", father (father)) + (* Kopiert 'dateiname' zum "Großvater" *) + + + +fetch + PROC fetch (TEXT CONST name) + Kopieren einer Datei von der Vater-Task in die Benutzer-Task + + + fetch("sicherungskopie") + + Fehlerfälle: + "datei" gibt es nicht + Passwort falsch + zu viele Dateien + + + PROC fetch (TEXT CONST name, TASK CONST manager) + Kopieren einer Datei in die Benutzer-Task von 'manager'. + + + fetch ("dateiname", /"global") + + + PROC fetch (THESAURUS CONST thesaurus) + Holt alle im 'thesaurus' enthaltenen Dateien von der Vater-Task. + + + fetch (ALL) + + + PROC fetch (THESAURUS CONST thesaurus, TASK CONST manager) + Zweck: Holt alle im 'thesaurus' enthaltenen Dateien von der 'manager'-Task. + + + fetch (ALL /"global", /"global") + + +forget + PROC forget (TEXT CONST datei) + Löschen einer Datei mit dem Namen 'name' in der Benutzer-Task. + + + forget ("alte datei") + + Fehlerfälle: + "datei" gibt es nicht + + PROC forget (THESAURUS CONST thesaurus) + Löscht die im 'thesaurus' enthaltenen Dateien in der Benutzer-Task. + + + forget (SOME myself) + + +format + PROC format (THESAURUS CONST thes) + Formatieren von Disketten und Einstellen des Namens. + + + format(archive) + + + PROC format (INT CONST art, THESAURUS CONST thes) + Formatieren von Disketten im Nichtstandardformat des benutzten Geräts + + + format(2,archive) + + +global manager + PROC global manager + Durch den Aufruf der Prozedur wird die Benutzer-Task zu einem Datei- + Manager. Danach können Söhne dieser Task eingerichtet werden. + + +list + PROC list + Listet alle Dateien der Benutzer-Task mit Namen und Datum des letzten Zugriffs + auf dem Terminal auf. + + PROC list (TASK CONST task) + Listet alle Dateien der angegebenen 'task' mit Namen und Datum der letzten + Änderung auf dem Terminal auf. + + + list (father) + + + +myself + TASK PROC myself + Liefert den internen Task-Bezeichner der Benutzer-Task. + + + save (ALL myself, father) + + + +public + TASK PROC public + Liefert den internen Task-Bezeichner von "PUBLIC". + + + fetch ("dateiname", public) + + + +rename + PROC rename (TEXT CONST altername,neuername) + Umbenennen einer Datei von 'altername' in 'neuername'. + + + rename("altes handbuch","neues handbuch") + + +save + PROC save (TEXT CONST dateiname) + Datei 'dateiname' wird an die unmittelbare Vater-Task übertragen. + + + save("neues handbuch") + + + Fehlerfälle: + "neues handbuch" gibt es nicht + zu viele Dateien + Passwort falsch + + PROC save (TEXT CONST name, TASK CONST task) + Datei mit dem Namen 'name' in Task 'task' kopieren + + + save ("dateiname", /"global") + + + Fehlerfälle: + "dateiname" gibt es nicht + zu viele Dateien + Passwort falsch + + PROC save (THESAURUS CONST thesaurus) + Kopiert die Dateien, die in 'thesaurus' enthalten sind, in die Vater-Task. + + + save (SOME myself) + + + PROC save (THESAURUS CONST thesaurus, TASK CONST manager) + Kopiert die Dateien, die in 'thesaurus' enthalten sind, in Task 'manager'. + + + save(SOME myself, /"global") + + +SOME + THESAURUS OP SOME (THESAURUS CONST thesaurus) + Bietet den angegebenen 'thesaurus' zum Editieren an. Dabei können nicht + erwünschte Namen gestrichen werden. + + THESAURUS OP SOME (TASK CONST task) + Bietet einen THESAURUS von 'task' zum Editieren an. + + THESAURUS OP SOME (TEXT CONST dateiname) + Bietet einen 'thesaurus', der aus 'dateiname' gebildet wird, zum Editieren an. + + +task + TASK PROC task (TEXT CONST task name) + Liefert den internen Task-Bezeichner von 'task name'. + + + save ("dateiname", task ("PUBLIC")) + = save ("dateiname", public) + + + +storage info + PROC storage info + Informationsprozedur über den belegten Hintergrund-Speicher. + + +task info + PROC task info + Informiert über alle Tasknamen im System unter gleichzeitiger Angabe der + Vater/Sohn-Beziehungen (Angabe durch Einrückungen). + + PROC task info (INT CONST art) + Informiert über alle Tasks im System. Mit 'art' kann man die Art der Zusatz- + Information auswählen. Für 'art' sind zur Zeit folgende Werte zugelassen: + + art=1: entspricht 'task info' ohne Parameter, d.h. es gibt nur die Tasknamen + unter Angabe der Vater/Sohn-Beziehungen aus. + + art=2: gibt die Tasknamen aus. Zusätzlich erhalten Sie Informationen über die + verbrauchte CPU-Zeit der Task, die Priorität, den Kanal, an dem die + Task angekoppelt ist, und den eigentlichen Taskstatus. Hierbei bedeuten: + + 0 -busy- Task ist aktiv. + 1 i/o Task wartet auf Beendigung des Outputs oder auf + Eingabe. + 2 wait Task wartet auf Sendung von einer anderen Task. + 4 busy-blocked Task ist rechenwillig, aber blockiert. + 5 i/o -blocked Task wartet auf I/O, ist aber blockiert. + 6 wait-blocked Task wartet auf Sendung, ist aber blockiert. + Achtung: Die Task wird beim Eintreffen einer + Sendung automatisch entblockiert. + + art=3: wie 2, aber zusätzlich wird der belegte Speicher angezeigt. (Achtung: + Prozedur ist zeitaufwendig!). + + + task info(2) + + +task status + PROC task status + Informationsprozedur über den Zustand der eigenen Task. Informiert u.a. über + - Name der Task, Datum und Uhrzeit; + - verbrauchte CPU-Zeit; + - belegten Speicherplatz; + - Kanal, an den die Task angekoppelt ist; + - Zustand der Task (rechnend u.a.m.); + - Priorität. + + PROC task status (TASK CONST t) + Wie obige Prozedur, aber über die Task mit dem internen Tasknamen 't'. + + + task status (father) + + + +task password + PROC task password (TEXT CONST geheim) + Einstellen eines Passworts für Benutzertask. Das Kommando 'task password' ist + ein Monitor-Kommando. Ist eine Task mit einem Paßwort geschützt, so wird + durch den Supervisor nach dem 'continue'-Kommando das Passwort angefragt. + Nur nach Eingabe des richtigen Passworts gelangt man in die gewünschte Task. + Das Passwort kann durch nochmaligen Aufruf von 'task password' geändert + werden, z.B. wenn es in regelmäßigen Abständen geändert werden muß, um + personenbezogene Daten zu schützen. + + Es gibt keine Möglichkeit, ein einmal eingestelltes Passwort in Erfahrung zu + bringen. Sollte das Passwort vergessen werden, kann somit die Task nur noch + gelöscht werden. + + Wird als Passwort ein '-'-Zeichen eingegeben, so wird verhindert, daß die + betreffende Task jemals wieder mit dem 'continue'-Kommando angekoppelt + werden kann. Dies ist z.B. für Manager-Tasks sinnvoll. + + + task password("mein geheimnis") + + ++ + THESAURUS OP + (THESAURUS CONST links, rechts) + Vereinigungsmenge von 'links' und 'rechts'. + + THESAURUS OP + (THESAURUS VAR thes, TEXT CONST name) + Nimmt den TEXT 'name' in den Thesaurus 'thes' auf. + + + save (SOME father + "rechnung", archive) + + + +- + THESAURUS OP - (THESAURUS CONST links, rechts) + Differenzmenge von 'links' und 'rechts'. + + THESAURUS OP - (THESAURUS VAR thes, TEXT CONST name) + Liefert einen Thesaurus aus 'thes', aber ohne den Eintrag 'name'. + + + save (ALL myself - "rechnung", archive) + + + +/ + THESAURUS OP / (THESAURUS CONST links, rechts) + Zweck: Schnittmenge von 'links' und 'rechts'. + + + save(ALL myself / ALL father, archive) + + + TASK OP / (TEXT CONST task name) + Liefert aus einem Tasknamen den internen Tasknamen. '/' kann überall dort + eingesetzt werden, wo ein interner Taskname verlangt wird. + + + fetch ("dateiname", /"global") + diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.4 b/doc/user-manual/1.8.7/doc/benutzerhandbuch.4 new file mode 100644 index 0000000..c13a091 --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.4 @@ -0,0 +1,2242 @@ +#start(5.0,1.5)##pagenr("%",1)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Teil 4: Der Editor +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +4 - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD 4 - % +#tableend##clearpos# +#end# +TEIL 4: Der Editor +#free(1.0)# + +4.0. Vorwort + +#free(1.0)# +Mit dem #ib#EUMEL-Editor#ie# schreiben Sie alle Ihre Texte und Daten. Er bietet vielfäl­ +tige Möglichkeiten, um Autoren oder Programmierer bei dem Erstellen, Korrigieren und +Gestalten von Manuskripten oder Programmen zu unterstützen. Die größte Hilfe beim +Schreiben besteht (durch die Speicherfähigkeit von Computern) im beliebig häufigen +Zugriff auf einmal geschriebene Informationen. Im Gegensatz zu einer Schreibmaschi­ +ne können Sie mit dem EUMEL-Editor (beliebig oft) Einfügungen vornehmen, Texte +korrigieren, löschen und neu gestalten. + +Somit ist das Schreiben von Texten mittels des EUMEL-Systems besonders dann +vorteilhaft und zeitsparend, wenn Texte häufig geändert werden oder wenn sie in +einer besonders schönen Form gedruckt werden sollen. Weiterhin bietet der Editor +Hilfen zum Schreiben an, wie z.B. automatischen Wortumbruch am Zeilenende, eine +Einrückungsautomatik, "Lernen" von Texten u.a.m. Zusätzlich kann der Editor in +seinen Fähigkeiten erweitert und somit für spezielle Schreibarbeiten angepaßt werden. +Aber das soll in einem späteren Kapitel beschrieben werden. + +Bei der Entwicklung des Editors wurde besonderer Wert auf einfache Bedienung +gelegt: innerhalb von wenigen Minuten können Sie schon Texte schreiben und Daten +erfassen und sehen stets auf dem Bildschirm, was mit Ihrem Text passiert. Das +Schreiben und Korrigieren werden durch einige wenige, aber leistungsstarke Funk­ +tionstasten unterstützt. + +Einige Gestaltungsmöglichkeiten für Texte kann man nicht direkt auf dem Terminal +"sehen", wie z.B. Proportionalschriften, Fettdruck usw. Solche Leistungen können +durch Anweisungen an die Textkosmetik-Programme und den EUMEL-Drucker +angefordert werden. Diese Anweisungen müssen in den Text eingefügt werden. Lesen +Sie hierzu Teil 5 ("Textkosmetik"). +#free(1.0)# + +#ib(9)#4.1. #ib#Ein- und Ausschalten des Editors#ie##ie(9)# + +#free("1.0")# + #on("i")# + Hier beschreiben wir, wie der Editor ein- und ausgeschaltet wird und wie der + Editor eine Datei einrichtet. + + #off("i")##free(1.0)# +Wenn in Ihrer Task auf dem Bildschirm die Aufforderung + +____________________________________________________________________________ + +gib kommando : + +____________________________________________________________________________ + + +erscheint, tippen Sie + +____________________________________________________________________________ + +#ib#edit#ie# ("dateiname") + +____________________________________________________________________________ + + +und der EUMEL-Editor wird eingeschaltet. Ist die Datei noch nicht vorhanden, d.h. +kein Text unter dem angegebenen Namen im System gespeichert, folgt eine Anfrage, +ob eine Datei unter dem eingegebenen Namen neu eingerichtet werden soll: + +____________________________________________________________________________ + +"dateiname" neu einrichten (j/n) ? + +____________________________________________________________________________ + + +Dies dient zur Kontrolle von Schreibfehlern, die besonders bei ähnlichen Dateina­ +men auftreten. Man kann dann das Einrichten der Datei ablehnen, den Dateinamen +verbessern und das Kommando erneut geben. + +Falls Sie die Datei neu anlegen wollen, bejahen Sie diese Frage mit + +#center##taste1(" j ")# #taste1(" J ")# #taste1(" y ")# oder #taste1(" Y ")# + + +Es erscheint ein leerer Editorbildschirm. Die oberste Zeile des Bildschirms ist die +#ib#Titelzeile#ie#. In ihr kann nicht geschrieben werden. Sie zeigt jedoch verschiedene +nützliche Dinge an: den Namen der Datei, die Nummer der aktuellen Zeile, in der +gerade geschrieben wird, Tabulatormarken, Einfügemodus, Lernmodus, Auftrennung +usw. + +____________________________________________________________________________ + + ................. dateiname ...................... Zeile 1 +_ + + +____________________________________________________________________________ + + +In unserem Fall haben Sie eine neue Datei angelegt. Sie enthält noch keinen Text. In +der Titelzeile sind jedoch schon der Name der Datei und die aktuelle Zeilennummer +eingetragen. Bei einer neuen Datei ist der Bildschirm unterhalb der Titelzeile leer. +Dieser Teil dient als "Schreibfläche". Der #ib#Cursor#ie# steht dann direkt unter der Titelzei­ +le. Er zeigt immer die aktuelle #ib# Schreibposition#ie# an. Jetzt kann sofort mit dem Schrei­ +ben begonnen werden, ganz wie mit einer normalen Schreibmaschine. + +Rufen Sie eine Datei auf, in die Sie schon Text geschrieben haben, zeigt Ihnen der +Editor das zuletzt bearbeitete Textstück und Sie können normal weiter schreiben. + +Wollen Sie die #ib#Schreibarbeit beenden#ie# und den #ib#Editor ausschalten#ie#, so drücken Sie die +beiden Tasten + + + +nacheinander. Es erscheint + +____________________________________________________________________________ + +gib kommando: + +____________________________________________________________________________ + + +und Sie haben damit den #ib#Editor verlassen#ie# und befinden sich wieder im Monitor. #page# + +#ib(9)#4.2. Die wichtigsten Tasten des Editors#ie(9)# +#free(1.0)# +#ib(9)#4.2.1. Das #ib#Tastenfeld#ie##ie(9)# + +#free(1.0)# + #on("i")# + Auf dem Tastenfeld gibt es einige Tasten, die auf einer Schreibmaschine nicht vor­ + handen sind. + + #off("i")# +#free(1.0)# +Das Tastenfeld eines EUMEL-Terminals entspricht weitgehend dem einer Schreib­ +maschine. Sie finden also die Buchstaben a-z und die Ziffern 0-9 auf Tasten. Mit +der #ib#SHIFT-Taste#ie# (Umschalttaste) und gleichzeitigem Drücken einer anderen Taste +können Sie die großen Buchstaben und eine Reihe von speziellen anderen Zeichen, +die #ib#Sonderzeichen#ie# genannt werden, schreiben. Die "Zwischenraumtaste" oder Leer­ +taste erzeugt immer ein Leerzeichen. + +Nun gibt es in der Praxis zwei unterschiedliche Tastaturen. Zum einen existiert die +#ib#EDV-Tastatur#ie#, die zum Schreiben von Programmen benutzt wird. Sie erkennt man +daran, daß keine #ib#Umlaute#ie# (ä, ö, ü) und kein ß auf den Tasten abgebildet sind. Dafür +gibt es Tasten für eckige und geschweifte Klammern. Sollen auf einer solchen Tasta­ +tur die Umlaute geschrieben werden, muß man sich eines Tricks bedienen: mit der +Taste ESC und nachfolgendem Betätigen einer anderen Taste (z.B. a, o, u) erhalten +wir den entsprechenden Umlaut. + +In der Regel kann man die Umlaute auf dem Bildschirm eines solchen EDV-Ter­ +minals nicht sehen, sondern sie erscheinen als "a", "u", usw. Beim Druck eines +Textes werden sie aber richtig dargestellt. + +Die andere Tastatur entspricht in der #ib#Tastenbelegung#ie# weitgehend einer deutschen +Schreibmaschine und besitzt Tasten für die Umlaute und ß. Sollen vorwiegend deut­ +sche Texte geschrieben werden, empfiehlt es sich, solch ein Terminal zu verwenden. + + + + Tastatur + + + + + + + + + + + + + + + +Neben diesen "einfachen" Tasten gibt es die Funktionstasten, die zur Bedienung des +Editors (aber auch anderer Programme) notwendig sind. Wo die Tasten auf Ihrem +Gerät liegen, hängt von dem jeweiligen Gerätetyp ab. Die Wirkung der Tasten +erklären wir in den anschließenden Abschnitten. #count("1")#) #foot# +#value("1")#) Es kann sein, daß die Tasten nicht richtig beschriftet sind. Die Installations­ + anleitung muß dann die Entsprechungen beschreiben. Zusätzlich zu den im + folgenden beschriebenen können sich noch weitere Tasten auf Ihrem Terminal + befinden, die aber standardmäßig keine besondere Bedeutung für den Editor + haben. +#end# +#page# +Die Funktionstasten des EUMEL-Systems +#l pos (0.0)##l pos(4.0)# + + +<,>,v,^ Positionierungstasten +#table# +#free(0.5)# + Umschalttaste +#free(0.5)# + Eingabe-/ Absatztaste +#free(0.5)# + Verstärkertaste +#free(0.5)# + Löschtaste +#free(0.5)# + Einfügetaste +#free(0.5)# + Tabulatortaste +#free(0.5)# + Markiertaste +#free(0.5)# + Kommandotaste +#free(0.5)# + Supervisortaste +#free(0.5)# + Stoptaste +#free(0.5)# + Weitertaste +#tableend##clear pos# + + +#page# +Die Wirkung der Funktionstasten +#free(0.5)# + + +#ib#Umschalttaste#ie# + +Wird diese Taste gleichzeitig mit einer anderen betätigt, so wird ein Buchstabe in +Großschreibung, bei den übrigen Tasten das obere Zeichen, ausgegeben. So wird z.B. +anstelle der "9" das Zeichen ")" ausgegeben. +#free(1.5)# + + +#ib#Kontroll-/Steuertaste#ie# + +Mit dieser Taste in Kombination mit Zusatztasten können Sonderfunktionen des +Systems angewählt werden. Für EUMEL sind folgende drei Tastenkombinationen +(wobei die Tasten gleichzeitig betätigt werden müssen) wichtig: + + Anhalten der Bildschirmausgabe + + Wirkung der SV-Taste (bei jedem Rechner) + + Bildschirmausgabe fortführen +#l pos (0.0)##l pos(4.0)# + + +#free(1.5)# + + +#ib#Eingabetaste / Absatztaste#ie#, Carriage Return, kurz: 'CR' + +Diese Taste wird im Editor betätigt, um das Ende eines Absatzes zu kennzeichnen. +Die kontinuierliche Fließtexteingabe wird durch sie unterbrochen und es wird an den +Beginn der nächsten Zeile positioniert. Einrückungen werden beibehalten. Eine Ab­ +satzmarke ist im Editor an der Inversmarkierung am rechten Bildschirmrand zu erken­ +nen. + +Die 'CR'-Taste ist oft mit einem geknicktem Pfeil nach links gekennzeichnet. Im +Kommandomodus (also bei "gib kommando :") wird durch Betätigung dieser Taste ein +gegebenes Kommando ausgeführt. + +Die sonstige Benutzung dieser Taste außerhalb des Editors wird in der jeweiligen +Anwendung beschrieben, z.B. Bestätigung eines Trennvorschlags bei der Silbentren­ +nung. + +<, >, v, ^ + +Tasten für die Positionierung + +#ib#Positionierung des Cursors#ie# um eine Spalten-/Zeilenposition in die jeweilige Richtung. +#free(1.5)# + + +"#ib#Verstärkertaste#ie#"; wird als Vorschalttaste bedient. + +In Kombination mit anderen Funktionstasten wird deren Wirkung verstärkt. (vgl. +4-#topage("HOP")#) + +#on("u")#Beispiel:#off("u")# + + + + +Steht der Cursor nicht am unteren Bildrand, so wird er dorthin positioniert. Steht er +am unteren Bildrand, so wird um einen Bildschirminhalt "weitergeblättert". + +Auch die Funktionen 'RUBIN'/'RUBOUT' werden in Kombination mit der HOP-Taste +verstärkt.(vgl. 4-#topage("verstärkt")#ff) #free(1.5)# + + +#ib#Löschtaste#ie# + +Das Zeichen, auf dem der Cursor steht, wird gelöscht. Wenn der Cursor hinter dem +letzten Zeichen einer Zeile steht, wie bei fortlaufender Eingabe üblich, wird das letzte +Zeichen gelöscht. + +#on("u")#Beispiel:#off("u")# + +____________________________________________________________________________ + ................. dateiname ...................... Zeile 4 + +Mit der RUBOUT-Taste ist es möglich, ein +Zeichen nach dem anderen auf dem Bildschirm +zu löschen. Steht der Cursor auf einem +Zeichen, das irrtümlicherweise eingetipp?t +wurde, kann dieses durch einmaliges +Betätigen der RUBOUT-Taste aus der Datei +gelöscht werden. + +____________________________________________________________________________ + + +Nach Betätigen der - Taste: + + +____________________________________________________________________________ + ................. dateiname ...................... Zeile 4 + +Mit der RUBOUT-Taste ist es möglich, ein +Zeichen nach dem anderen auf dem Bildschirm +zu löschen. Steht der Cursor auf einem +Zeichen, das irrtümlicherweise eingetippt +wurde, kann dieses durch einmaliges +Betätigen der RUBOUT-Taste aus der Datei +gelöscht werden. + +____________________________________________________________________________ + +#page# + + + + +#ib#Ein- bzw. Ausschalten des Einfügemodus.#ie# + +Das Betätigen der Taste schaltet in den Einfügemodus.Der Zustand wird durch das +Wort "RUBIN" im linken Drittel der Titelzeile der Datei angezeigt. Vor dem Zeichen, +auf dem der Cursor steht, wird eingefügt. Nochmaliges Betätigen der Taste schaltet +den Einfügemodus aus. + +#on("u")#Beispiel:#off("u")# + + +____________________________________________________________________________ + ................. dateiname ...................... Zeile 5 + +Das Betätigen der Taste schaltet in den +Einfügemodus. Der Zustand wird durch das +Wort "RUBIN" im linken Drittel der Titelzeile +angezeigt. Vor dem Zeichen, auf dem der +Cursor steht, wird ' ' eingefügt. +Nochmaliges Betätigen der Taste schaltet den +Einfügemodus aus. + +____________________________________________________________________________ + + + +Nach Betätigen der - Taste und Einfügen des Wortes " jetzt": + +____________________________________________________________________________ + .......RUBIN...... dateiname ..................... +Zeile 5 +Das Betätigen der Taste schaltet in den +Einfügemodus. Der Zustand wird durch das +Wort "RUBIN" im linken Drittel der Titelzeile +angezeigt. Vor dem Zeichen, auf dem der +Cursor steht, wird jetzt ' ' eingefügt. +Nochmaliges Betätigen der Taste schaltet den +Einfügemodus aus. + +____________________________________________________________________________ + + + + + +#ib#Tabulatortaste#ie# + +Betätigen Sie die 'TAB'-Taste, um vom linken Bildschirmrand auf den Textbeginn in +der Zeile bzw. eine Tabellenspalte zu positionieren. Erneutes Betätigen der 'TAB'- +Taste positioniert den Cursor auf die nächste eingestellte Tabulator-Position. Die +eingestellten Tabulatorpositionen erkennen Sie an den Tabulatorzeichen (Dachzei­ +chen) in der obersten Bildschirmzeile. + +Wenn keine TABs gesetzt sind, werden die beiden Schreibgrenzen, linker Bildschirm­ +rand und Ende der Zeile, als #on("i")#voreingestellte# #off("i")# TABs angesehen. +#free(1.5)# + + +#ib#Ein- bzw. Ausschalten der Markierung#ie#. + +Bei Betätigung dieser Taste wird in einen speziellen #ib#Markierzustand#ie# geschaltet. Alles, +was Sie jetzt schreiben bzw. durch Bewegen des Cursors in Richtung Dateiende +kennzeichnen, steht als #on("i")#markierter# #off("i")# Bereich für die Bearbeitung zur Verfügung. Zur +besseren Sichtbarkeit wird der markierte Bereich invers zum übrigen Text dargestellt. + +Wird der Cursor in eine Richtung bewegt, wird das gesamte Textstück zwischen +Einschaltpunkt der Markierung und aktueller Cursorposition markiert. Rückwärtsbewe­ +gungen des Cursors verkürzen den markierten Bereich wieder. + +Einen derart markierten Bereich können Sie nun z.B. duplizieren, verschieben, lö­ +schen, durchsuchen oder weiterverarbeiten. (vgl. 4- #topage("mark")# ff). + +Durch erneutes Betätigen der MARK-Taste schalten Sie den Markier-Zustand auch +wieder aus. + +#on("u")#Beispiel:#off("u")# + +Sie wollen einen Textteil markieren, um ihn an eine andere Stelle zu verschieben +(evtl. um ihn an dieser Stelle später zu löschen): + +Sie positionieren den Cursor auf den Beginn des Textteils, gehen in den Markierzu­ +stand durch Betätigen der MARK-Taste und führen nun den Cursor mit Hilfe der +Positioniertasten bis zum Ende des zu markierenden Bereichs. + + +____________________________________________________________________________ + ................. dateiname ...................... Zeile 5 + +Mit dem Cursor positionieren Sie an die +Stelle, ab der markiert werden soll und +betätigen die MARK-Taste. Nun führen Sie den +Cursor bis zu der Stelle, bis zu der +markiert werden soll. Der markierte Text wird +normalerweise "schwarz auf weiss" +dargestellt. + +____________________________________________________________________________ + + + +Mit weiteren Kommandos (vgl. ESC-Taste und Kommando-Verarbeitung, 4- #topage("ESC")#) +kann der Bereich nun bearbeitet werden. +#free(1.5)# + + +#ib#Kommandotaste#ie# + +Mit der ESC-Taste in Kombination mit einer Folgetaste können Sie vordefinierte +Aktionen anwählen. Es gibt Aktionen, die vorprogrammiert zur Verfügung stehen, und +Sie selbst können weitere hinzufügen. (vgl. 4-#topage("ESC")# ) #free(1.5)# + + +#ib#SUPERVISOR-Taste im Mehrbenutzer-Betrieb#ie# + +Betätigen Sie diese Taste im Editor, dann unterbrechen Sie Ihre Editierarbeit und +erhalten die Meldung + +____________________________________________________________________________ + + Terminal 2 + + + EUMEL Version 1.8/M + + + gib supervisor kommando: + + + + + ESC ? --> help + ESC b --> begin("") ESC h --> halt + ESC c --> continue("") ESC s --> storage info + ESC q --> break ESC t --> task info + + +____________________________________________________________________________ + + +Wollen Sie nun im Editor fortfahren bzw. haben Sie irrtümlich die SV-Taste betätigt, +dann geben Sie das Kommando + +____________________________________________________________________________ + + gib supervisor kommmando : + continue ("Sekretariat") + + +____________________________________________________________________________ + + +(falls Ihre Task, in der Sie arbeiteten, wirklich "Sekretariat" hieß!) + +Um Ihren in Bearbeitung befindlichen Text wieder vollständig auf dem Bildschirm zu +sehen, betätigen die die Tasten + + + +Sie sind wieder an der Stelle, an der Sie den Text mit der SV-Taste verlassen ha­ +ben, und können normal weiterarbeiten. + +#on("u")#Achtung:#off("u")# Die SV-Taste kann, je nach Terminal, durch das Betätigen von zwei +Tasten gleichzeitig realisiert sein (oft 'CTRL b'). Beachten Sie die Beschreibung Ihrer +Tastatur! +#free(1.5)# + + +#ib#Unterbrechen einer Ausgabe#ie# (oft auch als CTRL a realisiert). + +Haben Sie diese Taste aus Versehen betätigt, erkennen Sie dies daran, daß der +Editor nicht "reagiert". Betätigen Sie die WEITER-Taste (oft auch CTRL c). +#free(1.5)# + + +Unterbrochene Ausgabe fortsetzen. + +Ein mit der STOP-Taste angehaltene Ausgabe können Sie durch Betätigen der +#ib#WEITER-Taste#ie# fortsetzen. + + +#on("u")#VORSICHT:#off("u")# Die STOP-Taste unterbricht nur die Ausgabe auf den Bildschirm. +Zeichen, die während des STOP eingegeben werden, werden gespeichert und nach +'WEITER' ausgegeben! + + +#page# +4.2.2 Speicherung von Texten +#free(1.0)# + #on("i")# + In diesem Abschnitt wird der Begriff "Datei" erklärt und es wird erläutert, wie + unterschiedliche Texte auseinandergehalten werden können. + ## #off("i")# + + + +Das EUMEL-System speichert einmal geschriebene Texte, bis sie vom Benutzer +gelöscht werden. In der Regel wird nicht nur ein (langer) Text oder ein Programm +geschrieben, sondern mehrere und unterschiedliche. Um diese auseinanderhalten zu +können, versehen wir sie jeweils mit einem Namen, der frei gewählt werden kann. +Beispiele für Namen: + + + "Brief vom 1.12.86" + "1. Kapitel meines Buches" + + +Eine Sammlung von Zeichen (also im Normalfall unsere geschriebenen Texte), die mit +einem Namen versehen worden ist, nennt man eine #ib##on("bold")#Datei#ie##off("bold")#. Der Editor erstellt also eine +Datei, wenn wir einen Text schreiben. Eine Datei kann bis zu 4 000 Zeilen fassen, +wobei jede Zeile bis zu 32 000 Zeichen lang sein darf. Das Produkt aus der Anzahl +der Zeilen und den Zeichen pro Zeile kann z.Zt. jedoch 1 000 000 Zeichen (=1MB) +nicht übersteigen. #page# + +#ib(9)#4.2.3. #ib#Schreiben von Texten#ie##ie(9)# +#free(1.0)# + #on("i")# + Texte werden fortlaufend geschrieben. Absätze werden durch die CR-Taste + markiert. + # #off("i")# + +#free(0.8)# + +Nach dieser etwas langen Vorrede können wir endlich losschreiben. Wird ein Zeichen +geschrieben, rückt der #ib#Cursor#ie# automatisch nach rechts auf die nächste Schreibstelle. +Durch den automatischen #ib#Wortumbruch#ie# werden angefangene Worte, die über ein +Zeilenende hinausgehen würden, ohne Silbentrennung in die nächste Zeile gebracht. +#u##count("6")#)#e# +#foot# +#u##value("6")#)#e# Nehmen Sie bitte keine Silbentrennung "per Hand" vor. Eingebrachte Trenn­ + striche gelten als Bindestrich und bleiben somit auch bei Umformatierungen + erhalten, was unerwünscht ist. Für diese mühevolle Aufgabe gibt es in der Text­ + verarbeitung ein Programm! +#end# + +Die 'CR'-Taste (bei einer Schreibmaschine bedeutet sie "Wagenrücklauf") braucht +also nur noch betätigt zu werden, wenn eine Zeile vorzeitig beendet werden soll, d.h. +bei einem #ib#Absatz#ie# oder einer #ib#Leerzeile#ie#. Der Cursor wird dabei an den Anfang der +nächsten Zeile positioniert. Gleichzeitig erscheint in der vorherigen Zeile am rechten +Rand des Bildschirms eine Markierung, die anzeigt, daß hier ein Absatz gemacht +wurde. + +Darum ist das Betätigen der 'CR'-Taste bei Tabellenzeilen und Programmtexten +besonders wichtig, denn hier soll ja jede Zeile separat bleiben. Sie wirkt nur hinter +dem letzten Zeichen. + +Der Editor ist auf das Schreiben von "normalen" Texten eingestellt. Bei normalen +Texten soll ein Wort, welches über das Ende einer Zeile gehen würde, automatisch in +die nächste Zeile gebracht werden. Diese Funktion wird "Wortumbruch" genannt. + +Ist kein Wortumbruch erwünscht, zum Beispiel bei der Beschreibung von Program­ +men, so geben Sie, bevor Sie den Editor aufrufen, im Monitor das Kommando + +____________________________________________________________________________ +gib kommando : +#ib#word wrap (false)#ie# + +____________________________________________________________________________ + + +Der Wortumbruch kann durch das Kommando + +____________________________________________________________________________ + +gib kommando : +#ib#word wrap (true)#ie# + +____________________________________________________________________________ + + +wieder eingeschaltet werden. Der Editor ist standardmäßig auf "Wortumbruch" einge­ +stellt und Sie sollten nur in Ausnahmefällen diese Benutzungsart ausschalten. + +Ein Bildschirm faßt (neben der Titelzeile) üblicherweise 23 Zeilen, die mit Text be­ +schrieben werden können. Ist die letzte Zeile voll und muß eine neue Zeile begonnen +werden, "rutscht" der Bildschirminhalt automatisch um eine Zeile nach oben. Damit +ist Platz für eine Leerzeile, die nun ebenfalls beschrieben werden kann, usw. Keine +Angst: die so verschwundenen Zeilen sind natürlich nicht "weg". Da ein Bildschirm +immer nur eine beschränkte Anzahl von Zeilen hat, kann der Editor nur einen Aus­ +schnitt aus der Datei zeigen. +#page# +Einrückungen +#free(1.0)# + #on("i")# + Die #ib#Einrückungautomatik#ie# erlaubt bei fortlaufendem Schreiben, die Einrückung zu + erhalten. + # #off("i")# +#free(0.5)# +Soll ein Text eingerückt werden, so betätigt man entsprechend oft die Leertaste. Die +in dieser Zeile geschriebene Einrückung wird automatisch in den folgenden Zeilen +beibehalten, bis sie durch die Cursor-Positionierungstasten wieder aufgehoben wird. + +#on("u")#Beispiele für Aufzählungen:#off("u")# Einrückung funktioniert automatisch ohne aktive Eingabe +von Leerschritten. + +____________________________________________________________________________ + ................. dateiname ...................... Zeile 1 + - Der erste Typ der Aufzählungsform + ist die #ib#Aufzählung#ie# durch Voran­ + stellen eines Sondersymbols. + Als Sondersymbole sind die beiden + Zeichen "-" und "*" zugelassen. An + ihnen erkennt der Editor eine + Aufzählung. + + 12. Weiterhin können Aufzählungen + durch Begriffe, gefolgt von + einem Punkt oder einer ")", als + #ib#Aufzählungskriterium#ie# verwendet + werden. + + + Aufzählung: Auch diese Möglichkeit + steht Ihnen zur Verfü­ + gung. Der Editor er­ + kennt, daß Sie hier + einen Begriff erläutern + wollen. + +____________________________________________________________________________ + +#page# +Wann werden nun Aufzählungen vom Editor erkannt? + +Die hier aufgeführten Einzelheiten sollte nur der hieran interessierte Anfänger lesen! + +Wenn die Einrückung nicht funktionieren sollte, prüfen Sie die folgenden Punkte, die +für das Einrücken erfüllt sein müssen: + +1) Die Vorgängerzeile hat eine Absatzmarke. + + Wichtig: Innerhalb eines Aufzählungspunktes schaltet die Absatztaste die Aufzäh­ + lungseinrückung aus! + +2) "*" bzw. "-" und mindestes ein Leerzeichen sind die ersten Zeichen in der + Zeile. + +3) "." bzw. ")" und mindestens ein Leerzeichen nach höchstens sieben Zeichen sind + die ersten Zeichen in der Zeile. + +4) ":" und mindestens ein Leerzeichen nach höchstens 19 Zeichen sind die ersten + Zeichen in der Zeile. +#page# + +#ib(9)#4.2.4. #ib#Positionieren#ie# im Text#ie(9)# + +#free(1.0)# + #on("i")# + Um Korrekturen (Überschreiben, Löschen oder Einfügen) vorzunehmen, muß der + #ib#Cursor#ie#, der die aktuelle Schreibposition anzeigt, bewegt werden können. Bei + längeren Texten ist es möglich, den Cursor auch auf Zeilen zu positionieren, die + (noch nicht) auf dem Bildschirm angezeigt werden. Somit zeigt der Editor nicht nur + immer das Ende einer Datei, sondern einen beliebigen Ausschnitt, der auf dem + Bildschirm im sogenannten '#ib#Fenster#ie#' sichtbar ist. + #off("i")# +#free(1.0)# +Ist eine Korrektur notwendig, positionieren Sie den Cursor auf die Stelle, an der die +Korrektur vorgenommen werden soll. Dazu verwenden Sie die #ib#Positionierungstasten#ie# +LINKS, RECHTS, OBEN und UNTEN. LINKS und RECHTS bewegen den Cursor +innerhalb einer Zeile. Stößt man mit RECHTS an das Ende einer Zeile, wird der +Cursor an den Anfang der nachfolgenden Zeile bewegt. + + v ^ + +Ein #ib#Zeilenwechsel#ie# kann einfacher mit den Tasten OBEN und UNTEN vorgenommen +werden. Die Taste OBEN bewegt den Cursor eine Zeile nach oben, die Taste UNTEN +entsprechend eine Zeile tiefer. + +Was passiert nun, wenn Sie den unteren oder den oberen Rand des Bildschirms +erreicht haben, und Sie positionieren darüber hinaus? In diesem Fall wird der Text +zeilenweise nach oben oder nach unten verschoben und es erscheint die gewünschte +Zeile, wobei am anderen Rand einige verschwinden". Wir sehen also, daß wir mit den +Positionierungstasten den Bildschirm als Fenster über die Datei hinweggleiten lassen +können. Den Text selbst können wir uns auf einem langen Band geschrieben vorstel­ +len. Die #ib#Zeilennummer#ie#, die die Position des Cursors angibt, wird stets in der Titel­ +zeile angezeigt. + +Vermeiden Sie es, den Cursor über das Textende hinaus nach unten laufen zu las­ +sen. Sie verlängern dadurch Ihren Text um Leerzeilen, die Sie beim Weiterschrei­ +ben nicht auffüllen, sondern vor sich herschieben. + +Innerhalb einer Zeile ist es etwas anders: Positionieren wir bei einer Zeile, die breiter +als der Bildschirm ist, nach rechts, wird nicht das Fenster verschoben, sondern die +Zeile 'gerollt'.(vgl. Sie hierzu das Verschieben des Gesamtfensters mit dem 'mar­ +gin'-Kommando 4-#topage("margin")#) +4.2.5. Korrigieren im Text +#free(1.0)# + + #on("i")# + Einfache Korrekturen können durch #ib#Überschreiben von Zeichen#ie#, #ib#Löschen von + Zeichen#ie# und #ib#Einfügen von Zeichen#ie# vorgenommen werden. + + #off("i")# +#free(1.0)# + + +Die einfachste Möglichkeit der Korrektur ist das #ib#Überschreiben#ie#. Soll z.B. ein Zeichen +durch ein anderes ersetzt werden, so positioniert man der Cursor genau über dieses +und tippt das richtige Zeichen ein. Das kann natürlich auch mit mehreren Zeichen +nacheinander erfolgen. + +Korrekturen können Sie gleich beim Schreiben vornehmen, indem Sie die zuletzt +geschriebenen Zeichen mit der #ib#RUBOUT-Taste#ie# löschen. Häufig bemerkt man aber +#ib#Schreibfehler#ie# erst etwas später, so daß man diese Fehler nicht so leicht korrigieren +kann. Für solche Zwecke müssen Sie den Cursor an die Textstelle bewegen, an der +korrigiert werden soll. + +Wollen Sie ein #ib#Zeichen löschen#ie#, so positionieren Sie den Cursor auf dieses Zeichen +und betätigen die Taste #ib#RUBOUT#ie#. Das Zeichen verschwindet und die Restzeile rückt +heran. Sollen mehrere Zeichen gelöscht werden, muß die RUBOUT-Taste entspre­ +chend oft gedrückt werden. + +Steht der Cursor hinter dem letzten Zeichen der Zeile, wird immer das letzte Zeichen +der Zeile gelöscht. Man kann also mit dieser Eigenschaft eine Zeile "von hinten +wegradieren".(vgl. hierzu auch 4- #topage("ESC RUBOUT")#) + + + + + +Fehlende Zeichen können Sie genauso einfach einfügen. Sie bringen den Cursor auf +das Zeichen, vor das eingefügt werden soll. Dann drücken Sie die Taste #ib#RUBIN#ie#. Der +Editor gelangt in den #ib#Einfügemodus#ie#, was in der Titelzeile durch RUBIN angezeigt +wird. Er fügt alle Zeichen ein, die jetzt getippt werden (anstatt zu überschreiben). Der +Teil der Zeile rechts vom Cursor rückt jeweils um entsprechend viele Stellen nach +rechts. + +Wichtig ist, daß im RUBIN-Modus der Editor genauso funktioniert wie im Normalzu­ +stand (natürlich mit der Ausnahme, daß eingefügt statt überschrieben wird). + +Im eingeschalteten RUBIN-Modus können keine Zeichen verloren gehen. Viele +Benutzer lassen darum den RUBIN-Modus immer eingeschaltet, um sich vor einem +unbeabsichtigten Überschreiben von Texten zu schützen. Sie korrigieren, indem Sie +die Verbesserung einfügen und den alten Text löschen. + +Durch erneutes Betätigen der RUBIN-Taste beenden Sie den Einfügemodus. Die +RUBIN-Taste wirkt wie ein Schalter, der den Einfügemodus ein- und ausschaltet. +Allerdings können Sie nur so viele Zeichen in eine Zeile einfügen, bis das letzte Wort +der Zeile an das Zeilenende stößt. Das letzte Wort wird am Anfang der folgenden +Zeile eingefügt, sofern dort noch Platz ist und es sich nicht offensichtlich um die +letzte Zeile eines Absatzes handelt. Andernfalls wird automatisch eine neue Zeile für +das angefangene Wort eingefügt.(vgl. Sie hierzu auch 4- #topage("ESC RUBIN")#) #free(1.5)# +#page# +Springen und Zeilen einfügen/löschen +#free(1.0)# + #on("i")# + Bewegungen des Cursors sind mit den Positionierungstasten bei größeren "Ab­ + ständen" etwas mühsam, ebenso bei umfangreichen Löschungen und Einfügun­ + gen. Die "#ib#Verstärkertaste#ie#" HOP ermöglicht es, diese Operationen auf einfache + Weise zu beschleunigen. Mit der #ib#HOP-Taste#ie# kann man das Fenster über der + Datei nicht nur zeilenweise, sondern auch um jeweils eine Fensterlänge verschie­ + ben. Das nennt man #ib#Blättern#ie#. + + #off("i")# +#free(1.0)# +#goalpage("HOP")# +Wird die HOP-Taste vor einer anderen der schon erklärten Funktionstasten gedrückt, +verstärkt sie deren Wirkung. Die HOP-Taste ist eine "Präfix"-Taste: sie wird vor +(und nicht gleichzeitig mit, wie z.B. die Umschalttaste SHIFT) einer anderen Taste ge­ +drückt. Zuerst das springende Positionieren: +#free(1.0)# + <>> + +#ib#Sprung an das rechte Bildschirmende#ie#. + +Falls die Zeile länger als das Fenster breit ist, wird die Zeile um eine Fensterbreite +nach links verschoben. +#free(1.0)# + <<> + +#ib#Sprung an den Bildschirmrand links#ie# (ggf. seitlich blätternd). +#free(1.0)# + <^> + +#ib#Sprung auf die erste Zeile des Bildschirms#ie#. + +Nochmaliges Betätigen dieser Tastenkombination positioniert den Cursor (und damit +das Fenster in der Datei) um ein Fenster zurück. ("Blättern") +#free(1.0)# + + +#ib#Sprung auf die letzte Zeile des Bildschirms#ie#. + +Das Blättern erfolgt analog HOP OBEN. +#free(1.0)# + + +Positioniert das Fenster so, daß die aktuelle Zeile zur ersten des Fensters wird. +#free(1.0)# + + +#ib#Einfügen von Textpassagen#ie#. #goalpage("verstärkt")# Die HOP-Taste in Verbindung mit RUBIN und +RUBOUT wird zum "verstärkten" Löschen und Einfügen verwendet. + +Ab der aktuellen Position des Cursors "verschwindet" der restliche Text. Es kann wie +bei der anfänglichen Texteingabe fortgefahren werden. Die Anzeige '#ib#REST#ie#' in der +Titelzeile erinnert daran, daß noch ein Resttext existiert. Dieser erscheint nach einem +neuerlichen Betätigen der beiden Tasten HOP RUBIN wieder auf dem Bildschirm (die +Anzeige 'REST' verschwindet dann wieder). + +____________________________________________________________________________ + ................. dateiname ...................... Zeile 4 + +In diesem Text soll vor dem zweiten Satz +etwas eingefügt werden. #cursor("H")#ierzu wird der +Cursor an die Position geführt, an der +ein beliebiger Text eingefügt werden soll. + +____________________________________________________________________________ + + +Nach Betätigen der Tasten und sieht der Bildschirm wie folgt +aus: + +____________________________________________________________________________ + ............... dateiname .........REST.......... Zeile 4 + +In diesem Text soll vor dem zweiten Satz +etwas eingefügt werden. + + +____________________________________________________________________________ + + + +Nun kann beliebig viel Text eingefügt werden. Nochmaliges Betätigen von HOP und +RUBIN führt den Text-Rest wieder bündig heran. + + + + +Löscht die Zeile ab Cursor-Position bis Zeilenende. + + +____________________________________________________________________________ + ................. dateiname ...................... Zeile 4 + +Soll eine ganze Zeile oder ein Textrest +gelöscht werden, so positioniert man an die +Stelle, ab der gelöscht werden soll. 'R'est löschen.... +Nach HOP RUBOUT ist der Zeilenrest gelöscht. + + +____________________________________________________________________________ + + +Nach Betätigen der Tasten und sieht der Bildschirm wie +folgt aus: + +____________________________________________________________________________ + ................. dateiname ...................... Zeile 4 + +Soll eine ganze Zeile oder ein Textrest +gelöscht werden, so positioniert man an die +Stelle, ab der gelöscht werden soll. +Nach HOP RUBOUT ist der Zeilenrest gelöscht. + +____________________________________________________________________________ + + + +Steht der Cursor am Zeilenanfang, wird nach HOP RUBOUT dementsprechend die +ganze Zeile gelöscht und die Lücke durch Nachrücken der Folgezeilen geschlossen +(HOP RUBOUT betätigen). +#page# +Zeilen aufbrechen und Rückumbruch + +#free(1.0)# + #on("i")# + Um grössere Textpassagen einzufügen, betätigt man #ib#HOP RUBIN#ie# nacheinander. + Diese Tastenfolge kann benutzt werden, um eine Zeile bzw. eine längere Textpas­ + sage aufzubrechen). #ib#HOP RUBOUT#ie# am Ende einer Zeile macht einen #ib#Rückum­ + bruch#ie#. + + #off("i")# +#free(1.0)# + + +Wie bereits beschrieben, bewirkt #ib#HOP RUBIN#ie# in einer Zeile, daß der Zeilenrest rechts +des Cursors und alle Zeilen unterhalb der aktuellen Zeile scheinbar verschwinden. +#ib#REST#ie# in der Titelzeile erinnert daran, daß ein Teil der Datei nicht sichtbar ist. + +Wird unmittelbar nach HOP RUBIN wiederum HOP RUBIN betätigt, wird der vorherige +Zeilenrest als eigenständige Zeile dargestellt. Es ist damit eine Aufspaltung einer Zeile +in zwei Zeilen vollzogen. + + + + +Der umgekehrte Fall, nämlich zwei Zeilen zu einer zusammenzufassen (sog. #ib# Rück­ +umbruch#ie#), ist durch #ib#HOP RUBOUT#ie# hinter dem letzten Zeichen einer Zeile möglich. +Hinter das letzte Zeichen einer Zeile kann einfach mit dem Tabulator positioniert +werden. + +Das Aufbrechen einer Zeile und der Rückumbruch zusammen angewandt stellen den +ursprünglichen Zustand wieder her. Beispiel: Mit HOP RUBIN bricht man eine Zeile +auf, der Rest der Zeile und nachfolgende Zeilen verschwinden vom Bildschirm. Erneu­ +tes HOP RUBIN stellt den rechten Zeilenteil auf der nächsten Zeile und die nachfol­ +genden Zeilen auf dem Bildschirm wieder dar. Da der Cursor sich noch immer am +rechten Rand der aufgebrochenen Zeile befindet, kann man mit HOP RUBOUT den +ursprünglichen rechten Zeilenteil wieder rekombinieren. +#page# + + +#ib(9)#4.2.6. Der #ib#Tabulator#ie##ie(9)# + +#free(1.0)# + #on("i")# + Eine weitere wichtige #ib#Positionierungshilfe#ie# innerhalb einer Zeile ist die #ib#TAB#ie#-Taste. + Sie wird u.a. zum Schreiben von Tabellen benötigt. Wie bei einer Schreibmaschine + können #ib#Tabulatormarken#ie# gesetzt bzw. gelöscht werden. + + #off("i")# +#free(1.0)# + + +Der Tabulator hat eine wichtige Funktion für das schnelle Positionieren, auch wenn +keine Marken eingestellt wurden. #ib#Voreingestellte Tabulatormarken#ie# sind nämlich der +Textanfang einer Zeile (Einrückung, falls vorhanden) und die Stelle direkt hinter dem +letzten Zeichen der Zeile. Betätigt man also die Taste TAB, dann springt die Schreib­ +marke an die nächste dieser voreingestellten Positionen. So kann man schnell mit +dem Cursor an den Anfang oder das Ende einer Zeile gelangen (und z.B. am Zeilen­ +ende Zeichen "von hinten" löschen oder dort weiterschreiben). + + + +Nun zum #ib#Setzen des Tabulators#ie#: Sie setzen ihn, indem Sie den Cursor auf die Zei­ +lenposition bringen, in der die Marke plaziert werden soll. Hier betätigen Sie nun #ib#HOP +TAB#ie#. Die Tabulatorsetzung kann man in der Titelzeile an einer Markierung ("Dach­ +"-Zeichen) sehen, falls sie im Fensterbereich ist und die aktuelle Zeile nicht seitlich +verschoben ist. Betätigt man nun an irgendeiner Position innerhalb einer Zeile die +TAB-Taste, wird der Cursor auf die Position der nächsten Tabulatormarkierung (die +sich rechts von dem Cursor befindet) oder eine der voreingestellten Positionen be­ +wegt. + +#ib#Gesetzte Tabulatormarken#ie# können gelöscht werden, indem man mit der TAB-Taste +die Position der Tabulatormarke einstellt und dann HOP TAB betätigt. Die Marke ist +dann gelöscht, das Dach verschwindet in der Titelzeile. + +Tabulatormarkierungen hinterlassen keine Spuren in der Datei, sondern dienen nur als +Positionierungshilfen. mit 'HOP TAB' gesetzte Markierungen, die mit 'TAB' ange­ +sprungen werden, wirken beim Schreiben von Zahlen wie Dezimaltabulatoren, vgl. Sie +dazu 4- #topage("zahlen")#. + +#on("u")#Beispiel:#off("u")# + +Es soll für den Textbeginn eine Tabulatorposition auf die 12. Spalte gesetzt werden. +Hierzu wird der Cursor auf die 12. Spalte positioniert und die HOP- und die TAB- +Taste nacheinander betätigt. Das "Dach"-Zeichen erscheint in der 12. Spalte in der +Titelzeile und von nun an kann durch Betätigen der TAB-Taste diese Position direkt +angesteuert werden. + +____________________________________________________________________________ + ..........^....... dateiname ...................... Zeile 4 + +HOP TAB wurde in der 12. Spalte betätigt. + Mit TAB stehen Sie auf der 12. + Spalte. + +____________________________________________________________________________ + + +Werden #ib#Tabulatormarken#ie# gesetzt (HOP TAB), gelten die voreingestellten Tabulator­ +marken (Anfang und Ende einer Zeile) nicht mehr. Dies ist z.B. bei dem Schreiben +von Tabellen notwendig. Andererseits möchte man beim Schreiben von "normalem" +Text wieder die voreingestellten Tabulatormarken bedienen können. Mit den Tasten + + + +kann man die gesetzten Tabulatormarken (erkenntlich an dem "Dach"-Zeichen in +der Kopfzeile) vorübergehend verschwinden lassen. Dann gelten wieder die voreinge­ +stellten Marken. Erneutes #ib#ESC TAB#ie# stellt die gesetzten Tabulatormarken wieder her +usw.. +#free(1.5)# +Zahlentabellen schreiben: Dezimaltabulator +#goalpage("zahlen")# + +#free(1.0)# + #on("i")# + Beim Schreiben von #ib#Zahlentabellen#ie# sollen die Zahlen oft rechtsbündig im Text + erscheinen. Dazu bietet der Editor den #ib#Dezimaltabulator#ie# an. + + #off("i")# +#free(1.0)# +Für jede Zahlenkolonne wird die gewünschte Position der Einerstelle (also der letzten +Stelle) mit Hilfe eines Tabulators eingestellt. Mit #ib#TAB#ie# wird der Cursor zur jeweils +nächsten Tabulatormarke vorgerückt. Werden nun Ziffern geschrieben, so schreibt +man nicht - wie gewohnt - nach rechts, sondern die Ziffern werden nach links +eingerückt. Etwas genauer: Beim Drücken einer Zifferntaste wird, solange links vor +der Zahl noch ein Blank, eine Zahl, "+", "-" oder ein Punkt sichtbar ist, diese +gelöscht und die hierdurch neu entstandene Ziffernfolge rechtsbündig an der Tabula­ +torposition geschrieben. Das Schreiben von rechtsbündigen Zahlenkolonnen ist so +leicht möglich #count("11")#): +#foot# +#value("11")#) Wird eine #ib#Proportionalschrift#ie# (Schrift, bei der die Zeichen unterschiedliche + Breiten haben) verwendet, sollte man zwischen den einzelnen Zahlenkolonnen + mindestens zwei Leerzeichen schreiben. Andernfalls bekommt man - auf Grund + der unterschiedlicher Zeichenbreiten - keine rechtsbündigen Kolonnen gedruckt. +#end# + + + 12 12345,78 + 1 0,23 + 12345 1234,00 + + + +Es gibt somit vier nützliche Automatiken: neben dem automatischen Dezimaltabulator +den Wortumbruch, die Einrückautomatik und die Zeileneinfügeautomatik beim ein­ +fügenden Schreiben. +4.2.7. Lernen im Editor + +#free(1.0)# + + Beliebige Folgen von Tastenbetätigungen können gelernt und Tasten zugeordnet + werden. Das ist sinnvoll, wenn Sie wiederholt immer die gleichen Tastenbetä­ + tigungen ausführen müssen, wie z.B. in Tabellenzeilen etwas einfügen oder wenn + des öfteren gleiche Texte geschrieben werden müssen, wie z.B. ein Absender, + Grußformeln usw. + #goalpage("ESC")# + #free(1.0)# +< ESC> + +Der #ib#Lernmodus#ie# wird durch Betätigen der Tasten #ib#ESC HOP#ie# eingeschaltet, es erscheint +#ib#LEARN#ie# als Kontrolle rechts in der Titelzeile). Alle Tastenanschläge werden jetzt bis +zum Ausschalten des Lernmodus gelernt. Auch Tastenanschläge wie 'CR'), so daß +man kann demnach auch mehrere Zeilen lernen lassen kann. + + <'taste'> z.B. ESC HOP j + +Das Beenden oder Ausschalten des Lernmodus erfolgt durch Drücken der drei Tasten +#ib#ESC HOP 'taste'#ie#. Dabei wird die gelernte Tastenanschlagsfolge, auch #ib#Lernsequenz#ie# +genannt, der Taste 'taste' zugeordnet. + + <'taste'> z.B. ESC j + +Durch späteres Betätigen der Tastenfolge ESC 'taste' kann der gelernte Text an jeder +Stelle der Datei geschrieben werden. + +#on("u")#Beispiel:#off("u")# + +Ein Sachbearbeiter hat jeden Tag 50 mal die Worte 'Gesellschaft für Datenverarbei­ +tung' zu tippen. Er läßt den Editor diese Worte lernen mit + + +ESC HOP Gesellschaft für Datenverarbeitung ESC HOP m + +Die Worte liegen jetzt auf der Taste 'm'. Wird 'm' gedrückt, erscheint ein 'm' auf dem +Bildschirm. Mit ESC 'm' erscheinen die obigen Worte. ESC ist also notwendig, um +das normale 'm' von der Lernsequenz zu unterscheiden. + +Welche Tasten dürfen zum #ib#Lernen#ie# belegt werden? Alle Tasten, außer + +- vom System benutzte Tasten, wie SV, CTRL; +- vom Editor (je nach Anwendung) vorbelegte Tasten, wie die Tasten q oder ESC + und HOP; +- durch Programmierung (siehe dieses Kapitel) fest belegte Tasten. + +Praktische Tips: Man sollte die Tastatur nicht mit Lernsequenzen überlasten, weil man +sich zu viele Tasten nicht merken kann. Besser ist es, einige wenige Tasten fest zu +belegen und andere für momentane Aufgaben einzusetzen. + +Der Einsatz von #ib#Lernsequenz#ie#en ist besonders sinnvoll für das Schreiben von Text­ +kosmetikanweisungen. Anweisungen wie z.B. 'Unterstreichen einschalten', Schrift­ +typ-Anweisungen usw. werden zweckmäßigerweise auf Tasten gelegt. + +Hat man sich einmal beim '#ib#Lernen#ie#' verschrieben, so ist das nicht weiter schlimm: es +kann ohne Bedenken korrigiert werden (z.B. mit der Taste RUBOUT). Solche Tasten­ +anschläge werden dann allerdings auch gelernt, was aber bei der Benutzung der +Lernsequenzen keine Bedeutung hat. +4.2.8. Textabschnitte durch Markieren bearbeiten + +#free(1.0)# + #on("i")# + Oft ergibt sich die Notwendigkeit, mehrere Zeilen oder ganze Textpassagen zu + löschen oder zu verschieben. Hierbei hilft die Taste #ib#MARK#ie#, mit der man #ib#Texte + markieren#ie# (also kennzeichnen) kann. Die so markierten Texte können dann auf + verschiedene Weisen als Ganzes verarbeitet werden. + #goalpage("ESC")# + + #free(1.0)# + + +Durch Drücken der Taste MARK wird die #ib#Markierung#ie# eingeschaltet und - bei erneu­ +ter Betätigung - wieder ausgeschaltet. Der Anfang der Markierung wird "festgehal­ +ten" und man kann nun das Markierende durch die Positionierungstasten und die +HOP-Taste in Richtung auf das Dateiende verschieben, wobei die dazwischen lie­ +genden Zeichen markiert (in der Regel "schwarz auf weißem Grund" dargestellt) +werden. + + + + +Ein so markierter Text kann mit #ib#ESC RUBOUT#ie# gelöscht werden. #ib#Markieren und +löschen#ie# mit ESC RUBOUT ist eine bequeme und sichere Löschmethode, da man +genau sieht, was gelöscht wird.#goalpage("ESC RUBOUT")# + + + +#goalpage("ESC RUBIN")# + +Der gelöschte Abschnitt ist aber nicht vollständig gelöscht, sondern er kann an ande­ +rer (oder an der gleichen) Stelle im Text durch #ib#ESC RUBIN#ie# wieder eingefügt werden. +Der vorsichtig gelöschte Text landet in einem #ib#Zwischenspeicher#ie# und kann bei Bedarf +mit #ib#ESC RUBIN#ie# wieder aufgerufen werden. Wird erneut vorsichtig gelöscht, so wird +der letzte Text des Zwischenspeichers überschrieben. Im Zwischenspeicher ist nur für +einen #on("u")#Text#off("u")# Platz. Auf diese Art kann ein Textabschnitt beliebiger Länge an eine +andere Stelle des Textes sicher, schnell und bequem verschoben werden. Zusätzlich +ist die nachträgliche Korrektur von fehlerhaften Löschungen möglich, weil der Text +wieder mit ESC RUBIN reproduziert werden kann. + +Mit eingeschalteter Markierung kann auch geschrieben werden. Das #ib#markierende +Schreiben#ie# ist eine besonders vorsichtige Art der Texterstellung, denn der Textein­ +schub bleibt erst durch Ausschalten der Markierung (MARK) wirklich bestehen. Er +kann wieder gelöscht (ESC RUBOUT) und an eine andere Stelle gebracht werden +(ESC RUBIN). Beim markierenden Schreiben wirkt RUBOUT immer auf das Zeichen +vor der Cursorposition. + +Hinweis: Positionierungen sind nur innerhalb der Markierung möglich. +#page# +4.2.9. Der Fenstereditor +#free(1.0)# + + #on("i")# + Oft ist es notwendig, mit mehreren Dateien gleichzeitig zu arbeiten, z.B. wenn aus + einer Datei etwas in eine andere kopiert werden muß, wenn Fehler durch die + Textkosmetik-Programme oder einen Compiler gefunden werden oder wenn man + kurz etwas in einer anderen Datei nachschauen will. Zu diesem Zweck bietet der + Editor die Möglichkeit, zwei (oder mehr) Dateien zur gleichen Zeit zu bearbeiten. #off("i")# + + +#free(1.0)# +Der Editor ermöglicht dem Benutzer wie durch ein Fenster auf den zu bearbeitenden +Text zu schauen. Es ist in diesem Zusammenhang nur natürlich, daß man bei der +Bearbeitung eines Textes sich die Möglichkeit wünscht, weitere Texte gleichzeitig +ansehen zu können. Dies kann notwendig sein, um zu vergleichen, Fehler zu entdek­ +ken oder Textteile aus einem Fenster in ein anderes zu übertragen. + +Um ein neues Editor-Fenster zu "öffnen", betätigt man im Editor + + + +Betätigt man ESC e ungefähr in der Mitte des Bildschirms, hat man das Fenster auf +die neue Datei in der unteren Hälfte des Bildschirms und die "alte" Datei in der +oberen Bildschirmhälfte. Zunächst wird der Dateiname erfragt. Nach dessen Eingabe +und dem Betätigen der 'CR' Taste wird ein Fenster auf eine andere Datei eröffnet. +Die obere linke Ecke des Fensters befindet sich an der aktuellen Cursor-Position. +Dabei darf sich der Cursor nicht zu sehr am rechten oder unteren Rand befinden, weil +das Fenster sonst zu klein würde. In diesem "Fenster" kann man dann genauso +arbeiten wie im "normalen" Editor. + + +Mit der Tastenfolge + + + +wechselt man von einem Fenster (zyklisch) in das benachbarte. Es gibt eine Hier­ +archie zwischen den Fenstern in der Reihenfolge, in der eines im anderen einge­ +richtet worden ist. Gibt man + + + +in einem Fenster, so verschwindet dieses und alle darin eingeschachtelten Fenster, +und man befindet sich im übergeordneten Fenster. + +Wir schilderten zuvor, daß man mit ESC RUBOUT und ESC RUBIN Texte verschie­ +ben und löschen kann. Zwischen Dateien im Fenstereditor geht dies folgendermaßen: + +Durch + +

oder + +schreibt man einen markierten Teil in eine temporäre Datei (einen Zwischenspeicher); +durch ESC p wird ein markierter Text aus der Ursprungsdatei entfernt und in einen +Zwischenspeicher geschrieben. Im Gegensatz dazu wird er durch ESC d kopiert. +Durch + + + +fügt man ihn in eine andere (oder dieselbe) Datei ein. Im Unterschied zu ESC RUBIN +wird die temporäre Datei dadurch nicht entleert. + +Die Funktionen ESC d und ESC g leisten auf schnellere Weise dasselbe wie die +Kommandos 'PUT ""' und 'GET ""'. +#page# +4.2.10. Die wichtigsten vorbelegten Tasten +#free(1.0)# + + #on ("i")# + Lernsequenzen und Kommandos (d.h. ELAN-Programme) können Tasten zuge­ + ordnet werden. Da einige Funktionen häufig benötigt werden, sind diese stan­ + dardmäßig bestimmten Tasten zugeordnet. #off("i")# + + + +#free(1.0)# +#ib#ESC q#ie# Verlassen des Editors bzw. der eingeschachtelten Fenster. + +#ib#ESC e#ie# Weiteres Editorfenster einschalten. + +#ib#ESC n#ie# Notizbuch "aufschlagen". + +#ib#ESC v#ie# Dateifenster auf ganzen Bildschirm vergrößern + bzw. Bildschirm rekonstruieren (eingeschachteltes Fenster verlas­ + sen). + +#ib#ESC w#ie# Dateiwechsel beim Fenstereditor. + +#ib#ESC f#ie# Nochmalige Ausführung des letzten Kommandos. + +#ib#ESC b#ie# Das Fenster wird auf den linken Rand der aktuellen (ggf. verscho­ + benen) Zeile gesetzt. + +ESC > Zum nächsten Wortanfang. + +ESC < Zum vorherigen Wortanfang. + +#ib#ESC 1#ie# Zum Anfang der Datei. + +#ib#ESC 9#ie# Zum Ende der Datei. +#page# +Lernen + + +#ib#ESC HOP#ie# Lernen einschalten. + +#ib#ESC HOP taste#ie# Lernen ausschalten und Lernsequenz auf 'taste' legen. + +#ib#ESC HOP HOP#ie# Gelerntes vergessen. Bedingung ist, daß man die Lernsequenz in + der Task löscht, in der man sie hat lernen lassen. +#free(1.0)# +Operationen auf Markierungen + +#free(1.0)# +#ib#ESC RUBOUT#ie# Markiertes "vorsichtig" löschen. + +#ib#ESC RUBIN#ie# Vorsichtig mit ESC RUBOUT Gelöschtes einfügen. + +#ib#ESC p#ie# Markiertes löschen und in die Notiz-Datei schreiben. Kann mit ESC + g an anderer Stelle reproduziert werden. + +#ib#ESC d#ie# Duplizieren: + Markiertes in die Notiz-Datei kopieren (PUT ""), anschließend die + Markierung abschalten. Kann mit ESC g beliebig oft reproduziert + werden. + +#ib#ESC g#ie# MIT ESC p gelöschten oder mit ESC d duplizierten Text an aktuelle + Cursor-Stelle schreiben, d.h. Notiz-Datei an aktueller Stelle einfü­ + gen (GET ""). +#free(1.0)# +#on("b")#Zeichen schreiben#u#1#e# +#off("b")# +#foot# +1) Diese Tasten sind standardmäßig so vorbelegt wie hier aufgeführt, sie könne aber +von Benutzern und in Anwenderprogrammen geändert werden. +#end# +#free(0.5)# +#ib#ESC a#ie# Schreibt ein ä. +#ib#ESC A#ie# Schreibt ein Ä. +#ib#ESC o#ie# Schreibt ein ö. +#ib#ESC O#ie# Schreibt ein Ö. +#ib#ESC u#ie# Schreibt ein ü. +#ib#ESC U#ie# Schreibt ein Ü. +#ib#ESC s#ie# Schreibt ein ß. +#ib#ESC (#ie# Schreibt eine [. +#ib#ESC )#ie# Schreibt eine ]. +#ib#ESC <#ie# Schreibt eine {. +#ib#ESC >#ie# Schreibt eine }. +#ib#ESC \##ie# Schreibt ein \#, das auch gedruckt werden kann. +#ib#ESC ­#ie# Schreibt einen (geschützten) Trennstrich, siehe Textverarbeitung. +#ib#ESC k#ie# Schreibt ein (geschütztes) "k", siehe Textverarbeitung. +#ib#ESC blank#ie# Schreibt ein (geschütztes) Leerzeichen, siehe Textverarbeitung. +#free(1.0)# +Kommando auf Taste legen + +#free(1.0)# +#ib#ESC ESC#ie# Kommandodialog einschalten + +#ib#ESC ! taste#ie# Im Kommandodialog: + Geschriebenes Kommando auf Taste legen. + +#ib#ESC ? taste#ie# Im Kommandodialog: + Auf 'taste' gelegtes Kommando zum Editieren anzeigen. + +#ib#ESC k#ie# Im Kommandodialog: + Das zuletzt editierte Kommando (einzeilige ELAN-Programm) + anzeigen. + +Eine ausführliche Beschreibung des Kommandodialogs finden Sie im folgenden Kapi­ +tel. +4.3. Die wichtigsten Editor-Kommandos +#goalpage("ESC")# +#free(0.5)# + +#ib(9)#4.3.1. Der #ib#Kommandodialog#ie##ie(9)# + +#free(1.0)# + #on("i")# + Einige Operationen kann man nur mühselig mit den bis jetzt beschriebenen Tasten + durchführen. Z.B. ist es sehr zeitaufwendig, eine bestimmte Textstelle zu finden. + Andere Operationen sind mit den im vorigen Kapitel beschriebenen Tasten über­ + haupt nicht möglich, wie etwa die Zeilenbreite einzustellen oder Programme aufzu­ + rufen, die die zu editierende Datei verarbeiten. Solche Operationen werden durch + Kommandos ermöglicht, die man auf Editorebene geben kann. #off("i")# + + +#free(1.0)# +Um Kommandos an den Editor geben zu können, schalten wir in den #ib#Kommando­ +zustand#ie#. + + + +Durch zweimaliges Betätigen von ESC erfolgt #on("u")#im Editor#off("u")# die Aufforderung + +____________________________________________________________________________ + ................. dateiname ...................... Zeile 4 + +Mit der ESC-Taste ist es möglich, den Kommandodialog +gib kommando : + +____________________________________________________________________________ + + + +Auf dem Bildschirm erscheint eine #ib#Kommandozeile#ie#, in der der Benutzer +Kommandos schreiben kann. Durch Betätigen der Taste 'CR' wird das +Kommando ausgeführt. +#page# + + +#ib(9)#4.3.2. Zeile und #ib#Textstelle anwählen#ie##ie(9)# +#free(1.0)# + #on("i")# + Auf der Kommandoebene des Editors können Sie Kommandos erteilen, um an eine + beliebige Stelle in der Datei zu positionieren.#off ("i")# + +#free(1.0)# +Sie haben einen (größeren) Text erstellt und stehen nun vor dem Problem, für die +Korrektur die entsprechenden Textstellen aufzufinden. + +#on("u")#Beispiel:#off("u")# + +Bei der Durchsicht eines Ausdrucks Ihres Textes stellen Sie fest, daß Sie sich ver­ +schrieben haben. Anstelle von "diese Zeichen" haben Sie "diese Ziichen" geschrie­ +ben. Um diese Textstelle anzuwählen, gehen Sie wie folgt vor: Sie positionieren an +den Beginn der Datei und betätigen die Tastenfolge + + + + + +Auf dem Bildschirm ersceint: + +____________________________________________________________________________ + +gib kommando: + +____________________________________________________________________________ + + +Sie schreiben nun die zu suchende Textstelle auf: + +____________________________________________________________________________ + +gib kommando: "diese Ziichen" + +____________________________________________________________________________ + + +Durch die Angabe eines TEXTes in Anführungsstrichen wird nach dem eingeschlosse­ +nen TEXT 'diese Ziichen' ab der aktuellen Cursor-Position gesucht. Wird 'diese +Ziichen' gefunden, bleibt der Cursor auf dem gesuchten Text stehen. Andernfalls steht +der Cursor am Ende der letzten Zeile der Datei. + +Eine andere Möglichkeit, an eine entferntere Stelle im Text zu kommen, ist die fol­ +gende: + + + + +Es erscheint auf dem Bildschirm: + +____________________________________________________________________________ + +gib kommando: + +____________________________________________________________________________ + + +Sie geben nun die Textzeile an, die Sie suchen: + +____________________________________________________________________________ + +gib kommando: 134 + +____________________________________________________________________________ + + +Durch dieses Kommando wird auf die 134. Zeile positioniert. +#page# + +#ib(9)#4.3.3. #ib#Suchen und Ersetzen#ie##ie(9)# +#free(1.0)# + #on("i")# + Auf der Kommandoebene des Editors können Sie wie auf der Monitor-Ebene + beliebige Kommandos geben. Diese können Sie zu (ELAN-) Programmen ver­ + knüpfen. Zur Erstellung dieser Programme editieren Sie wie gewohnt in der Kom­ + mandozeile. Für das Positionieren, Suchen und Ersetzen innerhalb Ihres ELAN- + Programms stehen Ihnen Kommandos zur Verfügung. Beliebige ELAN-Prog­ + ramme sind zulässig.#off ("i")# + +#free(1.0)# +Die #ib#Kommandozeile#ie# kann wie eine "normale" Textzeile editiert werden (Positionieren, +Überschreiben, Einfügen, Löschen und Markieren). Bevor ein Programm eine Aus­ +gabe erzeugt oder fehlerhafte Kommandos Fehlermeldungen hervorrufen, wird der +Cursor in die linke obere Ecke positioniert. Um die Meldungen festzuhalten, sollte das +#ib#Kommando 'pause'#ie# folgen. Diese Meldungen werden dann in der ersten Zeile des +Bildschirms angezeigt. Danach ist man wieder im Editor und kann wie gewohnt +arbeiten. + +Kommandos werden durch ein Semikolon voneinander getrennt. + +#on("u")#Beispiel:#off("u")# + +____________________________________________________________________________ + +gib kommando: T1; "Geschäftsführung";fetch("Lieferanten",archive) + +____________________________________________________________________________ + + +Ihr ELAN-Programm besteht aus zwei Kommandos: zunächst positionieren Sie in die +erste Zeile und suchen ab dort nach dem Wort "Geschäftsführung". dann lesen Sie +die Datei "Lieferanten" von der Diskette in den Arbeitsspeicher. + +Die beiden beschriebenen Kommandos (Text bzw. eine Zeile anwählen) sind Spezial­ +kommandos und können in dieser Form nicht durch ein Semikolon mit anderen Kom­ +mandos kombiniert werden. Deshalb gibt es für sie eine ELAN-Form, die es erlaubt, +sie mit anderen Kommandos zusammen zu verwenden: + +a) Einen Text ab der aktuellen Cursor-Position suchen (D ist eine Abkürzung für + '#ib#DOWN#ie#'): + +____________________________________________________________________________ + +gib kommando: "diese Zeichen" + +____________________________________________________________________________ + +(* Kurzform *) + + +____________________________________________________________________________ + +gib kommando: #ib#D#ie# "diese Zeichen" + +____________________________________________________________________________ + +(* Allgemeine Version *) + + + +b) Auf eine Zeile positionieren (#ib#T#ie# ist eine Abkürzung für '#ib#TO LINE#ie#'): + +____________________________________________________________________________ + +gib kommando: 127 + +____________________________________________________________________________ + + +(* Kurzform *) + + +____________________________________________________________________________ + +gib kommando: T 127 + +____________________________________________________________________________ + + +(* Allgemeine Version *) + + +Mehrere Kommandos können in der Kommandozeile angegeben werden. Die einzel­ +nen Kommandos müssen in diesem Fall mit ';' voneinander getrennt werden. + +#on("u")#Beispiel:#off("u")# + + + +schaltet in den Kommandomodus + +____________________________________________________________________________ + +gib kommando: T 1; D "noch Zeichen" + +____________________________________________________________________________ + + + +Diese zwei Kommandos werden nacheinander ausgeführt. Zuerst wird auf die erste +Zeile positioniert und dann (von der ersten Zeile ab) nach 'noch Zeichen' gesucht. +Damit ist es möglich, die Datei nicht nur ab der aktuellen Zeile zu durchsuchen, +sondern die gesamte Datei. Soll nicht in Richtung auf das Dateiende, sondern in +Richtung auf den Dateianfang (also nach "oben") gesucht werden, kann man das +#ib#U-Kommando#ie# (Abkürzung für #ib#UP#ie#) verwenden: + + + +____________________________________________________________________________ + +gib kommando: U "noch ein Text" + +____________________________________________________________________________ + + + +Ein weiteres Kommando ist das #ib#C-Kommando#ie# (Abkürzung für '#ib#CHANGE#ie#'), mit +welchem man einen TEXT sucht und diesen dann ersetzt. + +#on("u")#Beispiel:#off("u")# + + + +____________________________________________________________________________ + +gib kommando: "alte Zeichen" C "neue Zeichen" + +____________________________________________________________________________ + + +Ab der aktuellen Cursor-Position wird nach 'alte Zeichen' gesucht. Wird der TEXT +gefunden, wird er durch 'neue Zeichen' ersetzt. Der Cursor befindet sich in diesem +Fall hinter dem ersetzten TEXT. Wird 'alte Zeichen' dagegen nicht in der Datei gefun­ +den, befindet sich der Cursor (wie beim erfolglosen Suchen mit D) am Ende der +letzten Zeile der Datei. + +Wie alle anderen Kommandos kann auch das C-Kommando mit anderen Komman­ +dos verbunden werden. + +#on("u")#Beispiel:#off("u")# + + + +____________________________________________________________________________ + +gib kommando: #ib#T#ie# 500; "Schreibfelher" #ib#C#ie# "Schreibfehler" + +____________________________________________________________________________ + + + +Hier wird ab der 500. Zeile der Datei nach 'Schreibfelher' gesucht und ggf. ersetzt. +Soll ein TEXT nicht nur einmal, sondern bei jedem Auftreten ersetzt werden, benutzt +man das #ib#CA-Kommando#ie# (Abkürzung für #ib#CHANGE ALL#ie#): + + + +____________________________________________________________________________ + +gib kommando: "dieser alte Text" CA "dieser neue Text" + +____________________________________________________________________________ + + +Dadurch wird 'dieser alte Text' bei jedem Auftreten ab der aktuellen Cursor-Position +durch 'dieser neue Text' ersetzt. +Pattern Matcher +#free(1.0)# + + + Der #ib#Pattern Matcher#ie# ist ein Werkzeug zur #ib#Mustererkennung#ie#. Er dient zur + Beschreibung von Texten, die in verschiedenen Ausprägungen auftreten können. + Zum Suchen oder Ersetzen wird nicht ein Text fester Gestalt vorgegeben, sondern + eine Beschreibung der gesuchten Struktur. + + +#free(1.0)# + +Häufig werden Sie #ib#Texte suchen#ie# oder ersetzen wollen, die in einigen Varianten inner­ +halb eines umfangreicheren Textes auftauchen können. + +Beispiel: Gesucht wird 'unser' in verschiedenen Zusammenstellungen, also auch + 'unsere' oder 'unserem'. Alle Textstellen, die diesem Muster entsprechen, + können in #on("u")#einem#off("u")# Suchverfahren gefunden werden, indem das Muster, + welches diese Texte beschreibt, für die Suche benutzt wird: + +____________________________________________________________________________ +Suchen nach Begriffen deren genaue Ausprägung unbekannt ist. +gib kommando:D(" unser" + any + " ") + + +____________________________________________________________________________ + + + + Leseweise: + + Suche 'unser', gefolgt beliebigen Zeichen plus einem Leerzeichen, oder + auch nur einem Leerzeichen. + + + Dieses Suchkommando liefert Treffer bei 'unser', 'unsere', 'unseres' usw.. + +#free(1.0)# +Wie baut man ein Pattern ? + +#free(1.0)# + + + Texte werden durch ihr Konstruktionsmuster aus bekannten und unbekannten + Teilen beschrieben + +#free(1.0)# + +Ein Text, der in seiner konkreten Form nicht bekannt ist, dessen Aufbau jedoch durch +ein Muster beschrieben werden kann, besteht aus Teilen, die als: + + - bekannte Texte + - unbekannte Texte + +bezeichnet werden und die mit dem Operatoren: + + '+' Zusammensetzen + 'OR' Alternative + +kombiniert werden können. + + +Ein bekannter Text ist z.B. ein Stück eines gesuchten Textes, das als fest vorgegeben +betrachtet werden kann, wie etwa der Wortstamm 'unser' in dem obigen Beispiel. Wie +gewohnt wird ein solcher bekannter Text, in Anführungsstriche gesetzt, als TEXT +CONST "text" notiert. + +Demgegenüber ist ein unbekannter Text von nicht näher zu beschreibender Gestalt. +Das Muster, welches einen unbekannten Text beschreibt, steht für irgendeinen einer +Vielzahl von Texten, die diesem Muster entsprechen. + +Mit der Prozedur: + + any + +wird das Muster für einen beliebigen Text geliefert. + +Im einleitenden Beispiel ist der Wortstamm bekannt, das Teilwort 'unser' kann also im +'Klartext' angegeben werden. Die Endungen sind je nach dem Zusammenhang in dem +das gesuchte Wort auftritt verschieden, also zunächst unbekannt. +Ein solcher unbekannter Text kann entweder durch Aufzählung der möglichen +Alternativen seiner Erscheinung beschrieben werden oder durch die Prozedur 'any'. + + + (text + ("er" OR "es" OR "em" OR ..... ) + + alternative Verknüpfung durch OR + + + ("text" + any + .... ) + + additive Verknüpfung durch + + +Grundsätzlich ist zu beachten, daß der Suchvorgang des Pattern Matcher Zeichenket­ +ten untersucht und nicht etwa einzelne Worte und stets nach dem längstmöglichen +Muster gesucht wird! + +Ein schlecht beschriebener Suchtext kostet somit nicht nur viel Rechenzeit, sondern +liefert auch unerwünschte Ergebnisse: z.B. sollte der Artikel 'der' mit einem führenden +Leerzeichen als " der" gesucht werden, da andernfalls jedes Wort, das die Silbe 'der' +enthält, einen Treffer in der Suche ergibt. + +Da die Suche nach unbekannten Texten viele unerwünschte Ergebnisse liefern +könnte, kann die Prozedur any in zweifacher Weise eingeschränkt werden: + + +D(" d" + any (2) ) + + Die Länge der unbekannten Textes wird vorgegeben, indem die Anzahl + der Zeichen aus denen der Text besteht, angegeben wird. Die Angabe + steht in Klammern hinter 'any'. (In diesem Beispiel genau 2 Zeichen). + + +D(" d" + any ("aeirs")) + + + Das Alphabet, aus dem der unbekannte Text bestehen darf, wird angege­ + ben. (In diesem Beispiel darf der Text der einen Treffer ergibt nur aus + den Zeichen 'a', 'e', 'i', 'r', 's' bestehen, z.B: der, die, das oder auch + dies.) + + +D(" d" + any (2,"aeirs") + + + Auch die Kombination der Beschränkungen ist möglich. (Jetzt liefern nur + noch 'der', 'die','das' etc. Treffer). + + +#on("b")# +ACHTUNG: Das Zeichen '*' nimmt eine Sonderstellung ein, da es als Abkürzung für + 'any' verwandt werden kann. Soll dieses Zeichen im Text gesucht oder + ersetzt werden, müssen Sie statt "*" 'any(1,"*")' schreiben. + + Weitere Informationen zum Pattern Matcher finden Sie im EUMEL- + Handbuch zur Programmierung. +#off("b")# +#free(1.0)# +4.3.4. Kommandos auf Tasten legen + +#free(1.0)# + #on("i")# + Oft benutzte Kommandos können auf Tasten gelegt werden. Damit ist es möglich, + den Editor auf Ihre speziellen Bedürfnisse einzurichten.#off ("i")# + +#free(1.0)# + +Oft benutzte Kommandos können mit der Drei-Tastenfolge + + <'taste'> auf eine Taste gelegt werden. + +#on("u")#Beispiel:#off("u")# + + + (* die Kommandozeile erscheint *) + +____________________________________________________________________________ + +gib kommando: save (SOME myself) + +____________________________________________________________________________ + + + (* das Kommando 'save (SOME myself)' ist + nun auf die Taste 's' gelegt *) + + +Wird nun die Taste 's' gedrückt, erscheint das Zeichen 's' auf dem Bildschirm. Mit +#ib#ESC s#ie# wird das 'save'-Kommando ausgeführt. Natürlich können auch kompliziertere +Kommandos auf Tasten gelegt werden. + +Möchten Sie ein Kommando, das auf eine Taste gelegt wurde, verändern, drücken Sie +im Kommandodialog (!) die Drei-Tastenfolge + + <'taste'> + + +#on("u")#Beispiel:#off("u")# + + (* in den Kommandodialog gehen *) + + + (* es erscheint nun: 'save (SOME myself)' *) + +Dieses Kommando kann nun z.B. verändert und ausgeführt (durch 'CR') oder +wiederum auf die gleiche oder eine andere Taste gelegt werden (durch #ib#ESC ! 'taste'#ie#). + +Im Editor kann das letzte im Kommandodialog eingegebene Kommando durch '#ib#ESC f#ie#' +wiederholt werden. +#page# + +#ib(9)#4.3.5. Texte aus anderen Dateien benutzen#ie(9)# +#free(1.0)# + #on("i")# + Manchmal ist es notwendig, einen Text in eine andere Datei zu schreiben (z.B. + wenn man diesen Text noch einmal verwenden will) oder einen Text einer anderen + Datei in den zu bearbeitenden Text einzufügen. Die '#ib#GET#ie#'- und '#ib#PUT#ie#'-Kom­ + mandos bieten die Möglichkeit, Texte zwischen Dateien auszutauschen (vergl. + auch den Abschnitt über paralleles Editieren).#off ("i")# + +#free(1.0)# +Mit dem #ib#'GET'-Kommando#ie# können wir Texte aus einer anderen Datei an die aktuelle +Schreibposition kopieren. + +____________________________________________________________________________ + +gib kommando: GET "absender" + +____________________________________________________________________________ + +holt den Text 'absender'. Wenn also des öfteren Briefe geschrieben werden, braucht +man sich den Absender nur einmalig in die Datei 'absender' zu schreiben und kann +diesen mit dem Kommando 'GET' (was man auf eine Taste legen kann) u.U. mehr­ +mals an verschiedenen Stellen in die Datei einfügen. + +Mit dem #ib#'PUT'-Kommando#ie# können wir zuvor markierte Textteile in eine Datei schrei­ +ben. + +____________________________________________________________________________ + +gib kommando: PUT "adressen" + +____________________________________________________________________________ + + +schreibt einen markierten Text in die Datei 'adressen'. 'adressen' wird ggf. eingerich­ +tet. Ist die Datei 'adressen' bereits vorhanden, so wird erfragt, ob die Datei gelöscht +werden kann, um den markierten Text aufzunehmen (überschreiben). Andernfalls wird +der markierte Text an den bereits vorhandenen Text in 'adressen' angefügt. Es ist +somit durch mehrmaliges Markieren und das 'PUT'-Kommando möglich, Texte aus +einer Datei zu sammeln und in eine neue Datei zu geben. +#page# + +#ib(9)#4.3.6. #ib#Breitere Zeilen#ie# bearbeiten#ie(9)##goalpage("margin")# +#free(1.0)# + #on("i")# + Der Editor ist auf eine Zeilenbreite von 77 Zeichen eingestellt. Oft ist es notwen­ + dig, mit einer anderen Zeilenbreite zu schreiben, welche man mit dem #ib#'limit'- + Kommando#ie# einstellen kann. Aber auch die Positionierung innerhalb einer Zeile + wird dadurch anders, weil breitere Zeilen nicht als Ganzes auf den Bildschirm + passen. In diesem Fall wird "#ib#gerollt#ie#".#off ("i")# + +#free(1.0)# +Eine andere Zeilenbreite stellt man durch 'limit' ein. Beachten Sie, daß die eingestell­ +te Zeilenbreite für die gesamte Datei gilt. + +#on("u")#Beispiel:#off("u")# + +____________________________________________________________________________ + +gib kommando: limit (180) + +____________________________________________________________________________ + + +Nun können Sie wie gewohnt schreiben. Allerdings wird die aktuelle Zeile, in der man +sich befindet, nicht wie gewohnt am Bildschirmende umgebrochen, sondern erst an +der Spalte 180, sofern sie nicht vorher durch die 'CR'-Taste beendet wird. Wird über +das rechte Bildschirmende hinaus geschrieben, bleibt die Cursor-Position am Ende +des Bildschirms erhalten, aber die Zeile wird beim weiteren Schreiben nach links +verschoben, "rollt" also nach links (der Anfang der Zeile verschwindet scheinbar nach +links). + +Mit der Positionierung verhält es sich ähnlich. Wird mit RECHTS über den rechten +Bildschirmrand positioniert, wird die Zeile ebenfalls gerollt. #ib#HOP RECHTS#ie# bewirkt ein +#ib#Blättern#ie# innerhalb einer einzelnen Zeile nach rechts. Analog verläuft es bei verscho­ +bener Zeile, wenn nach links (LINKS bzw. #ib#HOP LINKS#ie#) positioniert wird. + +Beim Schreiben von Tabellen kann es sinnvoll sein, das Fenster vorübergehend auf +eine andere Anfangsposition (als 1) einzustellen. Das kann mit dem +#ib#'margin'-Kommando#ie# erfolgen. + +#on("u")#Beispiel:#off("u")# + +____________________________________________________________________________ + +gib kommando:#ib#margin#ie# (50) + +____________________________________________________________________________ + + +Das Editorfenster zeigt nun einen Ausschnitt aus der Datei, beginnend ab der Spalte +50. In der Titelzeile wird "M50" angezeigt. +#page# + +#ib(9)#4.3.7. Die wichtigsten Kommandos#ie(9)# +#free(1.0)# + #on("i")# + Einige Kommandos sind speziell für die Textverarbeitung im Editor programmiert. + Die wichtigsten werden hier vorgestellt.#off ("i")# + +#free(1.0)# +any + TEXT PROC any + liefert ein Muster beliebiger Gestalt und Länge (also auch der Länge 0) für + Suchoperationen. + + + " ir" + any + "was" + + +any + TEXT PROC any (TEXT CONST alphabet) + liefert den längstmöglichen Text, der aus den in 'alphabet' angegebenen Zeichen + besteht. + + + any ("1234567890") (* suche Zahlen *) + + +any + TEXT PROC any (INT CONST laenge) + liefert ein Muster beliebiger Gestalt und der Länge 'laenge'. + + + " d" + any (2) + + +any + TEXT PROC any (INT CONST laenge, TEXT CONST alphabet) + liefert ein Muster der Länge 'laenge', das nur aus Zeichen aus + 'alphabet' besteht. + + + " d" + any (2,"erias") + + + +C + OP C (TEXT CONST muster, ersatz) + Ab der aktuellen Positon wird 'muster' in Richtung Dateiende gesucht und durch + 'ersatz' ersetzt. Der Cursor steht danach hinter 'ersatz'. + + + "alt" C "neu" + + + +CA + OP CA (TEXT CONST muster, ersatz) + Arbeitet ab der aktuellen Position wie C. Die Aktion wird jedoch bis zum Erreichen + des Dateiendes wiederholt. Nach Ausführung ist somit jedes 'muster' durch + 'ersatz' ersetzt. Der Cursor steht danach hinter dem letzten Zeichen der Datei. + + + "alt" CA "neu" + + + + +D + OP D (INT CONST n) + Positioniert das Fenster n Zeilen vorwärts in Richtung auf das Dateiende. + + + D 50 + + + OP D (TEXT CONST muster) + Sucht 'muster' vorwärts in Richtung auf das Dateiende. Die Suche beginnt direkt + hinter der aktuellen Cursor-Position. Wird 'muster' nicht gefunden, steht der + Cursor hinter dem letzten Zeichen der Datei. Wird 'muster' gefunden, steht der + Cursor direkt auf dem ersten Zeichen von 'muster'. + + + D "muster" + + + +GET + OP GET (TEXT CONST dateiname) + Kopiert den Inhalt der Datei mit dem angegebenen Namen vor die aktuelle + Cursor-Position. Ist ein Teil der Quelldatei markiert, wird nur der markierte Teil + kopiert. + + + GET "quelldatei" + + + OP G (TEXT CONST dateiname) + Wie GET. + + +limit + OP limit (INT CONST limit) + Setzt die rechte Schreibgrenze auf 'limit'. + + + limit (50) + + + +margin + PROC margin (INT CONST anfang) + Alle Zeilen erscheinen erst ab Spalte 'anfang' im Sichtfenster. + + + margin (50) + + + +OR + TEXT OP OR (TEXT CONST texteins,textzwei) + Liefert ein Muster, wenn texteins oder textzwei gefunden wird. Die Reihenfolge + spielt keine Rolle. + + + D ("Geschäfts" + ("führung" OR "leitung")) + + + +PUT + OP PUT (TEXT CONST dateiname) + Richtet eine Datei mit dem angegebenen Namen ein und kopiert den markierten + Textabschnitt in diese. + + + PUT ("meine hilfsdatei") + + + OP P (TEXT CONST dateiname) + Zweck: Wie PUT. + + +T + OP T (INT CONST n) + Positioniert auf die Zeile 'n'. + + + T 999 + + + +type + PROC type (TEXT CONST zeichenkette) + + Fügt 'zeichenkette' in die aktuelle Position der editierten Datei ein. Besonders + nützlich in Verbindung mit der Prozedur 'code', um nicht auf der Tastatur enthal­ + tene Zeichen in den Text zu bringen. + + + type(code(200)) + + + +U + OP U (INT CONST n) + Positioniert das Fenster n Zeilen rückwärts in Richtung auf den Dateianfang. + + + U 100 + + + OP U (TEXT CONST muster) + Sucht 'muster' rückwärts in Richtung auf den Dateianfang. Die Suche beginnt + links neben der aktuellen Cursor-Position. Vergl. D + + + U "muster" + + +word wrap + PROC word wrap (BOOL CONST an) + Schaltet den automatischen Wortumbruch an (voreingestellt) bzw. aus. + + + word wrap (true) (* angeschaltet *) + word wrap (false) (* ausgeschaltet *) + +4.4. Fehlersituationen und Abhilfe + +#free(1.0)# + #on("i")# + Von Zeit zu Zeit werden Sie als Anfänger in Arbeitssituationen geraten, wo Sie + nicht weiterwissen. Hier sind einige Tips, wie Sie sich behelfen können.#off ("i")# + +#free(1.0)# + +Wie helfe ich mir, wenn... + + +... nach + continue("taskname") + + der Monitor #on("u")#nicht#off("u")# + + gib kommando: + + sagt, sondern "schweigt"? + +=> Sie haben die Task bei der letzten Benutzung nicht mit dem Kommando + 'break' verlassen (evtl. haben Sie SV betätigt?). Sie sind jetzt im Editor, sehen + aber den zuletzt bearbeiteten Textausschnitt nicht. Betätigen Sie die Tasten + + ESC b + + und der Text wird neu auf dem Bildschirm ausgegeben. +#free(1.0)# +... im Editor kein Tastendruck mehr akzeptiert wird? + +=> Sie haben irrtümlich die STOP-Taste (auch oft als CTRL a realisiert, abhängig + vom Terminal), d.h. Anhalten der Bildschirmausgabe betätigt. + + Drücken Sie die WEITER-Taste (= CTRL c, d.h. Bildschirmausgabe fortfüh­ + ren). Alle Tastenanschläge, die zwischenzeitlich zu keiner Reaktion führten, + werden jetzt ausgegeben. + + Je nach Tastatur können STOP und WEITER auch auf anderen Tasten liegen. #free(1.0)# +... der Lernmodus über lange Zeit (ungewollt) eingeschaltet war? + +=> a) Sie merken plötzlich, daß über einen unbestimmt langen Zeitraum alle Ihre + Tastenanschläge gelernt wurden (zu erkennen an der "LEARN"-Anzeige in + der Überschriftzeile). + + #on("u")#Was ist zu tun?#off("u")# + + Mit dem Kommando + + ESC HOP HOP + + vergessen Sie alles Gelernte und schalten den Lernmodus aus. + +=> b) Sie beenden den Editor mit ESC q und die Meldung + +____________________________________________________________________________ + + WARNUNG: Lernmodus nicht ausgeschaltet + +____________________________________________________________________________ + + + + erscheint auf dem Bildschirm. + + #on("u")#Was ist zu tun?#off("u")# + + Sie können mit + + ESC HOP HOP + + das Gelernte sofort vergessen. +#free(1.0)# +... Sie zu viele Absatzzeichen in Ihrem Text gesetzt haben und diese entfernen + müssen? + +=> Sie positionieren in die Zeile, in der die Absatzmarke gelöscht werden soll. Sie + betätigen dann die TAB-Taste, um hinter den Text zu positionieren, dann die + RUBOUT-Taste. Wenn Sie jetzt die Zeile mit den Cursor-Tasten nach oben + oder unter verlassen, verschwindet die Absatzmarkierung. +#free(1.0)# +... nach + + save("dateiname","vatertask") + + das Betriebssystem nicht mehr reagiert? + +=> Sie haben die Vater-Task nicht mit dem Kommando 'global manager' in + jenem Prozeß zum Empfang von Daten aus anderen Prozessen vorbereitet. +#free(1.0)# +... Sie in Ihrer Task das Archive mit dem Kommando + + archive("archivname") + + anmelden wollen und das System Ihnen die Meldung + + "Fehler: Archive wird von Task "bib" benutzt" + + zustellt? + +=> Es gibt zwei Möglichkeiten: + a) Ein anderer Benutzer benötigt das Archiv-Laufwerk in diesem Moment. Sie + müssen warten, bis er seine Arbeit beendet hat. + + b) Ein anderer Benutzer (oder Sie selbst) hat vergessen, mit dem Kommando + + release(archive) + + das Archiv in jener Task freizugeben. Falls Sie es selbst waren, holen Sie + das nach. Ansonsten kann das Archiv-Kommando wieder erfolgreich gege­ + ben werden, wenn fünf Minuten nicht auf das Archiv + zugegriffen wurde. #free(1.0)# +... Sie eine (scheinbare oder echte) Endlosschleife auf einer Taste (z.B. Taste "x") + gelernt haben und diese (versehentlich oder bewußt) durch 'ESC x' aktivieren? + +=> Wie immer, wenn Sie eine endlos laufende Task beenden wollen, gelangen Sie + mit der SV-Taste in den Supervisor-Modus und mit dem Kommando + + 'halt' + + beenden Sie die Endlosschleife. + + Mit + + ESC HOP HOP x + + wird danach das Gelernte 'vergessen'! +#free(1.0)# +... Sie Ihre Datei verlassen wollen und + + 'ESC q' + + (scheinbar) nicht funktioniert? + +=> Sie haben versehentlich den Feststeller für Großbuchstaben (SHIFT LOCK / + CAPS LOCK) betätigt und ESC q zeigt keine Wirkung (wie auch andere Tasten­ + kombinationen mit Großbuchstaben evtl. keine Wirkung zeigen). + diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.5a b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5a new file mode 100644 index 0000000..1e907f0 --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5a @@ -0,0 +1,1446 @@ +#start(5.0,1.5)##pagenr("%",1)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Teil 5: Textkosmetik und Druck +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +5 - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD 5 - % +#tableend##clearpos# +#end# + +#ib(9)#TEIL 5: Textkosmetik und Druck#ie(9)# +#free(1.0)# +#ib(9)#5.0. Vorwort#ie(9)# + +#free(1.0)# +Die #ib#Textkosmetik-Programme#ie# des EUMEL-Systems bieten Ihnen eine einfach zu +erlernende und zu bedienende Möglichkeit, Texte für den Druck zu gestalten (pro­ +grammtechnisch: #ib#formatieren#ie#) und zu manipulieren. + +Die Textkosmetik-Programme bearbeiten Ihre Dateien, die durch den EUMEL-Editor +erstellt wurden. Darum sollten Sie sich zuerst mit dem EUMEL-Editor vertraut +machen. + +Die Programme sind so konstruiert, daß die meisten Aufgaben durch in den Text +eingefügte Anweisungen gesteuert werden. Solche Angaben für die Textkosmetik und +den EUMEL-Drucker nennen wir im folgenden kurz #on("b")##on("i")#'Anweisung' #off("b")##off("i")#. Die Form der +#ib#Anweisung#ie# ist für die Textkosmetik und den EUMEL-Drucker gleich und entspricht +der ELAN-Syntax. Beachten Sie den #ib#Unterschied zwischen einem Kommando und +einer Text-Anweisung#ie#: während ein Kommando direkt ausgeführt wird, wird eine in +den Text eingebettete Anweisung erst nach dem Aufruf von Textkosmetik- und +Drucker-Programmen wirksam. + +Die Wirkungsweise der Textkosmetik-Anweisungen ist leicht zu erlernen und kann +vor allen Dingen stufenweise erfolgen. Deshalb ein guter Rat für Anfänger: Lesen Sie +diesen Teil des Benutzer-Handbuchs erst oberflächlich, so daß Sie ungefähr +Bescheid wissen, welche Möglichkeiten die Textkosmetik-Programme bieten. Dann +können Sie diejenigen Teile der Textkosmetik auswählen und bei Bedarf anwenden, +die Sie für Ihre spezielle Anwendung benötigen. +#page# + +#ib(9)#5.1. Einführung in die Benutzung der + #ib#Textkosmetik#ie##ie(9)# + +#free(1.0)# + #on("i")# + In diesem Kapitel erhalten Sie eine Übersicht über die verfügbaren Programme der + Textkosmetik. + +#off("i")# +#free(1.3)# +Schreiben, Gestalten und Drucken von Texten + +#free(1.0)# + #on("i")# + Im EUMEL-System unterscheiden wir zwischen drei Stufen einer Textbehand­ + lung:#on("b")# Erstellung, Gestaltung#off("b")# und #on("b")#Druck#off("b")#. Die Trennung in verschiedene Arbeits­ + stufen hat den Vorteil, daß Sie sich zu einem Zeitpunkt nur auf einen Arbeitsschritt + konzentrieren müssen. + #off("i")# +#free(1.3)# +Texterstellung bzw. Textbearbeitung + +#free(1.0)# +Das Schreiben von Texten wird mit Hilfe des Editors erledigt. In dieser Stufe der +Texterstellung können Sie sich ausschließlich auf das Schreiben und die inhaltliche +Korrektheit Ihres Textes konzentrieren. Wird ein Text ohne Anweisungen gedruckt, +dann erscheint er so, wie er mit dem Editor geschrieben wurde. Bei der Erstellung +des Textes können Sie aber auch bereits Textkosmetik-Anweisungen in den Text +einfügen. + +____________________________________________________________________________ + + Es ist wichtig, daß Sie das Kapitel 'Editor' + \#on("b")\#sehr\#off("b")\# gründlich lesen. + +____________________________________________________________________________ + + +Druckbild: + +Es ist wichtig, daß Sie das Kapitel 'Editor' +#on("b")#sehr#off("b")# gründlich lesen. + + +Sie sollten Texte im 'Fließtext'-Modus erstellen, d.h., dann werden Worte, die über +Zeilengrenzen gehen, ohne Silbentrennung vom Editor in die nächste Zeile gebracht. +#free(1.5)# +Textkosmetik bzw. Textgestaltung + +#free(1.0)# +Nachdem Sie einen Text geschrieben haben, können Sie ihn mit #ib#Textkosmetik- +Programme#ie#n gestalten, ohne ihn inhaltlich zu verändern. Dies kann auch vor oder +nach eventuellen Korrekturen erfolgen. Die Textkosmetik bietet zur Zeit vier Pro­ +gramme an, die je nach Bedarf eingesetzt werden können: + +--- #on("b")#'#ib#lineform'/'autoform#ie#'#off("b")# formatiert einen Text zeilenweise und vollzieht eine + Silbentrennung. Weiterhin erlaubt 'lineform'/'autoform' die Verwendung unter­ + schiedlicher Schrifttypen und Schrifthöhen. + +--- #on("b")#'#ib#pageform#ie#'/'#ib#autopageform#ie#'#off("b")# gestattet die Formatierung eines Textes in Seiten + (drucktechnisch: "Seitenumbruch"). Dabei berücksichtigt 'pageform'/'auto­ + pageform' unterschiedliche Schrifthöhen. Es ist mit 'pageform'/ 'autopage­ + form' u.a. möglich, die Seiteneinteilung zu bestimmen, eine Seite in Spalten + zu formatieren ("Zeitungsformat"), Zeilen am Anfang bzw. Ende jeder Seite + einfügen zu lassen, eine Seitennumerierung (drucktechnisch: "Paginierung") + zu erhalten und Fußnoten zu gestalten. + +--- #on("b")#'#ib#index#ie#'#off("b")# erlaubt die Erstellung von Stichwort- und Inhaltsverzeichnissen aus + einer mit 'pageform'/'autopageform' bearbeiteten Datei. + +--- #on("b")#'#ib#outline#ie#'#off("b")# holt aus einer Datei alle mit Index-Anweisung gekennzeichneten + Überschriften und Stichworte. Es erstellt somit eine Übersicht bzw. Kurz­ + fassung eines Textes. +#free(1.5)# +Drucken +#free(1.0)# +Zu jedem Zeitpunkt der Texterstellung kann gedruckt werden. Der EUMEL-Drucker +beachtet die gleichen Anweisungen wie die Textkosmetik-Programme und noch +einige zusätzliche, die nur für die Druckaufbereitung notwendig sind. Spezielle Druck­ +leistungen, wie z.B. verschiedenartige Schrifttypen, können nur auf besonderen +Druckern erzeugt werden. Verfügt ein Drucker nicht über eine bestimmte Hardware- +Eigenschaft, wird die von ihm geforderte Leistung ignoriert. Somit ist es möglich, +Probedrucke für Korrekturen etc. auch auf preiswerten Druckern herzustellen. (siehe +hierzu 5.6.1.) +#page# + + +-------------------------+ + l Text-Eingabe l + l l + +->-+ Editor +->-+ + l l l l + l l erstellt Datei l l + l +------------+------------+ l + l l l + l V l + l +------------+------------+ l + l l lineform l l + +-<-+ +->-+ + l l formatiert Zeilen l l + l +------------+------------+ l + l l l + l V l + l +------------+------------+ l + l l outline l l +--------------------------+ + l l l l l E U M E L - Drucker l + +-<-+ gibt Übersicht bzw. +->-+ ->--+ l + l l Kurzfassung eines Textesl l l Probe- bzw. l + l l l l l endgültiger Druck l + l l Dateiname + '.outline' l l +--------------------------+ + l +------------+------------+ l + l l l + l V l + l +------------+------------+ l + l l pageform l l + l l l l + +-<-+ formatiert Seiten +->-+ + l l l l + l l Druckdatei l l + l l Dateiname + ".p" l l + l +------------+------------+ l + l l l + l V l + l +------------+------------+ l + l l index l l + l l l l + l l erstellt Stichwort- und l l + +-<-+ Inhaltsverzeichnisse +->-+ + l l + l Indexdatei(en) l + l Dateiname + "i" l + +-------------------------+ + #page# + +#ib(9)#5.1.1. Anweisungen für die Textkosmetik + und den Drucker#ie(9)# +#free(1.0)# + #on("i")# + In diesem Abschnitt wird beschrieben, wie Sie #ib#Anweisungen#ie# für die Textkosme­ + tik- und Druckprogramme in einen Text einfügen können. Beachten Sie, daß jede + Anweisung von '\#'-Zeichen eingeschlossen werden muß. Benötigen Sie das + '\#'-Zeichen in Ihrem Text, müssen Sie es mit 'ESC' schreiben. + #off("i")# +#free(1.0)# +Es gibt zwei Arten von Anweisungen: + +a) Anweisungen, die das gesamte Aussehen eines Manuskripts verändern (#on("i")##ib#"layout- + Anweisungen"#ie##off("i")#). Zu diesen Anweisungen gehören die Anweisungen \#limit (...)\#­ + (Einstellen der Zeilenbreite), \#linefeed (...)\# (Zeilenabstand), \#page\# (neue Seite) + usw. Diese Anweisungen gelten erst ab der nächsten Zeile und Sie sollten sie + daher in eine extra Zeile zwischen den Text stellen. + +____________________________________________________________________________ + +\#type ("trium8")\#\#limit (11.0)\# +\#start(5.0,1.5)\# +\#pagelength(17.4)\#\#pagenr("%",148)\#\#setcount(1)\# +\#block\#\#pageblock\# +\#count per page\# +\#headeven\# +\#lpos(0.0)\#\#cpos(5.5)\#\#rpos(11.0)\# +\#table\# + EUMEL-Benutzerhandbuch +\#fillchar(" ")\# +\#on("u")\# \#off("u")\# +\#table end\#\#clear pos\# + +\#end\# +\#headodd\# +\#lpos(0.0)\#\#cpos(5.5)\#\#rpos(11.0)\#\#fillchar(" ")\# +\#table\# + Teil 5: Textkosmetik und Druck +\#fillchar(" ")\# +\#on("u")\# \#off("u")\# +\#table end\#\#clear pos\# + +\#end\# + +____________________________________________________________________________ + + + Das Druckbild (das Ergebnis der Anweisungen) sehen Sie im vorliegenden + Benutzerhandbuch. + + Anweisungen, die für den Gesamttext gelten sollen, müssen Sie an den Anfang + der Datei stellen (noch vor \#head\#). + +b) Anweisungen, die unmittelbar auf den nachfolgenden Text wirken sollen, wie z.B. + \#type\# (Schrifttyp), \#on\#/\#off\# (Modifikationen wie unterstreichen oder fett druk­ + ken), \#ib\#/\#ie\# (Markierung von Stichworten) usw. Solche Anweisungen werden + unmittelbar beachtet und können überall auf einer Zeile stehen (wie in dem fol­ + genden Beispiel). + +____________________________________________________________________________ + + \#on("underline")\#Ausnahmen\#off("underline")\# werden bei der + Beschreibung der Anweisungen speziell erwähnt. + +____________________________________________________________________________ + + +Druckbild: + + #on("u")#Ausnahmen#off("u")# werden bei der + Beschreibung der Anweisungen speziell erwähnt. + +____________________________________________________________________________ + +Weitere Beispiele für Textkosmetik-Anweisungen: + +____________________________________________________________________________ + +\#page\# +\#free(3.0)\# +\#type("quadrato")\# + +____________________________________________________________________________ + + +Diese Anweisungen entsprechen - wie alle Kommandos im EUMEL-System - der +ELAN-Syntax (u.a. müssen sie klein geschrieben werden; Parameter in runden +Klammern; mehrere Parameter werden durch Kommata getrennt; #ib#TEXT-Parameter#ie# in +Anführungsstrichen; #ib#REAL-Parameter#ie# mit Dezimalpunkt usw.). Leerzeichen spielen +(außer in TEXT-Parametern) keine Rolle und können zur besseren Lesbarkeit belie­ +big verwendet werden. + +Die Zeichen, aus denen eine Anweisung besteht, werden bei der Formatierung einer +Zeile oder Seite nicht mitgezählt und vom EUMEL-Drucker nicht gedruckt. Eine +Zeile, die nur aus Anweisungen besteht, wird ebenso behandelt, auch wenn sie mit + abgeschlossen wird. +#page# +#on("b")# + +#ib(9)#5.1.2. #ib#Aufruf der Textkosmetik-Programme#ie##ie(9)# +#free(1.0)# + #on("i")# + In diesem Abschnitt wird beschrieben, wie Sie die #ib#Textkosmetik-Programme + aktivieren#ie# können. + #off("i")# +#free(1.0)# +Sie rufen die Textkosmetik-Programme durch Kommandos auf (d.h. in der 'gib +kommando'-Ebene). Sie geben ebenso wie zum Editieren den Namen des Pro­ +gramms und der Datei an.#goalpage("lineform")# + +____________________________________________________________________________ + + gib kommando: + lineform ("dateiname") + +____________________________________________________________________________ + + + oder: + autoform ("dateiname") + pageform ("dateiname") + autopageform ("dateiname") + outline ("dateiname") +#mark ("", "")# + index ("dateiname") + + + + +'lineform'/'autoform' können Sie auch vom EUMEL-Editor aus aufrufen. Zu diesem +Zweck markieren Sie den zu formatierenden Abschnitt der Datei und geben im +Kommando-Zustand ( drücken) 'lineform' bzw. 'autoform' (ohne Para­ +meter). +#mark ("", "")# + +Das Programm 'pageform'/'autopageform' erzeugt aus der Eingabedatei eine #ib#Druck­ +datei#ie#, die den Namen der angegebenen Eingabedatei mit dem Zusatz '.p' bekommt. + +____________________________________________________________________________ + + gib kommando: + pageform ("dateiname") + +____________________________________________________________________________ + + +Als Ergebnis erhalten Sie: "dateiname.p" + + + + +Das Programm 'index' kann nur eine Druckdatei bearbeiten: + +____________________________________________________________________________ + + gib kommando: + index ("dateiname.p") + +____________________________________________________________________________ + + +und erstellt die angeforderten Verzeichnisse in Dateien, die mit dem Zusatz +'.i' gekennzeichnet werden. + +Beispiele: "dateiname.i1", "dateiname.i2" etc. + + + + +'#ib#outline#ie#' erstellt ebenfalls eine neue Datei. + +____________________________________________________________________________ + + gib kommando: + outline ("dateiname") + +____________________________________________________________________________ + + +führt zu dem Ergebnis: "dateiname.outline" #mark ("", "")# +#page# + +#ib(9)#5.1.3. Vorzeitiger #ib#Abbruch#ie# und + #ib#Fehlermeldungen#ie##ie(9)# +#free(1.0)# + #on("i")# + Sie können alle Textkosmetik-Programme vorzeitig abbrechen. Eventuelle + Fehlermeldungen werden Ihnen in einem Fenster angezeigt. + #off("i")# +#free(1.0)# +Durch die #ib##ie(1,"-Abbruch")##ib##ie(1,"Abbruch mit ESC")#-Taste oder die #ib# #ie#-Taste und das Supervisor-Kommando 'halt' +können Sie die Textkosmetik-Programme jederzeit vorzeitig abbrechen. Die Eingabe­ +datei steht Ihnen dann unverändert zur Verfügung. Ein #ib#vorzeitiger Abbruch#ie# kann +notwendig sein, wenn Sie ein Programm mit einer falschen Datei aufgerufen haben +oder zu viele Fehler gemeldet wurden. +#mark ("", "")# + +Alle Textkosmetik-Programme melden Fehler, wenn Sie Anweisungen falsch be­ +nutzen. Die Fehlermeldungen werden auf dem Bildschirm angezeigt. Bei Beendigung +eines Programms wird - falls Fehler entdeckt wurden - automatisch der #ib#Fenster- +Editor#ie# aufgerufen, wobei die Fehlermeldungen im unteren #ib#Fenster#ie# (das ist das #ib#Notiz­ +buch#ie#) angezeigt werden, während Ihnen im oberen Fenster die Eingabedatei zur +Korrektur angeboten wird. + +____________________________________________________________________________ + +.......................dateiname.................Zeile 1 + + \#corner1("-5.0")\#\#on("i")\# + Sie können alle Textkosmetik-Programme vorzeitig abbrechen. + Eventuelle Fehlermeldungen werden Ihnen in einem Fenster ange­ + zeigt. + \#box3("T","2","115.0")\#\#off("i")\# + #cursor(" ")# + +.......................notebook..................Zeile 1 +FEHLER Zeile 1: Unbekannte Anweisung (ignoriert): corner1("-5.0") + >>> Bitte Korrigieren +FEHLER Zeile 5: Unbekannte Anweisung (ignoriert): + box3("T","2","115.0") + >>> Bitte Korrigieren + +____________________________________________________________________________ + + + + + +Um von der Eingabedatei zum Notizbuch - und umgekehrt - zu wechseln, betätigen +Sie . +#page# + +#ib(9)#5.2. #ib#Lineform/Autoform#ie##ie(9)# +#free(1.0)# + #on("i")# + Die Programme '#ib(1, "ff")#lineform#ie#' oder '#ib(1, "ff")#autoform#ie#' formatieren einen Text zeilenweise (ggf. + mit Silbentrennung) unter Berücksichtigung von Schrifttyp und Zeilenbreite. + #off("i")# +#free(1.0)# +Zur #ib#Zeilenformatierung#ie# werden Ihnen zwei Programme (Kommandos) angeboten, die +sich nur in ihrem interaktiven Charakter unterscheiden (Behandlung von Silben­ +trennungen): + +---- #on("b")##ib#autoform#ie##off("b")#: + Zeilenformatierung mit automatischer #ib#Silbentrennung#ie#. Sie sollten 'autoform' + nur bei Texten einsetzen, in denen einige wenige Trennfehler nicht von + großer Bedeutung sind, z.B. bei Probedrucken. + +---- #on("b")##ib#lineform#ie##off("b")#: + Zeilenformatierung mit Silbentrennung "per Hand", wobei (nach deutschen + Trennregeln) ein sinnvoller Trennvorschlag gemacht wird. Die Trennstelle + kann interaktiv soweit verschoben werden, wie das zu trennende Wort noch + auf die Zeile paßt. + + +'lineform'/'autoform' hat im wesentlichen vier Aufgaben: + +---- #ib#Auffüllen von Zeilen#ie#: + 'lineform'/'autoform' kann besonders gut nach Korrekturen eingesetzt wer­ + den, bei denen - nach Einfügungen oder Löschungen - nicht vollständige + oder zu lange Zeilen in der Datei stehenbleiben können. + +---- Erstellen von Zeilen mit unterschiedlichen Schrifttypen: + Werden in einer Datei mehrere Schriftarten (\#type\#-Anweisung) verwendet, + berechnet 'lineform'/'autoform' nach der eingestellten Zeilenbreite die Anzahl + der Zeichen, die auf eine Zeile passen. + +---- Bearbeitung unterschiedlicher Zeilenbreiten: + Manchmal ist es notwendig, die Zeilenbreite zu verändern (\#limit\#- + Anweisung). Dies wird von 'autoform'/'lineform' berücksichtigt. + +---- Silbentrennung: + Automatische ('autoform') und interaktive Silbentrennung ('lineform'). + + +'lineform'/'autoform' akzeptiert als Eingabe eine Datei und verändert diese. Dafür wird +eine (interne) Zwischendatei benötigt. Deshalb müssen Sie darauf achten, daß noch +ausreichend Platz auf dem System ist, der jedoch nur zwischenzeitlich für den Forma­ +tierungsschritt benötigt wird. + +'lineform' und auch 'pageform' sind auf den ersten Schrifttyp der Fonttabelle, auf eine +Zeilenbreite von 16.0 und eine Seitenhöhe von 25.0 initialisiert. Sind die ersten An­ +weisungen, die das verändern könnten, fehlerhaft, so bleiben diese Werte (wie auch +sonst bei ignorierten Anweisungen) erhalten. + +'lineform'/'autoform'fragt nach dem Kommando an, mit welchem #ib#Schrifttyp#ie# und mit +welcher #ib#Zeilenbreite#ie# die Datei formatiert werden soll. Dabei erscheinen zuerst die +voreingestellten Anweisungen. Beispiel: + +____________________________________________________________________________ + +LINEFORM (für ... Zeilen): dateiname + +Bitte Schrifttyp: micro +Zeilenbreite (in cm): 16.0 + + +____________________________________________________________________________ + + + +Diese Anweisungen können Sie jetzt durch Ihre gewünschten Anweisungen ersetzen. +Diese Informationen werden von 'autoform'/'lineform' in Form von \#limit\#- und +\#type\#-Anweisungen in der Datei vermerkt, so daß die Anfragen bei weiteren +Datei-Bearbeitungen entfallen. + +Bei Zeilen, die länger als die angegebene Zeilenbreite sind, werden diejenigen Worte, +die über die Zeilenbreite hinausgehen, in die nächste Zeile umgebrochen. Kürzere +Zeilen werden aus der nachfolgenden Zeile bis zur Zeilenbreite aufgefüllt. Worte +werden jedoch nicht über Absatzgrenzen hinweg verschoben. Deshalb sollten Sie vor +Anwendung von 'lineform'/'autoform' darauf achten, daß Absätze richtig markiert +wurden. Fehlende Markierungen sollten Sie nachträglich einfügen ( am Ende +einer Zeile), andernfalls werden Zeilen über Absatzgrenzen zusammengezogen. Dies +ist besonders bei Tabellenzeilen unangenehm. + +#ib#Einrückungen#ie# (Leerzeichen am Anfang einer Zeile) werden von 'lineform'/'autoform' +ebenfalls bei der Formatierung von Zeilen eingehalten. +#page# + +#ib(9)#5.2.1. #ib#Zeilenweise formatieren#ie##ie(9)# +#free(1.0)# +#ib(9)#5.2.1.1. #ib#Interaktive Silbentrennung#ie##ie(9)# +#free(1.0)# + #on("i")# + 'lineform' trennt Silben interaktiv, d.h., es werden Ihnen von 'lineform' #ib#Trennungs­ + vorschläge#ie# gemacht, die Sie bestätigen oder ablehnen können. + #off("i")# +#free(1.0)# +Paßt ein Wort nicht mehr ganz auf eine Zeile, dann wird es zur interaktiven Tren­ +nung angeboten. Bei der Trennung werden Anweisungen innerhalb des Wortes ent­ +sprechend berücksichtigt. Die Umgebung dieses Wortes wird zur Erleichterung des +Trennvorgangs mit angezeigt. Das Trennzeichen erscheint an einer sinnvollen Stelle +im zu trennenden Wort. + +____________________________________________________________________________ + + Text vor dem Trennwort; das + Trenn-wort steht mit diesem Text in dieser Zeile + +____________________________________________________________________________ + + +Der Teil des zu trennenden Wortes, der noch auf die Zeile passen würde, wird mar­ +kiert angezeigt. Sie können das Trennzeichen mit Hilfe der Positionierungstasten +innerhalb des Trennbereichs verschieben. An der gewünschten Trennposition (der +Wortteil, der noch auf die Zeile kommen soll, steht links vom Trennstrich) kann die +-Taste betätigt werden. zeigt dem Programm 'lineform' an, daß an dieser +Stelle die Trennung erfolgen soll. 'lineform' fügt an den ersten Teil des Wortes das +"-"-Zeichen an und schreibt den abgetrennten Wortteil in die nächste Zeile. +#page# +Es stehen folgende #ib(1)#Operationen bei der interaktiven Trennung#ie# zur Verfügung: +#lpos(0.0)# #bpos(4.0, 11.0)# #table# + +#on("b")#Taste Bedeutung#off("b")# + + Trennen. + + +<<> Trennzeichen um ein Zeichen nach links verschieben. + + +<>> Trennstelle um ein Zeichen nach rechts verschieben. + + + <<> Trennstelle vor das Wort setzen (das Wort wird an + dieser Position nicht getrennt). + + + <>> Trennstelle an das Ende der Markierung setzen. + + + Trennzeichen wird von "-" auf " " umgeschaltet. + Dies kann verwendet werden, um Worte, die nicht + zusammengeschrieben werden sollen, beim Trenn­ + vorgang in zwei Worte aufzuspalten. + + +<-> Schaltet das Trennzeichen von Leerzeichen (" ") + wieder auf den Trennstrich ("-") um. + + + Abbruch von 'lineform'/'autoform'. Die zu bearbeitende + Datei steht unverändert zur Verfügung. + +#tableend##clearpos# +#page# +Zwei Besonderheiten sind bei der interaktiven Trennung noch zu beachten: + + - Bei Worten mit Bindestrich wird die Trennstelle hinter dem Bindestrich als Leer­ + zeichen angezeigt. + + - Bei einer Trennposition zwischen den Zeichen "ck" wird das Zeichen "c" in ein + "k" umgewandelt. + + Beispiel: Druk-ker + +Sofern es für die Zeilenformatierung notwendig ist, macht die Prozedur 'lineform' +bereits erfolgte Trennungen rückgängig (das Trennzeichen wird entfernt und die +Wortteile werden wieder zusammengefügt), wenn sich das getrennte Wort (etwa durch +Korrekturen oder Veränderungen der Zeilenbreite) nicht mehr am Zeilenende befinden +sollte. + +Wenn Sie nicht Ihren Gesamttext mit 'lineform' bearbeiten möchten, haben Sie die +Möglichkeit, #ib#'lineform' auf einen Textausschnitt#ie# anzuwenden. Hierfür markieren Sie +den gewünschten Bereich, drücken und geben im Editor das Kommando +'lineform'. (siehe S. #topage("lineform")#) + +____________________________________________________________________________ + +...................dateiname................... Zeile 30 + + +Wenn Sie nicht Ihren Gesamttext mit 'lineform' bearbeiten +möchten/brauchen, haben Sie die Möglichkeit, +'lineform' für einen +Textausschnitt anzuwenden. Hierfür markieren Sie den gewünschten +Bereich, drücken 'ESC' 'ESC' und +geben das Kommando 'lineform'. + + +gib kommando:lineform + + +____________________________________________________________________________ + + +#page# + +#ib(9)#5.2.1.2. #ib#Automatische Silbentrennung#ie# mit + '#ib#autoform#ie#'#ie(9)# +#free(1.0)# + #on("i")# + 'autoform' arbeitet wie 'lineform', nur werden die Silbentrennungen automatisch + vorgenommen. + #off("i")# +#free(1.0)# +Ist eine Silbentrennung bei der Formatierung notwendig, übernimmt 'autoform' diese +automatisch. Die Trennungen werden in das #ib#Notizbuch#ie# eingetragen. Nach Beendigung +der Formatierung wird die bearbeitete Datei und das Notizbuch zur Kontrolle der +Silbentrennungen angezeigt. Die automatische Silbentrennung arbeitet mit einer hohen +#ib#Trenngüte#ie#; allerdings nur für deutsche Texte. Trotzdem kann es vorkommen, daß +einige Trennungen, insbesondere bei zusammengesetzten Worten, falsch vorgenom­ +men werden. In einem solchen Fall müssen Sie diese nachträglich mit dem Editor +korrigieren. (vgl. Sie dazu auch 5.8.4.) +#page# + +#ib(9)#5.2.2. #ib#Unterschiedliche Schriften#ie##ie(9)# +#free(1.0)# + #on("i")# + #ib#Unterschiedliche Schrifttypen#ie# (Schriftarten) können Sie mit der \#type ("schrift­ + name")\#-Anweisung anfordern. + #off("i")# +#free(1.0)# +Sie haben die Möglichkeit, mit 'lineform' verschiedenartige #ib#Schrifttypen#ie(1, ", unterschiedliche")# (kurz Typen +genannt) verarbeiten zu lassen. Jede Type hat eine bestimmte Höhe und jedes Zei­ +chen hat eine bestimmte Breite. Alle Typen werden auf einer Grundlinie gedruckt. + +Es gibt zwei Arten von Schriften: +bei#on("b")# #ib#äquidistanten Schriften#ie##off("b")# sind alle Zeichen gleich breit (wie bei einer Schreib­ +maschine).#on("b")# #ib#Proportionalschrift#ie##off("b")# findet man in gedruckten Büchern. Hier haben unter­ +schiedliche Zeichen auch unterschiedliche Breiten. Die Zeichen ".", "i", "!" sind z.B. +schmaler als die Zeichen "w", "o", "m" usw. + +Mit der Anweisung: + +____________________________________________________________________________ + + \#type ("schriftname")\# + +____________________________________________________________________________ + + +kann auf einen anderen Schrifttyp umgeschaltet werden (auch mehrmals innerhalb +einer Zeile). Diese Type gilt solange, bis wieder eine neue \#type ("schriftname")\#- +Anweisung gegeben wird. + +____________________________________________________________________________ + + + \#type ("micro")\#Jetzt schreiben wir mit einem + Schrifttyp, der 'micro' heißt. Und jetzt + \#type ("modern15")\#schalten wir auf eine an­ + dere Schriftart um. Nun \#type ("modern12")\# + möchten wir mit einer größeren Type schrei­ + ben. Um wieder zu unserem gewohnten Schrift­ + typ zu gelangen, schalten wir auf \#type + ("trium8")\# zurück. + + +____________________________________________________________________________ + + +Druckbild (ohne 'lineform'): + + +Jetzt schreiben wir mit einem +Schrifttyp, der 'micro' heißt. Und jetzt +schalten wir auf eine an­ +dere Schriftart um. Nun +möchten wir mit einer größeren Type schrei­ +ben. Um wieder zu unserem gewohnten Schrift­ +typ zu gelangen, schalten wir auf +\#type ("trium8")\# zurück. + + + +Welche Schriftarten Ihnen zur Verfügung stehen, hängt natürlich von dem verfügbaren +Drucker ab. Sie können die vorhandenen Schrifttypen mit dem Kommando 'list fonts' +erfragen. + +Schrifttypen können modifiziert, d.h. verändert, gedruckt werden (vergl. Sie dazu den +nächsten Abschnitt). Durch die Angabe einer \#type ("schriftname")\#-Anweisung +werden alle Modifikationen ausgeschaltet. +#page# +#goalpage("on")##goalpage("off")# + +#ib(9)#5.2.3. #ib#Veränderung des Schrifttyps#ie##ie(9)# +#free(1.0)# + #on("i")# + Mit der #ib#\#on ("..."\#-#ie(1,"Anweisung")# und #ib#\#off ("...")\#-Anweisung#ie# können Sie einen Schrifttyp in + seinem Aussehen verändern. Die Schrift wird zwar nicht gewechselt, aber ver­ + ändert gedruckt. Zur Zeit ist #ib##ie(1,"Unterstreichung")##ib# unterstrichen#ie#, #ib#fett#ie#, #ib#kursiv#ie# und der Druck von#ib# weiß auf + schwarz #ie#möglich (abhängig vom eingesetzten Drucker). + #off("i")# +#free(0.7)# +Die \#on\#/\#off\#-Anweisung wirkt wie ein Schalter, der die gewünschte #ib#Schrifttyp- +Modifikation#ie# ein- bzw. ausschaltet. Die Anweisung \#on\# schaltet die Modifikation ein, +\#off\# schaltet sie aus. + +____________________________________________________________________________ + + Das EUMEL-System ermöglicht es Ihnen, + + \#on ("italic")\#kursiv\#off ("italic")\# + \#on ("i")\# \#off ("i")\# + + und + + \#on ("underline")\#unterstrichen\#off ("underline")\# + \#on ("u")\# \#off ("u")\# + + und + + \#on ("bold")\#fett\#off ("bold")\# + \#on ("b")\# \#off ("b")\# + + und + + \#on ("reverse")\#invers (weiß auf schwarz)\#off ("reverse")\# + \#on ("r")\# \#off ("r")\# + + zu schreiben + +____________________________________________________________________________ +#page# +Druckbild: + + + Das EUMEL-System ermöglicht es Ihnen, + + #on("i")#kursiv#off("i")# + + und + + #on("underline")#unterstrichen#off("underline")# + + und + + #on("b")#fett#off("b")# + + und + + #on("reverse")#invers (weiß auf schwarz)#off("reverse")# + + zu schreiben. + + + +Dabei sollten Sie folgendes beachten: + +a) Ein \#type\#-Anweisung schaltet immer eine vorausgehende Modifikation aus, d.h. + ein Schrifttypwechsel macht eventuelle \#off ("b")\#-, \#off ("u")\#-, \#off ("i")\#- + und \#off ("r")\#-Anweisungen überflüssig. + +b) 'lineform'/'autoform' erzeugt eine Warnung, falls Sie vergessen haben, eine Modi­ + fikation auszuschalten. + +c) Nicht alle Drucker können die hier angegebenen Modifikationen auch drucken. + Welche Modifikationen gleichzeitig eingeschaltet werden können, ist ebenfalls + druckerabhängig. +#page# + +#ib(9)#5.2.4. #ib#Gesperrt schreiben#ie##ie(9)# +#free(1.0)# + #on("i")# + Die Silbentrennung an einem Leerzeichen verhindert man durch Verwendung des + geschützten Leerzeichens 'ESC' und 'Leertaste'. + #off("i")# +#free(1.0)# +Möchten Sie ein Wort g e s p e r r t schreiben, muß natürlich verhindert werden, daß +dieses Wort beim Formatieren getrennt wird. Andere Worte, wie z.B. in Formeln, +sollten ebenfalls zusammen auf eine Zeile geschrieben werden (z.B. 'sin (x)'). Dies +können Sie erreichen, indem Sie nicht das Leerzeichen zwischen die Zeichen schrei­ +ben, denn das Leerzeichen bedeutet für 'autoform'/'lineform' immer das Ende eines +Wortes. Stattdessen verwenden Sie . Das geschützte Leerzeichen +erscheint auf dem Bildschirm zur besseren Identifizierung invers dargestellt bzw. als +ein anderes Zeichen (abhängig von Ihrem Gerät). Beim Drucken wird jedoch wieder +ein Leerzeichen produziert. + + + +____________________________________________________________________________ + + g e s p e r r t + + +____________________________________________________________________________ + + +Druckbild: + + g e s p e r r t + + + +#page# +#goalpage("limit")# + +#ib(9)#5.2.5. #ib#Zeilenbreite einstellen#ie##ie(9)# +#free(1.0)# + #on("i")# + Mit der #ib#\#limit\#-Anweisung#ie# können Sie die Zeilenbreite einstellen. + #off("i")# +#free(1.0)# +Die \#limit\#-Anweisung gibt in cm an, wie breit die Zeile sein soll. Beachten Sie, daß +diese Anweisung nichts mit dem Editor-Kommando 'limit' zu tun hat. Dieses gibt an, +wie viele Zeichen eine Bildschirmzeile lang sein soll. + +Die Zeilenbreite wird zusammen mit dem Schrifttyp beim erstmaligen Aufruf von +'autoform'/'lineform' interaktiv erfragt und als \#limit\#-Anweisung (zusammen mit der +\#type\#-Anweisung) in die erste Zeile der Datei eingetragen. Sie kann in einer Datei +mehrmals verändert werden. + +Die neue Zeilenbreite gilt immer ab der #on("b")#nächsten#off("b")# Zeile, die der \#limit\#-Anweisung +folgt. Beachten Sie, daß Sie als Parameter in der \#limit\#-Anweisung eine Zahl mit +Dezimalpunkt und Nachkommastelle angeben müssen. + +____________________________________________________________________________ + + +\#limit(9.0)\# + Mit der \#limit\#-Anweisung können Sie Para­ + graphen in einem anderen Format leicht gestal­ + ten. Die rechte Schreibgrenze wird durch die + \#limit\#-Anweisung eingestellt, wobei Sie den + linken Rand durch eine entsprechende Ein­ + rückung gestalten können. +\#limit(11.0)\# + +____________________________________________________________________________ + + +Druckbild (mit 'lineform' bearbeitet): + + + Mit der \#limit\#-Anweisung können Sie Paragraphen in einem + anderen Format leicht gestalten. Die rechte Schreibgrenze + wird durch die \#limit\#-Anweisung eingestellt, wobei Sie den + linken Rand durch eine entsprechende Einrückung gestalten + können. + + + +Die folgende Tabelle gibt sinnvolle #ib#'limit'-Einstellungen#ie# für die am häufigsten ver­ +wendeten Papiergrößen an: + + + #on("b")#Format 'limit' Verbleibender + (Zeilenbreite) Rand#off("b")# + + DIN A4 16.0 cm je 2.50 cm + + DIN A5 12.0 cm je 1.42 cm + + DIN A4 quer 25.0 cm je 2.35 cm +#page# +#goalpage("einfache Tabellen")# + +#ib(9)#5.2.6. Einfache #ib#Tabellen#ie(1,", einfache")# und #ib#Aufzählungen#ie# + schreiben#ie(9)# +#free(1.0)# + #on("i")# + Aufzählungen und einfache #ib#Tabellen#ie(1, ", einfache")# werden automatisch richtig formatiert und + gedruckt, wenn Sie sich an einige einfache Regeln halten. + #off("i")# +#free(1.0)# +Verwenden Sie eine #ib#Proportionalschrift#ie# beim Tabellenschreiben, so sind die Spalten in +der Regel unterschiedlich breit, selbst wenn Sie eine gleiche Anzahl Zeichen in jeder +Spalte schreiben. Dies können Sie durch das Schreiben von einem "#ib#Doppelblank#ie#" +("#ib#Mehrfachblank#ie#") vermeiden; für kompliziertere Tabellen gibt es spezielle Tabellen­ +anweisungen. (siehe auch S. #topage("tabellenanw")#) + +____________________________________________________________________________ + + iiii ooooo + mmmm lllll + +____________________________________________________________________________ + + + +Druckbild: + + + iiii ooooo + mmmm lllll + +Erste und zweite Spalte stehen nicht untereinander. + + +Aber mit Doppelblanks: + +____________________________________________________________________________ + + iiii ooooo + mmmm lllll + +____________________________________________________________________________ + + +Druckbild: + + + iiii ooooo + mmmm lllll + +Erste und zweite Spalte stehen jetzt untereinander. + +Das Doppelblank dient 'lineform'/'autoform' und dem Drucker als Zeichen, daß die +Positionen speziell berechnet und beim Druck berücksichtigt werden müssen. Das gilt +nur nach einer Absatzzeile. In seltenen Fällen (insbesondere beim Einsatz von Schrift­ +typen, die in der Größe stark voneinander abweichen) kann es vorkommen, daß diese +Tabellenautomatik nicht funktioniert und Spalten übereinander gedruckt werden. In +solchen Fällen müssen Sie die Anzahl der trennenden Doppelblanks erhöhen. + +#on("b")##on("is")#Praktischer Tip:#off("is")##off("b")# +Beachten Sie, daß es für das Funktionieren der "#ib#Tabellenautomatik#ie#" erforderlich ist, +daß jede Tabellenzeile eine Absatzzeile ist. Man sollte diese Zeilen vor dem Druck +daraufhin überprüfen oder durch 'lineform'/'autoform' die Datei bearbeiten lassen. +Sollten durch die zeilenweise Formatierung einmal wegen fehlender Absatzkennzeich­ +nung zwei Zeilen zusammengezogen sein, können Sie diese leicht mit dem Editor +wieder "auseinanderbrechen" ( , und ). + + +Ähnliches gilt bei Aufzählungen. + +____________________________________________________________________________ + + 1) Das ist die erste Aufzählung. + Dieser Satz wird bündig gedruckt. + 2) Hier auch. + +____________________________________________________________________________ + + +Druckbild: + + + 1) Das ist die erste Aufzählung. + Dieser Satz wird bündig gedruckt. + 2) Hier auch. + + +Auch in solchen Fällen wird der gedruckte Text in der Regel richtig eingerückt. Die +#ib#Tabellenautomatik#ie# wirkt nur nach einem Absatz. Hier aber ein Beispiel für eine +typische Fehlersituation: + +____________________________________________________________________________ + + \#type("normal")\# + 1. Aufzählung + 2. Aufzählung + 3. Aufzählung + + \#type("fett")\#M1. Aufzählung + +____________________________________________________________________________ + + +Die Einrückbreite wird durch den Schrifttyp bestimmt, der vor der Zeile herrscht, und +den ganzen Absatz über beibehalten. + + +Druckbild: + + + 1. Aufzählung + 2. Aufzählung + 3. Aufzählung + + M1. Aufzählung + + +Das Blank zwischen 'M1.' und 'Aufzählung' reicht nicht aus, um eine Überschreibung +zu verhindern. Diesen Fehler können Sie umgehen, indem Sie die \#type\#-Anweisung +in eine gesonderte Zeile stellen. Richtig wäre folgendes (gewünschter Schrifttyp vor +die Zeile!): + +____________________________________________________________________________ + + \#type("trium8")\# + 1. Aufzählung + 2. Aufzählung + 3. Aufzählung + + \#type("triumb14")\# + M1. Aufzählung + +____________________________________________________________________________ + + + +Druckbild: + + + 1. Aufzählung + 2. Aufzählung + 3. Aufzählung + + + M1. Aufzählung + + +Die genauen Regeln sind etwas kompliziert, so daß sie hier nicht einzeln aufgeführt +werden (siehe S. 5-89#topage("block")# unter der Anweisung \#block\#). Treffen Sie auf einen der +seltenen Fälle, wo die Tabellenautomatik nicht funktioniert, können Sie immer noch +Tabellen-Anweisungen verwenden. +#mark ("", "")# +#page# + +#goalpage("tabellenanw")# +#ib(9)#5.2.6.1. #ib#Tabellenanweisungen#ie##ie(9)# +#free(1.0)# + Mit den Tabellenanweisungen der Textkosmetik können Sie auf einfache Art Tabel­ + len auch mit Porportionalschriften gestalten. +#free(1.0)# +Es ist sehr einfach, eine Tabelle in einer äquidistanten Schrift zu schreiben, denn +hierbei stimmt das Schriftbild auf dem Terminal weitgehend mit dem späteren Druck +überein. Bei einer äquidistanten Schrift ist jedes Zeichen gleich breit - Sie können +also "sehen", an welcher Zeilenposition eine neue Spalte beginnt. + +Etwas schwieriger sind Tabellen mit Proportionalschriften, da hier jedes Zeichen eine +unterschiedliche Breite hat. Sie können somit einer Spaltenbreite nicht direkt "an­ +sehen", wie breit sie beim Druck wirklich wird. "Einfache" Tabellen können Sie mit +dem Mehrfachblank gestalten (siehe S. 5-27). Bei komplizierteren Tabellen müssen +Sie die folgenden Tabellenanweisungen benutzen. + +Um eine Tabelle zu gestalten, gehen Sie folgendermaßen vor: + +- Definieren Sie die Spaltenpositionen der Tabelle mit den folgenden Anweisungen. + Für die Punkte bei den Anweisungen müssen Sie entsprechende Parameter + einsetzen. + +#goalpage("lpos")##goalpage("rpos")##goalpage("cpos")##goalpage("dpos")##goalpage("bpos")# +#goalpage("fillchar")# +____________________________________________________________________________ + + #ib#\#l pos#ie(1,"-Anweisung")# (...)\# (* linksbündig *) + #ib#\#r pos#ie(1,"-Anweisung")# (...)\# (* rechtsbündig *) + #ib#\#c pos#ie(1,"-Anweisung")# (...)\# (* zentrierend *) + #ib#\#d pos#ie(1,"-Anweisung")# (..., ...)\# (* zentrierend um eine Zeichenkette *) + #ib#\#b pos#ie(1,"-Anweisung")# (..., ...)\# (* Blocksatz in einer Spalte *) + #ib#\#fillchar#ie(1,"-Anweisung")# (...)\# (* Füllzeichen zwischen Spalten *) + +____________________________________________________________________________ + + + Die Zentrierung um eine Zeichenkette ist wie folgt zu verstehen: Die Spalte wird + bis zum Anfang der angegebenen Zeichenkette rechtsbündig und ab der Zeichen­ + kette linksbündig geschrieben. + +#goalpage("table")# +- Schreiben Sie dann die Tabelle. Sie muß von den Anweisungen + +____________________________________________________________________________ + + #ib#\#table\##ie(1,"-Anweisung")# + + + #ib#\#table end\##ie(1,"-Anweisung")# + +____________________________________________________________________________ + + + eingefaßt werden. Die Spalten in der Tabelle müssen Sie durch mindestens zwei + Leerzeichen voneinander trennen. Es müssen alle Spalten in einer Tabelle vor­ + handen sein. Soll einmal eine Spalte leer bleiben, müssen Sie für diese Spalte ein + #ib#geschütztes Leerzeichen#ie# verwenden. + +- Da die Spaltenpositionen erhalten bleiben (auch über die Anweisung \#table end\# + hinweg), sollten Sie direkt hinter dem Tabellenende die #ib#\#clear pos\#-Anweisung#ie# + geben. + +- Dann können Sie 'lineform'/'autoform' vornehmen. + +____________________________________________________________________________ + + + \#r pos (2.2)\#\#c pos (3.8)\#\#l pos (5.8)\#\#d pos (8.8, ".")\# + \#table\# + erste Spalte zweite Spalte dritte Spalte vierte Spalte + rechtsbündig zentriert linksbündig dezi.mal + 1234 1234 1234 12.34 + 12345 12345 12345 123.45 + 123456 123456 123456 1234.56 + \#table end\# \#clear pos\# + +____________________________________________________________________________ + + +Druckbild: + + + #r pos (2.2)##c pos (3.8)##l pos (5.8)##d pos (8.8, ".")# + #table# + erste Spalte zweite Spalte dritte Spalte vierte. Spalte + rechtsbündig zentriert linksbündig dezi.mal + 1234 1234 1234 12.34 + 12345 12345 12345 123.45 + 123456 123456 123456 1234.56 + #table end##clear pos# + + + +Solche Tabellen können Sie in \#head\#, \#bottom\# oder innerhalb von Fußnoten schrei­ +ben. Es ist jedoch nicht möglich, eine Fußnote innerhalb dieser Tabelle zu definieren. +Ausweg: Tabelle um die Fußnote aufspalten. +#page# + +#ib(9)#5.2.6.2. Einstellen der #ib#Tabellenpositionen#ie (1, ", Einstellen von")##ie(9)# +#free(0.7)# + #on("i")# + Mit den \#pos\#-Anweisungen können Sie eine bestimmte Position innerhalb der + Tabelle einstellen, zugleich aber auch bestimmen, wie die Spalte gedruckt werden + soll. #off("i")# + +#free(0.7)# +____________________________________________________________________________ + + \#l pos (5.0)\#\#r pos (10.0)\#\#d pos (15.0, ".")\# + +____________________________________________________________________________ + + +Die Anweisung oben stellt die erste Spalte der Tabelle auf 5 cm vom Rand ein (links­ +bündig). Die zweite Spalte endet 10 cm vom Rand, wobei diese Spalte rechtsbündig +geschrieben werden soll. Die dritte wird an die Position 15, zentriert um den Dezimal­ +punkt, gedruckt#u##count#)#e#.#foot# +#u##value#)#e# Spaltenposition < 0.0 und Spaltenposition > 'eingestelltes limit' sind nicht + erlaubt. +#end# + +Beachten Sie, daß ein "Überlappen" von Spalten erfolgen kann (in unserem Beispiel +kann die erste Spalte in die zweite hineinschreiben). 'lineform' bzw. 'autoform' meldet +bei Spalten-Überschreibungen einen entsprechenden Fehler. + +Für jede Spaltenposition nehmen Sie ein Element einer Zeile. Die Elemente müssen +Sie beim Schreiben im Editor durch mindestens zwei Leerzeichen voneinander tren­ +nen. Auf die erste Spaltenposition wird das erste Element gedruckt, auf die zweite +Position das zweite Element usw. Für das Drucken der Spalten wird der eingeschal­ +tete Schrifttyp mit möglicherweise einer Modifikation genommen. Der Schrifttyp und +die Modifikation können innerhalb der Tabelle geändert werden#u##count#)#e#.#foot# +#u##value#)#e# Die Zwischenräume zwischen den Spalten werden nicht modifiziert (also z.B. + nicht unterstrichen). +#end# + +Beachten Sie, daß die Tabellenpositionen so lange erhalten bleiben, bis sie explizit +gelöscht werden (\#clear pos\#-Anweisung, siehe S. 5-38). +#page# + +#ib(9)#5.2.6.3. #ib#Blocksatz innerhalb einer Spalte#ie##ie(9)# +#free(1.0)# + #on("i")# + Für Blocksatz innerhalb einer Spalte verwenden Sie die \#b pos (...)\#-Anweisung. + #off("i")# +#free(1.0)# +____________________________________________________________________________ + +\#l pos (0.0)\#\#b pos (2.2, 8.0)\#\#l pos (9.0)\# +\#table\# +1. Spalte Die mittlere Spalte wird bis zur Druck­ 3. Spalte +1. Spalte position '8.0' in Blocksatz gedruckt. Um 3. Spalte +1. Spalte in dieser Spalte einen Absatz zu bekom­ 3. Spalte +1. Spalte men, muß ein geschütztes Leerzeichen am 3. Spalte +1. Spalte Ende der Spalte stehen. #cursor(" ")# 3. Spalte +\#table end\# \#clear pos\# + +____________________________________________________________________________ + + + +Druckbild: + +#l pos (0.0)##b pos (2.2, 8.0)##l pos (9.0)# +#table# +1. Spalte Die mittlere Spalte wird bis zur Druck­ 3. Spalte +1. Spalte position '8.0' in Blocksatz gedruckt. Um 3. Spalte +1. Spalte in dieser Spalte einen Absatz zu bekom­ 3. Spalte +1. Spalte men, muß ein geschütztes Leerzeichen am 3. Spalte +1. Spalte Ende der Spalte stehen. 3. Spalte +#table end##clear pos# +#page# + +#ib(9)#5.2.6.4. #ib#Tabellenspalten auffüllen#ie# (#ib#Füllzeichen#ie#)#ie(9)# +#free(1.0)# + #on("i")# + Mit der \#fillchar\#-Anweisung können Sie Spaltenzwischenräume füllen. + #off("i")# +#free(1.0)# +Angenommen, Sie möchten eine Rechnung erstellen. Die Warenposten sollen links­ +bündig an der Druckposition '0.0' und die Beträge rechtsbündig an der Position '9.0' +gedruckt werden. Zwischen einem Warenposten und dem dazugehörigen Betrag sollen +entsprechend viele Punkte ('.') gedruckt werden. Das folgende Druckbild: + +#l pos (0.0)##r pos (9.0)##fillchar(".")# +#table# +30 Benutzerhandbücher 450,-DM +10 Systemhandbücher 150,-DM + +#table end##clear pos# + +wird mit + +____________________________________________________________________________ + + \#l pos (0.0)\#\#r pos (9.0)\#\#fillchar(".")\# + \#table\# + 30 Benutzerhandbücher 450,-DM + 10 Systemhandbücher 150,-DM + + \#table end\#\#clear pos\# + +____________________________________________________________________________ + + +erreicht. Mit der Anweisung \##ib#fillchar#ie#\# stellen Sie das/die #ib#Füllzeichen#ie# ein. Somit wer­ +den entsprechend viele Füllzeichen (anstatt der Leerzeichen) von dem Textende einer +Spalte bis zu dem Textanfang der nächsten Spalte gedruckt. Die Füllzeichen bleiben +so lange eingestellt, bis erneut die Anweisung \#fillchar\# gegeben wird. Insbesondere +bleibt das Füllzeichen - genauso wie auch die eingestellten Spaltenpositionen - +über das Tabellenende erhalten. Die Anweisung \#clear pos\# löscht - zusätzlich zu +den Tabellenpositionen - auch das eingestellte Füllzeichen (setzt das Zeichen auf ' ' +zurück). + +Beachten Sie, daß die Füllzeichen direkt gedruckt werden (also ohne Leerzeichen +zwischen dem Spaltentext und den Füllzeichen). Möchten Sie einen Zwischenraum +zwischen dem Spaltentext und den Füllzeichen haben, dann fügen Sie ein geschütz­ +tes Leerzeichen an den Spaltentext an oder setzen eins vor die nachfolgende Spalte. + +Die Anweisung \#fillchar\# gilt für Zwischenräume zwischen allen Spalten. Soll nur #on("i")#ein#off("i")# +Spaltenzwischenraum ausgefüllt werden, müssen Sie die \#fillchar\#-Anweisung in der +Tabelle entsprechend geben. + +____________________________________________________________________________ + + \#l pos (1.0)\#\#r pos (5.0)\#\#r pos (10.0)\# + \#table\# + 1\#fillchar(".")\# 3\#fillchar(" ")\# 4 + 2\#fillchar(".")\# 17\#fillchar(" ")\# 6 + \#table end\# + +____________________________________________________________________________ + + + +Druckbild: + +#l pos (1.0)##r pos (5.0)##r pos(10.0)# +#table# +1#fillchar(".")# 3#fillchar(" ")# 4 +2#fillchar(".")# 17#fillchar(" ")# 6 +#tableend##clear pos# + + + + +Eingeschaltete Modifikationen gelten in diesem Fall auch für die Spaltenzwischen­ +räume. +#page# + +#ib(9)#5.2.6.5. #ib#Tabellenpositionen löschen#ie##ie(9)# +#goalpage("clearpos")# +#free(1.0)# + #on("i")# + Mit der #ib#\#clear pos\#-Anweisung#ie# löschen Sie alle eingestellten Positionen. + #off("i")# +#free(1.0)# +Sollen gänzlich neue Positionen eingestellt werden, benutzen Sie die Anweisung + + +____________________________________________________________________________ + + \##ib#clear pos#ie(1,"-Anweisung")#\# + +____________________________________________________________________________ + + + +ohne Parameter. Sie löscht alle eingestellten Tabellenpositionen. Beachten Sie, daß +\#clear pos\# auch das Füllzeichen für die \#fillchar\#-Anweisung löscht (es wird wieder +ein ' ' voreingestellt). Eine einzelne Tabellenposition können Sie z.B. mit + + +____________________________________________________________________________ + + \#clear pos (10.0)\# + +____________________________________________________________________________ + + +löschen. +#mark ("","")# +#page# + +#goalpage("u")##goalpage("d")# +#ib(9)#5.2.7. #ib#Indizes#ie# und #ib#Exponenten#ie##ie(9)# + +#free(1.0)# + #on("i")# + Mit den Anweisungen #ib#\#u\##ie(1, "-Anweisung")#, #ib#\#d\##ie(1,"-Anweisung")# und #ib#\#e\##ie(1,"-Anweisung")# können Sie Exponenten und Indizes + schreiben. + #off("i")# +#free(1.0)# +Die Anweisung \#u\# (steht für 'up') schaltet auf eine Exponenten-Schreibweise um +und zwar so lange, bis die Anweisung \#e\# (steht für 'end') angetroffen wird. Dabei +wird automatisch auf den nächst kleineren Schrifttyp umgeschaltet (sofern vorhanden). + +____________________________________________________________________________ + + a\#u\#i,k\#e\# + +____________________________________________________________________________ + + +Druckbild: + + a#u#i,k#e# + + + +Die \#d\#-Anweisung ('d' steht für 'down') ist für Indizes gedacht und arbeitet analog +zur \#u\#-Anweisung. + +____________________________________________________________________________ + + a\#d\#i,k\#e\# + +____________________________________________________________________________ + + +Druckbild: + + a#d#i,k#e# + + +Die automatische Umschaltung auf den nächst kleineren Schrifttyp erfolgt nur, wenn +in der #ib#Fonttabelle#ie# ein nächst kleinerer Schrifttyp angegeben ist. Sonst wird der ein­ +gestellte Schrifttyp für den Exponenten beibehalten. + +Nach der \#e\#-Anweisung wird automatisch wieder der Schrifttyp eingestellt, der vor +der zugehörigen \#u\#-Anweisung galt. Die \#u\#- und \#e\#-Anweisungen bilden also +Klammern. Innerhalb einer Anweisung kann jede beliebige, sinnvolle Textkosmetik- +Anweisung stehen. Beachten Sie, daß Anweisungen innerhalb einer Klammer die +Zeilenhöhe nicht verändern sollen. Wenn Sie beispielsweise eine \#type\#-Anweisung +in eine Klammer schreiben, wird zwar der Index/Exponent in diesem Schrifttyp ge­ +druckt, aber der Drucker geht davon aus, daß die Zeilenhöhe nicht überschritten wird. +Deshalb ist es angeraten, nur einen kleineren Schrifttyp innerhalb eines Index/Expo­ +nenten zu verwenden. Wie bereits erwähnt, wird auch in diesem Beispiel nach dem +Klammerende auf den vorher eingestellten Schrifttyp zurückgestellt. + +Die Index/Exponenten-Klammern können auch geschachtelt werden. + +____________________________________________________________________________ + + a\#u\#um 1 hoch\#u\#noch 1 hoch\#e\#um 1 zurück\#e\# Grundlinie + +____________________________________________________________________________ + + +Druckbild: + + a#u#um 1 hoch#u#noch 1 hoch#e#um 1 zurück#e# Grundlinie + + + +Es gelten folgende #on("b")#Einschränkungen#off("b")#: + +1. Ein Exponent (Index) wird so positioniert, daß es in der Regel keine Überschrei­ + bung mit der vorhergehenden (nachfolgenden) Zeile gibt. + +2. Bei mehrfachen Exponenten oder Indizes oder bei Umschaltung auf einen anderen + Schrifttyp innerhalb eines Exponenten (Index) oder wenn nicht auf einen kleineren + Schrifttyp umgeschaltet werden kann, besteht die Möglichkeit, daß der Exponent + oder Index über die "normale" Zeile hinausragt. In diesem Fall kann es Über­ + schreibungen geben, die Sie mit der #ib#\#linefeed\#-Anweisung#ie# ausgleichen können. + +3. Eine Exponenten- oder Index-Klammer muß als Ganzes auf einer Zeile stehen. + +4. Gleichzeitige Exponenten- und Index-Ausdrücke, die übereinander stehen + sollen, sind zur Zeit mit den \#u\#/\#d\#-Anweisungen nicht möglich. Jedoch funk­ + tioniert folgendes: + + +____________________________________________________________________________ + + a\#u\#Exponent\#d\#Index des Exponenten\#e\#\#e\# + +____________________________________________________________________________ + + + + Druckbild: + + a#u#Exponent#d#Index des Exponenten#e##e# + + + +5. Doppelblanks spielen innerhalb einer solchen Klammer keine Rolle, wirken also + wie zwei "normale" Leerzeichen und nicht als implizite Positionierung. Innerhalb + einer solchen Klammer werden Blanks, sofern die Anweisung \#block\# gegeben + wurde, nicht verbreitert. + +6. Indizes oder Exponenten sollten nicht mit den Modifikationen \#underline\# und/oder + \#reverse\# zusammen verwendet werden, da z.B. ein Unterstreichen von Indizes + und Exponenten innerhalb einer unterstrichenen Zeile zu einem solchen Ergebnis + führt: + + + Druckbild: + + #on("u")#Indizes und Exponenten a#d#i,k#e# a#u#i,k#e# sollten nicht unterstrichen werden!#off("u")# +#page# + diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.5b b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5b new file mode 100644 index 0000000..748e398 --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5b @@ -0,0 +1,1632 @@ +#start(5.0,1.5)##pagenr("%",42)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Teil 5: Textkosmetik und Druck +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +5 - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD 5 - % +#tableend##clearpos# +#end# + +#ib(9)#5.3. #ib#Pageform#ie##ie(9)# +#free(1.0)# +#ib(9)#5.3.1. #ib#Seitenweise formatieren#ie##ie(9)# +#goalpage("pageform")##goalpage ("autopageform")# +#free(1.0)# + #on("i")# + 'pageform'/'autopageform' formatiert eine Datei seitenweise und erledigt Routine­ + arbeiten wie die Plazierung von Fußnoten, Seitennumerierung usw. + #off("i")# +#free(1.0)# + +Das Programm 'pageform' können Sie mit dem Kommando + +____________________________________________________________________________ + + gib kommando: + pageform ("dateiname") + +____________________________________________________________________________ + + + +aufrufen. 'pageform' erzeugt aus der Eingabedatei (z.B.: "dateiname") eine Druck­ +datei, deren Name durch ein angehängtes '.p' gebildet wird (z.B.: "dateiname.p"). + +Die von 'pageform' erzeugte Druckdatei besteht aus der Eingabedatei mit ggf. neu +eingefügten Zeilen. Die eingesetzten Zeilen stammen aus \#head\#-, \#bottom\#- oder +\#foot\#-Anweisungen. Dadurch erhöht sich die Zeilenanzahl der Datei. + +Sie können in Kopf- oder Fußzeilen Seitennummern aufnehmen. Diese Seiten­ +nummern werden von 'pageform'/'autopageform' bei Seitenwechseln automatisch +erhöht und an eine von Ihnen gekennzeichnete Stelle eingesetzt. Fußnoten können +auch durch Nummern gekennzeichnet werden. Querverweise sind ebenfalls möglich. +#page# +Nachdem 'pageform' eventuelle Kopf-, Fuß- und Fußnotenzeilen eingefügt hat, +berechnet es die Anzahl von Zeilen, die auf eine Seite passen, aus den Angaben für +Seitenlänge und Zeilenvorschub und aus der Höhe der eingestellten Schrifttypen +(\#type\#-Anweisung). Dann zeigt 'pageform' das errechnete Seitenende auf dem Bild­ +schirm an. Das Seitenende kann interaktiv verschoben werden, um es an eine ge­ +wünschte Stelle zu plazieren und es können Leerzeilen eingefügt/gelöscht werden, um +Seiten gleich lang zu machen. Zusätzlich können Sie Seiten in Spalten ("Zeitungs­ +druck") aufteilen und diese interaktiv formatieren. + +Bei mehreren Schrifttypen innerhalb einer Zeile wird als Zeilenhöhe automatisch die +des größten Schrifttyps genommen. Dabei müssen Sie bedenken, daß zu Beginn der +Zeile immer der Schrifttyp der vorherigen Zeile eingeschaltet ist. +#page# + +#ib(9)#5.3.1.1. #ib#Automatische Seitenformatierung#ie(9)##ie# +#free(1.0)# + + #on("i")# + 'autopageform' arbeitet wie 'pageform', jedoch werden die Seitenenden automa­ + tisch plaziert. + #off("i")# +#free(1.0)# +'autopageform' sucht zuerst das rechnerische Seitenende. Ist dort ein Absatz vor­ +handen, wird die Seite an dieser Stelle beendet. Falls nicht, sucht 'autopageform' +nach oben in den nächsten vier Zeilen nach einem Absatz. Wird keiner gefunden, +wird die Seite am rechnerischen Seitenende beendet. + +Ist die \#pageblock\#-Anweisung gegeben, wird zuerst nach oben in den vier letzten +Zeilen nach einem Absatz gesucht, um dort die Seite zu beenden. Ist dort keiner +vorhanden, wird auch über das rechnerische Seitenende hinweg versucht, die Seiten­ +länge zu plazieren (4 Zeilen). 'autopageform' beachtet in einem solchen Fall die +'pagelength'-Anweisung, indem der Zeilenabstand gestaucht wird. +#page# + +#ib(9)#5.3.1.2. #ib#Seitenende interaktiv verschieben#ie# #ie(9)# +#free(1.0)# + #on("i")# + In diesem Abschnitt wird beschrieben, welche interaktiven Möglichkeiten Ihnen + 'pageform' bietet, Seiten zu gestalten. + #off("i")# +#free(1.0)# +Auf dem Bildschirm wird das von 'pageform' errechnete jeweilige Seitenende unter +Angabe der aktuellen Seitennummer angezeigt. Das Seitenende erscheint ungefähr in +der Mitte des Bildschirmes und wird durch eine von 'pageform' erzeugte Zeile ge­ +kennzeichnet, die auch - nach erfolgter Seitenformatierung - in der Druckdatei zu +sehen ist. Der EUMEL-Drucker druckt diese Zeile nicht. + +____________________________________________________________________________ + +Mehrere Fußnoten innerhalb einer Seite werden von 'pageform'/­ +'autopageform' in der Reihenfolge ihres Auftretens gesammelt und +am Ende der Seite plaziert. Für eine entsprechende Trennung der +Fußnoten voneinander (z.B. durch Leerzeilen) müssen Sie selbst +sorgen. +\#page\#\#--------------------- Ende Seite 215 --------\# +Unter Umständen paßt die Fußnote nicht mehr auf die aktuelle +Seite und muß deshalb von 'pageform'/'autopageform' auf die näch­ +ste Seite gebracht werden. 'pageform'/'autopageform' geht davon +aus, daß die Kennzeichnung der Fußnote in der Zeile unmittelbar +vor der Fußnote steht und bringt diese Zeile ebenfalls auf die +neue Seite. + + +____________________________________________________________________________ + + +Über der Markierung erscheinen die letzten Zeilen der bereits verarbeiteten Seite, +darunter die ersten Zeilen der nächsten Seite. Sie können nun mit Hilfe der Positio­ +nierungstasten die Markierung und damit das Seitenende nach oben verschieben. +Damit vermeiden Sie, daß ein logisch zusammengehöriger Text auseinandergerissen +wird und sogenannte "Waisenkinder" entstehen (letzte Zeile eines Abschnittes kommt +auf die neue Seite). + +Bei der interaktiven #ib#Formatierung#ie (1, " für Seiten")# können Sie die Markierung nicht über das errech­ +nete Ende einer Seite nach unten oder über das vorherige, bereits verarbeitete Seiten­ +ende nach oben verschieben. + +Haben Sie jedoch zu Beginn die #ib#\#pageblock\##ie(1,"-Anweisung")#-Anweisung (siehe S. 5-91) gegeben, +ist es erlaubt, die Seitenende-Markierung auch einige Zeilen über das rechnerische +Seitenende hinaus zu bewegen. Betätigen Sie dann , wird der Drucker (sofern +möglich) den Zeilenabstand auf dieser Seite stauchen. In diesem Fall sollten Sie +darauf achten, daß das Seitenende bei einem Absatz immer #on("b")##on("i")#vor#off("b")##off("i")# eventuell vorhan­ +dene Leerzeilen plaziert wird. Andernfalls werden die Leerzeilen am Ende der Seite +als Textzeile mitgezählt und es bleibt entsprechender Platz frei! + +Innerhalb einer Fußnote kann die Markierung nicht verschoben werden. In diesem Fall +wird interaktiv angefragt, ob die Fußnote auf der nächsten Seite fortgesetzt werden +soll. Verneinen Sie die Anfrage, positioniert 'pageform' vor die Fußnote. Von dieser +Stelle aus können Sie das Seitenende wie gewohnt verschieben. + +Bejahen Sie dagegen die Anfrage nach dem Fußnotenumbruch, plaziert 'pageform' +das Seitende an dieser Stelle innerhalb der Fußnote. Der restliche Teil der Fußnote +kommt auf die nächste Seite mit einer Anmerkung ('Forts. von letzter Seite')#u##count#)#e#. +#foot# +#u##value#)#e# Bei fremdsprachlichen Texten sollten Sie nach 'pageform' diese Anmerkungen + in der '.p'-Datei ändern. +#end# + +Entstehen bei der Seitenformatierung am Anfang einer Seite #ib#Leerzeilen#ie(1, " am Seitenanfang")# (z.B. durch +Plazierung des Seitenendes zwischen zwei Absätzen), so werden diese von 'page­ +form' automatisch aus der Druckdatei entfernt. Möchten Sie #ib#Leerzeilen am Anfang +einer Seite#ie#, dann sollten Sie die \#free\#-Anweisung in Verbindung mit der \#page\#- +Anweisung verwenden. + +Zusätzlich können Sie Leerzeilen in eine Seite der Druckdatei einfügen und/oder +beliebige Zeilen löschen (vergl. b). +#page# +Folgende Operationen stehen Ihnen bei der interaktiven Seitenformatierung zur Ver­ +fügung: + +#on("b")#a) #ib#Seitenende verschieben#ie#:#off("b")# + +'pageform' berechnet das "rechnerische" Seitenende und zeigt dieses auf dem Bild­ +schirm durch die Markierung an. Die Markierung kann interaktiv verschoben werden: + + #on("b")#Taste Bedeutung#off("b")# + + Seitenende an diese Stelle plazieren. + + + <^> Seitenende eine Zeile nach oben verschieben. + + + Seitenende eine Zeile nach unten verschieben (wenn + vorher nach oben verschoben bzw. wenn \#pageblock\#- + Anweisung gegeben ist). + + + <^> Seitenende um einen Bildschirm nach oben verschieben. + + + Seitenende um einen Bildschirm nach unten verschieben. + + + Abbruch der Seitenformatierung. + + + +#on("b")#b) #ib#Leerzeilen einfügen#ie# und/oder #ib#Zeilen löschen#ie##off("b")# + +Ist nach den Berechnungen von 'pageform' der Text ungünstig auf der Seite plaziert, +können Sie in die Seite (der Druckdatei!) Leerzeilen einfügen und/oder Zeilen löschen. +Dies kann beispielsweise sinnvoll sein, wenn durch die Löschung einer Zeile ein +Absatz noch auf die Seite passen würde oder durch die Einfügung von Leerzeilen ein +Absatz auf der letzten Zeile der Seite endet. Oft ist es auch sinnvoll, daß alle Seiten +gleich lang sind. In diesem Fall sollten vor Kapiteln und Absätzen Leerzeilen eingefügt +oder gelöscht werden. + +Um Leerzeilen einzufügen und/oder Zeilen zu löschen, müssen Sie die Markierung +wie unter a) beschrieben an die Stelle plazieren, an der die Änderung vorgenommen +werden soll. + + + #on("b")#Taste Bedeutung#off("b")# + + + Leerzeilen einfügen. Anstatt der Markierung können + durch (u.U. mehrmaliges) Leerzeilen eingefügt + werden. beendet den Vorgang (wie + Zeileneinfügen im Editor). + + Zeile löschen. Die Zeile unmittelbar oberhalb der + Markierung wird gelöscht. + + + +Anschließend berechnet 'pageform' die Seite erneut. + + + +#on("b")#c) #ib(9)##ib#\#page\#-Anweisung bestätigen/löschen#ie(9)##ie##off ("bold")# + +Wird von der Prozedur 'pageform' eine #ib#\#page\#-Anweisung#ie# angetroffen, so wird das +gewünschte Seitenende auf Ihrem Bildschirm angezeigt. Die \#page\#-Anweisung +können Sie entweder bestätigen oder löschen. + + #on("b")#Taste Bedeutung#off("b")# + + + Seitenende bestätigen. + + \#page\#-Anweisung ignorieren. Die Prozedur 'pageform' + bearbeitet in diesem Fall die Datei weiter, als ob keine + \#page\#-Anweisung angetroffen wurde. + + Abbruch der Seitenformatierung. +#page# + +#ib(9)#5.3.2. #ib#Seitenlänge einstellen#ie##ie(9)# +#goalpage("pagelength")# +#free(0.7)# + #on("i")# + 'pageform'/'autopageform' ist auf ein Schreibfeld von 25.0 cm eingestellt (ent­ + spricht einem DIN A4-Schreibfeld). Wünschen Sie eine andere Seitenlänge, + müssen Sie die #ib#\#pagelength\#-Anweisung#ie# in den Text einfügen. + #off("i")# +#free(0.7)# +____________________________________________________________________________ + + \#pagelength (20.0)\# + +____________________________________________________________________________ + + +stellt die Seitenlänge auf 20 cm ein. + +Beachten Sie, daß + +1. die neu eingestellte Seitenlänge immer erst ab der nächsten Seite gilt (die bislang + eingestellte Seitenlänge gilt noch für die aktuelle Seite). + +2. die eingestellte Seitenlänge am Anfang der Datei (also vor der ersten Textzeile) für + die erste Seite gilt. +#mark ("", "")# + +3. der Dezimalpunkt bei der Seitenlänge mit angegeben werden muß. + +Die folgende Tabelle gibt die Seitenlänge für die am häufigsten gewählten Papier­ +größen an: + + #on("b")#Format Seitenlänge oberer und + (in cm) unterer Rand#off("b")# + + DIN A4 25.0 je 2.35 cm + + DIN A5 18.0 je 2.15 cm + + DIN A4 quer 16.0 je 2.50 cm +#page# + +#ib(9)#5.3.3. #ib#Zeilenabstand einstellen#ie##ie(9)# +#goalpage ("linefeed")# +#free(1.0)# + #on("i")# + Mit der #ib#\#linefeed\#-Anweisung#ie# stellen Sie einen #ib#Zeilenvorschub#ie# relativ zu der + #ib#Schrifthöhe#ie# des eingestellten Schrifttyps ein. + #off("i")# +#free(1.0)# +'pageform'/'autopageform' berechnet die Anzahl der Zeilen pro Seite immer in Ab­ +hängigkeit von dem eingestellten Schrifttyp. Haben Sie z.B. eine Schrift gewählt, die +doppelt so hoch wie eine Schreibmaschinenschrift ist, bekommen Sie auch entspre­ +chend weniger Zeilen auf eine Seite. Um diesen Berechnungsvorgang brauchen Sie +sich in der Regel nicht zu kümmern. + +Anders verhält es sich, wenn ein anderer #ib#Zeilenabstand#ie# als der "normale" Abstand +zwischen Zeilen eingestellt werden soll. In diesem Fall wird die \#linefeed\#- +Anweisung eingesetzt. Der Parameter gibt an, um welchen Faktor eine Zeilenhöhe #on("i")##on("b")#ab +der nächsten druckbaren Zeile#off("b")##off("i")# erhöht oder verringert werden soll. + +____________________________________________________________________________ + + \#linefeed (2.0)\# + +____________________________________________________________________________ + + +druckt die folgenden Zeilen mit doppeltem Zeilenabstand. Nach Antreffen dieser An­ +weisung wird die Zeilenhöhe durch 2 * eingestellte Schrifttypgröße errechnet. Es wird +also der Zeilenabstand zwischen den Zeilen entsprechend vergrößert, da die Schrift­ +größe gleich bleibt. Dies entspricht dem zweizeiligen Schreiben bei einer Schreib­ +maschine (wenn man davon absieht, daß auch hier unterschiedliche Schrifthöhen +möglich sind). Ein 1 1/2 zeiliges Schreiben wäre mit + +____________________________________________________________________________ + + \#linefeed (1.5)\# + +____________________________________________________________________________ + + +einzustellen. + +____________________________________________________________________________ + + \#linefeed (0.5)\# + +____________________________________________________________________________ + + +stellt die Zeilenhöhe = 1/2 * eingestellte Schrifthöhe ein, so daß die Zeilen teilweise +ineinander gedruckt werden (was bei manchen Druckern zu nicht lesbaren Resultaten +führt). Bei \#linefeed (0.0)\# werden Zeilen übereinander gedruckt (druckerabhängig). + +Beachten Sie, daß die Angabe in der \#linefeed\#-Anweisung relativ erfolgt. Bei allen +anderen Anweisungen der Textkosmetik werden Angaben in Zentimetern verlangt. Die +\#linefeed\#-Anweisung bildet somit eine Ausnahme. +#page# + +#ib(9)#5.3.4. #ib#Platz freihalten#ie# #ie(9)# +#goalpage ("free")# +#free(1.0)# + #on("i")# + Mit der #ib#\#free\#-Anweisung#ie# können Sie einen zusammenhängenden Teil auf einer + Seite freihalten. + #off("i")# +#free(1.0)# +Die \#free\#-Anweisung setzen Sie an solchen Stellen im Text ein, an denen - nach +dem Druck - Zeichnungen, Tabellen und ähnliches eingeklebt werden sollen. Sie +können sie auch zwischen Absätzen, Kapiteln usw. einsetzen, wenn der Abstand nicht +gleich dem Vielfachen der Zeilenhöhe ist. Es wird der in der \#free\#-Anweisung +angegebene Platz freigehalten. + +____________________________________________________________________________ + +\#free (2.0)\# + +____________________________________________________________________________ + + +hält zwei Zentimeter frei. Paßt der angeforderte Platz nicht mehr auf die Seite, so wird +er auf der nächsten Seite reserviert ('pageform'/'autopageform' plaziert das Seiten­ +ende vor die \#free\#-Anweisung). + + + +#on("i")##on("b")#Praktischer Tip:#off("b")##off("i")# +Sie sollten eine \#free\#-Anweisung allein auf eine Zeile schreiben, damit Sie sie u.U. +durch 'pageform' interaktiv entfernen können, wenn die \#free\#-Anweisung ungünstig +an den Seitenanfang oder das Seitenende kommt. +#page# + +#ib(9)#5.3.5. #ib#Neue Seite beginnen#ie##ie(9)# +#goalpage("page")# +#free(1.0)# + #on("i")# + An einigen Stellen im Text, z.B. zu Beginn eines neuen Kapitels, möchten Sie + unbedingt eine neue Seite anfangen. Dies erreichen Sie mit der #ib#\#page\#- + Anweisung#ie#. + #off("i")# +#free(1.0)# +'pageform' meldet in diesem Fall, nach wie vielen Zentimetern auf der Seite die An­ +weisung angetroffen wurde. Sie können nun mit das Seitenende bestätigen oder +die Anweisung (in der Druckdatei) löschen. Im letzteren Fall berechnet 'pageform' die +Seite neu, als ob die \#page\#-Anweisung nicht dagewesen wäre. + +Gleichzeitig können Sie mit Hilfe der #ib#\#page\#-Anweisung#ie(1, ", mit neuer Seitenummer")# eine neue Seitennummer +für die neue Seite einstellen (vergl. Sie dazu die nächsten Abschnitte). +#page# + +#ib(9)#5.3.6. #ib#Kopf- und Fußzeilen#ie##ie(9)# +#goalpage("head")##goalpage("bottom")# +#free(1.0)# + #on("i")# + Mit den #ib#\#head\#-#ie(1, "Anweisung")# und #ib#\#bottom\#-Anweisung#ie#en können Sie Zeilen am Anfang und + Ende jeder Seite einfügen. + #off("i")# +#free(1.0)# +Sie schreiben Zeilen am Anfang ("#ib#Kopfzeilen#ie#") und Ende ("#ib#Fußzeilen#ie#") jeder Seite nur +einmal und kennzeichnen sie mit Anweisungen. Diese Zeilen fügt 'pageform'/­ +'autopageform' dann an den entsprechenden Stellen ein. + +____________________________________________________________________________ + + \#head\# + Unser EUMEL-Benutzerhandbuch + + \#end\# + +____________________________________________________________________________ + + +Diese Zeile (also die zwischen den \#head\#- und #ib#\#end\#-Anweisung#ie#en eingeschlos­ +sene Zeile) wird von 'pageform'/'autopageform' an den Anfang jeder Seite in die +Druckdatei plaziert. + +Entsprechendes gilt für Fußzeilen, die zwischen \#bottom\# und \#end\# eingeschlossen +werden müssen: + +____________________________________________________________________________ + + \#bottom\# + + Autor: I. Listig + \#end\# + +____________________________________________________________________________ + + +#on("b")#Praktischer Tip#off("b")#: + +Fügen Sie mindestens eine Leerzeile am Ende eines \#head\# bzw. am Anfang eines +\#bottom\# ein, um den eigentlichen Text von den Kopf- bzw. Fußzeilen abzuheben. + + +'pageform'/'autopageform' zählt die Seiten, beginnend mit der Seitennummer '1'. (Wie +man Seitennummern in die Kopf- und Fußzeilen bekommt, erfahren Sie im nächsten +Abschnitt). Sie können nun getrennte Kopf- und Fußzeilen für gerade und ungerade +Seiten gestalten (wie in diesem Benutzerhandbuch). Dies erfolgt mit den Anweisungen +\#headeven\# und \#headodd\# für Seiten mit geraden und ungeraden Seitennummern; +ebenso \#bottomeven\# und \#bottomodd\#. Diese Anweisungen müssen ebenfalls jeweils +mit einer \#end\#-Anweisung beendet werden. + +Sie haben die Möglichkeit, Kopf- und Fußzeilen mehrmals innerhalb einer Datei zu +wechseln, um unterschiedliche Beschriftungen zu erhalten (z.B. kapitelweise). Dies ist +jedoch nur sinnvoll, wenn es auf einer neuen Seite erfolgt, also unmittelbar #on("b")##on("is")#nach#off("b")##off("is")# einer +\#page\#-Anweisung. + +____________________________________________________________________________ + + \#page\# + \#head\# + Neuer Seitenkopf + + \#end\# + +____________________________________________________________________________ + + +Kopf- und Fußzeilen sollen überall gleiches Aussehen haben, unabhängig davon, +welche Anweisungen im restlichen Text gegeben werden. Darum werden die bei der +Definition einer Kopf- und Fußzeile aktuellen Werte für + + + limit + type + linefeed + + +bei dem Einsetzen der Zeilen berücksichtigt. Für Kopf- oder Fußzeilen können Sie +einen anderen Schrifttyp als im restlichen Text verwenden, indem Sie die \#type\#- +Anweisung innerhalb eines \#head\#- oder \#bottom\#-Bereiches geben. Beachten Sie, +daß nach \#head\#-, \#bottom\# und auch \#foot\#-Bereichen die oben genannten An­ +weisungen nicht automatisch zurückgestellt werden. Darum sollten Sie vor der +\#end\#-Anweisung wieder auf die im übrigen Text verwendeten Werte zurückstellen. + +____________________________________________________________________________ + + \#bottom\# + \#type ("klein")\# + Autor: I. Listig + (Schrifttyp + zurückstellen): + \#type ("normal")\# + \#end\# + +____________________________________________________________________________ + + +#page# + +#ib(9)#5.3.7. #ib#Seiten numerieren#ie##ie(9)# +#free(1.0)# + #on("i")# + In den Kopf- und Fußzeilen steht das #ib#'%'-Zeichen#ie# für die aktuelle Seiten­ + nummer. + #off("i")# +#free(1.0)# +Erscheint das '%'-Zeichen innerhalb eines Kopf- oder Fußbereiches, wird von +'pageform'/'autopageform' beim Einsetzen dieser Zeilen auf jeder Seite die aktuelle +#ib#Seitennummer#ie# eingesetzt (sind mehrere '%'-Zeichen vorhanden, wird die Seiten­ +nummer mehrmals eingesetzt). + +____________________________________________________________________________ + + \#head\# + Seite: - % - + + \#end\# + +____________________________________________________________________________ + + +Wenn Sie die Seitenzahl in der Zeilenmitte oder am rechten Rand plazieren möchten, +können Sie die Anweisungen \#center\# (siehe S. 5-93) oder \#right\# (siehe S. 5-94) +verwenden. + +Durch das Einrichten eines Fußbereiches können Sie die Seitennummern auch am +unteren Ende einer Seite erzeugen. Beachten Sie, daß sich bei mehrstelligen Seiten­ +nummern die Zeilenlänge durch das Einsetzen vergrößert. + +Um zum Beispiel das #ib#Vorhandensein einer Folgeseite#ie# in einem Fußbereich zu kenn­ +zeichnen, müssen Sie das '%'-Zeichen zweimal direkt hintereinander schreiben. + +____________________________________________________________________________ + + \#bottom\# + + \#right\# %% + \#end\# + +____________________________________________________________________________ + + +In dem Beispiel oben wird die Seitenzahl rechtsbündig gedruckt. + + +Manchmal ist es notwendig und sinnvoll, einen Text in mehreren Dateien zu halten. +Bei einer Folgedatei müssen Sie die Seitennummer dann neu setzen. Das erfolgt mit +der \#pagenr\#- oder der \#page\#-Anweisung. + +____________________________________________________________________________ + + \#page (4)\# + +____________________________________________________________________________ + + +bewirkt eine neue Seite. Die Seitennummer der neuen Seite ist '4'. + +#goalpage("pagenr")# + +Bei einigen Spezialanwendungen benötigen Sie unter Umständen mehr als eine +Seitennummer. Beispielsweise soll ein Text nicht nur absolut, sondern auch jede Seite +in jedem Kapitel separat durchgezählt werden. + +____________________________________________________________________________ + + \#page (4711)\# + \#pagenr ("$", 1)\# + \#head\# + Mein Buch Seite: % Kapitelseite: $ + + \#end\# + +____________________________________________________________________________ + + +Die Anweisung #ib#\#pagenr#ie# ("$",1)\# veranlaßt, daß ab der nächsten Seite eine neue +Numerierung durchgeführt wird. Dabei steht '$' stellvertretend für die neue Zahl. Die +'1' bedeutet, daß bei der Numerierung mit '1' begonnen wird. 'pageform'/­ +'autopageform' erhöht bei jeder neuen Seite das Zeichen um '1' und setzt es ggf. in +die Kopf- und Fußzeilen. Es sind zwei zusätzliche Seitenzeichen (neben dem '%') +möglich. + +Beachten Sie, daß die neuen Seitennummern immer erst ab der nächsten Seite gel­ +ten. Geben Sie die \#page (...)\#- oder die \#pagenr (...,...)\#-Anweisung am Anfang +der Datei (also vor der ersten Textzeile), gelten die neuen Seitennummern für die +erste Seite. +#page# + +#ib(9)#5.3.8. #ib#Fußnoten#ie# schreiben#ie(9)# +#goalpage("foot")# +#free(1.0)# + #on("i")# + Fußnoten werden direkt im Text durch die Anweisungen \#foot\# und \#end\# + gekennzeichnet. Die Fußnoten plaziert 'pageform'/'autopageform' an das Ende + einer Seite. + #off("i")# +#free(1.0)# +#ib#Fußnoten#ie# schreiben Sie direkt in den Text, am besten an der Stelle, an der später die +Fußnote aufgerufen werden soll. Die Fußnote wird von 'pageform'/'autopageform' an +das Ende einer Seite, ggf. vor die Fußzeilen, plaziert. Für die Kennzeichnung von +Fußnoten und die entsprechende Markierung im Text sind Sie selbst zuständig. Aller­ +dings werden von 'pageform'/'autopageform' bei dem Einsetzen einer Fußnote am +Ende einer Seite Unterstriche vor die Fußnoten eingefügt, damit Fußnoten vom lau­ +fenden Text abgehoben werden. + +____________________________________________________________________________ + + \#foot\# + *) Das ist die erste Anmerkung auf dieser Seite. + \#end\# + +____________________________________________________________________________ + + +Druckbild: + +______ +*) Das ist die erste Anmerkung auf dieser Seite. + + +Mehrere Fußnoten innerhalb einer Seite werden von 'pageform'/'autopageform' in der +Reihenfolge ihres Auftretens gesammelt und am Ende der Seite plaziert. Für eine +entsprechende Trennung der Fußnoten voneinander (z.B. durch Leerzeilen) müssen +Sie selbst sorgen. + +Unter Umständen paßt die Fußnote nicht mehr auf die aktuelle Seite und muß deshalb +von 'pageform'/'autopageform' auf die nächste Seite gebracht werden. 'pageform'/­ +'autopageform' geht davon aus, daß die Kennzeichnung der Fußnote in der Zeile +unmittelbar vor der Fußnote steht und bringt diese Zeile ebenfalls auf die neue Seite. + +____________________________________________________________________________ + +Es ist auch möglich, eine Fußnote innerhalb eines Abschnitts zu +schreiben, wie z.B. in dieser Zeile\#u\#*)\#e\#.\#foot\# +\#u\#*)\#e\# Fußnote in einem Abschnitt! +\#end\# +Sie fahren anschließend ohne Unterbrechung mit dem Schreiben +Ihres Textes fort. + +____________________________________________________________________________ + + +Druckbild (nach lineform): + +Es ist auch möglich, eine Fußnote innerhalb eines Abschnitts zu schreiben, wie z.B. +in dieser Zeile#u#*)#e#. Sie fahren anschließend ohne Unterbrechung mit dem Schreiben#foot# +#u#*)#e# Fußnote in einem Abschnitt! +#end# +Ihres Textes fort. + + +In diesem Fall ist es wünschenswert, daß 'lineform' die Zeile, die \#foot\# vorausgeht, +mit der Zeile, die \#end\# folgt, auffüllt. Dies geschieht unter folgenden Bedingungen: + +1. Hinter \#foot\# darf nichts mehr stehen, also auch kein Absatzzeichen. + +2. Es werden so lange Worte von der Zeile nach \#end\# vor die \#foot\#-Anweisung + plaziert, bis die Zeile gefüllt oder die Zeile nach \#end\# leergeräumt ist. + +3. Beachten Sie, daß Textkosmetik-Anweisungen ebenfalls mit über die Fußnote + genommen werden. Handelt es sich beispielsweise um eine \#type\#-Anweisung, + kann sich das Aussehen der Fußnote verändern! Darum ist es angeraten, even­ + tuelle Anweisungen, die die Fußnote verändern sollen, innerhalb der Fußnote zu + plazieren. + +Sie sollten vermeiden, umfangreiche Texte in Fußnoten zu schreiben (beispielsweise +längere Zitate). Aus programmtechnischen Gründen begrenzt 'pageform'/'autopage­ +form' die maximale Länge von Fußnoten auf einer Seite auf 85% des effektiven +Schreibfeldes (effektives Schreibfeld: Seitenlänge minus Länge von \#head\#- bzw. +\#bottom\#-Zeilen). Nimmt eine Fußnote einen größeren Raum ein, bricht 'pageform'/ +'autopageform' die Seitenformatierung mit einer Fehlermeldung ab. +#page# + +#ib(9)#5.3.8.1. #ib#Fußnoten numerieren#ie##ie(9)# +#goalpage("count")##goalpage("value")# +#free(1.0)# + #on("i")# + Gleichartige Textteile wie Lehrsätze, Beispiele, Fußnoten usw. werden i. allg. + durchnumeriert. Da Sie bei der Abfassung eines längeren Textes ihre genaue + Anzahl meist nicht vorausplanen können, übernimmt 'pageform'/'autopageform' die + Zählung. + #off("i")# +#free(1.0)# +Durch die #ib#\#count\#-Anweisung#ie# wird 'pageform'/'autopageform' veranlaßt, einen +internen Zähler (beginnend bei dem Wert 0) zu erhöhen und diesen Wert statt der +\#count\#-Anweisungen in den Text einzusetzen. + +____________________________________________________________________________ + + \#count\# + +____________________________________________________________________________ + + +setzt den Wert 1 statt der Anweisung ein. Jede weitere \#count\#-Anweisung erhöht +den internen Zähler und der Zählerwert wird wiederum eingesetzt: + +____________________________________________________________________________ + + \#count\# + +____________________________________________________________________________ + + +setzt den Wert 2 ein usw. Dadurch ist es möglich, beliebige Textteile (Kapitel, +mathematische Sätze u.a.m.) fortlaufend zu numerieren, ohne auf die Numerierung +beim Schreiben und Ändern des Textes zu achten. + +Anmerkung: +Trifft 'lineform' auf eine \#count\#-Anweisung, so wird die Zeile berechnet, als ob drei +Ziffern anstatt der Anweisung im Text ständen. + +Mit der \#value\#-Anweisung können Sie den #on("b")##on("i")#letzten#off("i")##off("b")# erreichten count-Wert nochmals +einsetzen. Das ist insbesondere für Fußnoten sinnvoll einsetzbar. + +____________________________________________________________________________ + + Text ....... (\#count\#) + \#foot\# + (\#value\#) Text der Fußnote + \#end\# + Text ....... + +____________________________________________________________________________ + + +Das Resultat sähe folgendermaßen aus: + + Text ....... (3) + Text ....... + ............... + ______ + (3) Text der Fußnote + +Beachten Sie, daß in diesem Fall die \#value\#-Anweisung der \#count\#-Anweisung +folgen muß, ohne daß eine weitere \#count\#-Anweisung dazwischen steht. Das liegt +- wie bereits oben erwähnt - daran, daß die \#value\#-Anweisung immer den letzten +\#count\#-Wert einsetzt. + +Das können Sie umgehen, indem Sie die \#count\#- und \#value\#-Anweisungen mit +einem TEXT-Parameter versehen, der als Kennzeichnung dient. + +____________________________________________________________________________ + + \#count ("Merk1")\# + +____________________________________________________________________________ + + +\#count ("Merk1")\# arbeitet ebenso wie \#count\# ohne Parameter und setzt für unser +Kapitel hier den Wert 4 ein. Zusätzlich zu dem fortlaufend gezählten Wert (fortlau­ +fende Numerierung der Fußnoten) vermerkt 'pageform'/'autopageform' einen Wert, der +bei Bedarf an irgendeiner anderen Stelle im Text durch \#value ("Merk1")\# wieder +aufgerufen werden kann, zum Beispiel, wenn Sie auf eine andere Fußnote verweisen +möchten. + +____________________________________________________________________________ + + \#count\#\#count\# + \#value("Merk1")\# + +____________________________________________________________________________ + + +Die ersten zwei \#count\#-Anweisungen produzieren - in unserem Kapitel - die +Werte 5 bzw. 6. Die \#value\#-Anweisung dagegen setzt den vermerkten Wert 4 ein. + +Dies ist insbesondere sinnvoll, wenn Sie im Text auf eine Fußnote verweisen möch­ +ten. + +Beispiel: + +Sie schreiben einen mehrseitigen Prospekt über ein neues Produkt. Auf Seite 5 möch­ +ten Sie auf eine Fußnote verweisen, die auf einer anderen Seite steht. Dann fügen Sie +'siehe auch Anmerkung (\#value("liefertermin")\#) in Ihren Text ein und fahren mit dem +Schreiben fort. 'pageform'/'autopageform' setzt später die entsprechende Zahl für den +Verweis ein. + +Auf der Seite, auf die Sie Bezug nehmen, sieht das ganze folgendermaßen aus: + +____________________________________________________________________________ + + Der Textverarbeitungskurs ist ein Lernprogramm für Anfänger. + \#(count)("Liefertermin")\#) + \#foot\# + (\#(value)("Liefertermin")\#) + Der Textverarbeitungskurs wird ab August erhältlich sein. + \#end\# + Das Programm ist auf den neuesten Erkenntnissen der Lehr­ + forschung aufgebaut. Der Kurs umfaßt Lehrbuch, Arbeitsbuch und + sechs Kassetten. + +____________________________________________________________________________ + + +#page# +Soll die Zahl für den Verweis bzw. für die Fußnote hochgestellt werden, fügen Sie die +Anweisungen \#u\# und \#e\# hinzu. + +____________________________________________________________________________ + + \#u\# (\#value("Liefertermin")\#)\#e\# + +____________________________________________________________________________ + + + + +Im gedruckten Prospekt sähe es (nach 'lineform') wie folgt aus: + +Der Textverarbeitungskurs ist ein Lernprogramm für Anfänger#u##count#)#e#.#foot# +#u##value#)#e#Der Textverarbeitungskurs wird ab August erhältlich sein. +#end# +Das Programm ist auf den neuesten Erkenntnissen der Lehrforschung aufgebaut. Der +Kurs umfaßt Lehrbuch, Arbeitsbuch und sechs Kassetten. + +Manchmal ist es notwendig (ebenso wie bei der Seitennummer), den internen Zähler +neu zu setzen. + +____________________________________________________________________________ + + \#setcount (13)\#\#count\# + +____________________________________________________________________________ +#goalpage("setcount")# + +produziert den Wert 13. +#page# + +#ib(9)#5.3.9. #ib#Querverweise#ie# #ie(9)# +#goalpage("topage")##goalpage("goalpage")# +#free(1.0)# + #on("i")# + Mit den Anweisungen #ib#\#topage\##ie(1,"-Anweisung")# und #ib#\#goalpage\##ie(1,"-Anweisung")# sind Querverweise möglich, die + von 'pageform'/'autopageform' in die Druckdatei eingefügt werden. + #off("i")# +#free(1.0)# +Mit Hilfe von Querverweisen soll auf andere Stellen im Text verwiesen werden, was +nur bei längeren Texten üblich ist. Um dem Leser die mühselige Suche nach der +Textstelle zu ersparen, gibt man in der Regel die Seitennummer an. Normalerweise +steht die Seitennummer vor der Fertigstellung des Textes noch nicht fest. Auch in +diesem Fall kann 'pageform'/'autopageform' helfen. Die \#topage\#-Anweisung ver­ +weist auf eine andere Seite im Text, an der sich eine Anweisung \#goalpage\# befinden +muß. Statt der Anweisung \#topage\# wird die Seitennummer der Seite eingesetzt, auf +der sich \#goalpage\# befindet. Damit jedes \#topage\# auch sein entsprechendes \#goal­ +page\# findet, geben Sie bei beiden Anweisungen einen TEXT-Parameter an. + + +____________________________________________________________________________ + + ... siehe auch auf Seite \#topage("Funktionstasten")\# ... + + +____________________________________________________________________________ + + +Auf einer anderen Seite befindet sich + +____________________________________________________________________________ + + ... \#goalpage("Funktionstasten")\# + +____________________________________________________________________________ + + +Nach 'Seite' wird die entsprechende Seitennummer eingesetzt. + +Es ist möglich, mehrmals auf die gleiche (Ziel-)Seite zu verweisen. Sie müssen nur +darauf achten, daß Sie immer das gleiche Merkmal (TEXT-Parameter) verwenden. +Beachten Sie auch, daß die \#goalpage\#-Anweisungen sich in den Zeilen befinden +müssen, die tatsächlich gedruckt werden. Setzen Sie sie nicht in die ersten Zeilen +einer Seite oder eines Textes, die Anweisungen für das Layout enthalten. + +Die Zahl der Querverweise darf 300 nicht übersteigen. #page# + +#ib(9)#5.3.10. Kombination von Tabellen, Fußnoten + und Kopf- bzw. Fußzeilen#ie(9)# +#free(1.0)# + #on("i")# + In Fußnoten, \#head\#- oder \#bottom\#-Bereichen können Tabellen untergebracht + werden. + #off("i")# +#free(1.0)# +____________________________________________________________________________ + +\#head\# +\#lpos(0.0)\#\#cpos(5.0)\#\#rpos(11.0)\# +\#table\# +Korrekturen EUMEL-Benutzerhandbuch S.007 + +\#table end\# +\#end\# + + +____________________________________________________________________________ + + + +Die obigen Eingaben schreiben an jeden Seitenanfang folgenden Text: + +#lpos(0.0)##cpos(5.0)##rpos(11.0)# +#table# +Korrekturen EUMEL-Benutzerhandbuch S.007 +#table end##clear pos# + +Die Tabelle sollte also vollständig in den oben erwähnten Bereichen enthalten sein. +#page# + +#ib(9)#5.3.11. #ib#Formatierung von Spalten#ie##ie(9)# +#goalpage("columns")# +#free(1.0)# + #on("i")# + Mit der \#columns\#-Anweisung ist es möglich, einen Text in #ib#Spalten#ie(1,"formatierung")# zu formatie­ + ren ("Zeitungsdruck"). + #off("i")# +#free(1.0)# +Durch die Angabe der \#columns\#-Anweisung wird 'pageform'/'autopageform' auf­ +gefordert, den Text in Spalten zu formatieren. Die Spaltenbreite müssen Sie mit der #ib# +\#limit\#-Anweisung#ie (1, " für Spalten")# einstellen. + +____________________________________________________________________________ + + \#limit (18.0)\# + ... + \#columns (2, 2.0)\# + \#limit (8.0)\# + ... + +____________________________________________________________________________ + + + +Anfangs schreiben Sie mit einer Zeilenbreite von 18 cm. Dann fordern Sie mit der +\#columns\#-Anweisung zweispaltigen Druck an (zwischen den Spalten sollen 2 cm +Abstand sein). Somit muß die \#limit\#-Anweisung (sie gilt für beide Spalten) auf 8 cm +eingestellt werden. + +Die interaktive #ib#Spaltenformatierung#ie# wird von 'pageform' wie gewohnt vorgenommen. +Auf dem Bildschirm erscheint nun das Spaltenende, wobei die Nummer der Spalte +angezeigt wird. Fußnoten werden spaltenweise eingeordnet und müssen somit die +gleiche Zeilenbreite haben wie die restlichen Spalten. + +'pageform'/'autopageform' erzeugt in der Druckdatei die Spalten hintereinander. Das +folgende Beispiel zeigt einen Ausschnitt aus der Druckdatei mit Kopf- und Fußzeilen +bei einem zweispaltigen Druck: + +____________________________________________________________________________ + + head-Zeilen + xx + xx + xx + bottom-Zeilen + \#page\#\#------- Ende Seite 1 Spalte 1 ----\# + xx + xx + xx + \#page\#\#------- Ende Seite 1 Spalte 2 ----\# + +____________________________________________________________________________ + + +Die zweite Spalte erscheint also ohne Kopf- und Fußzeilen, die jedoch bei der +Berechnung berücksichtigt werden. Beachten Sie, daß die Kopf- und Fußzeilen über +die Spalten gehen können. Dies erreichen Sie durch geeignete \#limit\#-Anweisungen +in den genannten Bereichen. + +Die meisten Drucker plazieren die zweite Spalte im Druckbild neben die erste. Bei +einigen wenigen Druckern müssen Sie die Spalten nebeneinander kleben. + +Alle Anweisungen funktionieren beim spaltenweisen Formatieren wie üblich. Die +\#free\#-Anweisung z.B. hält entsprechenden Platz in einer Spalte frei. Eine Aus­ +nahme bildet die #ib#\#page\#-Anweisung#ie (1, " für Spaltenende")#. Sie vollzieht hier ein #ib#Spaltenende#ie#. Die +\#page\#-Anweisung mit einem Parameter (welcher die Seitennummer der nächsten +Seite angibt) vollzieht dagegen ein Seitenende. + +Die #ib#\#columns end\#-Anweisung#ie# beendet die spaltenweise #ib#Formatierung#ie(1, " spaltenweise")#. Sie wirkt wie +eine \#page\#-Anweisung. + +#ib#Überschriften#ie (1, " in Spalten")# (bzw. Textblöcke) über mehrere Spalten hinweg sind nur auf der ersten +Seite direkt hinter der \#columns\#-Anweisung möglich. + +____________________________________________________________________________ + + \#page\# + \#limit (10.0)\# + Überschriften (bzw. Textblöcke) über mehrere Spalten hinweg + sind nur auf der ersten Seite direkt hinter der \#columns\#- + Anweisung möglich. + + + \#columns (2,2.0)\# + \#limit (4.0)\# + Die erste Spalte soll nur wenige Zeilen beinhalten. Das vor­ + zeitige Beendigen der Spalte erreicht man mit der \#page\#- + Anweisung. + \#page\# + In der zweiten Spalte kann dann mit dem Schreiben des Textes + fortgefahren werden. + ..................... + ..................... + ..................... + ..................... + ..................... + \#columns end\# + +____________________________________________________________________________ + + +#page# +Druckbild (mit 'lineform' bearbeitet): + + + + Überschriften (bzw. Textblöcke) über mehrere Spalten hinweg sind nur auf + der ersten Seite direkt hinter der \#columns\#-Anweisung möglich. + #columns (2,2.0)# + + Die erste Spalte soll nur + wenige Zeilen beinhalten. + Das vorzeitige Beendigen + der Spalte erreicht man mit + der \#page\#-Anweisung. + #page# + + + In der zweiten Spalte kann + dann mit dem Schreiben + des Textes fortgefahren + werden. + ..................... + ..................... + ..................... + +#columns end# + + + + +Die Zeilen für die zweispaltige Überschrift werden berücksichtigt. Dies gilt jedoch nur +unmittelbar hinter der \#columns\#-Anweisung. Möchten Sie diesen Effekt nochmals +erzeugen, beenden Sie mit \#columns end\#, schreiben die breite Überschrift und +schalten die \#columns\#-Anweisung wieder ein (jeweils unter richtiger Setzung von +\#limit\#). +#page# + +#ib(9)#5.4. #ib#Index#ie##ie(9)# +#free(1.0)# +#ib(9)#5.4.1. Stichwort- und/oder#ib# + Inhaltsverzeichnis#ie#se erstellen#ie(9)# +#free(1.0)# + + #on("i")# + Mit dem Programm '#ib#index#ie(1, "-Kommando")#' können Sie Stichwort- und Inhaltsverzeichnisse er­ + stellen. #ib#Stichwortverzeichnis#ie#se können sortiert werden. Mehrere Stichwortverzeich­ + nisse können Sie durch 'index merge' zusammenführen. + #off("i")# +#free(1.0)# +Durch den Aufruf von: + +____________________________________________________________________________ + + gib kommando: + index ("dateiname.p") + +____________________________________________________________________________ + + + +werden durch #ib#Indexanweisungen#ie# gekennzeichnete Worte in Dateien, den sogenannten +Indexdateien, gespeichert. + +Die Worte, die in einen Index übernommen werden sollen, müssen Sie in der Druck­ +datei für 'index' durch Anweisungen kennzeichnen. Solche #ib(1,"ff")#Indexanweisungen#ie# werden +von den anderen Textbe- und -verarbeitungs-Programmen ('lineform', 'pageform', +EUMEL-Drucker) ignoriert. Sie können also bei dem Schreiben mit dem Editor +gleich festlegen, welche Worte in einen Index aufgenommen werden sollen. + +Solche Verzeichnisse von Worten werden im EUMEL-System allgemein als #ib#Index#ie# +bezeichnet. 'index' kann ebenfalls benutzt werden, um ein #ib#Inhaltsverzeichnis#ie# und/oder +ein Verzeichnis aller Abbildungen zu erstellen oder Literaturhinweise zu überprüfen. + +Nachdem eine oder mehrere Indexdateien aus einer Druckdatei erstellt sind, werden +die Indexdateien auf Anfrage alphabetisch sortiert. Bei einem Inhaltsverzeichnis sollten +Sie die Sortierung natürlich ablehnen. Nach der Sortierung werden gleiche Einträge +automatisch zusammengefaßt und die entsprechenden Seitennummern nacheinander +aufgeführt. + + + +#on("b")##on("i")#Praktischer Tip:#off("b")##off("i")# +Möchten Sie nur eine Sortierung, aber keine Zusammenfassung von Einträgen, dann +lehnen Sie die Sortieranfrage ab. Anschließend können Sie die Indexdatei mit '#ib#lex sort#ie# +("indexdateiname")' sortieren. Hierbei bleiben gleiche Einträge erhalten. + + + +Das Programm + +____________________________________________________________________________ + + gib kommando: + index merge ("dateiname.i1", "dateiname.i2") + +____________________________________________________________________________ + + + +erlaubt es Ihnen, zwei durch 'index' erzeugte Verzeichnisse zusammenzuführen und +- nach Anfrage - wieder zu sortieren. +#page# + +#ib(9)#5.4.1.1. #ib#Worte für 'index' kennzeichnen#ie##ie(9)# #goalpage ("ib")##goalpage("ie")# +#free(1.0)# + #on("i")# + Worte, die in einen Index übernommen werden sollen, kennzeichnen Sie mit \#ib\# + und \#ie\#. + #off("i")# +#free(1.0)# +Da in einem Index - neben dem eigentlichen Worteintrag - die #ib#Seitennummer#ie# +enthalten sein soll, arbeitet das Programm 'index' nur mit einer #ib#Druckdatei#ie#, d.h. einer +Ausgabedatei von 'pageform'/'autopageform'. Die Indexworte werden in #ib#Indexdateien#ie# +gesammelt. Die Indexdateien erhalten den Namen der bearbeiteten Datei, an den ".i" +und die Nummer des Index angefügt wird. + +____________________________________________________________________________ + + ... Hier wird eine Eigenschaft des \#ib(1)\#EUMEL- + Systems\#ie(1)\# beschrieben. ... + +____________________________________________________________________________ + + +Die durch die Anweisungen #ib#\#ib\##ie(1,"-Anweisung")# und #ib#\#ie\##ie(1,"-Anweisung")# gekennzeichneten Worte werden mit der +dazugehörigen Seitennummer in die erste Indexdatei geschrieben. + +Die Einträge in einer Indexdatei werden von den Seitennummern durch mindestens +drei Punkte getrennt. Werden diese nicht gewünscht, können Sie sie leicht mit dem +Editor entfernen. + + +Sie haben die Möglichkeit, bis zu neun unterschiedliche Indexdateien zu erstellen, +z.B. gehen durch + +____________________________________________________________________________ + + \#ib (1)\# und \#ie (1)\# + +____________________________________________________________________________ + + +gekennzeichnete Worte in die Indexdatei mit der Nummer 1, durch + +____________________________________________________________________________ + + \#ib (9)\# und \#ie (9)\# + +____________________________________________________________________________ + + +gekennzeichnete Worte gehen in die Indexdatei mit der Nummer 9. Wenn Sie nur +einen Index erstellen müssen, dürfen die \#ib\#- und \#ie\#-Anweisungen ohne Para­ +meter benutzt werden, was gleichbedeutend ist mit \#ib (1)\# und \#ie (1)\#. + + + +Die durch \#ib\#- und \#ie\#-Anweisungen gekennzeichneten Worte können auch über +Zeilengrenzen (mit Silbentrennungen) gehen. + +____________________________________________________________________________ + + .... \#ib\#viele Index­ + Anweisungen\#ie\# ... + +____________________________________________________________________________ + + +'index' zieht getrennte Worte zusammen (hier: 'viele Index-Anweisungen'). Möchten +Sie einige Worte in verschiedenen Indexdateien haben, dürfen Sie die \#ib\#- und +\#ie\#-Anweisungen auch "schachteln". Dies können Sie besonders bei Kapitelüber­ +schriften nutzen. + + + +____________________________________________________________________________ + + \#ib(9)\#Eine Anweisung: die '\#ib\#limit\#ie\#'-Anweisung\#ie(9)\# + +____________________________________________________________________________ + + +In diesem Beispiel wird das Inhaltsverzeichnis in die Indexdatei '9' gebracht, während +der "allgemeine" Index in der Indexdatei '1' gesammelt wird. +#page# + +#ib(9)#5.4.1.2. #ib#Nebeneinträge erzeugen#ie##ie(9)# + +#free(1.0)# + #on("i")# + Sie haben die Möglichkeit, an die Seitennummer eines Eintrags einen beliebigen + Text anfügen zu lassen. + #off("i")# #free(1.0)# +Beispiel: + + + EUMEL-System ... 27ff. + Monitor ........ 13(Def.) + + + + + +Dies wird durch eine weitere Form der \#ib\#-Anweisung ermöglicht: + +____________________________________________________________________________ + + ... der \#ib(1,"(Kap.4)")\#EUMEL-Editor\#ie\# ist gut + geeignet, Texte zu erstellen ... + +____________________________________________________________________________ + + + +erzeugt den folgenden Eintrag: + + + +Druckbild: + + EUMEL-Editor ... 1(Kap.4) + + +An einen Eintrag können Sie einen weiteren Text angefügen, um etwa Untereinträge +zu bilden: + +Druckbild: + + EUMEL-System .................................. 27 + + EUMEL-System, komplexes ....................... 29 + + +Das wird ebenfalls durch eine andere Form der \#ib\#-Anweisung ermöglicht: + +____________________________________________________________________________ + + ... ist das \#ib\#EUMEL-System\#ie(1,", benutzerfreundliches")\# + wirklich ein benutzerfreundliches System ... + +____________________________________________________________________________ + + +erzeugt den folgenden Eintrag: + +Druckbild: + + EUMEL-System, benutzerfreundliches ............ 28 + + + +Nach der Erstellung einer Indexdatei können - nach interaktiver Anfrage - die +Einträge sortiert werden. Die Sortierung erfolgt alphabetisch nach DIN 5007, Abschnitt +1 und 3.2 (Umlaute werden "richtig" eingeordnet). + + + +Wie bereits erwähnt, können Sie 'index' vielseitig einsetzen: + +a) Erstellung von Stichwortverzeichnissen: + Wie bereits beschrieben. + +b) Erstellung von Inhaltsverzeichnissen: + Kapitelüberschriften mit eigenen Indexanweisungen klammern und durch 'index' + wie beschrieben verarbeiten. + + ____________________________________________________________________________ + + \#ib(9)\#6.1. Eine Datei drucken\#ie(9)\# + + _________________________________________________________________________ + + + Dann sind Sie sicher, daß das Inhaltsverzeichnis bezüglich Seitennummern und + Kapitelüberschriften korrekt ist. + +c) Erstellung von #ib#Abbildungsverzeichnisse#ie#n: + Abbildungsüberschriften- bzw. -unterschriften wie Kapitelüberschriften verarbei­ + ten. + +d) Überprüfung von Literaturhinweisen auf Vollständigkeit: + Sie klammern alle Literaturhinweise mit gesonderten Indexanweisungen. + + ____________________________________________________________________________ + + \#ib(8)\#/Meier82/\#ie(8)\#) + + _________________________________________________________________________ + + und überprüfen dann mit Hilfe dieser Indexdatei die Literaturverweise. So können + Sie sichergehen, daß alle Literaturverweise im Text auch in der Literaturaufstellung + stehen. +#page# + +#ib(9)#5.4.1.3. #ib#Indexdateien zusammenführen#ie##ie(9)# +#free(1.0)# + #on("i")# + Durch das Programm '#ib#index merge#ie(1,"-Kommando")#' können Sie eine Indexdatei in eine zweite + "einmischen". + #off("i")# +#free(1.0)# +Es ist somit möglich, einen Index zu erstellen, der sich über mehrere Dateien er­ +streckt, indem Sie 'index' die Druckdateien dieser Dateien bearbeiten und an­ +schließend die entstandenen Indexdateien mit 'index merge' zusammenfassen lassen. +Indexdateien können ggf. mit dem Editor bzw. 'lineform' und/oder 'pageform'/­ +'autopageform' bearbeitet und anschließend gedruckt werden. + + +____________________________________________________________________________ + + gib kommando: + index merge ("1.kapitel.i1", "2.kapitel.i1") + +____________________________________________________________________________ + + + + +Hier wird die Indexdatei des 1. Kapitels in die Indexdatei des 2. Kapitels eingeordnet +und auf Wunsch sortiert. +#page# + +#ib(9)#5.5. #ib#Outline#ie##ie(9)# +#goalpage("outline")# +#free(1.0)# +#ib(9)#5.5.1. Eine#ib# Strukturübersicht#ie# oder + #ib#Zusammenfassung#ie# erstellen#ie(9)# +#free(1.0)# + #on("i")# + Das Programm 'outline' erstellt aus einem Text eine Zusammenfassung aller + (Kapitel-) Überschriften und Stichworte, sofern diese mit #ib#Index-Anweisungen#ie# + gekennzeichnet sind. + #off("i")# +#free(1.0)# +Manchmal sollen Stichworte oder das Inhaltsverzeichnis aus einem Text herausgeholt +werden, ohne vorher 'pageform' durchlaufen zu müssen. Das ist dann nützlich, wenn +Sie + +- Stichworte auf Korrektheit und Vollständigkeit überprüfen möchten; +- die Reihenfolge von Kapiteln überprüfen müssen; +- eine Übersicht durch Kapitel-Überschriften und Stichworte anfertigen möchten; +- einen Text auf logische Zusammenstellung überprüfen. + + +In solchen Fällen hilft das Programm 'outline', das mit dem Monitor-Kommando + +____________________________________________________________________________ + + gib kommando: + outline ("dateiname") + +____________________________________________________________________________ + + + +aufgerufen wird. 'outline' arbeitet ähnlich wie 'index', indem es alle mit \#ib\# und \#ie\# +markierten Textteile in eine Datei mit dem Zusatz 'outline' schreibt. Im Unterschied zu +'index' muß die Eingabe-Datei keine Druckdatei ('.p'-Zusatz) sein. + +Das Programm 'outline' fragt zuerst, mit welcher Indexnummer das Inhaltsverzeichnis +versehen ist. Das ist notwendig, weil die Kapitelüberschriften gegenüber Stichwörtern +in der 'outline'-Datei hervorgehoben werden (Einrückungen). + +Eingabe-Datei ("dateiname"): + +____________________________________________________________________________ + + ... + \#ib(9)\#1. Kapitel\#ie(9)\# + ... + ...\#ib\#Stichwort 1\#ie\# + \#ib\#Stichwort 2\#ie\#... + + \#ib(9)\#1.1. Kapitel\#ie(9)\# + ... + \#ib\#Stichwort 3\#ie\# + usw... + +____________________________________________________________________________ + + + +Druckbild der erzeugten Datei ("dateiname.outline"): + + 1. Kapitel + Stichwort 1 + Stichwort 2 + 1.1. Kapitel + Stichwort 3 + + +In diesem Beispiel werden alle Indizes mit Ausnahme der Kapitelüberschrift jeweils in +einer Zeile aufgeführt und gegenüber der Kapitelüberschrift eingerückt. Ein neues +Kapitel, sofern es dezimal gekennzeichnet ist, wird gegenüber einem Kapitel mit +höherer Ordnung eingerückt. +#page# + +#ib(9)#5.6. #ib#Print#ie##ie(9)##goalpage("print")# +#free(1.0)# + #on("i")# + Der #ib#EUMEL-Drucker#ie#, der mit dem #ib#'print'#ie(1,"-Kommando")#-Kommando angesprochen wird, ist + eine Software-Schnittstelle zu einem angeschlossenen Drucker. In diesem Kapitel + wird erklärt, wie Sie mit dem EUMEL-Drucker eine Datei drucken können und + welche speziellen Anweisungen den Drucker steuern. + #off("i")# +#free(1.0)# +Jeder Drucker erbringt "hardwaremäßig" unterschiedliche Leistungen (z.B. Typen und +Modifikationen). Diese Leistungen werden durch Eingabe spezieller Zeichenfolgen +veranlaßt, die herstellerspezifisch sind. + +Um vom EUMEL-System unterschiedliche Drucker auf gleiche Weise ansprechen zu +können, wurde eine Software-Schnittstelle geschaffen, die #ib#EUMEL-Drucker#ie# ge­ +nannt wird. Der EUMEL-Drucker akzeptiert eine Datei und veranlaßt, daß diese in +geeigneter Weise gedruckt wird. Weiterhin beachtet der EUMEL-Drucker die An­ +weisungen der Textkosmetik. Die Form der Anweisungen der Textkosmetik und des +EUMEL-Druckers sind identisch. +#page# + +#ib(9)#5.6.1. #ib#Eine Datei drucken#ie##ie(9)# +#free(1.0)# + #on("i")# + Mit dem Kommando '#ib#print#ie#' können Sie dem EUMEL-Drucker eine Datei zum + Drucken übergeben. + #off("i")# +#free(1.0)# +____________________________________________________________________________ + + gib kommando: + print ("dateiname") + +____________________________________________________________________________ + + +In der Regel ist im EUMEL-System (Multi-User) ein "Spooler" installiert, so daß Sie +sofort mit der Arbeit fortfahren können. Der EUMEL-Drucker arbeitet in diesem Fall +parallel zu Ihren anderen Arbeiten. +#page# + +#ib(9)#5.6.2. #ib#Anweisungen für den EUMEL-Drucker#ie##ie(9)# +#free(1.0)# +Ein Text (eine Datei) kann vom Drucker auch ohne Anweisungen gedruckt werden, +etwa für Probedrucke. Für diesen Fall hat der Drucker vernünftige Voreinstellungen. +Für einen "normalen" Text brauchen Sie keine speziellen Druckeranweisungen in den +zu druckenden Text einzufügen, denn die Anweisungen für die Textkosmetik reichen +zur Druckersteuerung aus. Nur wenn besondere Leistungen verlangt werden, wie z.B. +Blocksatz oder den gedruckten Text an eine bestimmte Stelle zu plazieren, sind +Druckeranweisungen notwendig. + +Werden vom Drucker Leistungen verlangt, die hardwaremäßig nicht vorhanden sind, +so sorgt der EUMEL-Drucker dafür, daß eine möglichst äquivalente Leistung erbracht +wird. Fordern Sie beispielsweise einen nicht vorhandenen Schrifttyp an, wird mit +dem Standard-Schrifttyp der jeweiligen Installation gedruckt. Damit ist es Ihnen +möglich, einen Text, der eigentlich für einen anderen Drucker bestimmt ist, auf einem +Drucker zu drucken, der die geforderte Type nicht kennt. + +Wie bereits erwähnt, beachtet der EUMEL-Drucker die gleichen Anweisungen wie +die Textkosmetik-Programme, aber einige Anweisungen sind nur für den Drucker +implementiert. Eine #ib#\#type\#-Anweisung#ie# beispielsweise, die einen bestimmten Schrift­ +typ anfordert, wird vom EUMEL-Drucker als Befehlsfolge an den angeschlossenen +Hardware-Drucker übergeben, sofern der Schrifttyp auf dem Drucker vorhanden ist. +Wie die Anweisungen geschrieben werden müssen, wurde in der Beschreibung der +Textkosmetik geschildert. + +Anweisungen werden nicht gedruckt. Besteht eine Zeile nur aus Anweisungen, so wird +diese Zeile vom EUMEL-Drucker nicht gedruckt. Im Gegensatz zu den Programmen +der Textkosmetik werden unbekannte oder #ib#fehlerhafte Anweisungen#ie# vom EUMEL­ +Drucker ohne Fehlermeldung "verschluckt". + +Neben den "normalen" Anweisungen, die nur in "\#"-Zeichen eingeschlossen wer­ +den, gibt es noch eine andere Form: + +Kommentar-#ib#Anweisungen#ie(1,", Kommentar-")#: + + Werden in "\#-" und "-\#"-Zeichen eingeschlossen. Solche Anweisungen wer­ + den ignoriert. + +____________________________________________________________________________ + + .......................... + Text...................... + .......................... + Kommentar-Anweisungen werden + beim Drucken ignoriert. + \#---- Ende der Seite 1 ---\# + +____________________________________________________________________________ + + + +Die letze Zeile erscheint im gedruckten Text nicht. +#page# +#goalpage("block")# +#ib(9)#5.6.3. #ib#Blocksatz#ie# #ie(9)# +#free(1.0)# +#ib(9)#5.6.3.1. #ib#Randausgleich#ie##ie(9)# +#free(1.0)# + #on("i")# + Die Anweisung #ib#\#block\##ie(1,"-Anweisung")# bewirkt einen Blocksatz beim Druck. + #off("i")# +#free(1.0)# +Fügen Sie in den Text (meist am Anfang einer Datei) die Anweisung + +____________________________________________________________________________ + + \#block\# + +____________________________________________________________________________ + + +ein, druckt der Drucker ab dieser Stelle alle Zeilen, die nicht mit einem Absatzkenn­ +zeichen versehen sind, im #ib#Blocksatz#ie#. Das heißt, daß durch Vergrößern der Wort­ +abstände alle Zeilen an der gleichen Position enden (rechter #ib#Randausgleich#ie#). Preis­ +werte Drucker können dies nur durch Einfügen ganzer Leerzeichen zwischen den +Worten vornehmen, was sich oft beim Lesen störend bemerkbar macht. Bei qualitativ +hochwertigen Druckern wird dagegen der Blocksatz durch Einfügen kleinerer Abstän­ +de zwischen den Worten erreicht. + +Der Text einer Zeile wird durch Vergrößern der #ib#Wortlücken#ie(1, ", Vergrößern der")# auf die Zeilenlänge, die +durch die \#limit\#-Anweisung eingestellt ist, verbreitert. + + +a) Es werden nicht verbreitert: + + - Absatzzeilen; + - der Text bis zum letzten #ib#Mehrfachblank#ie#; + - führende Leerzeichen (#ib#Einrückung#ie#); + - ein Leerzeichen hinter einer Aufzählung (siehe dazu b); + - geschützte Blanks. + + + +b) #ib#Aufzählungen#ie# gibt es nur nach einer Absatzzeile: + + - "Spiegelstrich" (Bindestrich und Leerzeichen am Anfang der Zeile); + - Doppelpunkt als Ende des ersten Wortes (Position < 20); + - schliessende Klammer oder Punkt als Ende des ersten Wortes (Position < 7), + z.B. 1) oder 1. +#page# +#goalpage ("pageblock")# + +#ib(9)#5.6.3.2. #ib#Seitenausgleich#ie##ie(9)# +#free(1.0)# + #on("i")# + Mit der #ib#\#pageblock\#-Anweisung#ie# wird der Drucker veranlaßt, einen Seiten­ + ausgleich (ähnlich wie bei der \#block\#-Anweisung für den rechten Rand­ + ausgleich) vorzunehmen. + #off("i")# +#free(1.0)# +Durch die automatische oder interaktive Seitenformatierung oder durch einen Fuß­ +notenumbruch von 'pageform'/'autoform' bleiben oft am Ende einer Seite Zeilen leer. +Dies können Sie durch die \#pageblock\#-Anweisung verhindern. Sie veranlaßt den +Drucker, Zwischenräume (Fachbegriff: Durchschuß) zwischen den Zeilen einzufügen, +so daß alle letzten Zeilen auf allen Seiten auf gleicher Höhe abschließen. Ebenso wie +beim Randausgleich hängt die Güte des Druckergebnisses jedoch von den Fähig­ +keiten des angeschlossenen Druckers ab. + +Beachten Sie jedoch, daß manche Verlage so bearbeitete Seiten nicht wünschen, weil +bei Verwendung von zu dünnem Papier beim Druck Zeilen "durchscheinen" können, +so daß das Lesen erschwert wird. + +Ist die Anweisung \#pageblock\# gegeben, können Sie in 'pageform' die Seitengrenze +auch über das rechnerische Seitenende hinaus plazieren. In diesem Fall werden die +Zeilen vom Drucker gestaucht. +#mark ("", "")# + + +____________________________________________________________________________ + +PAGEFORM für x Zeilen: dateiname ---> dateiname.p + +____________________________________________________________________________ + + +____________________________________________________________________________ + + Seitenende verschieben: UP, DOWN / bestaetigen: RETURN / Abbruch: ESC + +____________________________________________________________________________ + + +#page# + +#ib(9)#5.6.4. #ib#Schreibfeld verschieben#ie##ie(9)# #goalpage("start")# +#free(1.0)# + #on("i")# + Durch die Anweisung #ib#\#start\# #ie(1,"-Anweisung")#ist es Ihnen möglich, das #ib#Schreibfeld#ie# beim Druck auf + dem Papier an eine andere Stelle zu plazieren. + #off("i")# +#free(1.0)# +Der EUMEL-Drucker plaziert das Schreibfeld auf einem Drucker automatisch derart, +daß ein genügender Rand verbleibt. Die Wirkung dieser Voreinstellung ist natürlich +abhängig vom Drucker und der Installation. Mit der \#start\#-Anweisung können Sie +die automatische Einstellung verändern. + + +____________________________________________________________________________ + + \#start (1.0, 2.0)\# + +____________________________________________________________________________ + + +legt die linke, obere Ecke des Schreibfeldes fest (vom linken Rand 1 cm, vom oberen +Rand 2 cm). Die standardmäßige Voreinstellung ist \#start (2.54, 2.35)\#. Die \#start +(...)\#-Anweisung können Sie nur einmal pro Seite geben. +#page# + diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.5c b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5c new file mode 100644 index 0000000..010cacd --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5c @@ -0,0 +1,711 @@ +#start(5.0,1.5)##pagenr("%",93)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Teil 5: Textkosmetik und Druck +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +5 - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD 5 - % +#tableend##clearpos# +#end# +#goalpage("center")# +#ib(9)#5.6.5. #ib#Zentriert drucken#ie##ie(9)# +#free(1.0)# + #on("i")# + Mit der #ib#\#center\#-Anweisung#ie# können Sie einen Text in der Mitte der Zeile drucken + lassen. + #off("i")# +#free(1.0)# + +Die \#center\#-Anweisung zentriert den Text einer Absatzzeile. + + +____________________________________________________________________________ + + \#center\#Diese Zeile wird zentriert gedruckt. + +#mark ("", "")# + +____________________________________________________________________________ + + +Druckbild: + + #center#Diese Zeile wird zentriert gedruckt. +#page# + +#ib(9)#5.6.6. #ib#Rechtsbündig drucken#ie##ie(9)# +#goalpage("right")# +#free(1.0)# + #on("i")# + Mit der #ib#\#right\#-Anweisung#ie# können Sie einen Teil einer Absatzzeile rechtsbündig + drucken. + #off("i")# +#free(1.0)# + +Die \#right\#-Anweisung veranlaßt, daß der nachfolgende Text rechtsbündig gedruckt +wird. + +____________________________________________________________________________ + + \#head\# + \#center\#Diese Zeile wird zentriert\#right\#% + + \#end\# + +____________________________________________________________________________ + + + +Hierbei wird die Seitenzahl rechtsbündig gedruckt. + +Beachten Sie, daß die \#center\#- und die \#right\#-Anweisung zusammen verwendet +werden können. Beide Anweisungen wirken jedoch nur, wenn sie in einer Absatzzeile +stehen. + +#mark ("", "")# +#page# + +#ib(9)#5.6.7. #ib#Übereinander drucken#ie##ie(9)# +#goalpage ("b")# +#free(1.0)# + #on("i")# + Mit der #ib#\#b\#-Anweisung#ie# können Sie zwei Zeichen übereinander drucken. + #off("i")# + +#free(1.0)# +Die \#b\#-Anweisung veranlaßt, daß zwei aufeinanderfolgende Zeichen, die durch die +\#b\#-Anweisung verbunden sind, übereinander gedruckt werden. + + +____________________________________________________________________________ + +... 0\#b\#/ ... + +____________________________________________________________________________ + + + + +Druckbild: + +... 0#b#/ ... + + +Das Zeichen '/' wird über das Zeichen '0' gedruckt. 'lineform'/'autoform' nimmt für die +Zeilenberechnung nur ein Zeichen. Beachten Sie, daß direkt vor oder nach der +\#b\#-Anweisung keine Anweisung oder kein Blank stehen darf. +#mark ("", "")# +#page# + +#ib(9)#5.7. #ib#Textkosmetik-Makros#ie##ie(9)# +#free(1.0)# + #on("i")# + #ib#Makros#ie# verkürzen Ihren Arbeitsvorgang bei immer wiederkehrenden Textteilen + und/oder Anweisungen. + #off("i")# +#free(1.0)# +Unter 'Makro' verstehen wir eine "große" Anweisung, die aus vielen kleinen besteht +und die Sie mit Hilfe des Makronamens aufrufen können. + +Textkosmetik-Makros kommen zum Einsatz bei: + +- immer wiederkehrenden Textteilen; +- immer wiederkehrenden Anweisungssequenzen; +- bei der Erstellung von Manuskripten, deren endgültige Form Sie anfänglich noch + nicht kennen oder die Sie noch ändern möchten; +- oder bei Folgen von direkten Drucker-Anweisungen, die bestimmte Leistungen + erbringen. + +Die Definition von einem oder mehreren #ib#Makros#ie# wird mit dem Editor vorgenommen. +Diese #ib#Makro-Datei#ie# wird dann geladen. Von diesem Augenblick an "kennen" 'line­ +form'/'autoform' und 'pageform'/'autopageform' die Makros, d.h. die Textzeilen und/ +oder Anweisungen, die sich unter dem #ib#Makronamen#ie# "verbergen". + +'lineform'/'autoform' beachtet die Anweisungen, die ggf. in den Makros enthalten sind. +Sie erscheinen jedoch nicht in der Datei. Erst 'pageform'/'autopageform' setzt diese in +die Druckdatei ein. +#page# + +#ib(9)#5.7.1. Ein Makro-Beispiel#ie(9)# +#free(1.0)# + #on("is")# + Hier wird Ihnen ein einfaches Beispiel für einen Briefkopf gezeigt. + #off("is")# +#free(1.0)# +Angenommen, Sie schreiben mit dem EUMEL-System Ihre Geschäftsbriefe. Sie +haben einen Drucker zur Verfügung, mit dem Sie auch die Briefköpfe erstellen kön­ +nen. Für den #ib#Briefkopf#ie# schreiben Sie ein Makro \#kopf\# in eine Datei "macro defini­ +tionen": + +____________________________________________________________________________ + + \#*kopf\# + \#type("fett und gross")\#Firmenname + \#type("fett")\#Softwareprodukte + \#type("klein")\#Straße + Stadt + \#type ("normal")\# + \#*macro end\# + +____________________________________________________________________________ + + +Der Name des Makros ist \#kopf\#. Beachten Sie, daß eine #ib#Makro-Definition#ie# mit dem +Namen des Makros beginnen muß. Der #ib#Makroname#ie# muß dabei mit einem #on("b")#*#off("b")# gekenn­ +zeichnet werden, um ihn von "normalen" Text-Anweisungen unterscheiden zu kön­ +nen. Jedes Makro wird mit einer \#*macro end\#-Anweisung beendet. Sie dürfen +mehrere Makros hintereinander in die Datei schreiben. + +Nun müssen Sie das so definierte Makro 'laden': + +____________________________________________________________________________ + + gib kommando: + #ib#load macros#ie# ("macro definitionen") + +____________________________________________________________________________ +#goalpage("load macros")##goalpage("list macros")# + + +Zur Kontrolle können Sie sich die geladenen Makros in das Notizbuch ausgeben +lassen: + +____________________________________________________________________________ + + gib kommando: + #ib#list macros#ie# + +____________________________________________________________________________ +#mark ("", "")# + + + +Nun haben Sie von jetzt an eine neue Anweisung (mit dem Namen \#kopf\#) zur Ver­ +fügung, mit der Sie einen Briefkopf in jeden Brief drucken können. Sie schreiben nun +folgenden Brief: + +____________________________________________________________________________ + + \#kopf\# + + Sehr geehrter Herr .... + + usw. + +____________________________________________________________________________ + + +Beachten Sie hierbei, daß das Makro in Ihrem Text als Anweisung ohne #on("b")#*#off("b")# steht. Der +#ib#Aufruf eines Makros#ie#, welches z.B. in einer von 'lineform' zu bearbeitenden Datei +steht, unterscheidet sich also nicht von einer "normalen" Textanweisung. + +Nachdem Sie mit 'lineform' den Brief zeilenweise formatiert haben, kontrollieren Sie +die formatierte Datei. Hier hat sich noch nichts verändert. Die neue Anweisung \#kopf\# +steht unverändert in der Datei. 'lineform' beachtet zwar alle Anweisungen und Text­ +zeilen eines Makros, setzt diese jedoch nicht in die Datei ein. Allerdings ist 'lineform' +nicht in der Lage, die \#type\#- und \#limit\#-Anweisungen eines Makros zu erkennen, +wenn es an erster Stelle in einer Datei steht und in dessen Definition gleich zu +Anfang diese Anweisungen korrekt aufgeführt sind. Stattdessen fragt 'lineform' an­ +fangs 'type' und 'limit' an. Das können Sie umgehen, indem Sie mittels 'CR' die +Abfrage in 'lineform' ignorieren. + +Nun formatieren Sie die Datei, die den Brief enthält, mit 'pageform'/'autopageform'. In +der Druckdatei ist nun die Anweisung \#kopf\# verschwunden. Dort stehen nun die +Zeilen des #ib#Makrorumpf#ie#es. 'pageform'/'autopageform' setzt die Zeilen des Makros in +die Druckdatei ein: + +____________________________________________________________________________ + + \#type("fett und gross")\#Firmenname + \#type("fett")\#Softwareprodukte + \#type("klein")\#Straße + Stadt + \#type ("normal")\# + + + Sehr geehrter Herr ... + usw. + + +____________________________________________________________________________ + + + +#on("b")##on("i")#Anmerkung:#off("b")##off("i")# +Makros, die den gleichen Namen haben, aber sich durch die Anzahl der Parameter +unterscheiden, sind nicht erlaubt. Es ist auch nicht gestattet, Makros innerhalb einer +Makro-Definition aufzurufen. + +Beachten Sie ferner, daß Makro-Texte so verwendet werden, wie sie mit 'load +macros' geladen werden. + +____________________________________________________________________________ + + \#*textanfang\# + \#limit(11.0)\# + \#block\# + \#pageblock\# + \#type("trium8")\# + \#*macro end\# + +____________________________________________________________________________ + + +Betätigen Sie in der Makro-Datei nach jeder Zeile die #taste1(" CR ")#-Taste (Absatz), dann +erhalten Sie nach jedem \#...\# einen Absatz, was zum Beispiel bei Kapitelüberschriften +wünschenswert ist, nicht jedoch bei kleineren Anweisungen, bei denen dann mitten im +Satz ein Absatz erschiene. In solchen Anwendungen sollten Sie Makros ohne Absätze +speichern. Beachten Sie ferner, daß aus programmtechnischen Gründen eine \#foot\#- +oder die abschließende \#end\#-Anweisung einer Fußnote nicht in einem Makro ent­ +halten sein darf. +#page# + +#ib(9)#5.7.2. Ein Beispiel mit #ib#Makro-Parameter#ie#n#ie(9)# +#free(1.0)# + #on("i")# + Makro-Parameter erlauben es Ihnen, immer wiederkehrende Textteile, die sich + nur geringfügig voneinander unterscheiden, zu erzeugen. + #off("i")# +#free(1.0)# +Ihnen fällt nun auf, daß Sie Ihr Makro noch etwas verbessern können. Sie möchten +das Datum mit in den Briefkopf aufnehmen. Somit editieren Sie Ihre Makro-Datei +folgendermaßen (beachten Sie die '$'-Zeichen): + +____________________________________________________________________________ + + \#*kopf ($1)\# + \#type("gross")\#Firmenname + \#type("fett")\#Softwareprodukte + \#type("klein")\#Straße + Stadtname + \#type ("normal")\# + + Stadtname, den $1 + \#*macro end\# + +____________________________________________________________________________ + + +Damit haben Sie dem \#kopf\#-Makro einen Parameter gegeben: '$1'; die Parameter +werden numeriert. Ein zweiter Parameter würde '$2' heißen usw.. + +Bei der Erstellung eines Briefes müssen Sie die Anweisung \#kopf\# mit dem jeweiligen +Datum in einen Brief schreiben: + +____________________________________________________________________________ + + \#kopf ("20.8.1986")\# + +____________________________________________________________________________ + + +'pageform'/'autopageform' setzt nun das angegebene Datum direkt hinter 'Stadtname, +den' in den Briefkopf ein (in der Druckdatei). Beachten Sie, daß alle Parameter einer +Makro-Anweisung in Anführungszeichen stehen müssen (auch Zahlen). +#page# + +#ib(9)#5.7.3. #ib#Makros für Manuskripte#ie##ie(9)# +#free(1.0)# + #on("i")# + Hier wird gezeigt, wie Sie mit Makros Anweisungen formulieren können, die + aussagen, um was es sich bei einem Text handelt, und nicht, in welchem Format + er gedruckt wird. + #off("i")# +#free(1.0)# +Bei Manuskripten für Artikel, Bücher und Manuals wissen Sie oft vorher nicht, in +welchem Format das Manuskript gedruckt werden wird. Zu diesem Zweck ist es +ebenfalls nützlich, Makros zu verwenden. + +____________________________________________________________________________ + + \#*kapitelanfang ($1)\# + \#free (2.0)\# + \#type ("gross")\#\#ib (9)\#$1\#ie (9)\#\#type ("normal")\# + + \#*macro end\# + +____________________________________________________________________________ + + +In diesem Beispiel wird ein Makro für den Anfang eines Kapitels definiert. Zwischen +zwei Kapiteln sollen hier zwei Zentimeter Zwischenraum bleiben, die Kapitel- +Überschrift (als Parameter) wird in einer größeren Schrift gedruckt. Zusätzlich wird die +Überschrift für ein Inhaltsverzeichnis in den 9. Index aufgenommen. Nach der Über­ +schrift wird eine Leerzeile eingeschoben, bevor der eigentliche Text anfängt. + +Der Anwender dieses Makros schreibt also z.B. folgende Anweisung: + +____________________________________________________________________________ + + \#kapitelanfang ("Ein Beispiel fuer Manuskripte")\# + +____________________________________________________________________________ + + + +Beachten Sie, daß die Kapitel-Überschrift nicht länger als eine Textzeile sein darf. +Das liegt daran, daß 'lineform'/'autoform' zwar die Zeile bearbeitet, aber nicht in den +Text einsetzt. 'pageform'/'autopageform' setzt also die unveränderte - nicht umge­ +brochene - Textzeile ein. + +Sie können nun Makros für die meisten Textstrukturen definieren. Schreibkräfte +brauchen dann in der Regel die meisten Text-Anweisungen nicht zu kennen, son­ +dern nur noch eine Anzahl von einfachen Makro-Anweisungen. + +Die Makro-Definitionen können jederzeit geändert werden, um wechselnden Bedürf­ +nissen angepaßt zu werden, z.B. wenn ein Verlag ein bestimmtes Schreibformat +verbindlich vorschreibt. In diesem Fall brauchen nicht alle Text-Dateien geändert zu +werden, sondern nur die Makro-Definitionen. + +Ein weiterer Vorteil einer solchen Vorgehensweise ist, daß die Makro-Anweisungen in +diesem Fall angeben, #on("i")##on("b")#was#off("i")##off("b")# eine bestimmte Text-Struktur ist, und nicht, #on("i")##on("b")#wie#off("i")##off("b")# die +Struktur behandelt werden soll. + +#on("b")#Anmerkung#off("b")#: +In eine Makro-Definition sollten Sie ggf. \#limit\#-, \#type\#- und \#linefeed\#- +Angaben einsetzen, um die Makros unabhängig von der Aufrufstelle zu machen. Ggf. +sollten Sie auch die Datei vorher mit 'lineform' bearbeiten, um Trennungen vorzu­ +nehmen. +#page# + +#ib(9)#5.8. Textkosmetik für Spezialisten#ie(9)# +#free(1.0)# + #on("i")# + In diesem Abschnitt werden Ihnen Kommandos und Anweisungen vorgestellt, die + in der Regel nur für Spezialfälle benötigt werden. + #off("i")# +#free(1.0)# + +#ib(9)#5.8.1. Schalter-Anweisungen für + #ib#Kopf- und Fußbereiche#ie(1, "Schalter-Anweisungen für")##ie(9)# +#goalpage("head off")##goalpage("bottom off")# +#free(1.0)# + +Mit den Textkosmetik-Anweisungen + +____________________________________________________________________________ + + #ib#\#head off\##ie# + + #ib#\#bottom off\##ie# + +____________________________________________________________________________ + + + +können Sie die Erzeugung von Kopf- oder Fußzeilen abschalten. Mit + + +____________________________________________________________________________ + + #ib#\#head on\##ie# + + #ib#\#bottom on\##ie# + +____________________________________________________________________________ + + +können Sie diese wieder erzeugen. Beachten Sie, daß diese Anweisungen an der +Stelle beachtet werden, an der sie im Text stehen, d.h. diese Anweisungen gelten +bereits für die Seite, auf der sie sich bei der 'pageform'-Bearbeitung befinden. Möch­ +ten Sie die Kopfzeilen für eine Seite abschalten, dann sollten Sie an dieser Stelle die +#ib#\#head off\#-Anweisung#ie# geben. Um die Kopfzeilen für die nächste Seite wieder einzu­ +schalten, sollten Sie die #ib#\#head on\#-Anweisung#ie# an einer Stelle plazieren, von der Sie +sicher sind, daß sie auf die folgende Seite gelangt (im Zweifelsfall nach einer +\#page\#-Anweisung). +#mark ("", "")# +#page# + +#ib(9)#5.8.1.1. #ib#Kopf- und Fußbereiche abstellen#ie##ie(9)# +#goalpage ("first head")##goalpage("last bottom")# +#free(1.0)# + #on("i")# + Mit '#ib#first head#ie#' bzw. '#ib#last bottom#ie#' können Sie Kopf- oder Fußbereiche auf der + ersten (letzten) Seite ab- oder wieder anschalten. + #off("i")# +#free(1.0)# +Manchmal ist es notwendig, die Erzeugung von 'head'-Zeilen auf der ersten Seite +(z.B. weil dort ein Briefkopf erscheint) und/oder 'bottom'-Zeilen auf der letzten Seite +(weil keine Folgeseite existiert) zu verhindern. Mit dem Monitor-Kommando + +____________________________________________________________________________ + + gib kommando: + #ib#first head (FALSE)#ie# + +____________________________________________________________________________ + + +können Sie bei 'pageform' die Erzeugung von 'head'-Zeilen auf der ersten Seite +jeder Druckdatei abschalten. Die Erzeugung bleibt so lange abgeschaltet, bis sie +wieder durch + +____________________________________________________________________________ + + gib kommando: + #ib#first head (TRUE)#ie# + +____________________________________________________________________________ + + +angeschaltet wird. Das gleiche gilt analog für 'bottom'-Zeilen auf der letzten Seite: +Ein- und Ausschalten durch + +____________________________________________________________________________ + + gib kommando: + #ib#last bottom (FALSE)#ie# + +____________________________________________________________________________ +#mark("","")# + +bzw. + +____________________________________________________________________________ + + gib kommando: + #ib#last bottom (TRUE)#ie# + +____________________________________________________________________________ +#page# + +#ib(9)#5.8.2. Textzeilen markieren#ie(9)# +#goalpage("mark")# +#free(1.0)# +Mit der Anweisung + + +____________________________________________________________________________ + + \#mark("markierungszeichen links","markierungszeichen rechts")\# + +____________________________________________________________________________ + + + +können Sie einen Textabschnitt an den Rändern (außerhalb des Schreibfeldes!) mit +Texten markieren, wie z.B. im folgenden mit der Anweisung + +#mark ("", "")# + +____________________________________________________________________________ + + \#mark ("> ", " <")\# + +____________________________________________________________________________ + + +#mark ("> ", " <")# +Dabei gilt der erste Parameter für den linken und der zweite für den rechten Rand. +Beachten Sie, daß Sie einen genügenden Zwischenraum zwischen der Markierung +und dem Rand mit angeben müssen. + +Die Markierung ist insbesondere für Manuals interessant, wo Änderungen gegen­ +über der letzten Version hervorgehoben werden. Das Markierungszeichen wird neben +den linken und rechten Rand gedruckt (also außerhalb des von \#start\# und \#limit\# +begrenzten Textfeldes). Für das Drucken der Markierung wird der/die Schrifttyp/ Modi­ +fikationen benutzt, die an der Stelle der \#mark\#-Anweisung eingeschaltet ist. Der +eigentliche Text bleibt selbstverständlich unberührt. +#mark ("", "")# + +Um nur einen Rand zu markieren, kann auch ein leerer Parameter angegeben +werden. + +____________________________________________________________________________ + + \#type ("pica")\#\#mark ("", " |")\#\#type ("normal")\# + +____________________________________________________________________________ + + + +Mit der speziellen #ib#\#mark\#-Anweisung#ie# + +____________________________________________________________________________ + + \#mark ("", "")\# + +____________________________________________________________________________ + + +wird die Markierung ausgeschaltet. + +Soll ein Kopf-, Fuß-, Fußnoten- oder Tabellenbereich markiert werden, sollten sich +die Markierungsein- und ausschalt-Anweisungen vollständig in dem Bereich be­ +finden. +#page# + +#ib(9)#5.8.3. #ib#Fußnoten pro Seite zählen#ie##ie(9)# +#goalpage("countperpage")# +#free(1.0)# +Manchmal wird gewünscht, daß die Fußnoten für jede Seite separat - also für jede +Seite von 1 ab - gezählt werden. Das können Sie mit der Textkosmetik-Anweisung + + +____________________________________________________________________________ + + \#count per page\# + +____________________________________________________________________________ + + +erreichen. Sie schaltet von einer fortlaufenden Zählung auf eine seitenweise Zählung +um. Diese Anweisung sollte am Dateianfang stehen. Sie kann für die betreffende +Datei nicht mehr abgeschaltet werden. +#page# + +#ib(9)#5.8.4. Behandlung falscher #ib#Silbentrennungen#ie(1, ", Behandlung von falschen")#: + #ib#Ausnahmelexikon#ie##ie(9)# +#free(1.0)# + #on("i")# + In das Ausnahmelexikon können fehlerhaft getrennte Worte aufgenommen + werden. + #off("i")# +#free(1.0)# +Es kann vorkommen, daß das Silbentrenn-Programm der Textkosmetik einige Worte +immer wieder falsch trennt. Um dies zu vermeiden, können Sie diese Worte in ein +#on("b")##on("i")#Ausnahmelexikon#off("b")##off("i")# speichern. Die Worte des Ausnahme-Lexikons werden bei einer +Silbentrennung zuerst durchsucht. Wird ein Wort im Lexikon gefunden, dann wird das +eigentliche Silbentrenn-Programm nicht mehr ausgeführt. + +Die Ausnahmen müssen Sie - wie unten beschrieben - in einer Datei notieren und +mit dem Monitor-Kommando + +____________________________________________________________________________ + + gib kommando: + #ib#lade ausnahmen#ie# ("dateiname") + +____________________________________________________________________________ +#goalpage("lade ausnahmen")# + + +in das Lexikon laden. Die Ausnahmen müssen Sie folgendermaßen in die Datei +schreiben: + +____________________________________________________________________________ + + Sprech-stun-de + ins-be-son-de-re + Raum + Bei-spiel + ... + +____________________________________________________________________________ + + +Sie können jederzeit neue Ausnahmen in das Lexikon hinzuladen (wiederum mit 'lade +ausnahmen'). In diesem Fall wird angefragt, ob das Lexikon überschrieben werden +soll. + + + +Um zu kontrollieren, welche oder wie viele Ausnahmen sich im Lexikon befinden, +können Sie + +____________________________________________________________________________ + + gib kommando: + #ib#entlade ausnahmen#ie# ("dateiname") + +____________________________________________________________________________ + #goalpage("entlade ausnahmen")# + +geben. Das Lexikon wird dann in "dateiname" geschrieben. Auch hier können Sie +weitere Ausnahmen hinzufügen und diese neu laden (aber diesmal überschreiben). +#mark ("", "")# +#page# + +#ib(9)#5.8.5. #ib#Voreinstellungen ändern#ie#: + Einige Monitor-Kommandos#ie(9)# +#free(1.0)# +#ib(9)#5.8.5.1. Wenige oder viele #ib#Silbentrennung#ie#en: + #ib#Trennpunkt einstellen#ie##ie(9)# +#goalpage ("hyphenation width")# +#free(1.0)# + #on("i")# + Mit dem Kommando 'hyphenation width' können Sie bestimmen, an welchem + Punkt Worte zur Trennung angeboten werden. Die Trennbreite können Sie + zwischen 4 und 20 Prozent der Zeilenbreite einstellen. + #off("i")# +#free(1.0)# +Viele Silbentrennungen in einem Text erschweren das Lesen. Nehmen Sie keine +Silbentrennungen vor, wird der rechte Rand stark "ausgefranst" oder beim Blocksatz +("rechter Randausgleich") müssen viele Zwischenräume zwischen den Worten ein­ +gefügt werden. Durch das Monitor-Kommando + +____________________________________________________________________________ + + gib kommando: + #ib#hyphenation width#ie# (prozentuale angabe) + +____________________________________________________________________________ + + +unmittelbar vor dem Aufruf von 'autoform' oder 'lineform' können Sie den Punkt, an +dem die Silbentrennung einsetzen soll, einstellen. Die Klammern enthalten eine ganze +Zahl, die für Prozent der Zeilenbreite steht. Minimum sind 4, Maximum 20 Prozent. +Beispielsweise stellt 'hyphenation width (5)' den Trennpunkt auf 5% der Zeilenbreite +ein (voreingestellt ist 7). Bei einer Angabe von 20 werden somit sehr wenige Worte +zur Silbentrennung angeboten, d.h. je größer die Prozentangabe, desto weniger Worte +werden zur Trennung angeboten. Die Einstellung des Trennpunktes bestimmt also, ab +wann ein Wort zur Silbentrennung untersucht wird. Andererseits bestimmt die Ein­ +stellung auch, wieviel Zwischenraum zwischen Worten eingefügt werden muß, um +einen rechten Randausgleich zu erzielen. +#page# + +#ib(9)#5.8.5.2. Anzahl #ib#Leerzeilen vor Fußnoten#ie# + einstellen#ie(9)# +#goalpage("number empty")# +#free(1.0)# + #on("i")# + '#ib#number empty lines before foot#ie#' stellt die Anzahl der Leerzeilen vor Fußnoten ein. + #off("i")# +#free(1.0)# +Die Anzahl der Leerzeilen vor #ib#Fußnoten#ie(1, ", Leerzeilen davor")# (voreingestellt ist eine Leerzeile) können Sie +durch das Monitor-Kommando 'number empty lines before foot' einstellen. + + + +____________________________________________________________________________ + + gib kommando: + number empty lines before foot (3) + +____________________________________________________________________________ + + +stellt drei Leerzeilen vor dem Fußnotenblock ein. Beachten Sie, daß diese Einstellung +so lange gilt, bis Sie das Monitor-Kommando erneut geben. +#mark("","")# + diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.5d b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5d new file mode 100644 index 0000000..8a61f29 --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5d @@ -0,0 +1,211 @@ +#start(5.0,1.5)##pagenr("%",116)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Teil 5: Textkosmetik und Druck +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +5 - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD 5 - % +#tableend##clearpos# +#end# + +#ib(9)#5.9. Übersicht über die Anweisungen und + Kommandos der EUMEL-Textkosmetik#ie(9)# +#free(1.0)# + #on ("i")# + Zuerst werden die am häufigsten benutzten Kommandos/Anweisungen beschrie­ + ben. Danach sind (durch einen Strich getrennt) Kommandos/Anweisungen auf­ + geführt, die seltener benötigt werden. + #off ("i")# +#free(1.0)# +#on("b")# +#ib#Kommandos#ie##off("b")# +#free(1.0)# + #on("i")# + Kommandos werden im Monitor gegeben ('gib kommando :'). + #off("i")# +#free(1.0)# +#lpos(0.0)##lpos(4.6)# +#table# +#on("b")#Kommando Bedeutung#off("b")# +#free(1.0)# +#clearpos# +#lpos(0.0)##lpos(4.6)# +lineform ("x") Formatieren von Zeilen mit interaktiver Silben­ + trennung. +autoform ("x") Wie lineform, jedoch werden Silbentrennungen + automatisch vorgenommen. +pageform ("x") Interaktives Formatieren von Seiten, mit Behand­ + lung von Fußnoten, Kopf- und Fußzeilen, Seiten­ + numerierung, Seitenquerverweisen usw. Erzeugt + eine Druckdatei (Zusatz '.p'). +autopageform ("x") Wie pageform, jedoch werden die Seitengrenzen + automatisch plaziert. +print ("x") Datei drucken. +print ("x.p") Eine mit 'pageform' bearbeitete Datei drucken. +---------------- ---------------- +#page# +index ("x.p") Erstellt aus einer Druckdatei ein Stichwort- + und/oder Inhaltsverzeichnis. +index merge ("a.i1","b.i1") Führt Indexdateien zusammen. +outline ("x") Erstellt eine Übersicht aus Kapitelüberschriften + und Stichworten. +hyphenation width (int) Stellt die Trennbreite für die Silbentrennung ein. +load macros ("x") Lädt Makros. +list macros Zeigt geladene Makros. +lade ausnahmen ("x") Lädt Wörter, die von der Trennhilfe nicht korrekt + getrennt werden, in einen Ausnahme-Speicher. +entlade ausnahmen ("x") Entlädt die Worte aus dem Ausnahme-Speicher + in die angegebene Datei. +first head (false) Schaltet Kopfzeilen auf erster Seite aus. +first head (true) Schaltet Kopfzeilen auf erster Seite wieder ein. +last bottom (false) Schaltet Fußzeilen auf letzter Seite aus. +last bottom (true) Schaltet Fußzeilen auf letzter Seite wieder ein. +number empty lines before foot Stellt die Anzahl der Leerzeilen vor einer Fußnote +before foot ein. +#tableend##clearpos# +#page# +#on("b")# +#ib#Anweisungen#ie##off("b")# +#free(1.0)# + #on ("i")# + Anweisungen werden in die Datei geschrieben. Jede Anweisung muß in Anwei­ + sungszeichen eingeschlossen werden. Als Parameter (diese werden in Klammern + eingeschlossen) kommen in Frage: + 'int' bedeutet eine ganze Zahl: 17, 1, 311; + 'real' bedeutet eine Zahl mit Dezimalpunkt (meist cm-Angabe): 0.5, 1.25; + 'text' bedeutet eine Zeichen-Angabe. Muß in Anführungszeichen eingeschlos­ + sen werden: "%", "meine datei". + #off ("i")# +#free(1.0)# +#lpos(0.0)##lpos(4.6)# +#table# +#on("b")#Anweisung Bedeutung#off("b")# +#clearpos# +#lpos(0.0)##lpos (4.6)# + +type (text) Schrifttyp einstellen: \#type("trium8")\# +limit (real) Zeilenbreite einstellen: \#limit (16.0)\# +on (text) Modifikation einschalten: \#on("bold")\#. Erlaubt + sind: b(bold), r(everse), i(talic), u(nderline) +off (text) Modifikation ausschalten (siehe 'on'). +block Blocksatz (Randausgleich) einschalten. +head Kopfzeilen (für Seiten mit geraden/ungeraden +(bzw. headeven/headodd) Seitennummern) definieren. +... -%- Platzhalter für Seitenzahl. +end Kopfzeilen-Ende (pageform). +bottom Wie oben, jedoch für Fußzeilen. +(bzw. +bottomeven/bottomodd) +... +end Fußzeilen-Ende +pagenr (text, int) Seitennummer einstellen bzw. zusätzliches Sei­ + enzeichen ab nächster Seite einführen: + \#pagenr ("%", 17)\# +foot Fußnoten-Anfang. +... +end Fußnoten-Ende. +free (real) Platz freihalten (in cm): \#free (1.27)\# +page Neue Seite: \#page\# +page (int) Neue Seite mit Seitennummer 17: \#page (17)\# +linefeed (real) Zeilenhöhe relativ zum eingeschalteten Schrifttyp + verändern: \#linefeed (1.25)\# +pagelength (real) Seitenlänge einstellen (ab nächster Seite in cm): + \#pagelength (24.0)\# Nachfolgenden Zeilentext +center zentriert drucken. +right Nachfolgenden Zeilentext rechtsbündig drucken. +u ... e (steht für up) Exponent schreiben: \#u\#123\#e\# +d ... e (steht für down) Index schreiben. +start (real, real) Schriftfeld (linke obere Ecke) einstellen: \#start + (1.0, 2.0)\# +------------ ------------ +b Zwei Zeichen übereinander drucken. +bottom off Schaltet Fußzeilen aus. +bottom on Schaltet Fußzeilen ein. +bpos (real, real) Der Text zwischen den angegebenen Tabellen­ + positionen wird im Blocksatz gedruckt. +clearpos Löscht alle Tabellenpositionen. +clearpos (real) Löscht die angegebene Tabellenposition. +columns (int, real) Formatieren von Spalten mit Zwischenraum: + \#columns (3, 1.0)\#, 3 Spalten mit 1 cm Zwischen­ + raum. +columnsend Beendigung der Spaltenformatierung. +count Interner Zähler für Fußnoten wird eingesetzt + (pageform). +count (text) Wie oben, aber der Wert des internen Zählers + wird vermerkt: \#count ("neue Zahl")\# +count per page Interner Zähler beginnt bei jeder Seite mit 1. +cpos (real) Zentrierende Tabellenposition. +dpos (real, text) Um den angegebenen Text zentrierende Tabel­ + lenposition, meist Dezimalzeichen: + \#dpos (13.0, 2.")\# +fillchar (text) Zwischenräume zwischen Tabellenpositionen wer­ + den mit dem angegebenen Text beim Drucken + ausgefüllt. Beachten Sie, daß das Ausschalten der + Füllzeichen durch 'niltext' erfolgt. +goalpage (text) Stelle, auf die obige Anweisung verweist: \#goal­ + page ("1.Kapitel")\# +head off Schaltet Kopfzeile(n) aus. +head on Schaltet Kopfzeile(n) ein. +ib Anfang eines Stichworts oder einer Kapitel­ + überschrift kennzeichnen (Ablegen in Indexdatei + mit Zusatz '.i1'): \#ib\#ein Stichwort oder eine + Kapitelüberschrift\#ie\# +ib (int) Wie oben, jedoch wird Stichwort in angegebener + Indexdatei abgelegt. +ib (int, text) Wie oben, jedoch erhält Eintrag in der Indexdatei + den angegebenen Text an die Seiten­ + nummer angefügt. +ie Beendigung der Stichwortmarkierung. +ie (int) Wie oben (int-Angabe muß der in der ib-An­ + weisung entsprechen). +ie (int, text) Wie oben, jedoch wird die Textangabe hinter das + markierte Stichwort angefügt. +lpos (real) Linksbündige Tabellenposition. +mark (text, text) Markierung rechts und links neben der Schreib­ + fläche ein-/ausschalten. +pageblock Einschalten des vertikalen Blocksatzes. Falls ein­ + geschaltet, kann mit 'pageform' auch über das + (rechnerische) Seitenende formatiert werden. +rpos (real) Rechtsbündige Tabellenposition. +setcount (int) Zählerwert setzen: \#setcount (17)\# +table Anfang einer Tabelle. +... +table end Ende einer Tabelle. +topage (text) Seitenverweis (die Seitennummer, auf die verwie­ + sen wird, wird eingesetzt): + \#topage ("1.Kapitel")\# +value Letzter Zählerwert wird eingesetzt. +value (text) Wie oben, jedoch wird ein vermerkter Zählerwert + eingesetzt: \#value ("Vermerk")\# +#tableend# + diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.5e b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5e new file mode 100644 index 0000000..d515c6a --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.5e @@ -0,0 +1,223 @@ +#start(5.0,1.5)##pagelength(17.4)##pagenr("%",121)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Teil 5: Textkosmetik und Druck +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +5 - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD 5 - % +#tableend##clearpos# +#end# + +#ib(9)#5.10. Fehlersituationen und Abhilfe#ie(9)# + +#free(1.0)# +Was können Sie machen, wenn + + +... bestimmte Anweisungen, die den Gesamttext betreffen, erst ab der zweiten + Seite wirksam werden? + + + Textkosmetik-Anweisungen, die ab der ersten Seite für den ganzen Text gelten + sollen, müssen Sie als erstes, d.h. in die erste Zeile einer Datei, schreiben. Dies + bezieht sich u.a. auf 'pagelength', 'start', 'block', 'pageblock' etc., die noch vor + \#head\#- oder \#bottom\#-Anweisungen gesetzt werden müssen. + + + + +... sich der Cursor nicht mehr bewegen läßt? + + + Eine Möglichkeit besteht darin, daß Sie versehentlich die 'STOP' -Taste + (='CTRL a' gleichzeitig, d.h. Anhalten der Bildschirmausgabe) betätigt haben. + In diesem Fall drücken Sie die 'WEITER' -Taste ('CTRL c' gleichzeitig, d.h. + Bildschirmausgabe fortführen). Alle Tastenanschläge, die Sie in der Zwischen­ + zeit vollzogen haben, werden jetzt ausgeführt. + + Eine andere Möglichkeit wäre, daß Sie Ihre Datei/Task nicht ordnungsgemäß + verlassen haben. Versuchen Sie über die 'SV'-Taste und 'ESC h' wieder auf + die Monitor-Ebene zu gelangen, so daß Sie dann auf die Aufforderung 'gib + kommando' hin, wieder in Ihre Datei gelangen können. + + + + +... Sie nur einen Dateiausschnitt löschen, duplizieren oder mit 'lineform' bearbeiten + möchten? + + + Der betreffende Ausschnitt muß markiert werden. Zum Löschen benutzen Sie + die Tasten 'ESC RUBOUT'. Der Ausschnitt ist hiermit aber noch nicht 'voll­ + ständig verschwunden', sondern Sie können ihn mit 'ESC RUBIN' an gleicher + oder anderer Stelle wieder hervorbringen, so lange bis Sie die Tasten erneut + benutzen. + + Das Duplizieren eines Textbereiches erfolgt nach dem Markieren durch das + Betätigen der Tastenfolge 'ESC d'. Hierbei bleibt der Originaltext erhalten und + kann beliebig oft dupliziert werden. Den duplizierten Text holen Sie sich mit + 'ESC g' an die gewünschte Stelle in Ihrer Datei. + + Möchten Sie 'lineform' nur auf einen Ausschnitt anwenden, markieren Sie + diesen und geben nach 'ESC ESC' das Kommando 'lineform'. + + + + +... beim Drucken die letzte bzw. die letzten beiden Zeilen auf einer gesonderten + Seite ausgedruckt werden? + + + a) Sie müssen die Fonttabelle noch einrichten. + + oder + + b) Sie setzen die \#pageblock\#-Anweisung zu Beginn des Textes und "stau­ + chen" um zwei Zeilen. + + oder + + c) Sie wählen eine kleineren Schrifttyp. + + + + +... in Ihrer Datei die Meldung + + _______________________________________________________________________ + + FEHLER: FILE-Überlauf + + gib kommando: + edit ("dateiname") + + _______________________________________________________________________ + + erscheint und das Abschicken des Kommandos mittels der 'CR'-Taste aber nur + zu einer identischen Meldung (siehe oben) führt? + + + Wenn Sie auf dem oben dargestellten Weg nach mehrmaligem Versuchen nicht + wieder in Ihre Datei gelangen, haben Sie die Möglichkeit, mit dem Kommando + + _______________________________________________________________________ + + gib kommando: + reorganize ("dateiname") + + _______________________________________________________________________ + + + Ihre Datei neu zu 'organisieren', um 'Lücken', die durch Einfügen oder Löschen + entstanden sind, zu eliminieren. Die Datei beansprucht dann in der Regel auch + weniger Speicherplatz. + + Sind Sie wieder in Ihrer Datei, empfiehlt es sich, die große Datei in mehrere + kleine aufzuteilen. Entweder Sie halbieren oder (besser) Sie dritteln Ihre Text­ + datei und verteilen den Text auf zwei bis drei Dateien. Zukünftig sollten Sie es + sich dann bei umfangreichen Texten zur Regel machen, nur ein logisch + zusammenhängendes Kapitel in einer Datei abzulegen. Sie sollten Ihre Datei nur + so groß halten, daß Ihnen noch genügend Raum zur Verfügung steht, Proze­ + duren wie z.B. 'pageform' durchzuführen, durch die sich der Umfang einer Datei + (z.T. wesentlich) vergrößert. + + + + +... bei Ihrem Text einige Wörter mit extrem großem Zwischenraum gedruckt + wurden? + + + Sie haben in diesem Fall wahrscheinlich vergessen, die Absatzmarkierung zu + setzen, so daß aufgrund der \#block\#-Anweisung ein rechter Randausgleich + erfolgte, den Sie an dieser Stelle nicht wünschten. + + + + +... eine Überschreibung erfolgt ist bzw. wenn 'lineform' eine Überschreibung + meldet? + + + Eine solche Überschreibung kann auftreten, wenn Sie mit einer besonders + großen Type in Fettdruck (z.B. triumb14) schreiben (vgl. Sie hierzu auch Kapitel + 5.2.6.). Um dies zu verhindern, können Sie zum einen die Anzahl der Blanks + zwischen den einzelnen Gliedern erhöhen oder zum anderen auch die + \#type\#-Anweisung in die vorhergehende Zeile setzen (n i c h t direkt v o r den + betreffenden Text). + + + + +... nach der erfolgten Prozedur 'lineform' Ihre Tabellen durcheinander geraten + sind? + + + Wenn Sie Tabellen schreiben, müssen Sie nach jeder Zeile die Absatzmarke + setzen. Sollen bei einigen Tabellenpositionen Spalten leer bleiben, müssen Sie + für diese Positionen ein geschütztes Blank einsetzen. + + + + +... bei der Prozedur 'pageform' das Seitenende nicht interaktiv verschoben werden + kann, obwohl am Anfang der Datei eine \#pageblock\#-Anweisung gegeben + wurde? + + + Eine \#page\#-Anweisung im Text bewirkt, daß Sie an dieser Stelle das Seiten­ + ende nur bestätigen, die Anweisung löschen oder als dritte Möglichkeit, die + Seitenformatierung abbrechen können. Für den Fall, daß die \#page\#- + Anweisung nicht mehr zutrifft bzw. falsch gesetzt wurde, sollten Sie die Anwei­ + sung löschen und das Seitenende interaktiv plazieren. + + + + +... Sie bei der Erstellung eines Inhaltsverzeichnisses oder eines Indexes keine + Füllzeichen zwischen Text und Seitenangabe haben möchten? + + + In diesem Fall gehen Sie mit 'ESC ESC' in den Kommandozustand und ändern + mit Hilfe von CA (Change All) die Füllzeichen in Leerzeichen um. Verwenden + Sie nicht nur einen Punkt, da sonst auch die Punkte zwischen den Ziffern der + Kapitelnumerierung verschwänden. Es kann bei einer ungeraden Anzahl von + Füllzeichen notwendig sein, nachträglich noch einige Punkte entfernen zu + müssen. + + _______________________________________________________________________ + + gib kommando: ".." CA " " + + _______________________________________________________________________ + diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.6 b/doc/user-manual/1.8.7/doc/benutzerhandbuch.6 new file mode 100644 index 0000000..5e035d2 --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.6 @@ -0,0 +1,474 @@ +#start(5.0,1.5)##pagenr("%",1)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Teil 6: Spezialitäten +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +6 - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD 6 - % +#tableend##clearpos# +#end# + +#kap("TEIL 6: Spezialitäten")# +#free(1.0)# + +6.1. Notizbuch +#free(1.0)# + Das Notizbuch erlaubt es u.a., Fehlermeldungen zwischenzeitig zu speichern und + am Ende einer Verarbeitung die Fehlermeldungen zusammen mit dem bearbeiteten + Text im Fenstereditor anzuzeigen. +#free(1.0)# +Das #ib#Notizbuch#ie# wird von den Programmen 'lineform' und 'pageform' zum Sammeln +von Warnungen und Fehlermeldungen verwendet. Wenn das Fenster des Notizbuches +an Bildschirm eröffnet ist, können Sie es handhaben wie das gewohnte Editorfenster. + +Falls Sie das Notizbuch selbst beim Editieren für Notizen verwenden möchten, drük­ +ken Sie statt für den Fenstereditor die Tasten an beliebiger +Stelle des Bildschirms. Durch dieses Kommando wird das Notizbuch statt einer Datei +gezeigt. Sie sparen somit die Eingabe eines Dateinamens und können direkt mit allen +vorgestellten Editorfunktionen im Notizbuch arbeiten. + + +#page# +____________________________________________________________________________ + ................ handbuch teil6 .............. Zeile 56 +\#kap("6.2. EUMEL-Zeichensatz")\# +\#free(1.0)\# +\#zus\# + \#corner1("-5.0")\# + Das EUMEL-System definiert einen Zeichensatz, der gewähr­ + auf allen Maschinen überall gleich codiert werden. Dadurch ist + Dateien und Programme ohne Konvertierungen zwischen EUMEL-Syst + unterschiedlicher Hersteller zu übertragen. Der \#ib\#EUMEL- + dem ASCII-Zeichensatz (DIN 66 003) mit Erweiterungen. + \#box3("T","2","115.0")\# + + ................. notebook ................... Zeile 1 +FEHLER Zeile 55: Modifikation nicht angeschaltet bei off: b + >>> Anweisung in angegebener Zeilennummer überprüfen +WARNUNG Zeile 55: Umschaltung auf gleichen Schrifttyp: trium8 + >>> Schrifttyp wurde darum nicht verändert! +WARNUNG Zeile 75: Überschreibung nach >\#ib(9)\#6.2.< Fehlende + >>> Bitte fehlende Leerzeichen einfügen + +____________________________________________________________________________ +#page# +6.2. EUMEL-Zeichensatz +#free(1.0)# + + + Das EUMEL-System definiert einen Zeichensatz, der gewährleistet, daß Zeichen + auf allen Geräten gleich codiert werden. Dadurch ist es z.B. möglich, Dateien und + Programme ohne Konvertierungen zwischen EUMEL-Systemen unterschiedlicher + Hersteller zu übertragen. Der #ib#EUMEL-Zeichensatz#ie# beruht auf dem ASCII- + Zeichensatz (DIN 66 003) mit Erweiterungen. + +#free(1.0)# + +Die Darstellung der einzelnen Zeichen hängt vom Endgerät ab. Die hier aufgeführten +Zeichen sind i.A. auf allen Geräten vorhanden. Ein erweiterter Zeichensatz (mit ma­ +thematischen, diakritischen und griechischen Zeichen) ist nur auf Spezialgeräten +verfügbar und wird deshalb hier nicht angegeben. +#page# +Beispiele zum Lesen der Tabelle: + + code (" ") -> 32 + code ("m") -> 109 + | 0 1 2 3 4 5 6 7 8 9 +--+---------------------------------------- +3 | SP ! " \# $ % & ' + | +4 | ( ) * + , - . / 0 1 + | +5 | 2 3 4 5 6 7 8 9 : ; + | +6 | < = > ? § A B C D E + | +7 | F G H I J K L M N O + | +8 | P Q R S T U V W X Y + | +9 | Z [ ��\� ] ^ _ ` a b c + | +10| d e f g h i j k l m + | +11| n o p q r s t u v w + | +12| x y z | } ~ + | +13| + . + . + . +20| + | +21| Ä Ö Ü ä ö ü + | +22| k ­ \# SP + | +23| + | +24| + | +25| ß +#page# + + +Anmerkungen: + +1) SP bedeutet Leerzeichen ("blank"). + +2) Die Zeichen 'k', '-' und 'SP' mit den Codes 220, 221, 223 werden für die Zwecke + der Textkosmetik benötigt (Trenn-'k' bei der Umwandlung von 'ck' in 'kk'; Trenn­ + zeichen; geschütztes Leerzeichen). + +3) Das Zeichen '\#' (Code 222) ist druckbar, während das Zeichen '\#' (Code 35) nicht + druckbar ist (Einleitungszeichen für Anweisungen der Textkosmetik und Drucker). + +4) Das Zeichen SP (Code 223) wird zur besseren Identifizierung invers oder als + Unterstreichungsstrich auf dem Terminal dargestellt. In einem Ausdruck erscheint + es als ein Leerzeichen. + +Falls Sie Zeichen ausgeben möchten, die nicht auf der Tastatur sind, müssen Sie den +Code der gewünschten Zeichen zu Hilfe nehmen. + +Bewegen Sie den Cursor dazu an die Stelle der Datei, an die das Sonderzeichen +geschrieben werden soll und geben Sie nach ein: + + +____________________________________________________________________________ + ................. dateiname .................. Zeile 123 + + TABELLE 1 + _____________________ + | | + gib kommando : type(code(124)) + + + +____________________________________________________________________________ +#page# +6.3. Sortier-Programme +#free(1.0)# + + + Es stehen zwei verschiedene Sortier-Programme zur Verfügung: 'sort' (Sortierung + nach ASCII-Reihenfolge) und 'lex sort' (Sortierung nach deutschem Alphabet). + +#free(1.0)# + +Die Sortierprogramme sortieren eine Datei zeilenweise. + +Beispiel: + + +____________________________________________________________________________ + ................. dateiname ................. Zeile 1 + Berta ist eine Frau. + Adam ist ein Mann. + ... + +____________________________________________________________________________ + + +____________________________________________________________________________ +gib kommando : +#ib#sort#ie# ("dateiname") + +____________________________________________________________________________ + + + + +____________________________________________________________________________ + ................. dateiname ................. Zeile 1 + Adam ist ein Mann. + Berta ist eine Frau. + ... + +____________________________________________________________________________ + + + + +Dabei werden die Zeilen-Anfänge solange zeichenweise miteinander verglichen, bis +ein Unterschied auftritt und dann ggf. umgeordnet. Werden zwei ungleich lange Zeilen +(Anzahl Zeichen/Zeile) miteinander verglichen, dann kann man sich die kürzere Zeile +mit Leerzeichen auf die Länge der längeren Zeile verlängert denken. + +Die Reihenfolge, in der die Zeilen sortiert werden, erfolgt nach dem ASCII- +Zeichensatz in aufsteigender Reihenfolge (vergl EUMEL-Zeichencode): + + + das Leerzeichen + einige Sonderzeichen + die Ziffern + einige Sonderzeichen + große Buchstaben + einige Sonderzeichen + kleine Buchstaben + einige Sonderzeichen + die Umlaute und ß + + +Das bedeutet, daß z.B. folgendermaßen sortiert wird: + + +____________________________________________________________________________ + ................. dateiname ................. Zeile 1 + Adam + Ball + Zuruf + aber das ist ein Satz + niemals + Überlauf + +____________________________________________________________________________ + + + + +Um zu erreichen, daß große und kleine Buchstaben gleichwertig behandelt werden, +kann man das Kommando + +____________________________________________________________________________ +gib kommando : +#ib#lex sort#ie# ("dateiname") + +____________________________________________________________________________ + + + +geben. + +In diesem Fall würde die sortierte Datei folgendermaßen aussehen: + +____________________________________________________________________________ + ................. dateiname ................. Zeile 1 + aber das ist ein Satz + Adam + Ball + niemals + Überlauf + Zuruf + +____________________________________________________________________________ + + +Man beachte, daß der Umlaut 'Ü' wie 'Ue' behandelt wird (für die restlichen Umlaute +gilt eine analoge Behandlung; ebenso wird 'ß' wie 'ss' behandelt). Weiterhin werden +alle Sonderzeichen bei der Sortierreihenfolge ignoriert. + +6.4 Fonttabellen +#free(1.0)# + + + Eine Fonttabelle enthält Angaben zu den druckbaren Zeichen. + +#free(1.0)# + +Die Einstellung einer Fonttabelle#u#1)#e# erfolgt automatisch beim Einrichten der Drucker- +Task (siehe Anhang). Um den Namen der in der Task eingestellten Fonttabelle zu +erhalten geben Sie ein: +#foot# +1) Fonttabelle: Beschreibung der druckbaren Schrifttypen. +#end# + +____________________________________________________________________________ + +gib kommando: +put(fonttable) + +____________________________________________________________________________ + + +Die Ausgabe liefert den Namen der in der Task eingestellten Fonttabelle. + +____________________________________________________________________________ + +gib kommando: +put(fonttable) +agfa9 +gib kommando: + +____________________________________________________________________________ + + +Um eine neue oder andere Fonttabelle einzustellen, etwa weil verschiedene Drucker +benutzt werden können, geben Sie das 'fonttable' Kommando mit dem Namen der +gewünschten Fonttabelle als Parameter an: + +____________________________________________________________________________ + +gib kommando: +fonttable("name der fonttabelle") + +____________________________________________________________________________ + + + +Eine weitergehende Beschreibung der eingestellten Fonttabelle erhalten Sie durch das +Kommando 'list fonts': + +____________________________________________________________________________ + +gib kommando: +list fonts + +____________________________________________________________________________ + + +Durch dieses Kommando erhalten Sie in das Notizbuch eine Aufstellung der Schrift­ +typen mit Angaben zu Namen der verfügbaren Schrifttypen in der Fonttabelle, +Größenangaben zu den Schriftttypen etc. + +____________________________________________________________________________ + ................. notebook .................. Zeile 1 +FONTTABELLE : "agfa9"; + x einheit = 160.0; + y einheit = 160.0; + + FONT : "micro", "elanlist", "bulletin22"; + einrueckbreite = 20; + durchschuss = 7; + fonthoehe = 30; + fonttiefe = 8; + groesserer font = ""; + kleinerer font = ""; + + FONT : "trium10"; + einrueckbreite = 31; + durchschuss = 6; + fonthoehe = 54; + fonttiefe = 15; + groesserer font = "trium12"; + kleinerer font = "trium8"; + +____________________________________________________________________________ + + + +Anmerkung: + - Falls mehrere Namen für einen Schrifttyp angegeben sind, können Sie + einen beliebigen dieser Namen in der \#type\#-Anweisung benutzen. + + - Größenangaben sind in 'Mikroschritten', d.h. den kleinstmöglichen + Schritten des jeweiligen Druckers angegeben und nicht etwa in mm. + + - Weitere Informationen entnehmen Sie ggf. dem Systemhandbuch. + +#page# +6.5 Syntax der Kommandos +#free(1.0)# +code + TEXT PROC code (INT CONST zahl) + Wandelt 'zahl' in ein Zeichen um. Falls die Zahl kleiner als 32 oder größer als 254 + ist, (siehe Codetabelle) muß mit unerwarteten Ergebnissen gerechnet werden. + + + type(code(92)) + + + INT PROC code (TEXT CONST zeichen) + Wandelt 'zeichen' in die zugehörige EUMEL-Codierung um. Falls mehr als ein + Zeichen angegeben wird, ist das Resultat '-1'. + + + put(code(92)) + + + +list fonts + PROC list fonts + Listet die Fonts der eingestellten Tabelle ins #on("i")#notebook#off("i")#. + + PROC list fonts (TEXT CONST fonttable name) + Listet die Fonts der angegebenen Fonttabelle ins #on("i")#notebook#off("i")#. Die vorher eingestellte + Fonttabelle bleibt jedoch weiter eingestellt. + + + list fonts ("fonttab.alternativ") + + + +lex sort + PROC lex sort (TEXT CONST datei) + + Zeilenweise Sortierung nach (deutscher) lexikographischer Reihenfolge nach DIN + 5007. + + + lex sort ("telephonliste") + + + PROC lex sort (TEXT CONST datei, INT CONST anfang) + + Wie 'lex sort', jedoch wird bei der Sortierung bei 'anfang' jeder Zeile begonnen. + + + lex sort ("liste",20) + + +sort + PROC sort (TEXT CONST datei) + + Die Prozedur 'sort' sortiert die Datei 'datei' zeilenweise. Die Sortierung erfolgt + nach der Ordnung, die der EUMEL-Zeichencode vorschreibt. Beispielsweise + werden Zeilen ("Sätze"), die mit Ziffern beginnen, vor Sätzen, die mit Buchstaben + anfangen, eingeordnet. Sätze, die mit großen Buchstaben beginnen, werden vor + Sätzen mit kleinen Buchstaben einsortiert. Weiterhin werden die Umlaute und das + "ß" nach allen anderen Buchstaben eingeordnet. + + + sort ("liste") + + + PROC sort (TEXT CONST datei, INT CONST anfang) + + Sortiert eine Datei wie obige Prozedur, jedoch wird bei der Sortierung nicht der + Anfang eines Satzes beachtet, sondern die Position 'anfang'. + + + sort ("liste",10) + + + +type + PROC type (TEXT CONST zeichenkette) + + Fügt 'zeichenkette' in die aktuelle Position der editierten Datei ein. Besonders + nützlich in Verbindung mit der Prozedur 'code', um nicht auf der Tastatur enthal­ + tene Zeichen in den Text zu bringen. + + + type(code(200)) + diff --git a/doc/user-manual/1.8.7/doc/benutzerhandbuch.anhang b/doc/user-manual/1.8.7/doc/benutzerhandbuch.anhang new file mode 100644 index 0000000..5a58f95 --- /dev/null +++ b/doc/user-manual/1.8.7/doc/benutzerhandbuch.anhang @@ -0,0 +1,484 @@ +#start(5.0,1.5)##pagenr("%",1)##setcount(1)##block##pageblock##count per page# +#headeven# +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# + EUMEL-Benutzerhandbuch +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#headodd# +#lpos(0.0)##cpos(5.5)##rpos(11.0)##fillchar(" ")# +#table# + Anhang +#fillchar(" ")# +#on("u")# #off("u")# +#table end##clear pos# + +#end# +#bottomeven# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +A - % GMD +#tableend##clearpos# +#end# +#bottomodd# + +#lpos(0.0)##cpos(5.5)##rpos(11.0)# +#table# +#fillchar(" ")# +#on("u")# #off("u")# +#fillchar(" ")# +GMD A - % +#tableend##clearpos# +#end# +Aufbau und Installation +#free(0.5)# + Diese Installationsanleitung dient nur als Beispiel und soll nicht die Anleitung zu + dem von Ihnen benutzten Gerät ersetzen. Insbesondere die hier beschriebene + Möglichkeit der Partitionierung ist kein Standard! +#free(0.5)# +Allgemeines über das Betriebssystem EUMEL +#free(0.5)# + +Zum besseren Verständnis des Installierungsvorganges sei hier kurz der Aufbau des +Betriebssystems EUMEL erläutert (Der EUMEL-Kenner mag diesen Abschnitt über­ +springen) : + +Das System besteht im wesentlichen aus den folgenden Komponenten : + + - SHard (#on("i")##on("b")#S#off("b")##off("i")#oftware - #on("i")##on("b")#Hard#off("b")##off("i")#ware Interface) + - Systemkern (EUMEL-0) + - darauf aufbauende Systemteile + +Das #on("b")##ib#SHard#ie##off("b")# ist der #on("u")#hardwareabhängige#off("u")# Teil des Betriebssystems. Dieser Teil ist ver­ +antwortlich für den Informationsfluß zwischen der virtuellen Maschine EUMEL-0 und +den einzelnen Hardwarekomponenten (Tastatur, Diskettenlaufwerk, Schnittstellen, +usw.). + +Der #on("b")#Systemkern#off("b")# (auch mit EUMEL-0 oder Urlader bezeichnet) ist der #on("u")#prozessorab­ +hängige#off("u")# Teil des Systems. Er bestimmt im wesentlichen die Leistung des Betriebssy­ +stems, da er als virtueller Prozessor den Befehlsumfang für den ELAN-Compiler +definiert. Dieser Befehlsumfang wird dann auf den tatsächlichen Befehlsvorrat des +hardwaremäßig vorhandenen Prozessors abgebildet. + +Die auf dem Kern (EUMEL-0) #on("b")#aufbauenden Systemteile#off("b")# sind #on("u")#hardware- und prozes­ +sorunabhängig#off("u")#. Sie beinhalten den ELAN-Compiler und alle Tasks, Texte, insertier­ +ten ELAN-Pakete, benannte und unbenannte Datenräume eines EUMEL-Systems. +Diese Systemteile bilden zusammen mit dem Systemkern EUMEL-0 den #goalpage("v2")##on("b")#EUMEL- +Hintergrund#off("b")#, d.h. EUMEL-0 ist Teil des #ib#EUMEL-Hintergrundes#ie#. Momentan werden +je nach Rechnertyp Diskette und Festplatte als Hintergrundspeichermedium für +EUMEL unterstützt. + +Der Begriff EUMEL-Hintergrund (HG) resultiert aus dem Konzept des virtuellen +Speichers. Bei diesem Konzept wird der RAM-Speicherbereich der Hardware nur als +Pufferbereich nach dem Demand-Paging-Verfahren benutzt, mit Ausnahme der +residenten Systemteile (SHard und EUMEL-0). Das macht den Benutzer bezüglich +seiner Programme und Daten unabhängig von der eigentlichen Größe des RAM- +Speichers. Diese bestimmt lediglich den Durchsatz (Performance) des Systems, d.h. je +größer der RAM-Bereich Ihres Rechners ist, desto schneller arbeitet das EUMEL- +System. + +EUMEL-0 befindet sich auf der ersten Hintergrunddiskette. Das Laden von +EUMEL-0 und des restlichen EUMEL-Hintergrundes kann daher in einem Arbeits­ +gang geschehen. + +Der Auslieferungs-Hintergrund ist noch nicht konfiguriert und stellt ausschließlich die +im Handbuch beschriebenen Leistungen des Betriebssystems zur Verfügung. Er +besteht im wesentlichen aus insertierten ELAN-Paketen, die den Leistungsumfang +des Systems bestimmen (Single- oder Multiuser, mit oder ohne Textverarbeitung). +Steht dieser Hintergrund auf mehreren Disketten (Multiuser-Hintergründe), dann sind +diese fortlaufend numeriert. Die erste Hintergrunddiskette hat die Nummer 0, um +daran zu erinnern, daß sich auf dieser Diskette auch der Systemkern EUMEL-0 +befindet. + +Ein Hintergrund kann natürlich auch die Systemsicherung eines größeren Systems mit +z.B. mehreren Megabytes sein. Sollten Sie später einmal Ihr bestehendes System +durch ein anderes ersetzen wollen (Hintergrund überschreiben), so brechen Sie wäh­ +rend des Hochfahrens beim Speichertest das System durch Tastendruck ab und laden +durch Anwahl von 2 'neuen Hintergrund vom Archiv laden' im Startdialog das neue +System. + +#on("i")##on("u")#ACHTUNG:#off("u")##off("i")# Dabei gehen alle Daten des alten Systems unwiederbringlich verloren! + (Siehe dazu auch 'Laden eines EUMEL-Hintergrundes'.) + +Zur besseren Verständlichkeit sollen an dieser Stelle noch die Begriffe 'Systemstart' +und 'Systemabschaltung' des EUMEL-Systems erläutert werden : + +#on("i")##on("b")##ib#Systemstart#ie# :#off("b")##off("i")# +Wenn ein EUMEL-System gestartet wird (auch 'Hochfahren' genannt), und dies gilt +auch für kleinere Diskettensysteme wie den 'Generierungseumel' (siehe Seite #topage("v1")#), +wird zunächst das SHard geladen; dazu erscheint auf dem Bildschirm eine entspre­ +chende Meldung. Das SHard versucht nun den Systemkern vom Archivmedium (in der +Regel Diskette) zu laden. Ist keine entsprechende Diskette eingelegt, so wird ver­ +sucht, EUMEL-0 vom Hintergrundmedium (Festplatte) zu laden. + +Danach wird EUMEL-0 aktiv; auf dem Bildschirm erscheinen Angaben zu verfügba­ +ren Kanälen, RAM- und Hintergrundspeicher-Größe. Dann führt EUMEL-0 einen +Speichertest durch, was daran zu erkennen ist, daß eine Folge von Sternchen (*) auf +den Schirm geschrieben wird. Wird währenddessen eine beliebige Taste gedrückt, +dann gelangt man nach dem Speichertest in den 'Startdialog'. + +Nach dem Speichertest bzw. nach Wahl von <1> 'Systemstart' im Startdialog wird der +Hintergrund aktiviert, was je nach Größe des Systems und Art des Hintergrundmedi­ +ums unterschiedlich lange dauert. + +#on("i")##on("b")##ib#Systemabschaltung#ie# :#off("b")##off("i")# +Bevor man den Rechner ausschaltet, sollte jedes EUMEL-System ordnungsgemäß +abgeschaltet werden. Das geschieht durch den Befehl 'shutup', den man in der Multi­ +user-Version von EUMEL im privilegierten Zweig des Taskbaumes erteilen muß. Nur +dann ist gewährleistet, daß der aktuelle Zustand Ihres Systems gesichert ist. + +Andernfalls gilt das System als abgebrochen, was daran zu erkennen ist, daß sich das +System beim nächsten Systemstart mit 'RERUN' meldet. Dann kann nur am letzten +Fixpunkt wieder aufgesetzt werden, und Ihre in letzter Zeit (normalerweise ca. 15 +Minuten) gesammelten Daten können verloren sein. + +Installation des EUMEL-Systems +#free (1.0)# + +#goalpage("a1")#A: Erforderliche Disketten + + - EUMEL-Systemdiskette : "Generierungseumel XY"#u#1)#e# + - EUMEL-Hintergrunddisketten : "HG0" ... "HGn" + - EUMEL-Archivdisketten : "std..." + - EUMEL-Archivdiskette : "XY" (Typabhängig) + - MS-DOS-Diskette : "EUMELstart" + +#foot# +1) XY steht für die Typbezeichnung eines Rechners wie: XT, AT, M24 usw. + Die Anzahl der ausgelieferten Disketten ist auch typabhängig, da z.B. + 'EUMELstart' nur benötigt wird, falls tatsächlich eine Partitionierung möglich ist. +#end# + +Die Diskette #goalpage("v1")##on("u")#"Generierungseumel XY"#off("u")# ist ein kleines, jedoch vollständiges EUMEL- +System. Auf diesem System laufen nach dem Hochfahren Programme ab, die im +Dialog mit dem Benutzer die Generierung einer oder mehrerer EUMEL-Partitionen +ermöglichen, diese Bereiche bezüglich schlechter Spuren untersuchen und das SHard +auf der jeweiligen Partition installieren. #on("b")#Bei der Generierung darf diese Diskette nicht +schreibgeschützt sein !#off("b")# + +Die #on ("u")#Hintergrunddisketten "HG0" ... "HGn"#off ("u")# beinhalten das eigentliche Betriebssystem +EUMEL. Es sind dies der Systemkern EUMEL-0 und die darauf aufbauenden Sy­ +stemteile (siehe Seite #topage("v2")#). + +Die #on ("u")#Standardarchivdisketten "std..."#off ("u")# beinhalten ELAN-Programmpakete und Fontta­ +bellen, die Sie nach erfolgter Installation des Betriebssytems z.B. zum Zwecke einer +Druckerinstallation oder erweiterter Rechenfunktionen benötigen werden. Sie finden +dazu detaillierte Informationen in Ihrem Benutzer- und Systemhandbuch. + +Die #on("u")#Archivdiskette "XY"#off ("u")# beinhaltet ELAN-Programmpakete, die Funktionen, die nicht +zu den Standardleistungen von EUMEL bzw. der vorliegenden SHard-Version zählen. + +Die Diskette #on("u")#"EUMELstart"#off("u")# ist eine MS-DOS Diskette und beinhaltet Kommando- +Dateien. Falls Sie auch eine MS-DOS Partition eingerichtet haben, dann gewährlei­ +sten diese das Aktivieren einer EUMEL Partition mit gleichzeitigem Systemstart von +MS-DOS aus. +#free (1.0)# + +#goalpage("a2")#B: Partitionieren der Festplatte / Installation des SHard + + +Wenn Sie bereits ein Betriebssystem auf Ihrer Festplatte installiert haben, müssen Sie +darauf achten, daß noch ausreichend Platz für ein EUMEL-System übrig ist. Da z.B. +MS-DOS standardmäßig die gesamte Festplatte belegt, muß dieses System gesi­ +chert, mit dem MS-DOS-Kommando 'fdisk' gelöscht und entsprechend kleiner neu +eingerichtet werden. Sie können auch bei der EUMEL-Installation alle bereits beste­ +henden Systeme löschen; dazu bietet Ihnen der Generierungseumel die Option +#on("i")#Löschen der gesamten Partitionstabelle #off("i")# an. Dabei gehen jedoch alle bestehenden +Daten verloren. Achten Sie also darauf, daß sie alle Daten vorher gesichert haben ! + +#on("u")##on("i")#Hinweis:#off("i")##off("u")# Bei Festplatten mit einer Kapazität über 32 Megabyte kann die Installa­ + tion des SHard zu Problemen führen (Fehlermeldung #on("i")#Platte kann nicht + gelesen werden#off("i")# bei der Suche nach schlechten Spuren). Richten Sie + daher Ihre EUMEL-Partition(en) auf den ersten 32 Megabyte ein. + +Um nun die Partitionierung für Ihr EUMEL-System vorzunehmen, legen Sie die +Diskette 'Generierungseumel' in das Boot-Laufwerk. Sollte die Diskette mit einer +Schreibschutzmarke versehen sein, dann müssen Sie diese vorher entfernen. + +Schalten Sie nun den Rechner ein bzw. betätigen Sie den Tastatur-RESET, wenn Ihr +Gerät bereits eingeschaltet ist, indem Sie die Tasten gleichzeitig +betätigen. + +Der Generierungseumel meldet sich zunächst mit folgender SHard-Meldung: + + + +____________________________________________________________________________ + +Setup - SHard für EUMEL auf XY und Kompatiblen V x.x +Copyright (C) 1985,86 +EUMEL wird vom Hintergrund geladen + +____________________________________________________________________________ + + + +Danach erscheinen die EUMEL-0 Meldungen zu HG-, RAM- und Pufferkapazität, +bezogen auf den Diskettenhintergrundes des Generierungseumel. + +#on("i")##on("u")#ACHTUNG:#off("u")##off("i")# Der Generierungseumel soll während des Speichertests (Sternchen) + nicht unterbrochen werden. Geschieht dies versehentlich doch, dann + fahren Sie fort, indem Sie im Startdialog die Taste <1> für Systemstart + betätigen. Dann wird normal mit der Installation fortgefahren. Wählen + Sie keinesfalls <2> 'neuen Hintergrund vom Archive laden', solange sich + die Diskette 'Generierungseumel' im Archivlaufwerk befindet. + +Nach dem Hochfahren des 'Generierungseumel' wird Ihnen eine Tabelle angezeigt, +der Sie entnehmen können, ob bereits Partitionen auf der Festplatte eingerichtet und +wie diese spezifiziert sind. + +Angezeigt werden neben Größe, Start- und Endspur der einzelnen Partitionen auch +eine Typ-Nr.; für EUMEL-Partitionen werden in aufsteigender Reihenfolge die +Typ-Nummern 69 bis 72, für MS-DOS je nach Größe der eingerichteten Partition +die Nummer 1 oder 4 vergeben. Die Typ-Nummern der eingerichteten Partitionen +sollten Sie sich merken, da diese Angaben später von Bedeutung sind, wenn das +Gesamtsystem für Partitionswechsel vorbereitet wird. Richten Sie mehrere EUMEL- +Partitionen ein, dann können Sie diese ausschließlich über die Typ-Nummern identi­ +fizieren ! + +Außerdem wird die gerade aktive Partition durch einen entsprechenden Eintrag in der +Tabelle kenntlich gemacht. #on("b")#"Aktiv" ist die Partition, die nach dem nächsten Einschal­ +ten des Rechners bzw. nach dem nächsten Tastatur-RESET gebootet würde.#off("b")# + +Sie können nun eine der folgenden Funktionen auswählen : + + - Generieren einer EUMEL-Partition + - Aktivieren einer Partition + - Löschen einer EUMEL-Partition + - Löschen der gesamten Partitionstabelle + - Generierung beenden + +Beim Generieren einer EUMEL-Partition werden lediglich Angaben zu Größe und +Startzylinder abgefragt. Dafür werden Vorgaben gemacht, die Sie bestätigen können, +indem Sie die Taste betätigen. + +Beim Neueinrichten orientiert sich die Vorgabe für die Partitionsgröße an dem größten +zusammenhängenden Freiraum auf Ihrer Platte, die Vorgabe für den Startzylinder +orientiert sich dann an dem kleinsten zusammenhängenden Freiraum, auf dem eine +Partition der gewählten Größe eingerichtet werden kann. + +#on("i")##on("u")#ACHTUNG:#off("u")##off("i")# Soll eine EUMEL-Version installiert werden, die nur 16 Megabyte + verwalten kann (1.7.3 bzw. 1.8.0), dann darf die Partition nicht größer + eingerichtet werden. Es kann hier keine generelle Aussage über die + Anzahl der zu reservierenden Spuren gemacht werden, da sehr ver­ + schiedene Plattenaufteilungen angeboten werden. Entnehmen Sie die + entsprechenden Angaben bitte dem Festplatten-Handbuch Ihres Hard­ + wareherstellers. + +Das Löschen einer EUMEL-Partition geschieht nur logisch, nicht physisch, das heißt +es wird nur der Eintrag in der Partitionstabelle gelöscht. Sollten Sie später an gleicher +Stelle eine neue Partition einrichten und vorher diesen Bereich physisch nicht über­ +schrieben haben, dann würde nach dem Hochfahren des Rechners das alte System +wieder gestartet. Die Meldung 'kein EUMEL-System gefunden'(siehe unten) erscheint +dann nicht. + +Haben Sie Ihre EUMEL-Partition(en) eingerichtet, dann achten Sie darauf, daß Sie +Ihren Generierungseumel ordnungsgemäß wieder verlassen, da es sich hier, wie +bereits erwähnt, um ein vollständiges EUMEL-System mit Fixpoint/Rerun-Logik +handelt. Das 'shutup' wird automatisch ausgeführt, wenn Sie die Funktion '0. Gene­ +rierung beenden' wählen. + +Wenn die Meldung 'ENDE' auf Ihrem Bildschirm erscheint, ist dieser Schritt der +Installation beendet. Sie haben nun eine (oder mehrere) EUMEL-Partitionen einge­ +richtet und das SHard installiert. Bitte entfernen Sie jetzt die Diskette 'Generierungs­ +eumel' aus dem Diskettenlaufwerk. +#free (1.0)# +Laden eines EUMEL-Hintergrundes + +#free(1.0)# +Im nächsten Schritt wird auf Ihrer Festplatte das EUMEL-System installiert, d.h. es +wird ein Hintergrund auf der Festplatte erzeugt. + +Dazu müssen Sie nach dem ordnungsgemäßen Beenden des Generierungseumel und +Entfernen der Diskette aus dem Laufwerk den Tastatur-RESET betätigen. Dies +geschieht entweder durch gleichzeitiges Betätigen der Tasten +auf der Tastatur oder durch AUS- und wieder EIN-Schalten des Rechners (Bitte +warten Sie einen Augenblick zwischen dem AUS- und EIN-Schalten). + +Das System meldet sich nach kurzer Zeit mit folgender SHard-Meldung: + + +____________________________________________________________________________ + +SHard für EUMEL auf XY, V x.x +Copyright (C) 1985,86 +kein EUMEL-System gefunden + +____________________________________________________________________________ + + + +Sie legen nun die Hintergrunddiskette HG0 in das Boot-Laufwerk und betätigen eine +Taste. + +Der Systemkern wird nun geladen und es erscheinen die bereits oben erwähnten +Angaben zu HG-, RAM- und Pufferkapazität, sowie zu den angeschlossenen +Kanälen, diesmal jedoch bezogen auf die eingerichtete Festplatten-Partition. Wäh­ +rend des Speichertests drücken Sie bitte erneut eine Taste, um in den Startdialog zu +gelangen und damit zu verhindern, daß EUMEL-0 versucht, das System zu starten. +Sollten Sie dies versäumen, so erscheint die Meldung 'HG ungültig'. Sie haben dann +erneut die Möglichkeit, durch Betätigen einer Taste in den Startdialog zu gelangen. + +Hier wählen Sie den Menupunkt <2> 'neuen Hintergrund vom Archiv laden' und bestä­ +tigen die Frage 'Alten Hintergrund überschreiben' mit für 'ja'. + +Es erscheint ein Zähler auf dem Bildschirm, der die gelesenen Blöcke anzeigt. Verteilt +sich Ihr Hintergrund auf mehrere Disketten, dann müssen Sie bei bei der Frage +'Neues HG-Archiv eingelegt' die nächste Diskette einlegen und mit # #off("i")# quittieren. +Bitte beachten Sie dabei genau die Numerierung der HG-Disketten ! + +Es können bei beschädigten Disketten Lesefehler auftreten; dann gibt das System +eine der Meldungen 'Harter Lesefehler' bzw. 'Softerror' aus. Bei letzterem konnte der +entsprechende Sektor nach mehrmaligem Versuch noch gelesen werden. Bei einem +harten Lesefehler können Sie die Diskette nicht verwenden. + +Wenn alle Disketten eingelesen sind, müssen Sie ein letztes mal den Tastatur- +RESET betätigen, um das System zu starten. Vergessen Sie nicht, vorher die Hinter­ +grunddiskette aus dem Diskettenlaufwerk zu entfernen. + +Wenn Sie jetzt während des Hochfahrens keine Taste drücken, dann startet der Lader +durch und das EUMEL-System meldet sich mit 'System aufgebaut'. Dies dauert +beim Auslieferungshintergrund wenige Sekunden, kann jedoch bei größeren Systemsi­ +cherungen auch mehrere Minuten in Anspruch nehmen; verlieren Sie dann bitte nicht +allzu schnell die Geduld. + +Da der Auslieferungs-Hintergrund unkonfiguriert ist, gelangt das System beim ersten +Hochfahren nach der Installation sofort in den 'configurator'. Sie müssen jetzt den +Kanal 1 entsprechend der vorhandenen Tastatur als "PC.german" oder "PC.ascii" +konfigurieren. Sollten Sie eine EUMEL-Version 1.7.3 benutzen und diesen Konfigura­ +tionsdatenraum nicht zur Verfügung haben, dann konfigurieren Sie den Kanal 1 als +"PC" und Terminal. Näheres dazu finden Sie im Systemhandbuch (Teil 1). +#page# + Die einzelnen Schritte der Installation im Überblick +#free (0.5)# +#linefeed(1.5)# + 1. Die Diskette 'Generierungseumel' in das Laufwerk stecken + 2. Rechner einschalten oder Tastatur-RESET mit , + 3. EUMEL-Partition einrichten + 4. Generierung beenden und auf 'ENDE'-Meldung warten + 5. Diskette 'Generierungseumel' entnehmen + 6. Tastatur-RESET + 7. Die Meldung 'Kein EUMEL-System gefunden' abwarten. Wenn die Meldung + 'EUMEL wird vom Hintergrund geladen' erscheint, dann weiter bei 9. + 8. Erste Hintergrunddiskette (HG0) einlegen und Taste drücken + 9. Beim Speichertest eine Taste betätigen, um in den Startdialog zu gelangen. + 10. Menupunkt <2> anwählen : Neuen Hintergrund vom Archiv laden + 11. Eventuell weitere HG-Disketten nach entsprechender Aufforderung einlegen + und mit quittieren + 12. Tastatur-RESET nach entsprechender Aufforderung + 13. Nach dem Hochfahren des Systems Konfiguration lt. Systemhandbuch + vornehmen + 14. Ggf. in der Task 'SYSUR' ELAN-Pakete für Partitionswechsel insertieren. + #linefeed (1.0)# + Dazu - Falls eine EUMEL-Version 1.7.3 benutzt wird, zunächst das + Kommando #on("i")#free global manager#off("i")# in der Task 'configurator' absetzen + - Archivdiskette "XY" einlegen und anmelden : #on("i")#archive �("XY")#off("i")# + - Datei "XY install" von Archivdiskette lesen : + #on("i")#fetch ("XY install", archive)#off("i")# + - Insertierung starten : #on("i")#run#off("i")# +Druckersoftware einrichten + +#free(0.5)# +Um mit Ihrem EUMEL-System einen Drucker betreiben zu können, müssen Sie +außer dem Anschluß des Druckers mit einem passenden Kabel auch die passende +Software für diesen Drucker zur Verfügung stellen. Zu diesem Zweck dienen die +Druckeranpassungen. + +Das Standardarchive "std.printer" enthält Druckeranpassungen für die Ansteuerung +diverser gebräuchlicher Druckertypen. Soll einer dieser Drucker an das EUMEL- +System angeschlossen werden, so muß zuerst eine Task "#ib#PRINTER#ie#" als Sohntask +von "SYSUR" mit dem Supervisorkommando + +#linefeed (1.18)# + begin ("PRINTER", "SYSUR") +#linefeed (1.0)# + +eingerichtet werden. In dieser Task müssen dann die folgenden Schritte vollzogen +werden: + +- Archiv anmelden: +#linefeed (1.18)# + archive ("std.printer") +#linefeed (1.0)# + +- Druckeranpassung vom Archiv holen: +#linefeed (1.18)# + fetch ("printer.druckertyp", archive) +#linefeed (1.0)# + +- Zeilennummergenerierung bei der Insertierung abschalten: +#linefeed (1.18)# + check off +#linefeed (1.0)# + +- Druckeranpassung insertieren: +#linefeed (1.18)# + insert ("printer.druckertyp") +#linefeed (1.0)# + +Beispiel: +#linefeed (1.18)# + archive ("std.printer") + fetch ("printer.epson.fx", archive); + check off; + insert ("printer.epson.fx") +#linefeed (1.0)# + +Nach der Insertierung wird zuerst nach dem #ib#Druckerkanal#ie# gefragt. Dieser sollte mit +der Gerätetabelle 'transparent' konfiguriert sein. Dann werden ggf. druckerspezifische +Fragen zur Papierbreite, Positionierungsart oder ähnlichem gestellt, die mit 'j' oder 'n' +beantwortet werden müssen. Dabei werden alle Alternativantworten zu der jeweili­ +gen Frage hintereinander angeboten, bis eine Alternative mit 'j' beantwortet wird. + +Als letzter Schritt kommt die Aufforderung das Archiv mit der passenden Fonttabelle +einzulegen. Diese Fonttabelle, eine Beschreibung aller darstellbaren Zeichen in allen +druckbaren Schrifttypen, ist meistens auf derselben Diskette wie die Druckeranpas­ +sung. + +Wenn die Generierung beendet ist, muß im Multi-User Betrieb in allen bestehenden +Tasks - insbesondere in der Task 'PUBLIC' - die Fonttabelle mit dem fonttable- +Kommando eingestellt werden. + +Beispiel: + +#linefeed (1.18)# + fonttable("fonttab.epson.fx") +#linefeed (1.0)# + +Von jeder Task aus kann danach mit dem Kommando + +#linefeed (1.18)# + print ("dateiname") +#linefeed (1.0)# + +wird eine Datei ausgedruckt werden. + +Das Einstellene einer Fonttabelle ist insbesondere Voraussetzung für 'lineform', 'page­ +form' etc. + +Befindet sich keine passende Druckeranpassung für den anzuschließenden Drucker­ +typ auf dem Standardarchiv "std.printer", so sollte die Druckeranpassung "printer.std" +benutzt werden. Diese Druckeranpassung ist eine universelle Druckeranpassung für +alle Drucker, die mit ASCII-Code 13 ein 'Carriage Return' (d.h. Bewegung des +Druckkopfes an den linken Rand) und mit ASCII-Code 10 eine Zeilenschaltung von +1/6 Zoll vornehmen. Mit ihr kann dann in einem Schrifttyp (entweder 10 oder 12 +Zeichen pro Zoll, je nachdem welche Fonttabelle eingestellt ist) gedruckt werden. So +erhält man wenigstens eine Minimalansteuerung des Druckers. + + + +Druckersoftware im Single-User einrichten + + +Die Installation der Druckersoftware im Single-User erfolgt ähnlich wie die im Mul­ +ti-User. Hier brauchen nur die Schritte durchgeführt zu werden, die im Multi-User +in der Task "PRINTER" druchgeführt werden müssen. Eine Task "PRINTER" braucht +nicht eingerichtet zu werden. + diff --git a/doc/user-manual/1.8.7/doc/source-disk b/doc/user-manual/1.8.7/doc/source-disk new file mode 100644 index 0000000..97500ef --- /dev/null +++ b/doc/user-manual/1.8.7/doc/source-disk @@ -0,0 +1 @@ +grundpaket/09_handbuecher.1.img diff --git a/lang/basic/1.8.7/doc/basic handbuch.1 b/lang/basic/1.8.7/doc/basic handbuch.1 new file mode 100644 index 0000000..2e604cb --- /dev/null +++ b/lang/basic/1.8.7/doc/basic handbuch.1 @@ -0,0 +1,1075 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#Basic + + + + +#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# +#page nr ("%", 1)# +#head# +EUMEL-BASIC-Compiler Inhalt % +#end# + +Inhalt + +1 Einleitung 3 + +2 Installation des BASIC-Compilers 4 + +3 Aufruf und Steuerung des BASIC-Compilers 5 + +4 Umgang mit dem BASIC-Compiler 7 +4.1 Erläuterungen zur Syntax 7 +4.2 Datentypen und Konstanten 10 +4.3 Variablen und Felder 12 +4.4 Operatoren 14 +4.5 Funktionen 19 +4.6 Typanpassung 22 +4.7 Aufruf von EUMEL-Prozeduren in BASIC-Programmen 23 + +5 Steuerung der Bildschirmausgaben 25 + +6 Grenzen des Compilers 26 + +7 Fehlerbehandlung 28 +7.1 Fehler zur Übersetzungszeit 28 +7.2 Fehler zur Laufzeit 30 + +8 Übersicht über die Anweisungen und Funktionen 31 + +9 Anpassung von Programmen an den EUMEL-BASIC-Compiler 96 +9.1 Unterschiede zwischen BASIC-Interpretern + und dem EUMEL-BASIC-Compiler 96 +9.2 Abweichungen von ISO 6373-1984 (Minimal-BASIC) 97 +9.3 Anpassung von Microsoft-BASIC Programmen + an den EUMEL-BASIC-Compiler 98 + +Anhang A: Reservierte Wörter 100 +Anhang B: Vom Scanner erkannte Symboltypen 103 +Anhang C: Übersicht über die Fehlermeldungen 106 +Anhang D: ELAN-Prozeduren des Compilers 113 +#page# + + +#page nr ("%", 3)# +#head# +EUMEL-BASIC-Compiler 1. Einleitung % + +#end# + +1. Einleitung + + +BASIC entspricht heute nicht mehr den Vorstellungen von einer modernen Program­ +miersprache. Dennoch wurde für das EUMEL-Betriebssystem ein Compiler für BASIC +entwickelt. Er soll vor allem dazu dienen, schon bestehende BASIC-Programme - +gegebenenfalls nach entsprechender Anpassung - auch unter EUMEL verfügbar zu +machen. +Der Compiler ist weitgehend an die ISO-Norm 6373 für Minimal-BASIC angelehnt. +Die Syntax und Bedeutung der Anweisungen orientiert sich in den meisten Fällen an +Microsoft-BASIC. Anweichungen treten insbesondere an den Stellen auf, an denen +Prinzipien des Betriebssystems EUMEL verletzt würden. +Verglichen mit dem ELAN-Compiler des EUMEL-Systems ist der BASIC-Compiler +beim Übersetzen recht langsam. Auch aus diesem Grund scheint es nicht sinnvoll, +den BASIC-Compiler zur Neuentwicklung größerer Programme einzusetzen. + +Sinn dieses Handbuchs ist es vor allem, Kenntnisse über den Umgang mit dem +EUMEL-BASIC-Compiler zu vermitteln. Das Handbuch ist auf keinen Fall als Ein­ +führung in die Programmiersprache BASIC gedacht, sondern es soll dem Benutzer mit +BASIC-Erfahrung die Arbeit mit dem EUMEL-BASIC-Compiler ermöglichen und +erleichtern. Neben Erfahrung in BASIC setzt dieses Buch an einigen Stellen auch +Grundkenntnisse über das EUMEL-System voraus. + + + +Zur #ib(4)#Notation#ie(4)# in dieser Beschreibung + +Bei der Beschreibung der Anweisungen und Funktionen und auch an anderen Stellen +werden in dieser Beschreibung Syntaxregeln für BASIC-Programme oder Teile davon +angegeben. Dabei werden folgende Zeichen mit besonderer Bedeutung verwendet: + +[ ] optionale Angabe +[...] beliebig häufige Wiederholung der letzten optionalen Angabe +| alternative Angabe, d.h. entweder die letzte links stehende Angabe oder + die nächste rechts stehende Angabe, aber nicht beide +< > in spitzen Klammern stehende Begriffe sind entweder definiert (z.B. ) oder werden hinter der Syntaxregel erläutert + +Die Notation der exportierten ELAN-Prozeduren des Compilers (besonders in An­ +hangD) entspricht der in den EUMEL-Handbüchern üblichen Prozedurkopf- +Schreibweise. +#page# +#head# +EUMEL-BASIC-Compiler 2. Installation des BASIC-Compilers % + +#end# + +2. #ib(3)#Installation des BASIC-Compilers#ie(3)# + + +Der EUMEL-BASIC-Compiler wird auf zwei Disketten mit jeweils 360 KByte +Speicherkapazität ausgeliefert. +Auf der Diskette "BASIC.1" befindet sich das #ib(3)#Generatorprogramm#ie(3)#("gen.BASIC") zur +Installation des EUMEL-BASIC-Systems. +Legen Sie diese Diskette in das Laufwerk ihres Rechners ein und geben Sie in der +Task, in der das BASIC-System installiert werden soll, folgende Zeile nach 'gib +kommando :' (oder 'maintenance :') ein: + +archive ("BASIC.1"); fetch ("gen.BASIC", archive); run + +Lassen Sie die Diskette 'BASIC.1' im Laufwerk und antworten Sie auf die Frage +"Archiv "BASIC.1" eingelegt(j/n)?" mit "j". Das Generatorprogramm holt nun einige +Dateien von der Diskette. Nach Zugriff auf das Archiv erscheint die Meldung "Archiv +abgemeldet!" und die Frage "Archiv 'BASIC.2' eingelegt(j/n)?". Legen Sie nun statt +des Archivs 'BASIC.1' das Archiv 'BASIC.2' in das Laufwerk ein und drücken Sie bitte +wiederum "j". Nach weiteren Archivoperationen erscheint dann wieder die Meldung +"Archiv abgemeldet". Sie können nun die Diskette "BASIC.2" aus dem Laufwerk +entnehmen. +Das Generatorprogramm insertiert nun alle Programme des BASIC-Systems in der +Task. Dieser Vorgang nimmt einige Zeit in Anspruch. Zum Abschluß erscheint die +Meldung "BASIC-System installiert". +Der EUMEL-BASIC-Compiler steht Ihnen nun in der Task (und in nachfolgend +eingerichteten Söhnen) zur Verfügung. +#page# +#head# +EUMEL-BASIC-Compiler 3. Aufruf und Steuerung des BASIC-Compilers % + +#end# + +3. #ib(4)#Aufruf und #ib(3)#Steuerung des BASIC-Compilers#ie(3)##ie(4)# + + + + +Übersetzen von BASIC-Programmen + +Ein BASIC-Programm, das vom Compiler übersetzt werden soll, muß sich dazu in +einer EUMEL-Textdatei befinden (Syntax vgl. Kap. 4.). Steht das BASIC-Programm +zum Beispiel in der Datei "Programm.17+4", so wird der Compiler mit + + #ib(3)#basic#ie(3)# ("Programm.17+4") + +zum Übersetzen dieses Programms aufgerufen. +In einem Vordurchlauf werden die Zeilennummern des Programms auf Richtigkeit +überprüft. Beim eigentlichen Compilerdurchlauf wird das BASIC-Programm dann mit +Hilfe des EUMEL-Coders in einen von der EUMEL-0-Maschine ausführbaren Code +übersetzt. + +Das Programm wird mit 'check on' (Zeilennummergenerierung) übersetzt. +Ein 'runagain' wie bei ELAN-Programmen ist bei BASIC-Programmen zur Zeit +leider nicht möglich. + + + +Insertieren von BASIC-Programmen + +Der BASIC-Compiler kann BASIC-Programme auch insertieren. Das ganze Pro­ +gramm bildet dabei eine Prozedur, die nach dem Insertieren wie eine 'normale' +ELAN-Prozedur aufgerufen werden kann. +Zum Insertieren wird der Compiler mit einem zusätzlichen Text-Parameter aufge­ +rufen: + + #ib(3)#basic#ie(3)# ("Programm.17+4", "blackjack") + +Das Programm wird übersetzt und, falls keine Fehler gefunden wurden, fest einge­ +tragen ('insertiert'). Gestartet wird das Programm aber nicht. +"blackjack" ist nun der Prozedurname, unter dem das BASIC-Programm nach erfolg­ +reichem Insertieren aufgerufen werden kann. +Bei 'packets' erscheint jetzt der Eintrag 'BASIC.blackjack' in der Liste der insertierten +Pakete, und ein 'help ("blackjack")' zeigt, daß eine Prozedur 'blackjack' nun tatsäch­ +lich in der Task bekannt ist. Die Prozedur 'bulletin' funktioniert für insertierte +BASIC-Programme nicht. Sie ist aber auch nicht nötig, da das 'Paket' mit dem +BASIC-Programm ohnehin nur eine Prozedur enthält und ihr Name ja schon aus +dem Namen des Paketes hervorgeht. + +#on ("b")# +Beachten Sie: + - Der Prozedurname muß der Syntax für ELAN-Prozedurnamen entsprechen, darf + aber #on ("b")#keine Leerzeichen enthalten. + - Die BASIC-Programme können über den Prozedurnamen nur aufgerufen wer­ + den; die Übergabe von Parametern ist ebenso wie Wertlieferung nicht möglich. + - Jedes Insertieren belegt Speicherplatz im Codebereich der Task. Weil der Coder + und der Compiler ebenfalls recht viel Code belegen, kann es (vor allem, wenn + die BASIC-Programme lang sind) schnell zu einem Code-Überlauf kommen + (Compiler Error 305). Es sollten daher nur die Programme insertiert werden, für + die dies wirklich nötig ist. + - Achten Sie bei der Wahl des Namens für die gelieferte Prozedur darauf, daß sie + nicht ungewollt Prozeduren des Betriebssystems überdecken. (Der Aufruf 'ba­ + sic("tadellos","help")' wäre z.B. gar nicht tadellos, denn 'help' wäre nach dem + Insertieren überdeckt). + - Auch beim Insertieren werden die BASIC-Programme mit 'check on' übersetzt. +#off ("b")# + + +Ausgabe der übersetzten Zeilen während des +Compilierens +Mit '#ib(3)#basic list#ie(3)# (TRUE)' wird der Compiler so eingestellt, daß beim Übersetzen die +aktuelle Programmzeile ausgegeben wird. Diese Ausgabe kann auch mit '#ib(3)#sysout#ie(3)#' +umgeleitet werden. Zum Beispiel: + + sysout ("Fehlerprotokoll"); basic ("Programm.17+4") + +Dies kann beim #ib(3)#Debugging#ie(3)# von BASIC-Programmen eine wertvolle Hilfe sein, da in +der Ausgabedatei die Fehler sofort hinter der betreffenden Programmzeile vermerkt +werden. Das 'sysout' muß in Monitortasks ('gib kommando:') direkt vor dem Aufruf +des Compilers gegeben werden, weil der Monitor 'sysout' sonst wieder zurücksetzt. + +Mit 'basic list (FALSE)' kann die Ausgabe der Programmzeilen beim Übersetzen +wieder ausgeschaltet werden. + +#page# +#head# +EUMEL-BASIC-Compiler 4. Umgang mit dem BASIC-Compiler % + +#end# + +4. Umgang mit dem BASIC-Compiler + + + +4.1. Erläuterungen zur #ib(3)#Syntax#ie(3)# + + +Ein zu übersetzendes Programm muß dem BASIC-Compiler in Form einer +#ib(3)#EUMEL-Textdatei#ie(3)# übergeben werden. (Es gelten somit auch die für EUMEL-Text­ +dateien üblichen Begrenzungen, z.B. höchstens 32000 Zeichen pro Zeile und höch­ +stens 4075 Dateizeilen pro Datei.) +BASIC-Programme setzen sich aus Programmzeilen zusammen; jede Dateizeile der +#ib(3)#Programmdatei#ie(3)# bildet eine BASIC-Programmzeile. Die Syntax für ein Programm sieht +damit so aus: + + +[][...]EOF + +Dabei bedeutet #ib(3)#EOF (end of file)#ie(3)# das Ende der Programmdatei. + +Eine #ib(3)#Programmzeile#ie(3)# hat folgende Syntax: + + +[][][:][...][:]EOL + +Die #ib(3)#Zeilennummer#ie(3)# dient unter anderem als Sprungadresse an den Anfang der Pro­ +grammzeile während der Laufzeit des Programms (vgl. 'GOTO' und 'GOSUB'). Sie ist +fakultativ (d.h. sie muß nicht geschrieben werden). Durch sparsame Verwendung von +Zeilennummern (nämlich nur da, wo sie benötigt werden) kann eine gewisse Steige­ +rung der #ib(3)#Übersichtlichkeit von BASIC-Programmen#ie(3)# erreicht werden. Hat eine Pro­ +grammzeile keine Zeilennummer, so wird bei Fehlermeldungen (sowohl während der +Übersetzung als auch zur Laufzeit des Programms) die letzte Zeilennummer mit +angegeben, die davor auftrat. +Zeilennummern dürfen im Bereich von 1 bis 32767 liegen und müssen unbedingt in +aufsteigender Reihenfolge vergeben werden. Zeilennummern dürfen keine Leerzeichen +enthalten und müssen mit einem Leerzeichen abgeschlossen werden. Um spätere +Ergänzungen zu ermöglichen, ist eine Numerierung im Abstand zehn empfehlenswert. + +Hier ein Beispiel, wie ein BASIC-Programm in einer EUMEL-Datei aussehen +könnte: + + +...........................Einmaleins............................ +10 CLS: PRINT "Kleines Einmaleins" + FOR zahl% = 1 TO 10 + PRINT + 'Erzeugung einer Zeile + FOR faktor% = 1 TO 10 + PRINT TAB (faktor% * 5); + PRINT USING "\#\#\#"; faktor% * zahl%; + NEXT faktor% + NEXT zahl% + + + + +Die Syntax der Anweisungen, die vom EUMEL-BASIC-Compiler übersetzt werden +können, ist ausführlich im Kapitel 8 beschrieben. + +Der #ib(3)#Doppelpunkt#ie(3)# dient als Trennzeichen zwischen Anweisungen. Ihm muß nicht +unbedingt eine Anweisung folgen. Er kann somit als explizites "Ende der +Anweisung"-Symbol aufgefaßt werden (#ib(3)#EOS, "end of statement"#ie(3)#). + +#ib(3)#EOL (end of line)#ie(3)# ist das Ende einer Dateizeile. (Dieses "Zeichen" ist ebenso wie +EOF beim Editieren der Datei nicht sichtbar.) +Das #ib(3)#Hochkomma#ie(3)# ("'", Code 39) wird vom Compiler ebenfalls als EOL interpretiert. +Alle dem Hochkomma in der Dateizeile folgenden Zeichen werden überlesen. Dies +ermöglicht das Schreiben von Kommentaren ohne Verwendung der +'REM'-Anweisung. + +Es sei hier bereits bemerkt, daß sich durch die Realisierung des Übersetzers als +#on ("b")#Compiler gewisse Unterschiede gegenüber Interpretern #off ("b")#ergeben (siehe hierzu Kap. 9). +Der wesentliche Unterschied ist, daß der Interpreter dem Programmtext analog zum +Programmablauf folgt, der Compiler das Programm aber von vorne bis hinten Zeile für +Zeile übersetzt. Dies hat zur Folge, daß z.B. die Dimensionierungen von Feldvariablen +#on ("b")#textuell vor der Verwendung der Variablen stattfinden müssen#off ("b")# und nicht, wie bei +Interpretern, nur im Ablauf des Programms vorher ausgeführt werden müssen. + + + +Weitere Schreibregeln + +#on ("b")# +1. #ib(3)#Groß-/Kleinschreibung#ie(3)##off ("b")# +Für den BASIC-Compiler bestehen zwischen kleinen und großen Buchstaben keiner­ +lei Unterschiede, es sei denn es handelt sich um Textdenoter (Textkonstanten). +Daher können alle #ib(3)#Schlüsselwörter#ie(3)# und #ib(3)#Variablennamen#ie(3)# mit kleinen oder großen +Buchstaben geschrieben werden. Aus der Tatsache, daß zwischen großen und kleinen +Buchstaben nicht unterschieden wird, folgt aber bespielsweise auch, daß die Variab­ +lennamen (vgl. 4.3.) 'hallo' und 'HALLO' ein und dieselbe Variable bezeichnen. + +#on ("b")# +2. #ib(3)#Reservierte Wörter#ie(3)##off ("b")# +Der BASIC-Compiler erkennt eine ganze Reihe #on("i")#reservierter Wörter#off("i")#. Es handelt sich +hierbei im wesentlichen um die Namen der Anweisungen und Funktionen. Sie sollten +im eigenen Interesse darauf achten, daß sich sowohl vor als auch hinter reservier­ +ten Wörtern stets mindestens ein #on ("b")##ib(3)#Leerzeichen#ie(3)##off ("b")# (Blank) befindet. Der #ib(3)#Scanner#ie(3)# (ver­ +gleiche AnhangB) erkennt zwar manchmal die reservierten Wörter auch ohne Leer­ +zeichen, aber unter bestimmten Umständen kann es auch zu erkannten oder - noch +schlimmer - vom Compiler unerkannten Fehlern kommen. +Hierzu zwei Beispiele: +Die Anweisung 'IF a > b THENPRINT "größer"' führt beim Compilieren zur Fehler­ +meldung "Syntaxfehler: THEN oder GOTO erwartet". +Wesentlich gefährlicher ist da schon die Programmzeile + "LEThallo = 3 : PRINT hallo", +denn die unerwartete Wirkung ist die Ausgabe von "0" auf dem Bildschirm. Der Wert +"3" wurde nämlich nicht der Variablen mit dem Namen "hallo" zugewiesen, sondern +einer Variablen namens "LEThallo". + +#on ("b")# +3. Bedeutung der #ib(3)#Leerstelle#ie(3)# ("Blank") für den Compiler#off("b")# +Wie schon aus dem vorhergehenden Punkt ersichtlich kann das Fehlen von trennen­ +den Leerstellen unschöne Effekte haben, denn der #ib(3)#Scanner#ie(3)# (vgl. AnhangB) des +BASIC-Compilers erkennt anhand der Leerstelle (Code 32) beim Durchlauf durch das +Programm, daß ein #ib(3)#Symbol#ie(3)# zu Ende ist. +Es kommt somit immer dann zu Fehlern, wenn zwei Symbole (z.B. reservierte Wörter, +Konstanten, Variablen etc.) nicht durch Leerzeichen getrennt sind, und der Scanner +sie als ein Symbol "versteht". +Beispiel: + "a = 3 : b = 4 : PRINT a b" erzeugt die Ausgabe "34". + "a = 3 : b = 4 : PRINT ab" erzeugt hingegen die Ausgabe "0", denn der +Compiler sieht "ab" als #on ("b")#einen Variablennamen an. #off ("b")# + + + +4.2. #ib(3)#Datentypen#ie(3)# und #ib(3)#Konstanten#ie(3)# + + +Der EUMEL-BASIC-Compiler unterscheidet grundsätzlich zwischen zwei Daten­ +typen, nämlich zwischen #ib(3)#Texte#ie(3)#n und #ib(3)#Zahlen#ie(3)#. + +#on ("b")# +#ib(3)#Datentyp TEXT#ie(3)# #off ("b")# +Texte dürfen alle Zeichen enthalten (Codes 0 bis 255) und bis zu 32000 Zeichen lang +sein. +Die zugehörigen Konstanten werden von #ib(3)#Anführungszeichen#ie(3)# begrenzt, z.B.: + "Anzahl Einträge: " + "2.32 DM" + "General-Musik-Direktor" +Anführungszeichen (Code 34) dürfen #on("i")#innerhalb#off("i")# von Text-Konstanten nicht vor­ +kommen. + +Bei Zahlen unterscheidet der Compiler noch zwischen #ib(3)#INTs#ie(3)# (#ib(3)#Ganzzahlen#ie(3)#) und REALs +(#ib(3)#Gleitkommazahlen#ie(3)#). Diese entsprechen im Hinblick auf den Wertebereich genau den +in ELAN bekannten INTs und REALs. + +#on ("b")# +#ib(3)#Datentyp INT#ie(3)# #off ("b")# +INT-Werte dürfen zwischen -32768 und 32767 liegen. INT-Konstanten dürfen aber +#on("i")#nur#off("i")# aus Ziffern und einem optionalen '%'-Zeichen am Ende bestehen. Das bedeutet, +daß die INT-Konstanten im Bereich von 0 bis 32767 liegen können. +Ein nachgestelltes '%'-Zeichen kennzeichnet eine Konstante nochmals explizit als +INT. (Diese Option wurde aus Kompatibilitätsgründen implementiert.) + +#on ("b")# +#ib(3)#Datentyp REAL#ie(3)# #off ("b")# +REALs können Werte zwischen -9.999999999999*10#u#126#e# und +9.999999999999*10#u#126#e# annehmen. +Die kleinste positive von Null verschiedene Zahl ist 9.999999999999*10#u#-126#e#. +Der kleinste REAL-Wert mit x + 1.0 > 1.0 ist gleich 10#u#-12#e#. +REAL-Konstanten werden gebildet aus Vorkommastellen, Dezimalpunkt, Nachkom­ +mastellen, Zeichen "E" oder "D" (jeweils auch klein) für den #ib(3)#Exponent#ie(3)#en gefolgt vom +Vorzeichen und den Ziffern des Exponenten. +Dabei müssen nicht für jede REAL-Konstante alle diese Elemente benutzt werden. +Unverzichtbar sind #on("i")#entweder#off("i")# der Dezimalpunkt #on("i")#oder#off("i")# der Exponent. Ebenso müssen +zumindest entweder Vor- oder Nachkommastellen vorhanden sein. + +Beispiele für gültige REAL-Konstanten sind: + 0. + .01 + 1E-17 + 2.9979D8 + .3e-102 + 100.e+7 + +Nicht erlaubt sind dagegen folgende Schreibweisen für REAL-Konstanten: + e12 (#ib(3)#Mantisse#ie(3)# fehlt) + 100 (ist INT-Konstante) + . (weder Vor- noch Nachkommastellen) + .E-12 (dito) + 1exp-3 ('exp' nicht erlaubt) + -1.99e30 (Mantisse hat Vorzeichen) + +Das letzte Beispiel zeigt, daß auch vor REAL-Konstanten keine #ib(3)#Vorzeichen#ie(3)# erlaubt +sind. Da normalerweise keine REAL-Konstanten, sondern vielmehr numerische +Ausdrücke verlangt werden, können durch Voranstellen des Operators '-' (vgl. 4.4.) +auch #ib(3)#negative Zahlenwerte#ie(3)# leicht erzeugt werden. + +An REAL-Konstanten darf eines der Zeichen "!" und "\#" angehängt werden. Diese +Option wurde aus Kompatibilitätsgründen eingebaut. Wird ein "!" oder "\#" an eine +INT-Konstante angehängt, so verwandelt es diese in eine REAL-Konstante. +Beispiel: 10000! oder 10000\# entspricht 10000. oder 1E4 + + +#page# + +4.3. Variablen und Felder + + +Variablen + +Der BASIC-Compiler stellt für die in 4.2. vorgestellten Datentypen TEXT, INT und +REAL auch Variablen zur Verfügung. +Die #ib(3)#Variablennamen#ie(3)# müssen folgenden Bedingungen genügen: +- Ein Variablenname muß mit einem Buchstaben beginnen. +- Variablennamen dürfen ab der zweiten Stelle außer Buchstaben auch Ziffern, Dezi­ + malpunkte sowie die Zeichen "!", "\#", "$" und "%" enthalten. Leerzeichen dürfen + in Variablennamen dagegen nicht vorkommen. +- Variablennamen dürfen nicht mit FN beginnen (vgl. 4.5. benutzer-definierte Funk­ + tionen). +- #ib(3)#Reservierte Wörter#ie(3)# (siehe Anhang A) dürfen kein Variablenname sein. Als Teiltexte + dürfen reservierte Wörter aber in Variablennamen enthalten sein (auch am Anfang). + +Variablennamen dürfen beliebig lang sein, und alle Zeichen eines Variablennamens +sind signifikant. + +Welchen Typ eine Variable hat, entscheidet der Compiler nach folgenden #ib(3)#Kriterien#ie(3, " für den Typ einer Variablen")# (in +der Reihenfolge ihrer Beachtung): +- Ist das letzte Zeichen des Namens ein "!" oder "\#", so bezeichnet er eine + REAL-Variable. +- Ist das letzte Zeichen ein "%", so handelt es sich um eine INT-Variable. +- Ist das letzte Zeichen des Namens ein "$", so ist die Variable vom Typ TEXT. +- Liegt das erste Zeichen des Namens im Bereich der mit einer #ib(3)#DEFINT#ie(3)#-Anweisung + (vgl. Kap. 8) festgelegten Buchstaben, so ist die Variable eine INT-Variable. +- Liegt das erste Zeichen im Bereich der mit einer #ib(3)#DEFSTR#ie(3)#-Anweisung (vgl. Kap. 8) + festgelegten Buchstaben, so handelt es sich um eine TEXT-Variable. +- Wenn keine der obigen Bedingungen erfüllt ist, dann bezeichnet der Name eine + Variable des Datentyps REAL. + +Variablen, denen noch kein Wert zugewiesen wurde, haben den Inhalt null (bei INT +und REAL) beziehungsweise Leertext (bei TEXT). + + + +Felder (#ib(4)#Arrays#ie(4)#) + +Ein Feld (Array) ist eine Ansammlung von mehreren Variablen gleichen Typs. Jedes +Feld hat einen Namen. Für die #ib(3)#Feldnamen#ie(3)# gelten die gleichen Regeln wie für die +Namen von normalen Variablen. Auch die Datentypen werden nach den gleichen +Kriterien bestimmt wie bei einfachen Variablen. +In einem Feld können die Elemente in bis zu 100 #ib(3)#Dimensionen#ie(3)# abgelegt werden. Auf +ein Element eines Feldes wird über den Feldnamen und den Index / die #ib(3)#Indizes#ie(3)# des +Elements zugegriffen. Beim Zugriff auf das Element müssen so viele Indizes ange­ +geben werden, wie das Feld Dimensionen hat. +Beispiel: +Das Feld 'tabelle' habe zwei Dimensionen. Mit 'tabelle (3, 5)' wird auf das Element +mit dem Index 3 in der ersten Dimension und dem Index 5 in der zweiten Dimension +zugegriffen. + +Beim ersten Zugriff auf ein Element eines Feldes wird anhand der Zahl der Indizes +die Anzahl der Dimensionen festgestellt und das Feld so eingerichtet, daß in jeder +Dimension der größte Index zehn ist. +Soll ein Feld mit anderen größten Indizes eingerichtet werden, so muß hierzu die +#ib(3)#DIM#ie(3)#-Anweisung verwendet werden (siehe Kapitel 8). + +Der kleinste Index ist voreingestellt auf null, kann aber mit der #ib(3)#OPTION BASE#ie(3)#- +Anweisung (vgl. Kap. 8) auch auf eins eingestellt werden. + +Die Elemente eines Feldes sind, wie auch die einfachen Variablen, mit den Werten +null (INT und REAL) beziehungsweise Leertext (TEXT) vorbesetzt, sofern ihnen noch +nichts zugewiesen wurde. + +#page# + +4.4. Operatoren + +Nachfolgend sind alle Operatoren aufgelistet, die vom EUMEL-BASIC-Compiler +übersetzt werden. + + +Arithmetische #ib(4)#Operatoren#ie(4, ", arithmetische")# + +#ib(3)##ie(3, "+")##ib(3)##ie(3, "-")##ib(3)##ie(3, "*")##ib(3)##ie(3, "/")# +#ib(3)##ie(3, "\")##ib(3)##ie(3, "MOD")##ib(3)##ie(3, "^")# + + Operand(en) Zweck Ergebnistyp + + + INT positives Vorzeichen INT + REAL positives Vorzeichen REAL + + INT, INT INT-Addition INT + REAL, REAL REAL-Addition REAL + + - INT negatives Vorzeichen INT + REAL negatives Vorzeichen REAL + + INT, INT INT-Subtraktion INT + REAL, REAL REAL-Subtraktion REAL + + * INT, INT INT-Multiplikation INT + REAL, REAL REAL-Multiplikation REAL + + / (INT, INT) #linefeed (0.5)# + REAL-Division REAL + REAL, REAL #linefeed (1.0)# + + \ INT, INT #linefeed (0.5)# + INT-Division INT + (REAL, REAL) #linefeed (1.0)# + +MOD INT, INT INT-Divisionsrest INT + REAL, REAL Divisionsrest nach REAL + Runden auf Ganzzahl (nicht INT) + + ^ (INT, INT) #linefeed (0.5)# + Potenzierung REAL + REAL, REAL #linefeed (1.0)# + + +#on ("b")# +Hinweis: #off ("b")# +Wird ein Operator mit numerischen Operanden unterschiedlichen Typs (also INT und +REAL) aufgerufen, so wird der INT-Operand nach REAL konvertiert und der Operator +mit den beiden REAL-Operanden aufgerufen. +Sind die Operandtypen in Klammern angegeben, so werden vor Ausführung der Ope­ +ration die Operanden zu den nicht eingeklammerten Typen konvertiert. +Da jede #ib(3)#Konvertierung#ie(3)# Zeit benötigt, sollte der Benutzer darauf achten, daß möglichst +wenig konvertiert werden muß. +Hierzu ein (etwas extremes, aber nicht seltenes) Beispiel: +Der Aufruf a%\b bewirkt zunächst eine Konvertierung von a% nach REAL: +CDBL(a%)\b. Intern wird die Berechnung dann aber wieder mit INTs ausgeführt: +CINT(CDBL(a%))\CINT(b). Das Ergebnis wird also erst nach drei Konvertierungen +geliefert. Schreibt man dagegen sofort a%\CINT(b), dann reicht eine Konvertierung +aus. + +Es muß außerdem bei den Operatoren +, - und * für INTs darauf geachtet werden, +daß das Ergebnis innerhalb des INT-Wertebereichs liegen muß, da es sonst zu +einem #ib(3)#INT-Überlauf#ie(3)# kommt. + + + +Text-Operator #ib(4)#+#ie(4)# + +#ib(3)##ie(3, "Operatoren, Text-")# +Für Text-Manipulationen wird der Operator '+' mit zwei TEXT-Operanden zur +Verfügung gestellt. Mit '+' werden zwei Texte aneinandergehängt (konkateniert). + + + +Vergleichsoperatoren#ib(4)##ie(4, "Operatoren, Vergleichs-")# + +Im EUMEL-BASIC gibt es folgende Vergleichsoperatoren: + +#ib(3)#=#ie(3)# gleich +#ib(3)#<>#ie(3)# ungleich +#ib(3)#<#ie(3)# kleiner +#ib(3)#>#ie(3)# größer +#ib(3)#<=#ie(3)# kleiner oder gleich +#ib(3)#>=#ie(3)# größer oder gleich + +Bei den numerischen Datentypen werden mit den Vergleichsoperatoren die Zahlen­ +werte verglichen. +Sollen ein INT und ein REAL verglichen werden, dann wird der INT vorher nach +REAL konvertiert und ein REAL-Vergleich vorgenommen. + +Bei Texten dienen die Vergleichsoperatoren zum Vergleich der Zeichencodes. Dies +ermöglicht zum Beispiel ein alphabetisches Sortieren von Wörtern, mit der Einschrän­ +kung, daß Groß- und Kleinbuchstaben unterschiedliche Zeichencodes haben (ver­ +gleiche EUMEL-Zeichensatz-Tabelle im Benutzerhandbuch) und somit verschieden +eingeordnet werden. +Es gilt a$ < b$, wenn die Zeichenkette in a$ codemäßig vor der Zeichenkette in b$ + steht: "a" < "b" (TRUE) "aa"< "a" (FALSE) + + +Die Vergleichsoperatoren liefern, je nachdem ob die Aussage wahr oder falsch ist, die +INT-Werte 0 (falsch) oder -1 (wahr). +Anhand des Ergebnisses einer Vergleichsoperation kann zum Beispiel der Programm­ +ablauf gesteuert werden (siehe Kapitel 8, IF-Anweisung). + + + +Logische Operatoren + +#ib(3)##ie(3, "Operatoren, logische")# +Die logischen Operatoren haben zwei Aufgaben: +1. logische (Boolsche) Verknüpfung von #ib(3)#Wahrheitswerte#ie(3)#n, die zum Beispiel von + Vergleichsoperationen geliefert werden und +2. bitweise Ausführung von logischen Verknüpfungen auf den internen (Zweierkom­ + plement-) Darstellungen von INT-Werten. + +Da für beide Aufgaben die gleichen Operatoren benutzt werden, wurden für die Wahr­ +heitswerte die INT-Werte 0 für falsch (Bitmuster: 0000000000000000) und -1 für +wahr (Bitmuster: 1111111111111111) gewählt. + + Operand(en) Zweck insbesondere gilt + +#ib(3)#NOT#ie(3)# INT #linefeed (0.5)# NOT0->-1 + #ib(3)#Negation#ie(3)# + (REAL) #linefeed (1.0)# NOT-1->0 + +#ib(3)#AND#ie(3)# INT, INT #ib(3)#UND-Verknüpfung#ie(3)# 0AND0->0 + 0AND-1->0 + -1AND0->0 + -1AND-1->-1 + + #ib(3)#OR#ie(3)# INT, INT #ib(3)#ODER-Verknüpfung#ie(3)# 0OR0->0 + 0OR-1->-1 + -1OR0->-1 + -1OR-1->-1 + +#ib(3)#XOR#ie(3)# INT, INT #ib(3)#Exklusiv-ODER-Verknüpfung#ie(3)# 0XOR0->0 + 0XOR-1->-1 + -1XOR0->-1 + -1XOR-1->0 + +#ib(3)#EQV#ie(3)# INT, INT #ib(3)#Äquivalenz-Verknüpfung#ie(3)# 0EQV0->-1 + 0EQV-1->0 + -1EQV0->0 + -1EQV-1->-1 + +#ib(3)#IMP#ie(3)# INT, INT #ib(3)#Implikations-Verknüpfung#ie(3)# 0IMP0->-1 + 0IMP-1->-1 + -1IMP0->0 + -1IMP-1->-1 + + + +Prioritäten der Operanden + + +Hier die Übersicht über alle Operatoren in der Reihenfolge ihrer Ausführung + + + Operator Priorität + + ^ Potenzierung 13 + +, - positives/negatives Vorzeichen 12 + *, / Multiplikation, REAL-Division 11 + \ INT-Division 10 + MOD Divisionsrest- (MOD-) Operation 9 + +, - Addition, Subtraktion 8 + =, <>, <, >, <=, >= Vergleichsoperatoren 7 + NOT Negation 6 + AND UND-Verknüpfung 5 + OR ODER-Verknüpfung 4 + XOR Exklusiv-ODER-Verknüpfung 3 + EQV Äquivalenz-Verknüpfung 2 + IMP Implikations-Verknüpfung 1 + + +Die Reihenfolge der Auswertung von Ausdrücken kann durch Klammern geändert +werden. + +Beachten Sie, daß der Operator '=' in BASIC die Funktion eines Vergleichsoperators +und des #ib(3)#Zuweisungsoperators#ie(3)##ib(3)##ie(3, "Operator, Zuweisungs-")# (siehe Kapitel 8, LET-Anweisung) hat. + +#page# + +4.5. #ib(3)#Funktionen#ie(3)# + + + +Standard-Funktionen + +Der EUMEL-BASIC-Compiler unterstützt eine ganze Reihe von Funktionen. Diese +Funktionen liefern Werte und können in Ausdrücken zusammen mit Konstanten, +Variablen und Operatoren verwendet werden. +Viele der eingebauten Funktionen arbeiten mit Argumenten, das heißt es werden den +Funktionen Werte übergeben. +In Kapitel 8 dieses Handbuches sind alle Funktionen ausführlich beschrieben. +Beispiele für #ib(3)#Funktionsaufrufe#ie(3)#: + SQR (17) Dieser Ausdruck liefert die Wurzel von 17 als REAL. + RIGHT$ (text$, 5) Dieser Ausdruck liefert die letzten fünf Textzeichen +#right#aus 'text$' als TEXT. + + + +Benutzer-definierte Funktionen + +Neben der Verwendung der standardmäßig verfügbaren Funktionen besteht für den +Benutzer die Möglichkeit, selbst Funktionen innerhalb eines Programms zu definieren. + +#on ("b")# +#ib(3)#Definition benutzer-definierter Funktionen#ie(3)# #off ("b")# +Hierzu dient die #ib(3)#DEF FN#ie(3)#-Anweisung (vergleiche Kapitel 8). +Die Syntax der DEF FN-Anweisung lautet: + +DEFFN[([,][...])]= +#right# + +: Zeichenfolge, die der Syntax für Variablennamen ent­ + sprechen muß. + FN bilden zusammen den Namen der neuen + Funktion. +<#ib(3)#Parameter#ie(3)#>: Zeichenfolge, die der Syntax für Variablennamen ent­ + sprechen muß. +: Ausdruck, der Konstanten, Variablen, die Parameter der + Funktion und Aufrufe anderer Funktionen enthalten + darf. + +- Die benutzer-definierten Funktionen ("user functions") liefern, genau wie die + Standard-Funktionen, Werte. +- Das letzte Zeichen des Funktionsnamens gibt den Typ des Wertes an, den die + Funktion liefert. Soll die Funktion einen TEXT liefern, so muß der Name mit "$" + enden. Soll ein INT geliefert werden, muß der Name mit "%" enden. Für alle + anderen Endungen wird eine REAL-liefernde Funktion eingetragen. +- Die Syntax der Parameternamen entspricht der Syntax für die Namen von einfachen + Variablen. +- Die Parameter haben nur bei der Definition Gültigkeit. Hierbei 'überdecken' sie (für + diese Zeile) eventuell im BASIC-Programm vorhandene gleichnamige Variablen. +- Jeder Parameter darf in der Parameterliste nur einmal vorkommen. +- Bezeichnet der Funktionsname eine TEXT-liefernde Funktion, so muß auch die + Funktionsdefinition ein Ergebnis vom Typ TEXT liefern. Zwischen INTs und REALs + findet eine Typanpassung statt. +- Eine Funktion darf nicht in ihrer eigenen Definition erscheinen. +- Eine Funktion ist allein durch ihren Namen gekennzeichnet. Generische Funktionen + (gleicher Name, aber unterschiedliche Parameter) können somit nicht definiert wer­ + den. + +Beispiele für gültige Funktionsdefinitionen: + DEF FNPI = 3.1415927 + DEF FNumfang (radius) = 2.0 * FNPI * radius (Enthält Aufruf von FNPI) + DEF FNhallo$ (dummy$) = "Hallo " + name$ (name$ kommt im + #right#BASIC-Programm vor) + DEF FNheavyside% (x) = ABS (SGN (x) = 1) + +Beispiele für ungültige Funktionsdefinitionen: + DEF FNfunct (a, b, a) = a ^ 2 + b (a kommt zweimal als Parameter vor) + DEF FNfr (x) = x * FNfr (x - 1) (rekursive Definition) + + +#on ("b")# +#ib(3)#Aufruf benutzer-definierter Funktionen#ie(3)# #off ("b")# + +FN [ ( [, ] [...] ) ] + +<#ib(3)#Argument#ie(3)#> : Ausdruck, der für den entsprechenden Parameter bei der Evaluation + (Auswertung) der Funktion eingesetzt werden soll + +- Beim Funktionsaufruf werden die Argumente in der Reihenfolge ihres Auftretens für + die Parameter eingesetzt. Für TEXT-Parameter müssen die Argumente ebenfalls + TEXTe liefern. Zwischen INTs und REALs findet eine Typanpassung statt. +- Die Anzahl der Argumente muß genau mit der Anzahl der Parameter übereinstim­ + men. +- Für in der Funktionsdefinition vorkommende Variablen wird der zum Zeitpunkt des + Funktionsaufruf gültige Wert eingesetzt. +- Die Definition der Funktion muß dem ersten Aufruf der Funktion textuell voraus­ + gehen. +- Eine Definition gilt für alle textuell folgenden Aufrufe, bis die Funktion wieder neu + definiert wird. + +Beispiele für korrekte Funktionsaufrufe (bezogen auf obige Beispiel-Definitionen): + PRINT FNPI / 2.0 (Ausgabe: 1.570796) + PRINT FNumfang (20) (Ausgabe: 125.6637) + LET name$ = "Purzelbär":PRINT FNhallo$ ("") (Ausgabe: Hallo Purzelbär) + PRINT heavyside% (-17.3) (Ausgabe: 0) + +Beispiele für falsche Funktionsaufrufe (bezogen auf obige Beispiel-Definitionen): + PRINT FNPI (10) (kein Argument erwartet) + PRINT FNumfang (Argument erwartet) + PRINT FNhallo$ (zahl%) (Falscher Typ des Arguments) + PRINT FNheavyside (17.4, -12.3) (Zu viele Argumente) + + +#page# + +4.6. #ib(3)#Typanpassung#ie(3)# + + +In BASIC wird, im Gegensatz zu ELAN, nicht sehr streng zwischen den numerischen +Datentypen unterschieden, sondern es finden häufig automatische Typanpassungen +statt. Zu solchen Typanpassungen kommt es vor allem bei der Zuweisung, bei Opera­ +toren und bei Funktionen, aber auch bei einigen Anweisungen. +Die automatische Typanpassung hat zwei Nachteile: +1. Die Typkonvertierung von INT nach REAL und umgekehrt kostet Zeit während der + Programmausführung. +2. Es kann zu sehr unangenehmen Laufzeitfehlern kommen, wenn eine REAL- + INT-#ib(3)#Konvertierung#ie(3)# mit Fehler abbricht, weil der REAL-Wert außerhalb des + INT-Wertebereichs liegt. + +Allgemein gilt also, daß sich der Programmierer auch in BASIC über die Typen der +verwendeten Objekte im klaren sein sollte. Außerdem ist zu beachten, daß bei Konver­ +tierungen von REAL nach INT immer gerundet wird. + +Genaueres zur Typanpassung bei der Zuweisung finden Sie in Kapitel 8 bei der +LET-Anweisung. +Über Typkonvertierung bei Operatoren informiert Kapitel 4.4. +Informationen über die Funktionen betreffenden Typkonvertierungen befinden sich am +Anfang von Kapitel 8 und direkt bei der Beschreibung der jeweiligen Funktionen +(ebenfalls in Kapitel 8). + +#page# + +4.7. Aufruf von EUMEL-Prozeduren in + BASIC-Programmen + + + +Der EUMEL-BASIC-Compiler bietet die Möglichkeit, insertierte ELAN-Prozeduren +(und auch insertierte BASIC-Programme) in BASIC-Programmen aufzurufen. Hierzu +werden die beiden Anweisungen #ib(3)#CALL#ie(3)# und #ib(3)#CHAIN#ie(3)# (identisch) sowie die Funktion +#ib(3)#USR#ie(3)# zur Verfügung gestellt. +Mit der CALL-Anweisung (siehe auch Kapitel 8) können Prozeduren aufgerufen +werden, die keinen Wert liefern und nur die BASIC-Datentypen INT, REAL und/oder +TEXT als Parameter benötigen. +Beispiele: + CALL list + CALL taskstatus ("PUBLIC") + CALL cursor (10, 21) + CALL getcursor (x%, y%) + +Das letzte Beispiel zeigt, daß auch #ib(3)#VAR-Parameter#ie(3)# im ELAN-Sinne übergeben +werden können. + +Die Funktion USR dient im Gegensatz zu CALL zum Aufruf von #ib(3)#wertliefernden Pro­ +zeduren#ie(3)#. Die Prozeduren dürfen allerdings nur einen der BASIC-Datentypen INT, +REAL oder TEXT liefern. Es gilt auch bei USR, wie bei CALL, daß die aufgerufenen +Prozeduren nur Parameter der Typen INT, REAL oder TEXT haben dürfen. +Beispiele: + PRINT USR e (Ausgabe: 2.718282) + PRINT USR compress (" EUMEL ") (Ausgabe: EUMEL) + +#on ("b")# +Wichtige Hinweise zu CALL, CHAIN und USR: #off ("b")# +1. Bei den Parametern finden keinerlei Typkonvertierungen statt (ELAN- + Prozeduren werden ja gerade anhand der Typen ihrer Parameter eindeutig identifi­ + ziert). +2. Die Prozedurnamen nach CALL, CHAIN und USR dürfen keine Leerzeichen ent­ + halten, weil die Prozedur sonst nicht identifiziert werden kann. + Beispiel: CALLlernsequenzauftastelegen(...) statt + CALLlernsequenzauftastelegen(...) +3. Die Prozedurnamen können (nach BASIC-Konvention) auch Großbuchstaben + enthalten. + Beispiel: CALLcursor(17,4) ist äquivalent zu + CALLCURSOR(17,4) + + +Wie in Kapitel 3 erläutert kann ein BASIC-Programm auch insertiert werden. Somit +können mit der CALL-Anweisung auch andere (vorher insertierte) BASIC- +Programme aufgerufen werden. +Beispiel: +CALL blackjack ('blackjack' sei der Prozedurname, unter dem ein BASIC- + Programm zuvor insertiert wurde.) + +Die sonst in einigen BASIC-Dialekten vorhandene Möglichkeit, Programme oder +#ib(3)#Programmsegmente#ie(3)# nachzuladen, kann so durch Aufrufe von insertierten Programmen +nachgebildet werden. +#page# +#head# +EUMEL-BASIC-Compiler 5. Steuerung der Bildschirmausgaben % + +#end# + +5. #ib(4)#Steuerung der #ib(3)#Bildschirmausgaben#ie(3)##ie(4)# + + + +Die Ausgaben von BASIC-Programmen ('PRINT' und 'WRITE') werden im Paket +'basic output' behandelt. Dieses Paket ermöglicht unter anderem, daß die Ausgabe +auf das Terminal mit der Prozedur + + PROC #ib(3)#basic page#ie(3)# (BOOL CONST status) + +gesteuert werden können. Wird dabei 'TRUE' eingestellt, so wartet die Ausgabe bei +Erreichen der letzten Terminalzeile auf die Eingabe eines Zeichens, bevor sie fortfährt. +Das Eingabezeichen wird nach Ausgabe von ">>" in der rechten unteren Ecke des +Bildschirms erwartet und wie folgt interpretiert: + +#linefeed (1.5)# + Löschen des Bildschirms und Ausgabe der nächsten Bildschirmseite + Ausgabe der nächsten Zeile + Abbruch des Programms mit der Fehlermeldung "'halt' vom Terminal" + 'basic page' wird auf 'FALSE' gesetzt #linefeed (1.0)#und mit der normalen Ausgabe + weitergemacht + +Alle anderen Tasten bewirken eine Ausgabe der nächste Bildschirmseite (#ib(3)#Scrolling#ie(3)#). + +Ist 'basic page' auf 'FALSE' gesetzt, so kann durch Eingabe von vor einem Zei­ +lenwechsel 'basic page' auf 'TRUE' gesetzt werden. +#page# +#head# +EUMEL-BASIC-Compiler 6. Grenzen des Compilers % + +#end# + +6. #ib(3)#Grenzen des Compilers#ie(3)# + + +Es gibt verschiedene Grenzen, die bei der Benutzung des BASIC-Compilers erreicht +werden können. + +#on ("b")# +Grenzen des #ib(3)#EUMEL-Coder#ie(3)#s #off ("b")# +Da ein BASIC-Programm vom Compiler als eine Prozedur im Coder eingetragen +wird, darf der Code für ein BASIC-Programm die #ib(3)#Modulgrenze#ie(3)# von 7500 Byte Code +nicht überschreiten. +Sollte dies doch einmal der Fall sein (#ib(3)#Compiler Error 308#ie(3)#), so gibt es folgende +Abhilfe-Möglichkeiten: +- Zerlegen des BASIC-Programms in mehrere BASIC-Programme, wobei ein + Programm das andere während der Ausführung aufrufen kann (vgl.4.7.). + Bei dieser Methode können die Teilprogramme aber nicht mit gemeinsamen Variab­ + len arbeiten. +- Auslagerung von Programmteilen (z.B. Unterprogrammen) in ELAN-Prozeduren, + die insertiert und vom BASIC-Programm aufgerufen werden können (vgl.4.7.). + Dieses Verfahren bietet die Möglichkeit, Variablen zwischen BASIC-Programm und + ELAN-Prozedur über die Prozedurschnittstelle auszutauschen. + +Neben der Begrenzung des Codes ist auch die Größe des Datenspeicherbereichs pro +BASIC-Programm begrenzt. Insgesamt dürfen die Datenobjekte eines BASIC- +Programms nicht mehr als 32 KByte Speicherplatz belegen. Andernfalls kommt es +zum #ib(3)#Compiler Error 307#ie(3)#. + +Eine weitere Grenze des EUMEL-Coders stellt die maximal zulässige Anzahl der +#ib(3)#Labels#ie(3)# (interne Sprungadressen) dar. Es können nur höchstens 2000 Labels vom +Coder verwaltet werden. Der BASIC-Compiler vergibt für jede gefundene Zeile mit +Zeilennummer ein Label und benötigt auch bei Schleifen (FOR-NEXT, WHILE- +WEND), Fallunterscheidungen (IF-Anweisung), Unterprogramm-Aufrufen (GOSUB) +und bei der Definition von benutzer-definierten Funktionen (DEF) Labels. +Beim Auftreten des #ib(3)#Compiler Errors 304#ie(3)# (zu viele Label) ist Abhilfe relativ leicht +dadurch möglich, daß Zeilennummern nur den Zeilen vergeben werden, die tatsächlich +angesprungen werden (d.h. zu denen es GOTOs oder GOSUBs gibt). + +#on ("b")# +Grenzen des BASIC-Compilers #off ("b")# +Die interne #ib(3)#Namenstabelle#ie(3)# des BASIC-Compilers kann etwa 4240 Einträge aufneh­ +men. Ein Eintrag in dieser Tabelle wird für jede Variable, für jedes Feld, für jede +benutzer-definierte Funktion und für jeden Parameter einer benutzer-definierten +Funktion sowie für jede Konstante erzeugt. Numerische Konstanten erhalten, sofern +sie konvertiert werden müssen, sogar zwei Einträge in der Namenstabelle. +Bei Auftreten des seltenen Fehlers "volle Namenstabelle" kann durch eine Aufteilung +des BASIC-Programms in Teilprogramme oder eine Auslagerung von Unterprogram­ +men in ELAN-Prozeduren Abhilfe geschaffen werden. + +#on ("b")# +Sonstige EUMEL-Grenzen #off ("b")# +Außer den bisher genannten Begrenzungen sei nochmals auf die Begrenzung des +#ib(3)#Codebereichs pro Task#ie(3)# hingewiesen (maximal 256 KByte Code). +Da der EUMEL-Coder und der BASIC-Compiler recht viel Code belegen, sollte +"vorsichtig" insertiert werden, also nur das, was wirklich benötigt wird. +Auch die übrigen Grenzen des EUMEL-Systems sind zu beachten (vergleiche hierzu +die Aufstellung der möglichen Compiler Errors im EUMEL-Benutzerhandbuch)! + +#page# +#head# +EUMEL-BASIC-Compiler 7. Fehlerbehandlung % + +#end# + +7. #ib(3)#Fehlerbehandlung#ie(3)# + + +7.1. #ib(3)#Fehler zur Übersetzungszeit#ie(3)# + +Endeckt der BASIC-Compiler bei der Übersetzung eines BASIC-Programms Fehler, +so werden diese auf dem Bildschirm angezeigt und ins #ib(3)#Notebook#ie(3)# eingetragen. +Nur (syntaktisch) fehlerfreie Programme werden zur Ausführung gebracht beziehungs­ +weise insertiert. +Im #ib(3)#Vordurchlauf#ie(3)# werden die Zeilennummern auf Richtigkeit überprüft. Falls bereits +hiebei Fehler festgestellt werden, bricht der Compiler die Übersetzung nach dem +Vordurchlauf ab. +Im #ib(3)#Hauptdurchlauf#ie(3)# wird das Programm Zeile für Zeile auf syntaktische Richtigkeit +überprüft und gleichzeitig übersetzt. Wird dabei in einer Programmzeile ein Fehler +entdeckt, so wird er angezeigt und die Übersetzung des Programms #on("i")#in der nächsten +Programmzeile#off("i")# fortgesetzt. Eine Ausnahme von dieser Regel bildet nur die #ib(3)#DEF FN#ie(3)#- +Anweisung, bei der bei gewissen Fehlern die Übersetzung fortgesetzt wird. (Der +Grund hierfür liegt darin, daß die Folgefehlerzahl besonders bei der DEF FN- +Anweisung sehr groß wäre, wenn beim Auftreten eines Fehlers die Übersetzung der +Zeile sofort abgebrochen würde. Die Parameter würden dann nämlich nicht oder +falsch abgelegt, und bei jedem Aufruf der Funktion würde ein Fehler gemeldet.) + +Eine Übersicht über alle verwendeten Fehlermeldungen zur Übersetzungszeit befindet +sich im AnhangC. + + + +Interne Compilerfehler + +Neben den "normalen" Fehlern (siehe oben) kann es in seltenen Fällen möglicher­ +weise auch zu internen Fehlern kommen. +Es gibt zwei verschiedene Sorten von internen Fehlern: +1. interne Fehler, die das Compilerprogramm selbst feststellt. + Solche Fehler bewirken die Meldung "Interner Fehler !" (meist mit näherer Erläu­ + terung) und die Fortsetzung der Übersetzung in der nächsten Programmzeile. +2. Fehler, die in anderen Paketen des BASIC-Systems oder des EUMELs (z.B. im + EUMEL-Coder) während der Übersetzungszeit ausgelöst werden (siehe auch + Kapitel 6: "Grenzen des Compilers"). + Solche Fehler werden mit "#ib(3)#BASIC-Compiler ERROR#ie(3)#" und eventuell näheren + Angaben gemeldet. Beim Auftreten eines solchen Fehlers wird die Übersetzung + des gesamten Programms abgebrochen. + +Sollten bei Ihrer Arbeit mit dem EUMEL-BASIC-Compiler interne Fehler auftreten, +die nicht auf das Überschreiten von Compilergrenzen zurückzuführen sind, dann +wären wir Ihnen für eine Meldung der Fehler dankbar. Bitte senden Sie eine Fehler­ +beschreibung an: + + Gesellschaft für Mathematik und Datenverarbeitung + Schloß Birlinghoven + Postfach 1240 + 5205 Sankt Augustin 1 + +Die Fehlerbeschreibung sollte nach Möglichkeit folgende Informationen enthalten: +- verwendete Hardware +- Urlader-Version +- EUMEL-Version +- Programmtext des Programms, das den Fehler auftreten ließ +- genaue Angabe der ausgegebenen Fehlermeldung + + +#page# + +7.2. #ib(3)#Fehler zur Laufzeit#ie(3)# + +Treten während der Laufzeit eines BASIC-Programms Fehler auf, so wird die Ausfüh­ +rung des Programms mit einer entsprechenden Fehlermeldung abgebrochen. +Da die meisten Laufzeit-Fehlermeldungen durch Prozeduren des EUMEL-Systems +(und nicht des BASIC-Systems) erzeugt werden, entsprechen sie oft nicht der +BASIC-Terminologie. (Beispielsweise führt ein zu großer Feldindex zu der Fehlermel­ +dung "Ueberlauf bei Subskription".) + +Die bei Laufzeitfehlern gemeldete #ib(3)#Fehlerzeile#ie(3)# bezieht sich nicht (wie bei ELAN-Pro­ +grammen) auf die Nummer der Dateizeile, sondern auf die letzte der Programmzeile +vorangegangene BASIC-Zeilennummer. + +Fast alle ausgelösten Laufzeitfehler erzeugen auch #ib(3)#Fehlercodes#ie(3)#. Dabei liefern Fehler +aus EUMEL-Betriebssystem-Prozeduren die EUMEL-Standard-Fehlercodes (vgl. +Systemhandbuch), zum Beispiel wird beim Fehler "INT-Ueberlauf" der Fehlercode 4 +geliefert. +Laufzeitfehler, die in Prozeduren des BASIC-Systems ausgelöst werden, liefern dage­ +gen den in Microsoft-BASIC üblichen Fehlercode plus 1000. So liefert die Meldung +"Keine Daten mehr für READ" den Fehlercode 1004 (MS-BASIC: "Out of data", +Fehlercode 4). +Es läßt sich so anhand des gelieferten Fehlercodes ermitteln, ob der Fehler im +BASIC-System oder an einer anderen Stelle des EUMEL-Systems ausgelöst wurde. + +Eine Übersicht über die innerhalb des BASIC-Systems erzeugten Fehlermeldungen +enthält Anhang C. + diff --git a/lang/basic/1.8.7/doc/basic handbuch.2 b/lang/basic/1.8.7/doc/basic handbuch.2 new file mode 100644 index 0000000..1379e9e --- /dev/null +++ b/lang/basic/1.8.7/doc/basic handbuch.2 @@ -0,0 +1,2441 @@ +#page nr ("%", 31)# +#head# +EUMEL-BASIC-Compiler 8. Übersicht über die Befehle und Funktionen % + +#end# + +8. Übersicht über die Anweisungen und Funktionen + + + +In diesem Kapitel sind alle Anweisungen und Funktionen des vom Compiler übersetz­ +baren BASIC-Sprachumfangs in alphabetischer Reihenfolge aufgeführt. +Auch die Anweisungsbestandteile (z.B. ELSE und TO) sind mit einem Hinweis auf die +zugehörige Anweisung eingeordnet. +Sind bei Funktionen INT- oder REAL-Ausdrücke als Argumente angegeben, so ist +dies als Hinweis auf den Sinn der Funktion zu verstehen. Es können auch Ausdrücke +des jeweils anderen Datentyps eingesetzt werden. Wird statt eines INT-Ausdrucks +ein REAL-Ausdruck angegeben, so darf dessen Wert aber nur innerhalb des +Wertebereichs für INTs liegen, da der REAL-Wert bei der Ausführung der Funktion +in einen INT-Wert konvertiert wird. + + + +Funktion : ABS + +Zweck : Berechnung des Betrages (Absolutwertes) einer Zahl + +Syntax : ABS () + +Erklärung : Liefert den Betrag des numerischen Ausdrucks. + Das Ergebnis ist vom gleichen Typ wie das Argument. + + +Beispiel : 10 a = -12.74 + 20 PRINT ABS (a) + Ausgabe: 12.74 + +Vergleiche : SGN-Funktion + + + +Operator : AND + +Siehe Kapitel 4.4. (Operatoren) + + + +Anweisungsbestandteil : AS + +Siehe NAME-Anweisung + + + +Funktion : ASC + +Zweck : Ermittlung des ASCII-Codes eines Textzeichens + +Syntax : ASC () + +Erklärung : Die Funktion liefert den ASCII-Code des ersten Zeichens des + TEXT-Ausdrucks. + Der Code wird als INT geliefert. + + +Beispiel : 10 a$ = "Guten Tag !" + 20 PRINT ASC (a$) + Ausgabe: 71 + +Vergleiche : CHR$-Funktion (Komplementärfunktion) + + + +Funktion : ATN + +Zweck : Berechnung des Arcustangens + +Syntax : ATN () + +Erklärung : Die Funktion liefert den Arcustangens des + numerischen Ausdrucks in Radiant. + + +Beispiel : 10 LET x = 4 + 20 PRINT ATN (x) + Ausgabe: 1.325818 + +Vergleiche : TAN-Funktion (Komplementärfunktion), SIN, COS + + + +Anweisungsbestandteil : BASE + +Siehe OPTION BASE-Anweisung + + + +Anweisung : CALL + +Zweck : Aufruf einer insertierten Prozedur + +Syntax : CALL #right#[ ( [, ] [...] ) ] + +Erklärung : : Folge aus Zeichen, die für Prozeduren im + EUMEL-System zugelassen sind (also Buchstaben und - ab der + zweiten Stelle - Zahlen), aber keine Leerzeichen. + + : | + + : Ausdruck (genau des von der Prozedur + benötigten Typs) + : Variable (genau des von der Prozedur benö­ + tigten Typs) + + Die Prozedur mit dem angegebenen wird mit den + angegebenen Parametern aufgerufen. + Die aufgerufene Prozedur darf keinen Wert liefern (vgl. USR-Funk­ + tion). + + Mögliche Fehlerfälle: + - Eine Prozedur mit dem Namen und den an­ + gegebenen Parametern gibt es nicht. + - Die Prozedur liefert einen Wert. + - Die Prozedur benötigt Parametertypen, die in BASIC nicht bekannt + sind (z.B. BOOL, FILE, TASK, QUIET). + - Ein Parameter ist CONST, es wird aber ein VAR-Parameter ver­ + langt. + + Weitere Informationen finden Sie in Kapitel 4.7. + +Hinweis : 1. Bei den Parametern wird keine Typkonvertierung vorgenommen. + 2. Der Prozedurname muß (entgegen der ELAN-Gewohnheit) ohne + Leerzeichen angegeben werden. + 3. Statt des Anweisungswortes CALL kann auch CHAIN geschrieben + werden. CALL und CHAIN werden im EUMEL-BASIC nicht wie + in Microsoft-BASIC benutzt. + + +Beispiel : 10 CALL sysout ("Meine Datei") + 20 PRINT "Dieser Text geht nun in die Datei" + 30 CALL sysout ("") + 40 PRINT "Wieder auf den Bildschirm" + + +Vergleiche : USR-Funktion + + + +Funktion : CDBL + +Zweck : Konvertierung in den Datentyp REAL + +Syntax : CDBL () + +Erklärung : Das Ergebnis des numerischen Ausdrucks wird als REAL geliefert. + + +Beispiel : 10 LET a! = 17 + 20 PRINT USR max (CDBL (a!), 152.3) + 30 REM max benötigt zwei REALs als Parameter + + +Vergleiche : CINT-Funktion + + + +Anweisung : CHAIN + +Vollkommen identisch mit der CALL-Anweisung (Erklärung siehe dort !) + + + +Funktion : CHR$ + +Zweck : Erzeugung eines Textzeichens mit einem bestimmten ASCII-Code + +Syntax : CHR$ () + +Erklärung : Die Funktion liefert das Zeichen mit dem ASCII-Code, den der + INT-Ausdruck angibt. + Das Zeichen wird als TEXT geliefert. + Die Leistung der Funktion ist nur für Werte im Bereich 0 bis 255 + definiert. + + +Beispiel : 10 PRINT CHR$ (61) + Ausgabe: = + +Vergleiche : ASC-Funktion (Komplementärfunktion) + + + +Funktion : CINT + +Zweck : Konvertierung in den Datentyp INT + +Syntax : CINT () + +Erklärung : Das Ergebnis des numerischen Ausdrucks wird als INT geliefert. + REALs werden gerundet. Werte außerhalb des INT-Bereichs führen + zu einem INT-Überlauf. + + +Beispiel : 10 LET a = 17.625 + 20 PRINT CINT (a); CINT (-a) + Ausgabe: 18 -18 + +Vergleiche : CDBL-, FIX-, INT-Funktionen + + + +Anweisung : CLS + +Zweck : Löschen des Bildschirms + +Syntax : CLS + +Erklärung : Löscht den Bildschirm und positioniert den Cursor in die linke obere + Bildschirmecke (Position 1, 1). + + +Beispiel : 10 CLS + 20 PRINT "PROGRAMMBEGINN" + + + + +Funktion : COS + +Zweck : Berechnung des Cosinus eines Radiantwertes + +Syntax : COS () + +Erklärung : : REAL-Ausdruck, der den Winkel in Radiant angibt. + Die Funktion liefert den Cosinus des Winkels als REAL. + + +Beispiel : 10 PI = 3.141593 + 20 PRINT COS (PI/4) + Ausgabe: .7071067 + +Vergleiche : SIN-, TAN-Funktionen + + + +Funktion : CSRLIN + +Zweck : Ermittlung der aktuellen Cursorzeile + +Syntax : CSRLIN + +Erklärung : Geliefert wird die Nummer der Zeile (als INT), in der sich der Cursor + auf dem Bildschirm befindet. Die oberste Zeile hat die Nummer 1. + + +Beispiel : 10 CLS + 20 PRINT + 30 PRINT CSRLIN + Ausgabe: 2 + +Vergleiche : POS-Funktion + + + +Funktion : CVD, CVI + +Zweck : Decodierung von in Texten verschlüsselten Zahlenwerten + +Syntax : CVD () + CVI () + +Erklärung : INTs und REALs können (mit MKI$ und MKD$) zu Texten codiert + werden. + CVD decodiert einen in 8 TEXT-Zeichen codierten REAL-Wert. + CVI decodiert einen in 2 TEXT-Zeichen codierten INT-Wert. + Es wird beim ersten Zeichen des TEXT-Ausdrucks mit der Dekodie­ + rung begonnen. + Ist der TEXT zu kurz, so wird mit der Meldung "Ueberlauf bei Subs­ + kription" abgebrochen. + + +Beispiel : 10 zahl$ = MKD$ (3.1415) + 20 PRINT CVD (zahl$) + Ausgabe: 3.1415 + +Vergleiche : MKD$-, MKI$- Funktionen (Komplementärfunktionen) + + + +Anweisung : DATA + +Zweck : Ablegen von Konstanten + +Syntax : DATA [] [, []] [...] + +Erklärung : : | + : von Anführungszeichen umschlossene Zeichen­ + folge, die alle Zeichen außer Anführungs­ + zeichen enthalten darf + : Zeichenfolge, die alle Zeichen außer Komma + und Doppelpunkt enthalten darf + + Eine DATA-Anweisung stellt einen Datenspeicher dar, der mit READ + (s.d.) ausgelesen werden kann. + In der DATA-Anweisung können "quoted strings" oder "unquo­ + ted strings" angegeben werden. "quoted strings" können später nur + noch als Texte ausgelesen werden. + Bei "unquoted strings" wird der Datentyp in der DATA-Anweisung + dagegen nicht festgelegt. Sie können also als INTs, REALs oder + TEXTe ausgelesen werden. Sollen "unquoted strings" Zahlenwerte + darstellen, so müssen sie den in BASIC üblichen Schreibregeln für + die numerischen Konstanten des jeweiligen Typs genügen. Es sind + allerdings zusätzlich noch Vorzeichen erlaubt. + Wenn die nicht angegeben sind, so wird ein "nil-Datum" + abgelegt. Dieses bewirkt bei einem READ mit numerischer Variable + die Lieferung des Wertes null und bei einem READ mit TEXT-Vari­ + able die Lieferung eines Leertextes. + + Die DATA-Anweisungen können an beliebiger Stelle im Programm + (vor oder hinter den zugehörigen READ-Anweisungen) stehen. + + Alle DATA-Anweisungen eines Programms bilden zusammen einen + großen sequentiellen Speicher, auf den mit READ der Reihe nach + zugegriffen wird. Intern wird ein sogenannter READ-DATA-Zeiger + geführt, der immer auf das nächste auszulesende Element zeigt. + Die RESTORE-Anweisung (s.d.) ermöglicht es, den READ- + DATA-Zeiger auf das erste Element einer bestimmten DATA-Zeile + zu setzen. + + +Beispiel : 2020 PRINT "Stadt", "Land", "Fluß" + 2030 READ stadt$, land$, fluß$ + 2040 PRINT stadt$, land$, fluß$ + . + 5000 DATA Paris, Frankreich, Seine + + +Vergleiche : READ-, RESTORE-Anweisungen + + + +Funktion : DATE$ + +Zweck : Abrufen des aktuellen Tagesdatums + +Syntax : DATE$ + +Erklärung : Das Tagesdatum wird als Text in der Form TT.MM.JJ geliefert. + + +Beispiel : 10 PRINT "Heute ist der " + DATE$ + Ausgabe (z.B.): Heute ist der 28.08.87 + +Vergleiche : TIME$-Funktion + + + +Anweisung : DEFDBL, DEFINT, DEFSNG, DEFSTR + +Zweck : Definition von Anfangsbuchstaben zur Kennzeichnung bestimmter + Variablentypen + +Syntax : DEFDBL [ - ] + #right#[, [ - ] ] [...] + DEFINT [ - ] + #right#[, [ - ] ] [...] + DEFSNG [ - ] + #right#[, [ - ] ] [...] + DEFSTR [ - ] + #right#[, [ - ] ] [...] + + +Erklärung : Mit den aufgeführten Anweisungen ist es möglich, bestimmte Buch­ + staben festzulegen, die, wenn sie als Anfangsbuchstaben eines + Variablennamens verwendet werden, der Variablen einen bestimmten + Typ zuordnen. + + Die Typfestlegung durch Kennzeichnung mit den Zeichen '!', '\#', '%' + oder '$' hat jedoch Vorrang vor den festgelegten Anfangsbuchstaben. + Eine genaue Erläuterung, nach welchen Kriterien der BASIC-Compi­ + ler den Typ einer Variablen feststellt, befindet sich in Kapitel 4.3. + + Die DEFINT-Anweisung legt Anfangsbuchstaben für INT-Variablen + fest. + Mit der DEFSTR-Anweisung werden Anfangsbuchstaben von + TEXT-Variablen festgelegt. + Die Anweisungen DEFDBL- und DEFSNG- wurden nur aus Kom­ + patibilitätsgründen implementiert. Sie werden zwar auf syntaktische + Richtigkeit überprüft, aber ansonsten vom Compiler nicht beachtet. + + Werden bei den Anweisungen ganze Buchstabenbereiche angegeben, + so muß der Buchstabe vor dem Bindestrich auch im Alphabet vor + dem Buchstaben hinter dem Bindestrich stehen. + +Hinweis : 1. Die oben beschriebenen Anweisungen gelten stets erst für die im + weiteren Text neu benutzten (also neu eingerichteten) Variablen. + 2. Die beschriebenen Anweisungen dürfen auch mehr als einmal in + einem Programm vorkommen. Die Buchstaben, die in der zweiten + und in den folgenden Anweisungen festgelegt werden, werden + #on("izusätzlich#off("i zu den in der ersten Anweisung festgelegten Buchsta­ + ben als Kennzeichen für den betreffenden Datentyp vom Compiler + vermerkt. + 3. Der Compiler überprüft nicht, ob gleiche Buchstaben als Kennzei­ + chen für mehr als einen Variablentyp angegeben werden (siehe + Kapitel 4.3.). Der Benutzer ist also selbst dafür verantwortlich, daß + solche Überschneidungen nicht vorkommen. + + +Beispiel : 10 DEFSTR s - z + 20 DEFINT a - h, n + 30 DIM tabelle (17) 'TEXT-Feld + 40 LET c = 4 'INT-Variable + 50 LET nummer = 17 'INT-Variable + 60 LET ueberschrift = "Willkommen" 'TEXT-Variable + 70 LET reellezahl = 19.563 'REAL-Variable + 80 LET aha\# = -1.36E17 'REAL-Variable + + + + +Anweisung : DEF FN + +Zweck : Definition einer benutzer-definierten Funktion + +Syntax : DEF FN [ ( [, ] #right# [...] ) ] = + +Erklärung : : Zeichenfolge, die der Syntax für Variablennamen + entsprechen muß + FN bilden zusammen den Namen der + neuen Funktion + : Zeichenfolge, die der Syntax für Variablennamen + entsprechen muß + : Ausdruck, der Konstanten, Variablen, die + Parameter der Funktion und Aufrufe + anderer Funktionen enthalten darf + + Mit der DEF FN-Anweisung wird eine benutzer-definierte Funktion + ("user function") mit dem Funktionsnamen FN definiert + (vergleiche hierzu auch Kapitel 4.5.). + Die benutzer-definierte Funktion liefert, genau wie die standard­ + mäßig eingebauten Funktionen, einen Wert, der sich aus der Auswer­ + tung des unter angegebenen Ausdrucks + ergibt. + Das letzte Zeichen des Funktionsnamens gibt den Typ des Wertes + an, den die Funktion liefert. Soll die Funktion einen TEXT liefern, so + muß der Name mit "$" enden. Soll ein INT geliefert werden, muß der + Name mit "%" enden. Für alle anderen Endungen wird eine REAL- + liefernde Funktion eingetragen. + Bezeichnet der Funktionsname eine TEXT-liefernde Funktion, so + muß auch die Funktionsdefinition ein Ergebnis vom Typ TEXT liefern. + Zwischen INTs und REALs findet eine Typanpassung statt. + + Die Parameter stehen für die beim Aufruf der Funktion übergebenen + Argumente. + Sie haben nur bei der Definition Gültigkeit. Hierbei 'überdecken' sie + (für diese Zeile) eventuell im BASIC-Programm vorhandene gleich­ + namige Variablen. + Die Syntax der Parameternamen entspricht der Syntax der Namen + von einfachen Variablen. + Jeder Parameter darf in der Parameterliste nur einmal vorkommen. + + In der Definition dürfen auch Aufrufe von zuvor definierten anderen + "user functions" erscheinen, nicht aber die zu definierende Funktion + selbst (rekursive Definition). + + Die Funktionen sind allein durch ihre Namen gekennzeichnet. Gene­ + rische Funktionen (gleicher Name, aber unterschiedliche Parameter) + können somit nicht definiert werden. + +Hinweis : 1. Die Definition einer "user function" muß ihrem ersten Aufruf + immer textuell vorausgehen. + 2. "user functions" können auch mehrfach definiert werden. Der + Compiler gibt in einem solchen Fall aber eine Warnung aus, da + die neue Definition nur für die textuell folgenden Aufrufe gültig ist. + + +Beispiel : 10 LET pi = 3.1415927 + 20 DEF FNkreisflaeche (radius) + #right#= 4.0 * pi * radius * radius + 1010 PRINT FNkreisflaeche (1.75) + Ausgabe: 38.48451 + + + +Anweisung : DIM + +Zweck : Dimensionierung eines Feldes + +Syntax : DIM [, ] [...] + +Erklärung : : ( + #right#[, ] [...] ) + : Name des Feldes (Syntax wie Name von einfachen + Variablen, vgl. 4.3.) + + Mit der DIM-Anweisung wird ein Feld dimensioniert, das heißt die + Anzahl seiner Dimensionen sowie der kleinste und größte Index in + jeder Dimension werden festgelegt und der Speicherplatz für seine + Elemente (siehe 4.3.) wird reserviert. + + Der kleinste Index in allen Dimensionen richtet sich nach der letzten + vorausgegangenen OPTION BASE-Anweisung. + Geht der Dimensionierung die Anweisung OPTION BASE 0 textuell + voraus oder ist keine OPTION BASE-Anweisung vor der Dimensio­ + nierung vorhanden, so ist der kleinste Index in allen Dimensionen + null. + Wenn der Dimensionierung aber eine OPTION BASE 1-Anweisung + vorausgeht, dann ist der kleinste Index in allen Dimensionen eins. + + Der größte Feldindex wird für jede Dimension durch die in Klammern + stehenden INT-Konstanten angegeben. Die Anzahl dieser INT-Kon­ + stanten bestimmt auch, wie viele Dimensionen das dimensionierte + Feld hat. + + Wird auf ein Element einer Feldvariablen zugegriffen, ohne daß die + Feldvariable vorher dimensioniert wurde, dann wird das Feld automa­ + tisch dimensioniert, wobei die Anzahl der Dimensionen anhand der + Anzahl der Indizes beim Aufruf ermittelt wird. Der größte Feldindex + wird bei dieser automatischen Dimensionierung in jeder Dimension + auf zehn gesetzt. Der kleinste Index richtet sich nach den vorausge­ + gangenen OPTION BASE-Anweisungen (siehe oben). + + Fehlerfälle bei der Dimensionierung: + - "Das Feld ist bereits dimensioniert": + Das Feld wurde bereits explizit, oder automatisch durch den Zugriff + auf ein Feldelement dimensioniert . + - "Die Obergrenze muß >= 1 sein": + Es wurde versucht, 0 als größten Index in einer Dimension festzu­ + legen, obwohl mit OPTION BASE der kleinste Index auf eins fest­ + gelegt wurde. + + Fehlerfälle beim Zugriff auf ein Feldelement: + - "Dimensioniert in ... Dimensionen, gefundene Anzahl Indizes ...": + Beim Zugriff wurde eine Anzahl von Indizes gefunden, die nicht mit + der Anzahl der Dimensionen übereinstimmt (Fehler zur Über­ + setzungszeit). + - "Ueberlauf bei Subskription" oder "Unterlauf bei Subskription": + Der Index ist zu groß beziehungsweise zu klein (Fehler zur Lauf­ + zeit). + + +Beispiel : 10 DIM a% (20, 10), text$ (30, 40) + 20 DIM tabelle (5, 7, 25) + 30 LET element = matrix (1, 7) + + Zeile 30 führt eine automatische Dimensionierung durch, die einem + DIM matrix (10, 10) entspricht. + + + +Anweisungsbestandteil : ELSE + +Siehe IF-Anweisung + + + +Anweisung : END + +Zweck : Beenden der Programmausführung eines BASIC-Programms + +Syntax : END + +Erklärung : END beendet die Programmausführung des BASIC-Programms ohne + eine Meldung (im Gegensatz zu STOP, s.d.). + END-Anweisungen dürfen im Programm an beliebiger Stelle stehen, + und es darf auch mehr als eine END-Anweisung in einem + Programm vorkommen. + Der Compiler übersetzt ein Programm auch nach Erreichen einer + END-Anweisung weiter. + Nach der letzten Anweisung eines Programms muß kein END stehen. + + +Beispiel : 2020 PRINT "Das war's !" + 2030 REM Hiernach hört's auf + 2040 END + + +Vergleiche : STOP-Anweisung + + + +Anweisungsbestandteil : EOF + +Siehe INPUT-Anweisung + + + + +Operator : EQV + +Siehe Kapitel 4.4. (Operatoren) + + + +Funktion : ERL + +Zweck : Ermittlung der letzten Fehlerzeile + +Syntax : ERL + +Erklärung : Die Nummer der Zeile, in der der letzte Fehler auftrat, wird als INT + geliefert. + +Hinweis : ERL ist realisiert durch Aufruf der Prozedur 'errorline' des Betriebs­ + systems. + Da die Fehlerbehandlungs-Anweisung ON ERROR nicht zur Verfü­ + gung steht, ist diese Funktion nicht im üblichen BASIC-Sinne + brauchbar. + +Vergleiche : ERM$, ERR-Funktionen, ERROR-Anweisung + + + +Funktion : ERM$ + +Zweck : Ermittlung der letzten Fehlermeldung + +Syntax : ERM$ + +Erklärung : Die letzte Fehlermeldung wird als TEXT geliefert. + +Hinweis : ERM$ ist realisiert durch Aufruf der Prozedur 'errormessage' des + Betriebssystems. + Da die Fehlerbehandlungs-Anweisung ON ERROR nicht zur Verfü­ + gung steht, ist diese Funktion nicht im üblichen BASIC-Sinne + brauchbar. + +Vergleiche : ERL-, ERR-Funktionen, ERROR-Anweisung + + + +Funktion : ERR + +Zweck : Ermittlung des letzten Fehlercodes + +Syntax : ERR + +Erklärung : Der Code des letzten aufgetretenen Fehlers wird als INT geliefert. + +Hinweis : ERR ist realisiert durch Aufruf der Prozedur 'errorcode' des Betriebs­ + systems. + Da die Fehlerbehandlungs-Anweisung ON ERROR nicht zur Verfü­ + gung steht, ist diese Funktion nicht im üblichen BASIC-Sinne + brauchbar. + +Vergleiche : ERL-, ERM$-Funktionen, ERROR-Anweisung + + + +Anweisung : ERROR + +Zweck : Auslösen eines Fehlers mit bestimmtem Fehlercode + +Syntax : ERROR + +Erklärung : Es wird ein Fehler mit dem durch den INT-Ausdruck bestimmten + Fehlercode ausgelöst. + +Hinweis : ERROR ist realisiert durch Aufruf der Prozedur 'errorstop' des Be­ + triebssystems. + Da die Fehlerbehandlungs-Anweisung ON ERROR nicht zur Verfü­ + gung steht, ist diese Anweisung nicht im üblichen BASIC-Sinne + brauchbar. + +Vergleiche : ERL-, ERM$-, ERR-Funktionen + + + +Funktion : EXP + +Zweck : Berechnung einer Potenz der Eulerschen Zahl + +Syntax : EXP () + +Erklärung : Die Funktion liefert e (die Basis des natürlichen Logarithmus) poten­ + ziert mit dem Wert des REAL-Ausdrucks. + Bei zu großen Werten kommt es zum Fehler 'REAL-Ueberlauf'. + Das Ergebnis der Funktion wird als REAL geliefert. + + +Beispiel : 10 PRINT EXP (10.0) + Ausgabe: 22026.47 + +Vergleiche : LOG-Funktion (Komplementärfunktion) + + + +Funktion : FIX + +Zweck : Ermittlung der Vorkommastellen einer REAL-Zahl + +Syntax : FIX () + +Erklärung : Die Funktion schneidet die Nachkommastellen ab und liefert nur die + Vorkommastellen des REAL-Ausdrucks. + Die Vorkommastellen werden ebenfalls als REALs geliefert. + + +Beispiel : 10 zahl = 1.2345E2 + 20 PRINT FIX (zahl) + Ausgabe: 123 + +Vergleiche : CINT-, INT-Funktionen + + + +Anweisung : FOR + +Zweck : Beginn einer Zählschleife + +Syntax : FOR = #ib(3)#TO#ie(3)# + #right#[ #ib(3)#STEP#ie(3)# ] + + + +Erklärung : : INT- oder REAL-Variable + : numerischer Ausdruck + : numerischer Ausdruck + : numerischer Ausdruck + : Folge von Programmzeilen + + Die FOR-Anweisung erlaubt die komfortable Programmierung von + automatischen Zählschleifen (sogenannten FOR-NEXT-Schleifen). + Gelangt das Programm während der Ausführung an eine FOR-An­ + weisung, so werden zunächst die Ausdrücke , + sowie gegebenenfalls ausgewertet. Der + Anfangswert wird dann der Variablen zugewiesen. + Wenn der Wert der Variablen größer ist als der Endwert (bzw. kleiner + als der Endwert bei negativer Schrittweite), dann wird das Programm + mit der nach dem korrespondierenden NEXT (s.d.) folgenden + Anweisung fortgesetzt. + Ist dies jedoch nicht der Fall, werden die Anweisungen des ausgeführt. Erreicht das Programm nun die zum FOR + gehörige NEXT-Anweisung (gleiche Variable), so wird der Wert der + Variablen um die Schrittweite erhöht beziehungsweise erniedrigt (je + nach Vorzeichen), und wieder an den Anfang der Schleife verzweigt. + Hier findet dann wieder der Vergleich des Variableninhalts mit dem + Endwert statt (siehe oben). + + Die Laufvariable darf innerhalb der Schleife in Ausdrücken vorkom­ + men. Sie darf sogar verändert werden (, was aber zu unübersichtli­ + chen Effekten führen kann). Auch eine Schachtelung mehrerer + Schleifen mit der gleichen Laufvariable ist syntaktisch möglich, sollte + aber #on("iunter allen Umständen#off("i vermieden werden. + + FOR-NEXT-Schleifen dürfen (auch mit WHILE-WEND-Schleifen, + s.d.) geschachtelt werden. Überschneidungen von FOR-NEXT- + Schleifen und WHILE-WEND-Schleifen sind aber nicht zulässig. + + +Beispiel : 10 DIM name$ (5) + 20 FOR i = 1 TO 5 + 30 PRINT "Bitte geben Sie den " + STR$ (i) + #right#+ ". Namen ein:"; + 40 INPUT name$ (i) + 50 NEXT i + + + Es werden die fünf Elemente des Feldes 'name$' eingelesen. + +Vergleiche : NEXT-, WHILE-, IF-Anweisungen + + + +Funktion : FRE + +Zweck : Ermittlung des verfügbaren Speicherplatzes + +Syntax : FRE () + FRE () + +Erklärung : Die Funktion liefert die Anzahl der freien Bytes. + FRE veranlaßt außerdem ein 'collect heap garbage' (EUMEL- + Systemprozedur). + + Das Ergebnis der Funktion wird als REAL geliefert. + Der Argument-Ausdruck ist ein Dummy-Argument (hat keinen + Einfluß auf den gelieferten Wert). + +Hinweis : Bei der EUMEL M+ Version wird ein korrektes Ergebnis geliefert + (vgl.'storage info'). + + +Beispiel : 10 PRINT FRE (0) + Ausgabe (z.B.): 5324800 + + + +Anweisungsbestandteil : GO + +Siehe GOSUB und GOTO + + + +Anweisung : GOSUB + +Zweck : Unterprogramm-Aufruf + +Syntax : GOSUB + +Erklärung : : INT-Konstante + Statt GOSUB darf auch GO #ib(3)#SUB#ie(3)# geschrieben werden. + + Die Programmausführung wird in der Zeile mit der angegebenen + Zeilennummer fortgesetzt. Die Zeile mit der Zeilennummer muß im + Programm existieren. + Wird im weiteren Programmablauf die Anweisung RETURN gefunden, + so wird hinter dem letzten abgearbeiteten GOSUB die Programm­ + ausführung fortgesetzt. + GOSUB dient zum Aufruf von #on("iUnterprogrammen#off("i, die von mehr als + einer Stelle im Programm (und auch in anderen Unterprogrammen) + aufgerufen werden können. + +Hinweis : Es wird empfohlen, Unterprogramme im Programm deutlich als solche + zu kennzeichnen und (durch END, STOP oder GOTO) sicherzustel­ + len, daß nur mit GOSUB zu ihnen verzweigt wird, da es sonst leicht + zu der (Laufzeit-) Fehlermeldung "RETURN ohne GOSUB" kommen + kann. + + +Beispiel : 140 GOSUB 10000 'Zeige Uhrzeit + . + . + 370 GOSUB 10000 'Zeige Uhrzeit + 9990 END + 10000 REM Unterprogramm Zeige Uhrzeit + 10010 PRINT "Es ist " + TIME$ + " Uhr" + 10020 RETURN + + +Vergleiche : RETURN-, ON-, GOTO- Anweisungen + + + +Anweisung : GOTO + +Zweck : Sprung zu einer angegebenen Zeile + +Syntax : GOTO + +Erklärung : : INT-Konstante + Statt GOTO darf auch GO #ib(3)#TO#ie(3)# geschrieben werden. + + Die Programmausführung wird in der Zeile mit der angegebenen + Zeilennummer fortgesetzt. Die Zeile mit der Zeilennummer muß im + Programm existieren. + + +Beispiel : 10 INPUT "Monat (1-12)", monat% + 20 IF monat% < 1 OR monat% > 12 THEN GOTO 10 + + +Vergleiche : ON-, IF-, GOSUB- Anweisungen + + + +Funktion : HEX$ + +Zweck : Erzeugung der hexadezimalen Darstellung einer Zahl als Text + +Syntax : HEX$ () + +Erklärung : Die Funktion liefert die hexadezimale (Zweierkomplement-) Darstel­ + lung der Zahl, die sich aus dem INT-Ausdruck ergibt. + + +Beispiel : 10 PRINT HEX$ (10000) + Ausgabe: 2710 + +Vergleiche : OCT$-Funktion + + + +Anweisung : IF + +Zweck : Sprung zu einer angegebenen Zeile + +Syntax : IF + #right#[,] #ib(3)#THEN#ie(3)# | + #right#[ [,] #ib(3)#ELSE#ie(3)# |] + IF [,] GOTO + #right#[ [,] ELSE |] + +Erklärung : : numerischer Ausdruck + : Eine oder mehrere BASIC-Anweisungen, wobei + mehrere wie gewohnt durch ':' zu trennen sind + : INT-Konstante + Statt GOTO darf auch GO TO geschrieben werden. + + Anhand der Bedingung wird entschieden, ob die Abarbeitung des + Programms mit dem THEN- oder ELSE-Zweig fortgesetzt werden + soll. Mit dem THEN-Zweig wird das Programm fortgesetzt, wenn die + Bedingung erfüllt ist (, d.h. der numerische Ausdruck ungleich null + ist). Im anderen Fall (Bedingung nicht erfüllt, numerischer Ausdruck + gleich null) wird das Programm mit dem ELSE-Teil fortgesetzt. Ist + kein ELSE-Teil angegeben, so wird die Abarbeitung des + Programmes in der folgenden #on("iZeile#off("i (nicht nach ':') fortgesetzt. + + Sind statt Anweisungen Zeilennummern nach THEN oder ELSE + angegeben, so entspricht dies einem GOTO (s.d.) zu diesen Zeilen­ + nummern. + + +Hinweis : Auch eine IF-Anweisung muß in #on("ieiner#off("i Programmzeile stehen. + + +Beispiel : 10 IF a >= b THEN IF a > b THEN + #right#PRINT "a größer b" ELSE PRINT "a gleich b" + #right#ELSE PRINT "a kleiner b" + + + Das Beispiel zeigt, daß bei geschachtelten IF-Anweisungen die + ELSE-Teile immer auf das letzte vorhergehende IF bezogen werden, + für das noch kein ELSE-Teil gefunden wurde. + + + +Vergleiche : GOTO-, GOSUB-, ON-Anweisungen + + + +Operator : IMP + +Siehe Kapitel 4.4. (Operatoren) + + + +Funktion : INKEY$ + +Zweck : Holen eines Zeichens von der Tastatur + +Syntax : INKEY$ + +Erklärung : Die Funktion liefert ein Textzeichen aus dem Tastaturzeichenpuffer. + Wurde kein Zeichen eingegeben, so wird ein Leertext (niltext) gelie­ + fert. + Die gelieferten Zeichen erscheinen nicht auf dem Bildschirm. + + +Beispiel : 10 REM Schreibmaschine + 20 LET a$ = INKEY$ + 30 IF ASC (a$) = 27 THEN STOP + 40 PRINT a$; + 50 GOTO 20 + + + Die eingegebenen Zeichen werden ausgegeben. Abbruch mit ESC. + +Vergleiche : INPUT$-Funktion, INPUT-Anweisung + + + +Anweisung : INPUT + +Zweck : Einlesen von Daten von der Tastatur + +Syntax : INPUT [;] [ ,|; ][ #ib(3)#EOF#ie(3)# + ] + #right# [, ] [...] + +Erklärung : : TEXT-Konstante + : INT-Konstante + : Variable, der der eingelesene Werte + zugewiesen werden soll + + Mit der INPUT-Anweisung werden Daten zur Laufzeit des + Programms von der Tastatur in Variablen eingelesen. + + Folgt dem INPUT-Statement ein Semikolon, so wird nach + Beendigung der Eingabe kein Zeilenwechsel vorgenommen. + + Fehlt die , so wird "? " als Eingabe­ + aufforderung ausgegeben. + Folgt der ein Semikolon, so wird "? " noch zusätzlich ausge­ + geben. Bei einem Komma wird dieser Standard-Prompt unter­ + drückt. + + Folgt der die Zeichenfolge 'EOF', so wird + bei Eingabe eines Leertextes zu der nach 'EOF' angegebenen + Zeilennumer verzweigt. + + Sollen mehrere Variablen eingelesen werden, so muß der Benutzer + auch entsprechend viele Daten (durch Kommata getrennt) zur Verfü­ + gung stellen. + + Wird nichts eingegeben beziehungsweise nur die richtige Anzahl von + Kommata, so wird den entsprechenden Variablen 0, 0.0 bzw. 'niltext' + zugewiesen. + + Bei der Eingabe für eine Textvariable können alle Zeichen (außer + Steuerzeichen) eingegeben werden. Beginnt eine Eingabe mit dem + Anführungszeichen oder endet sie damit, dann muß sie auch damit + enden beziehungsweise beginnen. Diese beiden Anführungszeichen + werden nicht mit zugewiesen. Innerhalb dieser Texteingabe dürfen + Anführungszeichen stehen, aber keine Kommata. + + Eingaben für numerische Variablen müssen in der für Konstanten + üblichen Schreibweise erfolgen. Vorzeichen sind allerdings zusätzlich + erlaubt. + + Vor Zuweisung der eingegebenen Werte an die Variablen werden + Anzahl und Typ(en) und die Anzahl überprüft. + Dabei können folgende Fehlerfälle auftreten: + - "falscher Typ": + Es wurde ein Text statt einer Zahl eingegeben, es wurde ein REAL + statt eines INTs eingegeben oder eine Texteingabe ist fehlerhaft. + - "zu wenig Daten" + - "zu viele Daten" + - "Überlauf": + Es wurde eine zu große (oder zu kleine) Zahl eingegeben. + + Kommt es zu einem Fehler, dann wird nach der Meldung "?Eingabe + wiederholen ! ()" die Eingabe zum Editieren + angeboten. + +Hinweis : Bei Eingabe von 'ESC k' kann die letzte Eingabezeile zum Editieren + zurückgeholt werden. + + Die Eingabe kann mit der Systemprozedur 'sysin' aus einer Datei + erfolgen. Aus der Eingabedatei wird für jedes INPUT-Statement eine + Zeile eingelesen. Die Ausgabe der Eingabeaufforderung und der + Zeilenwechsel nach der Eingabe werden unterdrückt. Sind die + Eingabedaten fehlerhaft, so wird das Programm mit 'errorstop' + abgebrochen. + + Wird die Ausgabe mit 'sysout' umgeleitet, so werden die Eingabe­ + aufforderung, die Eingabezeichenfolge und der Zeilenwechsel nach + der Eingabe auf den Bildschirm und in die Ausgabedatei ausgegeben, + auch dann, wenn der Text der Eingabe aus einer Datei eingelesen + wurde. + + +Beispiel : 1990 INPUT "Name, Vorname, Alter"; + #right#name$, vorname$, alter% + + +Vergleiche : INKEY$-, INPUT$-Funktionen + + + +Funktion : INPUT$ + +Zweck : Holen einer Zeichenfolge von der Tastatur + +Syntax : INPUT$ () + +Erklärung : : INT-Ausdruck + + Die Funktion liefert eine Folge von Textzeichen + aus dem Tastaturzeichenpuffer. Enthält der Puffer nicht alle ge­ + wünschten Zeichen, so wird auf weitere Zeichen von der Tastatur + gewartet. + Die gelieferten Zeichen erscheinen nicht auf dem Bildschirm. + + +Beispiel : 10 PRINT "Bitte drei Zeichen eingeben !" + 20 LET a$ = INPUT$ (3) + 30 PRINT "Danke schön !" + + +Vergleiche : INKEY$-Funktion, INPUT-Anweisung + + + +Funktion : INSTR + +Zweck : Suchen einer Zeichenfolge in einer anderen + +Syntax : INSTR ( [,] , + #right#) + +Erklärung : : INT-Ausdruck + + Die Funktion liefert die Position, ab der der TEXT-Ausdruck 2 das + erste Mal im TEXT-Ausdruck 1 vorkommt. + Die Position wird als INT geliefert. + + +Beispiel : 10 LET a$ = "hallihallo" + 20 LET b$ = "all" + 30 PRINT INSTR (a$, b$); INSTR (5, a$, b$) + Ausgabe: 2 7 + + + +Funktion : INT + +Zweck : Ermittlung der nächstkleineren ganzen Zahl + +Syntax : INT () + +Erklärung : Die Funktion liefert die größte ganze Zahl, für die gilt: + n kleiner gleich . + Bei positiven Werten bedeutet das, daß die Nachkommastellen abge­ + schnitten werden. + Das Ergebnis wird als REAL geliefert. + + +Beispiel : 10 PRINT INT (11.74); INT (-11.74) + Ausgabe: 11 -12 + +Vergleiche : CINT-, FIX-Funktionen + + + +Anweisung : KILL + +Zweck : Löschen einer Datei in der Task + +Syntax : KILL + +Erklärung : : TEXT-Ausdruck + Die Datei wird (ohne Nachfrage) gelöscht. + + +Beispiel : 2110 KILL "Scratchdatei" + + + + +Funktion : LEFT$ + +Zweck : Erzeugung eines Teiltextes aus einem anderen Text + +Syntax : LEFT$ (, ) + +Erklärung : : INT-Ausdruck + + Die Funktion liefert die ersten Textzeichen des + TEXT-Ausdrucks. + + +Beispiel : 10 LET a$ = "hallihallo" + 20 PRINT LEFT$ (a$, 4) + Ausgabe: hall + +Vergleiche : MID$-, RIGHT$-Funktionen, LSET-, MID$-, RSET- + Anweisungen + + + +Funktion : LEN + +Zweck : Ermittlung der Länge eines Textes + +Syntax : LEN () + +Erklärung : Die Funktion liefert die Anzahl der im TEXT-Ausdruck enthaltenen + Zeichen (also die Länge des Textes). Die Länge wird als INT + geliefert. + Ein Leertext (niltext, "") hat die Länge null. + + +Beispiel : 10 LET a$ = "hallihallo" + 20 PRINT LEN (a$) + Ausgabe: 10 + + + +Anweisung : LET + +Zweck : Zuweisung eines Wertes an eine Variable + +Syntax : [LET] = + +Erklärung : Die LET-Anweisung ermöglicht das Zuweisen von Werten an Variab­ + len (dazu gehören auch die Elemente von Feldern). + + Das Schlüsselwort LET ist optional, d.h. eine Zuweisung wird auch + ohne dieses Schlüsselwort erkannt. + + #on("iZuweisung an TEXT-Variablen:#off("i + LET = oder + Die numerische Konstante wird automatisch in einen TEXT umge­ + wandelt (vgl. STR$-Funktion) + + #on("iZuweisung an INT-Variablen:#off("i + LET = + Ist der numerische Ausdruck ein REAL-Ausdruck, so wird automa­ + tisch nach INT konvertiert (vgl. CINT-Funktion). + + #on("iZuweisung an REAL-Variablen:#off("i + LET = + Ist der numerische Ausdruck ein INT-Ausdruck, so wird automatisch + nach REAL konvertiert (vgl. CDBL-Funktion). + + +Beispiel : 10 LET t$ = "murmel marmel" + 20 LET t$ = 1245.3 'wie "1245.3" + 30 LET i% = 852 + 40 LET i% = 12.73 'aufgerundet: 13 + 50 LET r = 564 'wie 564. + 60 LET r = 157.36 + + + + +Anweisung : LINE INPUT + +Zweck : Einlesen einer Eingabe von der Tastatur in eine TEXT-Variable + +Syntax : LINE INPUT [;] [;] + #right# + +Erklärung : Die LINE INPUT-Anweisung ermöglicht das Einlesen von Eingaben + in TEXT-Variablen, aber im Gegensatz zu INPUT ohne Beachtung + von Trennzeichen (z.B. ","). + + Steht direkt nach LINE INPUT ein Semikolon, so wird nach Beendi­ + gung der Eingabe der Zeilenwechsel unterdrückt. + + Der eingegebene Text wird (bis auf das CR-Zeichen) der TEXT- + Variablen zugewiesen. + + +Beispiel : 2110 LINE INPUT "Name: ";name$ + + + Der Benutzer könnte nun auch folgendes eingeben: + Neumann, Alfred E. + +Vergleiche : INPUT-Anweisung + + + +Funktion : LOG + +Zweck : Berechnung des natürlichen Logarithmus einer Zahl + +Syntax : LOG () + +Erklärung : Die Funktion liefert den natürlichen Logarithmus des Wertes des + REAL-Ausdrucks. + Bei nicht-positiven Werten kommt es zu einem Fehler in der + EUMEL-Prozedur 'log2'. + Das Ergebnis der Funktion wird als REAL geliefert. + + +Beispiel : 10 PRINT LOG (10.0) + Ausgabe: 2.302585 + +Vergleiche : EXP-Funktion (Komplementärfunktion) + + + +Funktion : LPOS + +Zweck : Ermittlung der aktuellen Druckspalte + +Syntax : LPOS () + +Erklärung : Geliefert wird die Nummer der Spalte (als INT), in die das nächste + nächste Zeichen mit LPRINT ausgegeben wird. Die Spalte ganz links + hat die Nummer 1. + Der Argument-Ausdruck ist ein Dummy-Argument (hat keinen + Einfluß auf den gelieferten Wert). + + +Beispiel : 3010 IF LPOS (0) > 65 THEN LPRINT + 3020 LPRINT name$ + + + Falls die Druckposition hinter Spalte 65 liegt, wird eine neue Druck­ + zeile begonnen. + +Vergleiche : LPRINT-Anweisung, TAB-, POS-Funktion + + + +Anweisung : LPRINT + +Zweck : Ausgabe in eine Druckdatei + +Syntax : LPRINT [#ib(3)#USING#ie(3)# ;] + #right#[ #ib(3)#TAB#ie(3)# () | , | ; | ] [...] + +Erklärung : : TEXT-Ausdruck für USING (vgl. PRINT) + : INT-Ausdruck (vgl. PRINT) + : TEXT-Ausdruck oder numerischer Ausdruck + + Die LPRINT-Anweisung arbeitet wie PRINT (siehe dort), mit dem + Unterschied, daß LPRINT die Zeichen nicht auf den Bildschirm, son­ + dern in eine Datei mit dem Namen "BASIC LPRINT OUTPUT" + ausgibt. Diese Datei wird automatisch eingerichtet, falls sie noch + nicht existiert. Ist sie schon vorhanden, so werden die auszugeben­ + den Zeichen am Ende der Datei angefügt. + Nach oder bei Ablauf des Programms kann die Datei (evtl. nach + vorheriger Aufbereitung durch Textverarbeitungsprogramme) mit + 'print', wie im EUMEL-System üblich, an den Drucker geschickt + werden. Der Benutzer ist selbst dafür verantwortlich, daß er die + Druckdatei, sofern die Daten nicht mehr benötigt werden, vor einem + neuen Programmlauf leert oder löscht. Versäumt er dies, so bleiben + die alten Daten in der Druckdatei, und die neuen Ausgaben werden + hinten angefügt. Das Löschen der Druckdatei kann zum Beispiel + durch das BASIC-Programm mit der KILL-Anweisung erreicht + werden. + + Die Art der Ausgabe und die Syntax ist sonst analog zur PRINT- + Anweisung (siehe Erläuterungen dort). + + +Beispiel : 2110 LPRINT "Dieser Text geht in die Druckdatei" + 2120 LPRINT TAB (12); "Datum: " DATE$ + 2130 LPRINT 1, 2, 3 + + +Vergleiche : PRINT-Anweisung, LPOS-Funktion + + + +Anweisung : LSET + +Zweck : Ersetzen von Zeichen eines Textes von links her + +Syntax : LSET = + +Erklärung : Das Ergebnis des TEXT-Ausdrucks wird, links beginnend, in der + TEXT-Variablen eingesetzt. Es werden höchstens so viele Zeichen + ersetzt, wie bisher schon in der Variablen vorhanden waren, das heißt + die Länge des Textes in der Variablen ändert sich nicht. + + +Beispiel : 210 LET a$ = "12345" + 220 LSET a$ = "ABCDEFG" + 230 PRINT a$, + 240 LSET a$ = "abc" + 250 PRINT a$ + Ausgabe: ABCDE abcDE + +Vergleiche : MID$-, RSET-Anweisungen, LEFT$-, MID$-, RIGHT$-Funk­ + tionen + + + +Anweisung : MID$ + +Zweck : Ersetzen von Zeichen innnerhalb eines Textes + +Syntax : MID$ (, + #right#[, ] ) = + +Erklärung : : INT-Ausdruck + : INT-Ausdruck + + Das Ergebnis des TEXT-Ausdrucks wird, bei + beginnend, in der TEXT-Variablen eingesetzt. Es werden höch­ + stens LEN Textzeichen ersetzt. Ist keine + angegeben, so werden so viele Zeichen des + TEXT-Ausdrucks wie möglich in der TEXT-Variablen eingetragen. + Außerdem gilt: Es wird nicht über das bisherige Ende des Variablen­ + inhalts ersetzt, das heißt die Länge des Textes in der Variablen + ändert sich nicht. + + +Beispiel : 210 LET a$ = "12345" + 220 MID$ (a$, 3) = "ABCDEFG" + 230 PRINT a$, + 240 MID$ (a$, 2, 1) = "abc" + 250 PRINT a$ + Ausgabe: 12ABC 1aABC + +Vergleiche : LEFT$-, MID$-, RIGHT$-Funktionen, LSET-, RSET- + Anweisungen + + + +Funktion : MID$ + +Zweck : Erzeugung eines Teiltextes aus einem anderen Text + +Syntax : MID$ (, + #right# [, ]) + +Erklärung : : INT-Ausdruck + : INT-Ausdruck + + Die Funktion liefert höchstens Textzeichen des + TEXT-Ausdrucks von Position an. + Wird nicht angegeben, so werden alle Zeichen + ab Startposition geliefert. + Werden rechts von keine Zeichen mehr gefunden + oder ist gleich null, so wird ein Leertext geliefert. + + +Beispiel : 10 LET a$ = "hallihallo" + 20 PRINT MID$ (a$, 4, 4), + 30 PRINT MID$ (a$, 6) + Ausgabe: liha hallo + +Vergleiche : LEFT$-, RIGHT$-Funktionen, LSET-, MID$-, RSET- + Anweisungen + + + +Funktion : MKD$, MKI$ + +Zweck : Codierung von Zahlenwerten in Texte + +Syntax : MKD$ () + MKI$ () + +Erklärung : Mit MKD$ und MKI$ können INTs und REALs zu Texten codiert + werden. + + Die Funktion MKD$ liefert einen 8 Zeichen langen TEXT, der den + Wert des REAL-Ausdrucks codiert enthält. + Vergleichbar arbeitet MKI$, das einen 2 Zeichen langen TEXT liefert, + der den Wert des INT-Ausdrucks darstellt. + + Mit MKD$ und MKI$ codierte Werte können mit CVD und CVI (s.d.) + wieder decodiert werden. + + +Beispiel : 10 zahl$ = MKD$ (3.1415) + 20 PRINT CVD (zahl$) + Ausgabe: 3.1415 + +Vergleiche : CVD-, CVI-Funktionen + + + +Operator : MOD + +Siehe Kapitel 4.4. (Operatoren) + + + +Anweisung : NAME + +Zweck : Umbenennen einer Datei + +Syntax : NAME AS + +Erklärung : : TEXT-Ausdruck + : TEXT-Ausdruck + + NAME benennt die Datei in um. + + +Beispiel : 10 NAME "Käufer" AS "Kunden" + + + + +Anweisung : NEXT + +Zweck : Markierung des Endes einer FOR-Schleife + +Syntax : NEXT [] [, ] [...] + +Erklärung : NEXT markiert das Ende einer FOR-Schleife (vergleiche FOR- + Anweisung). + + Wird keine Variable angegeben, so bezieht sich das NEXT auf das + letzte textuell vorhergehende FOR. + Wird eine Laufvariable angegeben, so muß sie mit der im letzten + FOR verwendeten Laufvariable übereinstimmen. + Werden mehrere Variablen angegeben, so werden durch die + NEXT-Anweisung mehrere FOR-Schleifen abgeschlossen. + Beachten Sie, daß FOR-Schleifen sich nicht überschneiden dürfen, + sondern nur Schachtelungen zulässig sind. Es kommt daher auf die + Reihenfolge der Variablen bei den NEXT-Anweisungen an. Die + letzte (innerste) FOR-Schleife muß als erste wieder mit dem zuge­ + hörigen NEXT abgeschlossen werden. + +Vergleiche : FOR-, WHILE-Anweisungen + + + +Operator : NOT + +Siehe Kapitel 4.4. (Operatoren) + + + +Funktion : OCT$ + +Zweck : Erzeugung der oktalen Darstellung einer Zahl als Text + +Syntax : OCT$ () + +Erklärung : Die Funktion liefert die oktale (Zweierkomplement-) Darstellung der + Zahl, die sich aus dem INT-Ausdruck ergibt. + + +Beispiel : 10 PRINT OCT$ (10000) + Ausgabe: 23420 + +Vergleiche : OCT$-Funktion + + + +Anweisung : ON + +Zweck : Ausführung eines "berechneten" Sprungs oder Unterprogramm- + Aufrufs + +Syntax : ON GOTO | GOSUB + #right# [, ] [...] + +Erklärung : : INT-Ausdruck + : INT-Konstante + + ON ermöglicht die Verzweigung des Programms an eine von mehre­ + ren Stellen abhängig vom Ergebnis eines INT-Ausdrucks. + Gelangt das Programm an eine ON-Anweisung, dann wird zunächst + der Wert des INT-Ausdrucks berechnet. Dieses Ergebnis bildet dann + die Nummer n des Sprungziels. Danach wird zur n-ten Zeilen­ + nummer, die nach GOTO beziehungsweise GOSUB steht, verzweigt. + Die maximale Anzahl von Zeilennummern, die nach GOTO oder + GOSUB angegeben werden dürfen, ist 512. + Nimmt einen Wert an, zu dem keine Zeile in der + Liste gefunden wird (z.B. Werte kleiner gleich null oder Werte größer + als die Anzahl der angegebenen Zeilennummern), so wird das Pro­ + gramm mit der der ON-Anweisung folgenden Programmzeile fortge­ + setzt. + + Statt GOTO und GOSUB darf auch GO TO beziehungsweise + GO SUB geschrieben werden. + +Hinweis : Die ON-Anweisung muß in #on("ieiner#off("i Programmzeile stehen. + + +Beispiel : 260 INPUT "Menüpunkt 1, 2 oder 3", a + 270 ON VAL (a) GOTO 300, 400, 500 + 280 GOTO 260 + 300 PRINT "Menüpunkt 1" + . + . + 400 PRINT "Menüpunkt 2" + . + . + 500 PRINT "Menüpunkt 3" + + + Entsprechend der Eingabe wird nach 300, 400 oder 500 verzweigt. + Bei Fehleingaben wird Zeile 280 ausgeführt. + +Vergleiche : GOSUB-, GOTO-, IF-Anweisungen + + + +Anweisung : OPTION BASE + +Zweck : Festlegung des kleinsten Wertes für Feldindizes + +Syntax : OPTION BASE 0|1 + +Erklärung : OPTION BASE legt fest, ob die nachfolgend dimensionierten Felder + Elemente mit dem Index 0 erhalten, oder ob der niedrigste Index 1 + ist. Voreingestellt ist OPTION BASE 0. + +Hinweis : Der niedrigste Feldindex kann für jedes Feld individuell eingestellt + werden. Die OPTION BASE-Anweisung gilt für alle Felder, deren + Dimensionierung ihr textuell nachfolgen. Eine erneute OPTION + BASE-Anweisung kann dann die Untergrenze für die #on("iihr#off("i folgenden + Dimensionierungen festlegen. + + +Beispiel : 10 DIM a (100) 'Indizes 0-100 + 20 OPTION BASE 1 + 30 b$ (3) = "hallo" 'Indizes 1-10 + 40 DIM a% (5) 'Indizes 1-5 + 50 OPTION BASE 0 + 60 DIM c% (9) 'Indizes 0-9 + 70 LET d (4) = 12.3 'Indizes 0-10 + + +Vergleiche : DIM-Anweisung + + + +Operator : OR + +Siehe Kapitel 4.4. (Operatoren) + + + +Funktion : POS + +Zweck : Ermittlung der aktuellen Cursorspalte + +Syntax : POS () + +Erklärung : Geliefert wird die Nummer der Spalte (als INT), in der sich der Cursor + auf dem Bildschirm befindet. Die Spalte ganz links hat die Num­ + mer 1. + Der Argument-Ausdruck ist ein Dummy-Argument (hat keinen + Einfluß auf den gelieferten Wert). + + +Beispiel : 10 CLS + 20 PRINT "testtext"; + 30 PRINT POS (0) + Ausgabe: testtext 9 + + +Vergleiche : CSRLIN-, LPOS-Funktionen + + + +Anweisung : PRINT + +Zweck : Ausgabe auf den Bildschirm + +Syntax : PRINT [#ib(3)#USING#ie(3)# ;] + #right#[ #ib(3)#TAB#ie(3)# () | , | ; | ] [...] + +Erklärung : : TEXT-Ausdruck für USING (s. u.) + : INT-Ausdruck (s. u.) + : TEXT-Ausdruck oder numerischer Ausdruck, der + ausgegeben werden soll. + + PRINT dient der Ausgabe von Zeichen auf dem Bildschirm. + Numerische Werte werden mit sieben signifikanten Ziffer ausgege­ + ben. Bei Exponentendarstellung werden für den Exponent maximal 3 + Ziffern ausgegeben. Hinter allen numerischen Werten und vor posi­ + tiven numerischen Werten wird jeweils ein Leerzeichen ausgegeben. + + TAB bewirkt eine Positionierung des Cursors auf die angegebene + Spalte (die Spalte ganz links hat die Nummer 1). Ist die Spaltenzahl + größer als die mit WIDTH eingestellte Ausgabebreite, so wird auf die + Spalte mit der Nummer Spalte MODULO Ausgabebreite positioniert. + Eine Spaltennummer kleiner gleich null bewirkt eine entsprechende + Warnung. + Ist die Spalte mit der angegebenen Nummer in der aktuellen Zeile + bereits überschritten, dann wird auf die nächste Zeile positioniert. + + Ein Semikolon bewirkt, daß der Cursor an der gerade erreichten + Position bleibt. + + Ein Komma bewirkt die Positionierung auf die nächste gültige Spal­ + te, für deren Nummer gilt: Nummer MODULO 16 ist 1. + Das Komma dient also der Ausgabe in 16 Zeichen breiten Zonen. + + Endet die PRINT-Anweisung mit TAB (), einem Komma + oder einem Semikolon, dann wird kein Zeilenvorschub ausgelöst. + + #onbold#USING + Der EUMEL-BASIC-Compiler unterstützt auch die PRINT + USING-Anweisung für formatierte Ausgaben. + Der nach dem Wort USING angegebene TEXT-Ausdruck spezifi­ + ziert das Ausgabeformat für eine PRINT USING-Anweisung. + + Formatierung von Texten: + "!": Nur das erste Zeichen einer Zeichenfolge wird ausgegeben + "\n Leerzeichen\": Es werden die 2 + n ersten Zeichen einer + Zeichenfolge ausgegeben + "&": Alle Zeichen einer Zeichenfolge werden ausgegeben + + Formatierung von Zahlen: + "\#": bezeichnet eine Ziffernposition + ".": Position des Dezimalpunkts + "+": (vor oder nach Zahlen) Ausgabe des Vorzeichens + "-": (nach Zahlen) gegebenenfalls Ausgabe von "-" hinter der + Zahl + "**": Führende Leerstellen werden mit Sternchen aufgefüllt; wirkt + außerdem wie "\#\#". + "$$": Es wird ein Dollarzeichen links vor der formatierten Zahl ausgegeben; + wirkt außerdem wie "\#\#". + "**$": Führende Leerstellen werden mit Sternchen ausgefüllt und direkt vor + der formatierten Zahl wird ein Dollarzeichen ausgegeben; wirkt + außerdem wie "\#\#\#". + ",": (vor Dezimalpunkt) Unterteilung der Vorkommastellen in Dreier­ + gruppen mittels Komma + "^^^^": Position des Exponenten + "_": Ein Zeichen, das einem Unterstreichungsstrich folgt, wird unverändert + ausgegeben + + Ist der Format-Ausdruck fehlerhaft, so kommt es zum Fehler "USING- + Format fehlerhaft". + Überschreitet eine auszugebende Zahl in irgendeiner Hinsicht die im + Format-Ausdruck für sie vorgesehene Stellenzahl, so wird das Zeichen "%" + ausgegeben, um den Fehler anzuzeigen. + + +Hinweis : 1. PRINT (und PRINT USING) richtet sich bei allen Ausgaben nach + der mit WIDTH eingestellten Ausgabebreite. + 2. Alle Ausgaben von PRINT können mit der Systemprozedur + 'sysout' in eine Datei umgeleitet werden. Dann wird nichts auf + das Terminal ausgegeben. + 3. Das Verhalten beim Erreichen der letzten Bildschirmzeile kann + mit der Prozedur 'basic page' gesteuert werden. Vergleiche + hierzu Kapitel 5, "Steuerung der Bildschirmausgabe". + + +Beispiel : 10 PRINT "hallo", 2 ^ 32 TAB (33) "Ende"; + + Ausgabe: hallo 4.294967E+09 Ende + Position: 1234567890123456789012345678901234567890 + + +Vergleiche : WRITE-, LPRINT-Anweisungen, POS-, CSRLIN-, SPC- + Funktionen + + + +Anweisung : RANDOMIZE + +Zweck : Festlegung eines Anfangswertes für den Zufallszahlengenerator + +Syntax : RANDOMIZE [] + +Erklärung : Mit RANDOMIZE erhält der Zufallszahlengenerator einen bestimmten + Startwert. + Ist kein numerischer Ausdruck angegeben, so wird während des + Programmlaufs die Meldung "Startwert des Zufallszahlen­ + generators ?" ausgegeben und ein Startwert eingelesen. + + Wird der Zufallszahlengenerator immer mit dem gleichen Wert gestar­ + tet, so liefert er auch immer die gleichen Zufallszahlen. Soll er immer + verschiedene Werte liefern, so kann er zum Beispiel mit der System­ + uhr auf zufällige Startwerte gesetzt werden (RANDOMIZE TIMER). + + +Beispiel : 10 RANDOMIZE 4711 + 20 FOR i = 1 TO 5 + 30 PRINT INT (RND * 10); + 40 NEXT i + Ausgabe: 5 6 2 9 6 + +Vergleiche : RND-Funktion + + + +Anweisung : READ + +Zweck : Auslesen von Daten aus DATA-Anweisungen + +Syntax : READ [, ] [...] + +Erklärung : : numerische Variable oder TEXT-Variable + + Die READ-Anweisung liest die nächsten Elemente aus der aktuellen + DATA-Anweisung (s.d.) in die angegebenen Variablen ein. + + In TEXT-Variablen können sowohl "quoted strings" als auch "un­ + quoted strings" (vgl. DATA-Anweisung) eingelesen werden. + In numerische Variablen können dagegen nur "unquoted strings" + eingelesen werden. Außerdem müssen die Zeichen des "unquoted + string" eine gültige Darstellung einer numerischen Konstanten (even­ + tuell mit Vorzeichen) sein. Sind diese Bedingungen nicht erfüllt, so + kommt es bei der Ausführung des Programms zu entsprechenden + Fehlern. + + Eine READ-Anweisung kann Daten aus vorangehenden und nach­ + folgenden DATA-Anweisungen lesen. + Alle DATA-Anweisungen eines Programms bilden zusammen einen + großen sequentiellen Speicher, auf den mit READ der Reihe nach + zugegriffen wird. Intern wird ein sogenannter READ-DATA-Zeiger + geführt, der immer auf das nächste auszulesende Element zeigt. + + Die RESTORE-Anweisung (s.d.) ermöglicht es, den READ-DATA- + Zeiger auf das erste Element einer bestimmten DATA-Zeile zu + setzen. + + Sind keine Daten mehr für READ vorhanden, so wird die Ausführung + des Programms mit der Fehlermeldung "Keine Daten mehr für + READ" abgebrochen. + + +Beispiel : 2020 PRINT "Stadt", "Land", "Fluß" + 2030 READ stadt$, land$, fluß$ + 2040 PRINT stadt$, land$, fluß$ + . + 5000 DATA Köln, Bundesrepublik Deutschland, Rhein + + +Vergleiche : DATA-, RESTORE-Anweisungen + + + +Anweisung : REM + +Zweck : Ermöglicht das Einfügen von Kommentaren in ein Programm + +Syntax : REM + +Erklärung : : Beliebige Folge von Zeichen + + Wird eine REM-Anweisung gefunden, so wird der Rest der Pro­ + grammzeile nicht weiter beachtet. Die Compilierung wird in der fol­ + genden Zeile fortgesetzt. + Es empfielt sich, von Kommentarzeilen möglichst oft Gebrauch zu + machen, weil sie den Programmtext dokumentieren und strukturieren. + +Hinweis : Nach REM können keine weiteren Anweisungen mehr in einer Pro­ + grammzeile stehen, da sie nicht übersetzt werden. Auch der Doppel­ + punkt wird nach REM nicht beachtet. + + +Beispiel : 1000 REM Ausgabe des Feldes + 1010 FOR i = 1 TO feldgroesse% + 1020 PRINT "Eintrag"; i; feld (i) + 1030 NEXT i + + + +Anweisung : RESTORE + +Zweck : Setzen des READ-DATA-Zeigers auf den Anfang einer angegebe­ + nen Zeile + +Syntax : RESTORE [] + +Erklärung : : INT-Konstante + + Der READ-DATA-Zeiger (vgl. DATA-Anweisung) wird auf die Zeile + gesetzt. + Wird keine Zeilennummer angegeben, so wird für + 1 eingesetzt. + + Existiert die Programmzeile nicht oder ist in ihr + keine DATA-Anweisung vorhanden, so wird der Zeiger auf die + nächste textuell folgende DATA-Anweisung gesetzt. + Folgt der angegebenen Zeilennummer im Programm keine DATA- + Anweisung mehr, kommt es zu der Fehlermeldung "RESTORE: Keine + DATA-Anweisung in oder nach Zeile gefunden !" + + +Beispiel : 10 READ a, b, c + 20 RESTORE + 30 READ d, e, f + 40 DATA 2, 3, 5 + 50 PRINT a; b; c; d; e; f + Ausgabe: 2 3 5 2 3 5 + +Vergleiche : DATA-, READ-Anweisungen + + + +Anweisung : RETURN + +Zweck : Rücksprung aus einem Unterprogramm + +Syntax : RETURN + +Erklärung : RETURN bewirkt einen Rücksprung aus dem Unterprogramm hinter + die aufrufende GOSUB-Anweisung. + + Es dürfen auch mehrere RETURN-Anweisungen in einem Unterpro­ + gramm vorkommen, um es an verschiedenen Stellen zu verlassen. + + Wird ein RETURN gefunden, ohne daß ein GOSUB durchlaufen + wurde, so wird mit der Fehlermeldung "RETURN ohne GOSUB" + abgebrochen. + + +Beispiel : 140 GOSUB 10000 'Zeige Uhrzeit + . + . + 370 GOSUB 10000 'Zeige Uhrzeit + 9990 END + 10000 REM Unterprogramm Zeige Uhrzeit + 10010 PRINT "Es ist " + TIME$ + " Uhr" + 10020 RETURN + + +Vergleiche : GOSUB-, ON-Anweisungen + + + +Funktion : RIGHT$ + +Zweck : Erzeugung eines Teiltextes aus einem anderen Text + +Syntax : RIGHT$ (, ) +Erklärung : : INT-Ausdruck + + Die Funktion liefert die letzten Textzeichen des + TEXT-Ausdrucks. + Ist größer gleich der Länge des TEXT- + Ausdrucks, so wird der gesamte Ausdruck geliefert. + + +Beispiel : 10 LET a$ = "hallihallo" + 20 PRINT RIGHT$ (a$, 5) + Ausgabe: hallo + +Vergleiche : LEFT$-, MID$-Funktionen, LSET-, MID$-, RSET-Anweisungen + + + +Funktion : RND + +Zweck : Erzeugung von Zufallszahlen + +Syntax : RND [] + +Erklärung : Wird kein Argument angegeben, so wird ein Wert größer null für den + Ausdruck angenommen. + + RND (x) liefert + + für x > 0: + eine neue Zufallszahl. Es gilt immer: 0 <= RND < 1. Der Betrag + des Arguments hat keinen Einfluß auf das Ergebnis. + + für x = 0: + die letzte gelieferte Zufallszahl noch einmal. + + für x < 0: + eine neue Zufallszahl. Vorher wird aber RANDOMIZE x (s.d.) ausge­ + führt. + + Die Zufallszahlen werden als REALs geliefert. + Der Zufallszahlengenerator kann mit der RANDOMIZE-Anweisung + auf bestimmte Startwerte eingestellt werden. + + +Beispiel : 10 FOR i = 1 TO 5 + 20 PRINT INT (RND * 10) + 30 NEXT i + Ausgabe (z.B.): 7 9 9 5 0 + +Vergleiche : RANDOMIZE-Anweisung + + + +Anweisung : RSET + +Zweck : Ersetzen von Zeichen eines Textes von rechts her + +Syntax : RSET = + +Erklärung : Das Ergebnis des TEXT-Ausdrucks wird, rechts beginnend, in der + TEXT-Variablen eingesetzt. Es werden höchstens so viele Zeichen + ersetzt, wie bisher schon in der Variablen vorhanden waren, das heißt + die Länge des Textes in der Variablen ändert sich nicht. + Soll ein Text eingesetzt werden, der länger ist als der Text in der + Variablen, so wird die Variable nicht verändert. + + +Beispiel : 210 LET a$ = "ABCDEFG" + 220 RSET a$ = "12345" + 230 PRINT a$, + 240 RSET a$ = "abc" + 250 PRINT a$ + Ausgabe: AB12345 AB12abc + +Vergleiche : LSET-, MID$-Anweisungen, LEFT$-, MID$-, RIGHT$-Funk­ + tionen + + + +Funktion : SGN + +Zweck : Ermittlung des Vorzeichens einer Zahl + +Syntax : SGN () + +Erklärung : SGN (x) liefert + für x > 0: 1 + für x = 0: 0 + für x < 0: -1 . + + +Beispiel : 10 a = -12.74 + 20 PRINT SGN (a); SGN (-a); SGN (0 * a) + Ausgabe: -1 1 0 + +Vergleiche : ABS-Funktion + + + +Funktion : SIN + +Zweck : Berechnung des Sinus eines Radiantwertes + +Syntax : SIN () + +Erklärung : : REAL-Ausdruck, der den Winkel in Radiant angibt. + Die Funktion liefert den Sinus des Winkels als REAL. + + +Beispiel : 10 PI = 3.141593 + 20 PRINT SIN (PI/4) + Ausgabe: .7071068 + +Vergleiche : COS-, TAN-Funktionen + + + +Funktion : SPACE$ + +Zweck : Erzeugung einer bestimmten Anzahl von Leerzeichen + +Syntax : SPACE$ () + +Erklärung : Die SPACE$-Funktion liefert einen TEXT, der aus so vielen Leerzei­ + chen (Code 32) besteht, wie der Wert des INT-Ausdrucks angibt. + + +Beispiel : 10 PRINT "123456789" + 20 PRINT "^" + SPACE$ (7) + "^" + + Ausgabe: 123456789 + ^ ^ + + +Vergleiche : STRING$-Funktion + + + +Funktion : SPC + +Diese Funktion entspricht exakt der SPACE$-Funktion und wurde nur aus Kompatibi­ +litätsgründen implementiert. + + + +Funktion : SQR + +Zweck : Berechnung der Quadratwurzel einer Zahl + +Syntax : SQR () + +Erklärung : SQR (x) liefert die Quadratwurzel des durch den numerischen Aus­ + druck angegebenen Wertes. + Das Ergebnis wird als REAL geliefert. + + +Beispiel : 10 PRINT SQR (100); + 20 PRINT SQR (2); + 30 PRINT SQR (17.453) + Ausgabe: 10 1.414214 4.177679 + + + +Anweisungsbestandteil : STEP + +Siehe FOR-Anweisung + + + +Anweisung : STOP + +Zweck : Beenden der Programmausführung eines BASIC-Programms mit + Meldung + +Syntax : STOP + +Erklärung : STOP beendet die Programmausführung des BASIC-Programms. + Im Gegensatz zu END (s.d.) erzeugt STOP dabei die Meldung "STOP + beendet das Programm in Zeile ...". + + STOP-Anweisungen dürfen im Programm an beliebiger Stelle + stehen, und es darf auch mehr als eine STOP-Anweisung in einem + Programm vorkommen. + Der Compiler übersetzt ein Programm auch nach Erreichen einer + STOP-Anweisung weiter. + + +Beispiel : 3220 IF eingabe$ = "Ende" THEN STOP + + +Vergleiche : END-Anweisung + + + +Funktion : STR$ + +Zweck : Konvertierung einer Zahl in einen Text + +Syntax : STR$ () + +Erklärung : Die Funktion liefert die Darstellung des Wertes des numerischen + Ausdrucks als TEXT. + Die Zahlen werden so als Text geliefert, wie sie bei einer PRINT- + Anweisung auf dem Bildschirm erscheinen würden. + + +Beispiel : 10 LET zahl$ = STR$ (1e6) + 20 PRINT zahl$; LEN (zahl$) + Ausgabe: 1000000 7 + +Vergleiche : VAL-Funktion (Komplementärfunktion) + + + +Funktion : STRING$ + +Zweck : Erzeugung eines Textes mit mehreren gleichen Zeichen + +Syntax : STRING$ (, |) + +Erklärung : : INT-Ausdruck + : INT-Ausdruck (Wert im Bereich 0 bis 255) + + Die Funktion liefert mal das Zeichen, + - das den ASCII-Code hat oder + - das am Anfang vom Ergebnis des TEXT-Ausdrucks steht. + + +Beispiel : 10 LET pfeil$ = STRING$ (10, "=") + ">" + 20 PRINT pfeil$;" ";STRING$ (5, 35) '35 entspr. \# + Ausgabe: ==========> \#\#\#\#\# + +Vergleiche : SPACE$-Funktion + + + +Anweisungsbestandteil : SUB + +Siehe GOSUB-Anweisung + + + +Anweisung : SWAP + +Zweck : Tauschen der Inhalte zweier Variablen + +Syntax : SWAP , + +Erklärung : SWAP tauscht die Inhalte der beiden Variablen. + + Die beiden Variablen müssen vom gleichen Typ sein. + + +Beispiel : 3220 LET a = 10 + 3230 LET b = 20 + 3240 SWAP a, b + 3250 PRINT a; b + Ausgabe: 20 10 + + + +Anweisungsbestandteil : TAB + +Siehe PRINT- und LPRINT-Anweisung + + + +Funktion : TAN + +Zweck : Berechnung des Tangens eines Radiantwertes + +Syntax : TAN () + +Erklärung : : REAL-Ausdruck, der den Winkel in Radiant angibt. + Die Funktion liefert den Tangens des Winkels als REAL. + + +Beispiel : 10 PI = 3.141593 + 20 PRINT TAN (PI/4) + Ausgabe: 1 + +Vergleiche : COS-, SIN-Funktionen + + + +Anweisungsbestandteil : THEN + +Siehe IF-Anweisung + + + +Funktion : TIMER + +Zweck : Lesen der Systemuhr (CPU-Zeit der Task) + +Syntax : TIMER + +Erklärung : Die bisher von der Task verbrauchte CPU-Zeit (in Sekunden) wird + als REAL geliefert. + + TIMER eignet sich auch zum Starten des Zufallszahlengenerators + (vgl. RANDOMIZE-Anweisung). + + +Beispiel : 2010 LET starttime = TIMER + . + . + 2620 PRINT "Verbrauchte CPU-Zeit:"; + 2630 PRINT TIMER - starttime; "Sekunden" + + +Vergleiche : TIME$-Funktion + + + +Funktion : TIME$ + +Zweck : Abrufen der aktuellen Tageszeit + +Syntax : TIME$ + +Erklärung : Die Tageszeit wird als Text in der Form HH.MM.SS geliefert. + + +Beispiel : 10 PRINT "Es ist jetzt "; TIME$; " Uhr" + Ausgabe (z.B.): Es ist jetzt 10:51:17 Uhr + +Vergleiche : DATE$-, TIMER-Funktionen + + + +Anweisungsbestandteil : TO + +Siehe FOR- und GOTO-Anweisungen + + + +Anweisung : TRON / TROFF + +Zweck : Ein- und Ausschalten der TRACE-Funktion + +Syntax : TRON + TROFF + +Erklärung : Der TRACE-Modus dient der Suche nach logischen Fehlern bei der + Entwicklung von BASIC-Programmen. + + TRON schaltet den TRACE-Modus für die nachfolgend übersetzten + Programmzeilen ein. + + Ist der TRACE-Modus eingeschaltet, so wird für jede gefundene + Zeilennummer die Ausgabe dieser Zeilennummer in eckigen + Klammern mit in den erzeugten Code aufgenommen. Dies hat dann + während des Laufens den Effekt, daß immer bei Abarbeitung der im + TRACE-Modus übersetzten Zeilen die aktuelle Zeilennummer aus­ + gegeben wird. Es ist so leicht zu verfolgen, in welcher Reihenfolge + die Zeilen des Programms ausgeführt werden. + + TROFF schaltet den TRACE-Modus für die textuell folgenden Pro­ + grammzeilen wieder aus. + + +Beispiel : 5220 TRON + 5230 REM hier beginnt die kritische + 5240 REM Programmstelle + . + . + . + 5970 TROFF + + + Die Zeilen 5230 bis 5970 werden im TRACE-Modus übersetzt. + + + +Anweisungsbestandteil : USING + +Siehe PRINT-Anweisung + + + +Funktion : USR + +Zweck : Aufruf einer wertliefernden insertierten Prozedur + +Syntax : USR + #right#[ ( [, ] [...] ) ] + +Erklärung : : Folge aus Zeichen, die für Prozeduren im + EUMEL-System zugelassen sind (also Buchstaben und - ab der + zweiten Stelle - Zahlen), jedoch keine Leerzeichen. + + : | + + : Ausdruck (genau des von der Prozedur + benötigten Typs) + : Variable (genau des von der Prozedur benö­ + tigten Typs) + + Die Prozedur mit dem angegebenen und den + angegebenen Parametern wird aufgerufen. + Die USR-Funktion liefert nach Ausführung der Prozedur das von der + Prozedur übergebene Ergebnis (Typ INT, REAL oder TEXT). + + Mögliche Fehlerfälle: + - Eine Prozedur mit dem Namen und den ange­ + gebenen Parametern gibt es nicht. + - Die Prozedur liefert keinen Wert. + - Die Prozedur liefert einen Typ, der in BASIC unbekannt ist (zum + Beispiel BOOL). + - Die Prozedur benötigt Parametertypen, die in BASIC nicht bekannt + sind (z.B. BOOL, FILE, TASK, QUIET). + - Ein Parameter ist CONST, es wird aber ein VAR-Parameter ver­ + langt. + + Weitere Informationen finden Sie in Kapitel 4.7. + +Hinweis : 1. Bei den Parametern wird keine Typkonvertierung vorgenommen. + 2. Der Prozedurname muß (entgegen der ELAN-Gewohnheit) ohne + Leerzeichen angegeben werden. + 3. USR ist die einzige Funktion, bei der das Argument (nämlich der + Prozeduraufruf) nicht in Klammern stehen darf. + + +Beispiel : 10 LET euler = USR e + 20 PRINT euler + Ausgabe: 2.718282 + +Vergleiche : CALL-, CHAIN-Anweisungen + + + +Funktion : VAL + +Zweck : Konvertierung eines Texts in eine Zahl + +Syntax : VAL () + +Erklärung : Die Funktion liefert den Wert der Zahl, deren Darstellung in dem + übergebenen TEXT-Ausdruck enthalten ist. Führende Leerstellen + werden dabei überlesen. + Sobald ein nicht wandelbares Zeichen festgestellt wird, wird der bis + dahin ermittelte Wert (am Anfang null) geliefert. + + +Beispiel : 10 LET zahl$ = "-1.256E-63" + 20 PRINT VAL (zahl$) + Ausgabe: -1.256E-63 + +Vergleiche : STR$-Funktion (Komplementärfunktion) + + + +Anweisung : WEND + +Zweck : Markierung des Endes einer WHILE-Schleife + +Syntax : WEND + +Erklärung : WEND markiert das Ende einer WHILE-Schleife (vergleiche + WHILE-Anweisung). + +Vergleiche : WHILE-, FOR-Anweisungen + + + +Anweisung : WHILE + +Zweck : Beginn einer abweisenden Schleife + +Syntax : WHILE + + +Erklärung : : numerischer Ausdruck + : Folge von Programmzeilen + + Die WHILE-Anweisung erlaubt die komfortable Programmierung von + abweisenden Schleifen (sogenannten WHILE-WEND-Schleifen) in + BASIC. + Gelangt das Programm während der Ausführung an eine WHILE- + Anweisung, so wird zunächst der Bedingungs-Ausdruck ausge­ + wertet. Ist die Bedingung nicht erfüllt (falsch, Wert gleich null), so + wird das Programm mit der nächsten Anweisung hinter der korres­ + pondierenden WEND-Anweisung fortgesetzt. + Ist die Bedingung dagegen erfüllt (wahr, Wert ungleich null), so + werden die Anweisungen des Schleifenrumpfs abgearbeitet. Beim + Erreichen der WEND-Anweisung springt das Programm wieder zur + WHILE-Anweisung zurück, die Bedingung wird erneut überprüft und, + je nach Ergebnis, wird der Schleifenrumpf oder die Anweisung nach + WEND ausgeführt. + + WHILE-WEND-Schleifen dürfen (auch mit FOR-NEXT-Schleifen, + s.d.) geschachtelt werden. Überschneidungen von WHILE-WEND- + Schleifen und FOR-NEXT-Schleifen sind jedoch nicht zulässig. + + +Beispiel : 10 LET weiter$ = "j" + 20 WHILE LEFT$ (weiter$, 1) = "j" + 30 REM Hier beginnt das eigentliche Programm + . + . + 1650 INPUT "Weiter ? (j/n)", weiter$ + 1660 WEND + + + Das eigentliche Programm wird so lange ausgeführt, bis der Benutzer + etwas anderes als "j" an der ersten Stelle von 'weiter$' eingibt. + +Vergleiche : FOR-, IF-Anweisungen + + + +Anweisung : WIDTH + +Zweck : Einstellung der Bildschirmbreite + +Syntax : WIDTH + +Erklärung : : INT-Ausdruck + + Mit der WIDTH-Anweisung wird festgelegt, wie viele Zeichen pro + Zeile bei Ausgaben auf den Bildschirm oder in Dateien pro Zeile + ausgegeben werden sollen. + Soll für die Druckdatei eine andere Anzahl von Zeichen pro Zeile + gelten als für den Bildschirm, dann muß vor jeder Sequenz von + LPRINT-Anweisungen die gewünschte Anzahl mit WIDTH einge­ + stellt werden. + WIDTH gilt auch für Ausgaben in 'sysout'-Dateien. + Insbesondere bei der Ausgabe in Dateien kann ein Wert von mehr als + 80 Zeichen pro Zeile sinnvoll sein. + + +Beispiel : 10 REM es sollen nur 45 Zeichen pro Zeile + 20 REM ausgegeben werden + 30 WIDTH 45 + + +Vergleiche : PRINT-, LPRINT-, WRITE-Anweisungen + + + +Anweisung : WRITE + +Zweck : Ausgabe von Zahlen und Texten auf dem Bildschirm + +Syntax : WRITE [] [, ] [...] + +Erklärung : : numerischer Ausdruck oder TEXT-Ausdruck + + Die WRITE-Anweisung erlaubt die Ausgabe von Daten auf dem + Bildschirm. Die angegebenen Ausdrücke werden ausgewertet und + ausgegeben. Dabei werden numerische Werte im gleichen Format + wie bei der PRINT-Anweisung (s.d.) ausgegeben, mit der Einschrän­ + kung, daß den Zahlen keine Leerstelle folgt. + Die Ergebnisse von Text-Ausdrücken werden von Anführungszei­ + chen umschlossen ausgegeben. + Alle Einzelausgaben werden durch Kommata voneinander getrennt. + + Nach Ausgabe aller angegebenen Ausdrücke wird der Cursor an den + Anfang der nächsten Zeile positioniert. + + +Beispiel : 10 LET a = 10.7: b = 20 + 20 LET c$ = "Testtext" + 30 WRITE a, b, c$ + Ausgabe: 10.7, 20,"Testtext" + +Vergleiche : PRINT-, LPRINT-, WIDTH-Anweisungen + + + +Operator : XOR + +Siehe Kapitel 4.4. (Operatoren) + diff --git a/lang/basic/1.8.7/doc/basic handbuch.3 b/lang/basic/1.8.7/doc/basic handbuch.3 new file mode 100644 index 0000000..14cb499 --- /dev/null +++ b/lang/basic/1.8.7/doc/basic handbuch.3 @@ -0,0 +1,698 @@ +#page nr ("%",97)# +#head# +EUMEL-BASIC-Compiler 9. Anpassung von Programmen an den EUMEL-BASIC-Compiler % + +#end# + +9. Anpassung von Programmen an den EUMEL-BASIC-Compiler + + +9.1. Unterschiede zwischen BASIC-Inter­ + pretern und dem EUMEL-BASIC- + Compiler + +Bei der Anpassung von Programmen für BASIC-Interpreter an den EUMEL- +BASIC-Compiler gibt es einige Besonderheiten zu beachten, die auf den unterschied­ +lichen Arbeitsweisen von Compilern gegenüber Interpretern beruhen. +Bei Interpretern fällt die Übersetzung und Ausführung des Quellprogramms zeitlich +zusammen (genau genommen gibt es ja gar keine Übersetzung, sondern das Quell­ +programm wird #on("i")#interpretiert#off("i")#). Dies hat zur Folge, daß auch nicht zur Ausführung +bestimmte Anweisungen (z.B. Dimensionierungen, Typfestlegungen etc.) erst während +der Ausführung des Programms erkannt und ausgewertet werden. +Bei Compilern hingegen muß deutlich zwischen der Übersetzungszeit (Compiletime) +und der Laufzeit (Runtime) eines Programms unterschieden werden. +Der wesentliche Unterschied zwischen Compilern und Interpretern liegt nun in der +Reihenfolge der Kenntnisnahme von den Anweisungen. Während der Interpreter von +den Anweisungen in der Reihenfolge ihres Auftretens entlang des Programmablaufs +Kenntnis nimmt, werden die Anweisungen vom Compiler in der Reihenfolge ihres +textuellen Auftretens zur Kenntnis genommen. +Da es sich bei dem EUMEL-BASIC-Compiler um einen One-Pass-Compiler +handelt, ist es zwingend notwendig, daß +- DIM-Anweisungen vor dem ersten Zugriff auf das zu dimensionierende Feld + stehen. +- OPTION BASE-Anweisungen vor den betreffenden Dimensionierungen stehen. +- DEF FN-Anweisungen vor dem ersten Aufruf der zu definierenden Funktion ste­ + hen. +- DEFINT- beziehungsweise DEFSTR-Anweisungen vor der ersten Verwendung der + betreffenden Variablen erscheinen. + +Einige Interpreter lassen sogar den Abschluß von FOR-NEXT- und WHILE- +WEND-Schleifen an mehreren Stellen im Programm zu (z.B. mehrere NEXT- +Anweisungen zu einer FOR-Anweisung). Auch solche "Kunstgriffe" gestattet der +EUMEL-BASIC-Compiler (aus den oben geschilderten Gründen) nicht. + + + + +9.2. Abweichungen von ISO 6373-1984 + (Minimal-BASIC) + + + +Der EUMEL-BASIC-Compiler weicht in folgenden Punkten von der ISO-Norm +6373-1984 für Minimal-BASIC ab: +- Treten bei der Auswertung von numerischen Ausdrücken Überläufe auf, so wird + nicht, wie im Standard vorgesehen, eine Warnung ausgegeben und mit bestimmten + Höchstwerten weitergerechnet, sondern die Ausführung des BASIC-Programms + wird mit einer entsprechenden Fehlermeldung abgebrochen. +- Nimmt die Sprungziel-Nummer bei der ON-Anweisung einen fehlerhaften Wert an + (Nummer < 1 oder Nummer > Anzahl Sprungziele), dann wird nicht, wie im + Standard empfohlen, mit einer Fehlermeldung abgebrochen, sondern es wird (wie + auch in Microsoft-BASIC üblich) das Programm mit der der ON-Anweisung fol­ + genden Anweisung fortgesetzt. +- Bei der DATA-Anweisung müssen nicht unbedingt Zeichenfolgen angegeben + werden. Werden sie weggelassen, dann wird bei Ausführung der READ- + Anweisung null beziehungsweise Leertext geliefert (vergleiche Kapitel 8, DATA- + Anweisung). +- Bei den Eingaben für eine INPUT-Anweisung können ebenfalls die Daten wegge­ + lassen werden. Auch hier wird null beziehungsweise Leertext geliefert (vergleiche + Kapitel 8, INPUT-Anweisung) + + +Die Erweiterungen gegenüber ISO 6373 sollen hier nicht im einzelnen aufgeführt +werden. Bitte vergleichen Sie in Zweifelsfällen die Normungsschrift mit dieser Doku­ +mentation! + + + + +9.3. Anpassung von Microsoft-BASIC Pro­ + grammen an den EUMEL-BASIC- + Compiler + + + +Bei der Entwicklung des EUMEL-BASIC-Compilers wurde zwar auf Übereinstim­ +mung mit Microsoft-BASIC Wert gelegt, von einer echten Kompatibilität kann aber +aufgrund einer ganzen Reihe fehlender Anweisungen und Funktionen nicht gespro­ +chen werden. +Gegenüber Microsoft-BASIC fehlen vor allem: +- alle "Direkt-Kommandos" (RUN, LIST, LOAD, SAVE, MERGE usw.). Die Aufgaben + dieser Anweisungen werden von den Prozeduren des EUMEL-Systems über­ + nommen. +- im weiteren Sinne "hardware-nahe" oder an Maschinensprache orientierte Anwei­ + sungen und Funktionen (CALL, PEEK, POKE, USR, WAIT usw.) +- die ERROR-Handling Anweisungen (ON ERROR, RESUME) +- die Dateiverarbeitungs-Anweisungen und -Funktion (INPUT\#, PRINT\# u.a.; die + INPUT- und PRINT-Anweisungen wurden aber auf Zusammenarbeit mit 'sysin' + und 'sysout' abgestimmt.) +- die Single-Precision-Variablen (Single- und Double-Precision-Variablen wer­ + den beide auf den Datentyp REAL abgebildet.) +- die hexadezimalen und oktalen Konstanten + +Anweisungen und Funktionen, die sich abweichend vom Microsoft-Standard verhal­ +ten, sind vor allem: +- CALL, CHAIN, USR +- ERROR, ERR, ERL +- LSET, RSET + +Wichtige Erweiterungen gegenüber Microsoft-BASIC sind: +- Möglichkeit des Aufrufs von ELAN-Prozeduren +- Maximale Anzahl von Zeichen pro Zeile: 32000 +- Maximale Anzahl von Zeichen pro TEXT-Objekt: 32000 +- OPTION BASE wirkt auf einzelne Felder (und nicht unbedingt auf ein ganzes + Programm) + +#on ("b")# +Hinweis zur Verwendung von MS-BASIC-Programmen im EUMEL-System#off ("b")# +Sollen Microsoft-BASIC-Programme in das EUMEL-Systemm übernommen wer­ +den, so ist dabei so vorzugehen: +1. Speichern Sie das Programm von MS-BASIC aus mit der ASCII-SAVE-Option + ab. + Beispiel: SAVE "PROGRAMM.BAS",A +2. Lesen Sie das Programm mittels "DOSDAT" (Programm zum Lesen von MS- + DOS-Dateien) im "file ascii"-Modus ein: + + reserve ("file ascii", /"DOS"); fetch ("PROGRAMM.BAS", /"DOS") + +Danach steht ihnen das BASIC-Program in der EUMEL-Textdatei +"PROGRAMM.BAS" zur Verfügung. + +#page# +#head# +EUMEL-BASIC-Compiler Anhang A: Reservierte Wörter % + +#end# + +Anhang A: #ib(4)#Reservierte Wörter#ie(4)# +Dieser Anhang enthält eine Übersicht über alle vom EUMEL-BASIC-Compiler +erkannten reservierten Wörter. + +ABS Funktion +AND Operator +AS Anweisungsbestandteil +ASC Funktion +ATN Funktion +BASE Anweisungsbestandteil +CALL Anweisung +CDBL Funktion +CHAIN Anweisung +CHR$ Funktion +CINT Funktion +CLEAR nicht implementiert +CLOSE nicht implementiert +CLS Anweisung +COMMON nicht implementiert +FIELD nicht implementiert +COS Funktion +CSRLIN Funktion +CVD Funktion +CVI Funktion +DATA Anweisung +DATE$ Funktion +DEF Anweisung +DEFDBL Anweisung +DEFINT Anweisung +DEFSNG Anweisung +DEFSTR Anweisung +DIM Anweisung +ELSE Anweisungsbestandteil +END Anweisung +EOF Anweisungsbestandteil +EQV Operator +ERL Funktion +ERM$ Funktion +ERR Funktion +ERROR Anweisung +EXP Funktion +FIX Funktion +FOR Anweisung +FRE Funktion +GET nicht implementiert +GO Anweisungsbestandteil +GOSUB Anweisung +GOTO Anweisung +HEX$ Funktion +IF Anweisung +IMP Operator +INKEY$ Funktion +INPUT Anweisung +INPUT$ Funktion +INSTR Funktion +INT Funktion +KILL Anweisung +LEFT$ Funktion +LEN Funktion +LET Anweisung +LINE Anweisungsbestandteil +LOC nicht implementiert +LOG Funktion +LPOS Funktion +LPRINT Anweisung +LSET Anweisung +MID$ Anweisung/Funktion +MKD$ Funktion +MKI$ Funktion +MOD Operator +NAME Anweisung +NEXT Anweisung +NOT Operator +OCT$ Funktion +ON Anweisung +OPEN nicht implementiert +OPTION Anweisung +OR Operator +OUT nicht implementiert +POS Funktion +PRINT Anweisung +PUT nicht implementiert +RANDOMIZE Anweisung +READ Anweisung +REM Anweisung +RESTORE Anweisung +RESUME nicht implementiert +RETURN Anweisung +RIGHT$ Funktion +RND Funktion +RSET Anweisung +SGN Funktion +SIN Funktion +SPACE$ Funktion +SPC Funktion +SQR Funktion +STEP Anweisungsbestandteil +STOP Anweisung +STR$ Funktion +STRING$ Funktion +SUB Anweisungsbestandteil +SWAP Anweisung +TAB Anweisungsbestandteil +TAN Funktion +THEN Anweisungsbestandteil +TIME$ Funktion +TIMER Funktion +TO Anweisungsbestandteil +TROFF Anweisung +TRON Anweisung +USING Anweisungsbestandteil +USR Funktion +VAL Funktion +WAIT nicht implementiert +WEND Anweisung +WHILE Anweisung +WIDTH Anweisung +WRITE Anweisung +XOR Operator +#page# +#head# +EUMEL-BASIC-Compiler Anhang B: Vom Scanner erkannte Symboltypen % + +#end# + +Anhang B: Vom #ib(3)#Scanner#ie(3)# erkannte #ib(3)#Symbol­ +typen#ie(3)# + + Der Scanner (ein Paket des EUMEL-BASIC-Systems) hat die Aufgabe, den Pro­ +grammtext Zeichen für Zeichen durchzugehen und auszulesen ('scannen'). Dabei +werden die Zeichen immer zu logischen Gruppen, sogenannten #on("i")#Symbolen#off("i")# zusammen­ +gefaßt. Diese Symbole werden dann dem eigentlichen Compilerprogramm geliefert. +Der Scanner entscheidet nach recht komplizierten Regeln, welche Zeichen aus der +Quelldatei zu einem Symbol zusammengefaßt werden. Dennoch soll in diesem An­ +hang der Begriff des Symbols etwas näher erklärt werden, da der Anwender (vor allem +bei den Fehlermeldungen) mit Symboltypen konfrontiert wird. + + + +Reservierte Wörter +#on ("b")# +Anfangszeichen:#off ("b")# Buchstaben +#on ("b")# +Folgezeichen:#off ("b")# Buchstaben +#on ("b")# +Beispiele:#off ("b")# PRINT, VAL, TAB, SUB, TO +#on ("b")# +Vergleiche:#off ("b")# Anhang A + + + +Operatoren ++ - * / \ ^ MOD +NOT AND OR XOR EQV IMP +< > = <= >= <> + +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.4. + + + +numerische Konstanten +#on ("b")# +Anfangszeichen:#off ("b")# Ziffern 0 bis 9, Dezimalpunkt '.' +#on ("b")# +Folgezeichen:#off ("b")# zusätzlich: 'd', 'D', 'e' oder 'E', am Schluß auch '%', '!' oder '\#' +#on ("b")# +Beispiele:#off ("b")# 1.0, 1.256d123, 12! +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.2. + + + +TEXT-Konstanten +#on ("b")# +Anfangszeichen:#off ("b")# Anführungszeichen +#on ("b")# +Folgezeichen:#off ("b")# Alle Zeichen, sogar Doppelpunkte, Apostrophe und Steuerzei­ + chen. Anführungszeichen dürfen #on("i")#innerhalb#off("i")# von + TEXT-Konstanten nicht vorkommen. Eine + TEXT-Konstante #on("i")#muß#off("i")# aber mit einem Anfüh­ + rungszeichen enden. +#on ("b")# +Beispiele:#off ("b")# "tadellos", "!?': alles mögliche" +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.2. + + + +Variablen +#on ("b")# +Anfangszeichen:#off ("b")# Buchstaben +#on ("b")# +Folgezeichen:#off ("b")# zusätzlich: Punkt '.', Ziffern 0 bis 9, Zeichen '$', '%', '!' und '\#' +#on ("b")# +Beispiele:#off ("b")# zeiger, A$, Zahl!, n%, var\#4.3% +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.3. + + + +Felder/Feldelemente +wie Variablen, jedoch gefolgt von '(', den Indexangaben und ')' +#on ("b")# +Beispiele:#off ("b")# zeiger (3), A$ (pointer), Zahl! (7), n% (a, b, c + d) +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.3. + + + +Benutzer-definierte Funktionen +#on ("b")# +Anfangszeichen:#off ("b")# FN +#on ("b")# +Folgezeichen:#off ("b")# Buchstaben, Punkt '.', Ziffern 0 bis 9, + Zeichen '$', '%', '!' und '\#' +#on ("b")# +Beispiele:#off ("b")# FNfunct, FNgauss%, FNf!4.5.6d\# +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.5. + + + +EOS (End of Statement, Anweisungsende) +Doppelpunkt ':' + +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.1. + + + +EOL (End of Line, Zeilenende) +Apostrophzeichen ' oder Ende der Dateizeile +EOL bedeutet gleichzeitig auch EOS + +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.1. + + + +EOF (End of File, Dateiende) +Ende der Quelldatei +EOF bedeutet gleichzeitig auch EOL (und somit auch EOS) + +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.1. + + + +Trennzeichen +Alle bisher nicht genannten Zeichen werden vom Scanner als Trennzeichen behan­ +delt. In BASIC benötigte Trennzeichen sind das Komma (','), das Semikolon (';') sowie +die beiden runden Klammern '(' und ')'. +Zeichen mit Codes kleiner als 32 (Steuerzeichen) werden vom Scanner überlesen. +#page# +#head# +EUMEL-BASIC-Compiler Anhang C: Übersicht über die Fehlermeldungen % + +#end# + +Anhang C: Übersicht über die Fehlermeldungen + + +Übersicht über die verwendeten Fehlermeldungen zur +Übersetzungszeit +Diese Übersicht enthält alle zur Übersetzungszeit möglichen Fehler, mit Ausnahme +der internen Fehler. +Die Erläuterungen geben die üblichen Ursachen für die Fehlermeldung an. Es wird +empfohlen, sich im Falle eines Fehlers außerdem in Kapitel 8 über die genaue Syntax +der betreffenden Anweisung beziehungsweise Funktion zu informieren. + + +#on ("b")#AS ohne NAME#off ("b")# +AS darf nur in NAME-Anweisungen vorkommen. + +#on ("b")#Accessrecht VAR erwartet, CONST gefunden#off ("b")# +Beim Aufruf einer ELAN-Prozedur (CALL, CHAIN oder USR) wurde ein VAR-Para­ +meter verlangt. Angegeben wurde aber ein CONST-Parameter (zum Beispiel ein +Ausdruck). + +#on ("b")#Ausdruck erwartet#off ("b")# +Es wurde ein numerischer oder TEXT-Ausdruck erwartet. Diese Fehlermeldung +erscheint zum Beispiel, wenn nach einem Operator kein Ausdruck mehr gefunden +wird. + +#on ("b")#BASE ohne OPTION#off ("b")# +BASE darf nur in OPTION BASE-Anweisungen vorkommen. + +#on ("b")#Bei SWAP nur gleiche Variablentypen erlaubt#off ("b")# +Mit SWAP können nur Variablen von genau dem gleichen Typ bearbeitet werden. + +#on ("b")#Das Feld ist bereits dimensioniert#off ("b")# +Diese Fehlermeldung erscheint bei DIM-Anweisungen, wenn das Feld vorher schon +explizit oder automatisch dimensioniert wurde. + +#on ("b")#ELSE ohne IF#off ("b")# +ELSE darf nur in IF-Anweisungen vorkommen. ELSE muß in der gleichen Zeile +stehen wie die zugehörige IF-Anweisung. + +#on ("b")#Falsche Felddimension: +Dimensioniert in ... Dimensionen, gefundene Anzahl Indizes: ...#off ("b")# +Beim Zugriff auf ein Feldelement wurden zu viele oder zu wenig Indizes angegeben. + +#on ("b")#FOR ohne NEXT#off ("b")# +Diese Fehlermeldung erscheint, wenn am Programmende für eine FOR-Anweisung +kein korrespondierendes NEXT gefunden wurde. + +#on ("b")#Falsche Reihenfolge der Zeilennummern#off ("b")# +Die Zeilennummern wurden nicht in aufsteigender Reihenfolge angegeben. + +#on ("b")#Falscher Typ#off ("b")# +Es wurde ein anderer Datentyp erwartet als angegeben, und es konnte keine automa­ +tische Konvertierung vorgenommen werden. + +#on ("b")#Falscher Typ der Operanden#off ("b")# +Bei einem dyadischen Operator wurden Operanden angegeben, für deren Typen +dieser Operator nicht definiert ist (vergleiche Kapitel 4.4.). + +#on ("b")#Falscher Typ des Operanden#off ("b")# +Bei einem monadischen Operator wurde ein Operand angegeben, für dessen Typ +dieser Operator nicht definiert ist (vergleiche Kapitel 4.4.). + +#on ("b")#Fehlerhafte Bereichsangabe#off ("b")# +Diese Fehlermeldung kann bei den Anweisungen DEFDBL, DEFINT, DEFSNG und +DEFSTR auftreten, wenn bei einer Bereichsangabe der Buchstabe vor dem Binde­ +strich im Alphabet nach dem Buchstaben hinter dem Bindestrich steht. + +#on ("b")#Fehlerhafte Dimensionierung: Die Obergrenze muß >= 1 sein#off ("b")# +Es wurde versucht, ein Feld mit dem größten Index null in einer Dimension zu +dimensionieren, obwohl die Index-Untergrenze mit OPTION BASE auf eins einge­ +stellt war. + +#on ("b")#Fehlerhafte Laufvariable#off ("b")# +Nach einer NEXT-Anweisung wurde eine Laufvariable gefunden, die nicht zur letzten +anhängigen FOR-Anweisung gehört. Der Fehler tritt auf, wenn Schleifen geschachtelt +wurden. + +#on ("b")#Fehlerhafte Zeilennummer#off ("b")# +Die Zeilennumer entspricht nicht der Syntax für Zeilennumern. + +#on ("b")#Fehlerhafter Funktionsaufruf#off ("b")# +- Die Prozedur liefert keinen Wert + Es wurde versucht, eine Prozedur mit USR aufzurufen, die keinen Wert liefert. +- Der Typ des Resultats ist nicht erlaubt, gefunden: ... + Es wurde versucht, eine Prozedur mit USR aufzurufen, die ein Objekt liefert, + dessen Datentyp in BASIC nicht bekannt ist. +- Kein Argument erwartet + Es wurde versucht, eine benutzer-definierte Funktion, die ohne Parameter definiert + wurde, mit Argument(en) aufzurufen. +- ... Argument(e) erwartet + Die Anzahl der angegebenen Argumente ist kleiner als die Anzahl der bei der + Funktionsdefinition angegebenen Parameter. +- Nur ... Argument(e) erwartet + Die Anzahl der angegebenen Argumente ist größer als die Anzahl der bei der Funk­ + tionsdefinition angegebenen Parameter. +- Kein Resultat erlaubt (gefunden: ...) + Bei CALL oder CHAIN wurde versucht, eine wertliefernde Prozedur aufzurufen. + +#on ("b")#Funktionsaufruf ohne Zusammenhang#off ("b")# +Es wurde ein Funktionsaufruf angegeben, wo eine Anweisung erwartet wurde. + +#on ("b")#GO ohne TO oder SUB#off ("b")# +Das reservierte Wort GO kann nur in GO SUB oder GO TO auftreten. + +#on ("b")#Interner Fehler#off ("b")# +Bei der Übersetzung wurde innerhalb des Compilerprogramms ein interner Fehler +ausgelöst. (vergleiche Kapitel 7.1.) + +#on ("b")#Nach OPTION BASE ist nur 0 oder 1 erlaubt#off ("b")# +Es wurde versucht, eine Zahl > 1 nach OPTION BASE anzugeben. + +#on ("b")#NEXT ohne FOR#off ("b")# +Es wurde eine NEXT-Anweisung gefunden, die keiner FOR-Anweisung zuzuordnen +ist, da keine "offenen" FOR-Schleifen mehr anhängig sind. + +#on ("b")#Nicht implementiert#off ("b")# +Einige reservierte Wörter werden vom BASIC-Compiler erkannt, obwohl die zugehö­ +rigen Anweisungen oder Funktionen nicht implementiert sind (vgl. Anhang A). + +#on ("b")#Parametervariable kommt mehrmals vor#off ("b")# +Bei der Definition einer "user function" kommt ein Parameter in der Parameterliste +mehr als einmal vor. + +#on ("b")#Rekursive Funktionsdefinition#off ("b")# +Es wurde versucht, in der Definition einer "user function" die zu definierende Funk­ +tion aufzurufen. + +#on ("b")#STEP ohne FOR#off ("b")# +STEP darf nur in FOR-Anweisungen vorkommen. + +#on ("b")#SUB ohne GO#off ("b")# +SUB darf nur in GOSUB vorkommen. + +#on ("b")#Syntaxfehler: #off ("b")# +Wenn dieser Fehler erscheint, wurde vom Compiler eine Angabe gefunden, die nach +den Syntaxregeln dort nicht erwartet wurde oder fehlerhaft ist. + +#on ("b")#TAB ohne (L)PRINT#off ("b")# +TAB darf nur in PRINT- und LPRINT-Anweisungen vorkommen. + +#on ("b")#THEN ohne IF#off ("b")# +THEN darf nur in IF-Anweisungen vorkommen. THEN muß in der gleichen Zeile +stehen wie die zugehörige IF-Anweisung. + +#on ("b")#TO ohne Zusammenhang#off ("b")# +TO darf nur in FOR-Anweisungen oder in GO TO vorkommen. + +#on ("b")#Text zu lang#off ("b")# +Dieser Fehler erscheint, wenn ein Anführungszeichen fehlt beziehungsweise ein +Anführungszeichen zu viel gefunden wird. + +#on ("b")#Unbekannte Funktion, Argument(e) angegeben: ...#off ("b")# +Es wurde versucht, eine Funktion mit einem Argument aufzurufen, für dessen Typ die +Funktion nicht definiert ist. + +#on ("b")#Unbekannte Prozedur, Parameter angegeben: ...#off ("b")# +Die angegebene Prozedur konnte mit den angegebenen Parametertypen nicht gefun­ +den werden. + +#on ("b")#Undefinierte 'user function'#off ("b")# +Es wurde versucht, eine benutzer-definierte Funktion aufzurufen, die (noch) nicht +definiert wurde. + +#on ("b")#USING ohne (L)PRINT#off ("b")# +USING darf nur in PRINT- und LPRINT-Anweisungen vorkommen. + +#on ("b")#WEND ohne WHILE#off ("b")# +Es wurde eine WEND-Anweisung gefunden, die keiner WHILE-Anweisung zuzuord­ +nen ist, da keine "offenen" WHILE-Schleifen mehr anhängig sind. + +#on ("b")#WHILE ohne WEND#off ("b")# +Diese Fehlermeldung erscheint, wenn am Programmende für eine WHILE-Anweisung +kein korrespondierendes WEND gefunden wurde. + +#on ("b")#Zeile mit dieser Nummer existiert nicht#off ("b")# +Es wurde versucht, mit GOTO oder GOSUB zu einer Zeilennumer zu verzweigen, die +im Programm nicht angegeben wurde. + + + + +Übersicht über die innerhalb des BASIC-Systems +ausgelösten Laufzeitfehler +Die meisten Laufzeitfehler werden auch bei BASIC-Programmen im EUMEL-System +erzeugt (vergleiche Kapitel 7.2.). Einige werden aber innerhalb des BASIC-Systems +erzeugt. Die nachfolgende Übersicht enthält die innerhalb des BASIC-Systems aus­ +gelösten Fehler mit Angabe des gelieferten Fehlercodes und der Fehlermeldung. + +#on ("b")#Fehlercode:#off ("b")# 1003 +#on ("b")#Fehlermeldung:#off ("b")# RETURN ohne GOSUB +Eine RETURN-Anweisung wurde gefunden, obwohl keine GOSUB-Anweisung mehr +anhängig war. + + +#on ("b")#Fehlercode:#off ("b")# 1004 +#on ("b")#Fehlermeldung:#off ("b")# RESTORE: Keine DATA-Anweisung in oder nach +#right#Zeile ... gefunden +Eine RESTORE-Anweisung konnte nicht ausgeführt werden, weil in oder nach der in +der Anweisung angegebenen Zeilennummer keine DATA-Anweisung mehr steht. + + +#on ("b")#Fehlercode:#off ("b")# 1005 +#on ("b")#Fehlermeldung:#off ("b")# bei ^: negative Basis, gebrochener Exponent: ... +Es wurde versucht, eine negative Zahl mit einer gebrochenen Zahl zu potenzieren. + + +#on ("b")#Fehlercode:#off ("b")# 1005 +#on ("b")#Fehlermeldung:#off ("b")# USING: kein Format gefunden +Bei einer PRINT USING-Anweisung wurde kein Format für die Ausgabe angegeben +oder die Formatzeichenkette enthält keine Formatzeichen. + + +#on ("b")#Fehlercode:#off ("b")# 1005 +#on ("b")#Fehlermeldung:#off ("b")# USING-Format fehlerhaft: ... +Bei einer PRINT USING-Anweisung wurde ein fehlerhaftes Format angegeben. + + +#on ("b")#Fehlercode:#off ("b")# 1004 +#on ("b")#Fehlermeldung:#off ("b")# Keine Daten mehr für READ +Es stehen keine Daten mehr für die READ-Anweisung zur Verfügung; der READ- +DATA-Zeiger zeigt hinter das Ende der letzten DATA-Anweisung. + + +#on ("b")#Fehlercode:#off ("b")# 1005 +#on ("b")#Fehlermeldung:#off ("b")# WIDTH: negative Angabe: ... +Nach WIDTH wurde eine negative Zahl gefunden. + + +#on ("b")#Fehlercode:#off ("b")# 1013 +#on ("b")#Fehlermeldung:#off ("b")# READ: Falscher Datentyp, ... ist kein INT +Einer INT-Variablen konnte kein Wert zugewiesen werden, da das aktuelle Objekt +aus der DATA-Liste keine gültige Darstellung eines INT-Wertes war oder ein +"quoted string" gefunden wurde. + + +#on ("b")#Fehlercode:#off ("b")# 1013 +#on ("b")#Fehlermeldung:#off ("b")# READ: Falscher Datentyp, ... ist kein REAL +Einer REAL-Variablen konnte kein Wert zugewiesen werden, da das aktuelle Objekt +aus der DATA-Liste keine gültige Darstellung eines REAL-Wertes war oder ein +"quoted string" gefunden wurde. + + +#on ("b")#Fehlercode:#off ("b")# 1051 (interner Fehler) +#on ("b")#Fehlermeldung:#off ("b")# variierend +Bei der Ausführung des Programms trat in einer Prozedur des BASIC-Systems ein +interner Fehler auf. (Vergleiche Kapitel 7.) + + +#on ("b")#Fehlercode:#off ("b")# 1080 +#on ("b")#Fehlermeldung:#off ("b")# INPUT-Fehler ( Fehlerart ) : > Eingabezeile < +Bei einer INPUT-Anweisung, die auf eine mit 'sysin' eingestellte Datei wirken sollte, +kam es zu einem Fehler der angegebenen Fehlerart. Nach dem Doppelpunkt wird die +Eingabezeile aus der Eingabedatei ausgegeben. +#page# +#head# +EUMEL-BASIC-Compiler Anhang D: ELAN-Prozeduren des Compilers % + +#end# + +Anhang D: ELAN-Prozeduren des Compilers + + #on ("b")#PROC #ib(3)#basic#ie(3)# (TEXT CONST dateiname)#off ("b")# + Das in der Datei 'dateiname' enthaltene BASIC-Programm wird dem BASIC- + Compiler zur Übersetzung übergeben. Werden keine Fehler gefunden, so wird das + Programm direkt nach der Übersetzung ausgeführt. + Beispiel: + + basic ("Mein liebstes BASIC-Programm")#off ("b")# + + + #on ("b")#PROC basic (TEXT CONST dateiname, prozedurname)#off ("b")# + Das in der Datei 'dateiname' enthaltene BASIC-Programm wird dem BASIC- + Compiler zur Übersetzung übergeben. Werden keine Fehler gefunden, dann wird + das Programm unter dem Namen 'prozedurname' dauerhaft eingetragen (inser­ + tiert). + Das Programm wird nicht ausgeführt. Beachten Sie, daß der Prozedurname den + Vorschriften für ELAN-Prozedurnamen entsprechen muß und außerdem #on ("b")#keine + Leerzeichen#off ("b")# enthalten darf. (Zur Namenswahl siehe auch Kapitel 3.) + Beispiel: + + basic ("Mein liebstes BASIC-Programm", "liebstesprogramm")#off ("b")# + + + + #on ("b")#PROC #ib(3)#basic list#ie(3)# (BOOL CONST status)#off ("b")# + Mit der Prozedur 'basic list' kann eingestellt werden, ob die gerade vom Compiler + übersetzten Programmzeilen angezeigt werden sollen oder nicht (vergleiche Kapitel + 3.). + + basic list (TRUE)#off ("b")#: Die übersetzten Zeile werden angezeigt + basic list (FALSE)#off ("b")#: Die übersetzten Zeile werden nicht angezeigt + + + #on ("b")#PROC #ib(3)#basic page#ie(3)# (BOOL CONST status)#off ("b")# + Mit der Prozedur 'basic page' kann eingestellt werden, wie die Ausgaben von + BASIC-Programmen behandelt werden, wenn der Bildschirm voll ist (vergleiche + Kapitel 5, Steuerung der Bildschirmausgaben). + + basic page (TRUE): Beim Erreichen des Bildschirmendes wird auf einen + Tastendruck gewartet (vgl. Kap. 5.) + basic page (FALSE): Beim Erreichen des Bildschirmendes wird 'gescrollt'. + diff --git a/lang/basic/1.8.7/doc/basic handbuch.index b/lang/basic/1.8.7/doc/basic handbuch.index new file mode 100644 index 0000000..4ac7e16 --- /dev/null +++ b/lang/basic/1.8.7/doc/basic handbuch.index @@ -0,0 +1,232 @@ +#page nr ("%",115)# +#head# +EUMEL-BASIC-Compiler Stichwortverzeichnis % + +#end# + +Stichwortverzeichnis + +>= 15 +\ 14 +- 14 ++ 14 ++ 15 +<= 15 +* 14 +/ 14 += 15 +> 15 +< 15 +<> 15 +^ 14 +ABS 31 +AND 16 +Anführungszeichen 10 +Argument 21 +Arithmetische Operatoren 14 +Arrays 13 +ASC 32 +ATN 32 +Äquivalenz-Verknüpfung 17 +Aufruf benutzer-definierter Funktionen 21 +Aufruf und Steuerung des BASIC-Compilers 5 +basic 5, 113 +BASIC-Compiler ERROR 28 +basic list 6, 113 +basic page 25, 114 +benutzer-definierte Funktionen 19, 104 +Bildschirmausgaben 25 +CALL 23, 33 +CDBL 35 +CHAIN 23, 35 +CHR$ 35 +CINT 36 +CLS 36 +Codebereichs pro Task 27 +Compiler Error 304 26 +Compiler Error 307 26 +Compiler Error 308 26 +COS 37 +CSRLIN 37 +CVD, CVI 38 +DATA 38 +DATE$ 40 +Datentypen 10 +Datentyp INT 10 +Datentyp REAL 10 +Datentyp TEXT 10 +Debugging 6 +DEFDBL, DEFINT, DEFSNG, DEFSTR 40 +DEF FN 19, 28, 42 +Definition benutzer-definierter Funktionen 19 +DEFINT 12 +DEFSTR 12 +DIM 13, 43 +Dimensionen 13 +Doppelpunkt 8 +ELSE 54 +END 45 +EOF 56 +EOF (End of File, Dateiende) 7, 105 +EOL (End of Line, Zeilenende) 8, 105 +EOS (End of Statement, Anweisungsende) 8, 105 +EQV 17 +ERL 46 +ERM$ 47 +ERR 47 +ERROR 48 +EUMEL-Coder 26 +EUMEL-Textdatei 7 +Exklusiv-ODER-Verknüpfung 17 +EXP 49 +Exponent 10 +Fehlerbehandlung 28 +Fehlercodes 30 +Fehlerzeile 30 +Fehler zur Laufzeit 30, 111 +Fehler zur Übersetzungszeit 28, 106 +Felder (Arrays) 13 +Felder/Feldelemente 104 +Feldnamen 13 +FIX 49 +FOR 50 +FRE 51 +Funktionen 19 +Funktionsaufrufe 19 +Ganzzahlen 10 +Generatorprogramm 4 +Gleitkommazahlen 10 +GOSUB 52 +GOTO 53 +Grenzen des Compilers 26 +Groß-/Kleinschreibung 9 +Hauptdurchlauf 28 +HEX$ 54 +Hochkomma 8 +IF 54 +IMP 17 +Implikations-Verknüpfung 17 +Indizes 13 +INKEY$ 56 +INPUT$ 58 +INPUT 56 +Insertieren von BASIC-Programmen 5 +Installation des BASIC-Compilers 4 +INSTR 59 +INT 59 +Interne Compilerfehler 28 +INTs 10 +INT-Überlauf 15 +KILL 60 +Konstanten 10 +Konvertierung 15, 22 +Kriterien für den Typ einer Variablen 12 +Labels 26 +Leerzeichen 9 +LEFT$ 60 +LEN 61 +LET 61 +LINE INPUT 62 +LOG 63 +Logische Operatoren 16 +LPOS 63 +LPRINT 64 +LSET 65 +Mantisse 11 +MID$ 65, 66 +MKD$, MKI$ 67 +MOD 14 +Modulgrenze 26 +NAME 68 +Namenstabelle 27 +Negation 16 +negative Zahlenwerte 11 +NEXT 50, 68 +NOT 16 +Notation 3 +Notebook 28 +numerische Konstanten 103 +OCT$ 69 +ODER-Verknüpfung 17 +ON 69 +Operatoren 103 +Operatoren, arithmetische 14 +Operatoren, logische 16 +Operatoren, Text- 15 +Operatoren, Vergleichs- 15 +Operator, Zuweisungs- 18 +OPTION BASE 13, 71 +OR 17 +Parameter 19 +POS 72 +PRINT 72 +Prioritäten der Operanden 18 +Programmdatei 7 +Programmsegmente 24 +Programmzeile 7 +RANDOMIZE 75 +READ 75 +REM 77 +Reservierte Wörter 9, 12, 100, 103 +RESTORE 77 +RETURN 78 +RIGHT$ 79 +RND 80 +RSET 81 +Scanner 9, 103 +Schlüsselwörter 9 +Scrolling 25 +SGN 81 +SIN 82 +SPACE$ 82 +SPC 83 +SQR 83 +Standard-Funktionen 19 +STEP 50 +Steuerung der Bildschirmausgaben 25 +Steuerung des BASIC-Compilers 5 +STOP 84 +STR$ 84 +STRING$ 85 +SUB 52 +SWAP 86 +Symbol 9 +Symboltypen 103 +Syntax 7 +sysout 6 +TAB 64, 72 +TAN 86 +Texte 10 +TEXT-Konstanten 104 +Text-Operator + 15 +THEN 54 +TIME$ 88 +TIMER 87 +TO 50, 53 +Trennzeichen 105 +TRON / TROFF 88 +Typanpassung 22 +UND-Verknüpfung 16 +USING 64, 72 +USR 23, 90 +Übersetzen von BASIC-Programmen 5 +Übersichtlichkeit von BASIC-Programmen 7 +VAL 91 +Variablen 12, 104 +Variablennamen 9, 12 +VAR-Parameter 23 +Vergleichsoperatoren 15 +Vordurchlauf 28 +Vorzeichen 11 +Wahrheitswerte 16 +Weitere Schreibregeln 9 +WEND 92 +wertliefernden Prozeduren 23 +WHILE 92 +WIDTH 93 +WRITE 94 +XOR 17 +Zahlen 10 +Zeilennummer 7 +Zuweisungsoperator 18 + diff --git a/lang/basic/1.8.7/source-disk b/lang/basic/1.8.7/source-disk new file mode 100644 index 0000000..c87f56d --- /dev/null +++ b/lang/basic/1.8.7/source-disk @@ -0,0 +1 @@ +informatikpaket/02_basic.img diff --git a/lang/basic/1.8.7/src/BASIC.Administration b/lang/basic/1.8.7/src/BASIC.Administration new file mode 100644 index 0000000..6df6854 --- /dev/null +++ b/lang/basic/1.8.7/src/BASIC.Administration @@ -0,0 +1,1886 @@ +(***************************************************************************) +(* *) +(* Zweite von drei Dateien des EUMEL-BASIC-Systems *) +(* *) +(* Autor: Heiko Indenbirken *) +(* Überarbeitet von: Rudolf Ruland und Michael Overdick *) +(* *) +(* Stand: 27.10.1987 *) +(* *) +(***************************************************************************) + +PACKET basic errors DEFINES basic error, (* Autor: Heiko Indenbirken *) + return error, (* Stand: 26.08.1987/rr/mo *) + basic warning: + +TEXT VAR erste zeile, + message; +LET errorsize = 40; +LET ERROR = STRUCT (INT no, TEXT msg); + +ROW errorsize ERROR CONST error msg :: ROW errorsize ERROR : +(ERROR:( 1, "NEXT ohne FOR"), + ERROR:( 2, "Syntaxfehler:"), + ERROR:( 5, "Fehlerhafter Funktionsaufruf"), + ERROR:( 8, "Zeile mit dieser Nummer existiert nicht"), + ERROR:(10, "Das Feld ist bereits dimensioniert"), + ERROR:(13, "Falscher Typ:"), + ERROR:(15, "Text zu lang"), + ERROR:(18, "Undefinierte 'user function'"), + ERROR:(22, "Ausdruck erwartet"), + ERROR:(26, "FOR ohne NEXT"), + ERROR:(29, "WHILE ohne WEND"), + ERROR:(30, "WEND ohne WHILE"), + ERROR:(51, "Interner Fehler"), + ERROR:(80, "Fehlerhafte Zeilennummer"), + ERROR:(81, "Falsche Reihenfolge der Zeilennummern"), + ERROR:(82, "Falscher Typ des Operanden:"), + ERROR:(83, "Falscher Typ der Operanden:"), + ERROR:(84, "Falsche Felddimension:"), + ERROR:(85, "Rekursive Funktionsdefinition"), + ERROR:(86, "Fehlerhafte Laufvariable:"), + ERROR:(87, "Fehlerhafte Bereichsangabe:"), + ERROR:(88, "Fehlerhafte Dimensionierung:"), + ERROR:(89, "Parametervariable kommt mehrmals vor"), + ERROR:(90, "AS ohne NAME"), + ERROR:(91, "BASE ohne OPTION"), + ERROR:(92, "ELSE ohne IF"), + ERROR:(93, "STEP ohne FOR"), + ERROR:(94, "TAB ohne (L)PRINT"), + ERROR:(95, "THEN ohne IF"), + ERROR:(96, "TO ohne Zusammenhang"), + ERROR:(97, "USING ohne (L)PRINT"), + ERROR:(98, "Unbekannte Funktion,"), + ERROR:(99, "Unbekannte Prozedur,"), + ERROR:(100,"Nicht implementiert"), + ERROR:(101,"SUB ohne GO"), + ERROR:(102,"GO ohne TO oder SUB"), + ERROR:(103,"Accessrecht VAR erwartet, CONST gefunden"), + ERROR:(104,"Funktionsaufruf ohne Zusammenhang"), + ERROR:(105,"Nach OPTION BASE ist nur 0 oder 1 erlaubt"), + ERROR:(106,"Bei SWAP nur gleiche Variablentypen erlaubt")); + +TEXT PROC errortext (INT CONST no): + INT VAR i; + FOR i FROM 1 UPTO errorsize + REP IF errormsg [i].no = no + THEN LEAVE errortext WITH errormsg [i].msg FI + PER; + "Unbekannter BASIC-Fehler #" + text (no) . +END PROC errortext; + +PROC basic error (TEXT CONST packet, + INT CONST error nr, + INT CONST line nr, + INT CONST statement nr, + TEXT CONST position, addition, + BOOL CONST leave statement): + erste zeile aufbauen; + einfache fehlermeldung aufbauen; + diese auf terminal ausgeben; + diese in sysout datei ausgeben wenn noetig; (* F20/rr *) + fehlermeldung in fehlerdatei ausgeben; + IF leave statement (* DEF/mo *) + THEN errorstop (101, packet + "-Fehler") + FI. + +erste zeile aufbauen: + IF line nr = 0 AND statement nr = 0 + THEN erste zeile := "FEHLER" + ELSE erste zeile := "FEHLER (Dateizeile "; + erste zeile CAT text (line nr); + erste zeile CAT ") in Zeile "; + erste zeile CAT text (statement nr); + FI; + + erste zeile CAT " bei >> "; + erste zeile CAT position; + erste zeile CAT " << : " . + +einfache fehlermeldung aufbauen: + message := " "; + message CAT error text (error nr); + message CAT " " . + +diese auf terminal ausgeben: (* F20/rr *) + display (""13""10""); + display (erste zeile); + display (""13""10""); + display (message + addition); + display (""13""10"") . + +diese in sysout datei ausgeben wenn noetig : (* F20/rr *) + IF sysout <> "" + THEN putline (erste zeile); + putline (message + addition); + line; + FI . + +fehlermeldung in fehlerdatei ausgeben: + note (erste zeile); + note line; + note (message); + note (addition); + note line . + +END PROC basic error; + +PROC basic warning (INT CONST line nr, (* mo *) + statement nr, + TEXT CONST warning text): +generate warning; +on screen; +in sysout file; +into the notebook. + +generate warning: + IF line nr = 0 AND statement nr = 0 + THEN erste zeile := "WARNUNG" + ELSE erste zeile := "WARNUNG (Dateizeile "; + erste zeile CAT text (line nr); + erste zeile CAT ") in Zeile "; + erste zeile CAT text (statement nr); + FI; + erste zeile CAT ": "; + erste zeile CAT warning text. + +on screen: + display (""13""10""); + display (erste zeile); + display (""13""10""). + +in sysout file: + IF sysout <> "" + THEN putline (erste zeile); + line; + FI. + +into the notebook: + IF warnings + THEN note (erste zeile); + note line + FI. + +END PROC basic warning; + +PROC return error: + errorstop (1003, "RETURN ohne GOSUB") +END PROC return error; + +END PACKET basic errors; + +PACKET basic types DEFINES symbol of, (* Autor: Heiko Indenbirken *) + type of, (* Stand: 07.09.1987/rr/mo *) + dim of, + shift, deshift, + reserved, + param list, + is bool op: + +LET (* S y m b o l T y p e n *) + any = 0, const = 1, var = 2, array = 3, + expr = 4, unused = 5, letter = 6, param = 7, + res word = 8, operator = 9, eos = 10, del = 11, + stat no = 12, eol = 13, eop = 14, + user fn = 20; (* DEF/mo *) +(* Operatoren *) +LET less equal = 28, unequal = 29, greater equal = 30; + +TEXT VAR dummy; + +TEXT PROC symbol of (INT CONST n) : + IF n < 0 + THEN ""19"" + symbol of (-n) + ELSE SELECT n OF + CASE less equal : "<=" + CASE unequal : "<>" + CASE greater equal : ">=" + + CASE eos : "EOS" + CASE eol : "EOL" + CASE eop : "EOF" + OTHERWISE : character END SELECT + FI . + +character : + IF n > 32 AND n < 128 + THEN code (n) + ELIF n >= 128 AND n <= 255 + THEN res word of (n) + ELSE "%" + subtext (text (n+1000), 2) + " " FI . + +END PROC symbol of; + +TEXT PROC type of (INT CONST n) : + SELECT n OF + CASE any : "ANY" + CASE const : "Konstante" + CASE var : "Variable" + CASE array : "Feld" + CASE expr : "Ausdruck" + CASE unused : " -?- " + CASE letter : "Buchstabe" + CASE param : "Parameter" + CASE res word : "reserviertes Wort" + CASE operator : "Operator" + CASE eos : "EOS" + CASE del : "Trennzeichen" + CASE stat no : "Zeilennumer" + CASE eol : "EOL" + CASE eop : "EOF" + CASE user fn : "'user function'" (* DEF/mo *) + OTHERWISE "?TYPE #" + text (n) ENDSELECT. +END PROC type of; + +TEXT PROC dim of (TEXT CONST parameter): + IF parameter = "" + THEN "" + ELSE base limits and size FI . + +base limits and size: + INT CONST dimension :: (LENGTH parameter DIV 2) - 2; + TEXT VAR result :: text (parameter ISUB dimension+1); + INT VAR i; + result CAT ": ["; + FOR i FROM 1 UPTO dimension-1 + REP result CAT text (parameter ISUB i); + result CAT ", " + PER; + result CAT text (parameter ISUB dimension); + result CAT "] "; + result CAT text (parameter ISUB dimension+2); + result . + +END PROC dim of; + +TEXT PROC param list (INT CONST first, no): + IF no < first + THEN "keine" + ELSE parameter list FI . + +parameter list: + INT VAR i; + TEXT VAR result :: "("; + FOR i FROM first UPTO no + REP result CAT dump (dtype (i)); + IF i = no + THEN result CAT ")" + ELSE result CAT ", " FI + PER; + result . + +END PROC param list; + +TEXT PROC shift (TEXT CONST word) : + INT VAR i; + dummy := word; + FOR i FROM 1 UPTO length (word) + REP shift char PER; + dummy . + +shift char: + INT VAR local letter :: code (dummy SUB i); + IF 97 <= local letter AND local letter <= 122 + THEN replace (dummy, i, code (local letter - 32)) FI . + +END PROC shift; + +TEXT PROC deshift (TEXT CONST word) : + INT VAR i; + dummy := word; + FOR i FROM 1 UPTO length (word) + REP deshift char PER; + dummy . + +deshift char: + INT VAR local letter :: code (dummy SUB i); + IF 65 <= local letter AND local letter <= 90 + THEN replace (dummy, i, code (local letter + 32)) FI; + +END PROC deshift; + +(* Verwaltung der Reservierten BASIC-Wörter *) +LET first operator = 249, (* MOD NOT AND OR XOR EQV IMP *) + first bool op = 250; (* 249 250 251 252 253 254 255 *) + +INT VAR index; +ROW 9 TEXT VAR res words :: ROW 9 TEXT : +("", + ""129"as"163"go"167"if"188"on"217"to"252"or", + ""128"abs"130"asc"131"atn"141"cos"142"cvd"143"cvi"145"def"150"dim"152"end"153"eof"154"erl"155"err"157"exp"159"fix"160"for"161"fre"162"get"172"int"175"len"176"let"178"loc"179"log"191"out"192"pos"194"put"202"rnd"197"rem"204"sgn"205"sin"207"spc"208"sqr"214"tab"215"tan"221"val"227"cls"234"usr"235"sub"249"mod"250"not"251"and"253"xor"254"eqv"255"imp", + ""132"base"133"call"134"cdbl"136"chr$"137"cint"144"data"151"else"165"goto"166"hex$"173"kill"177"line"181"lset"182"mid$"183"mkd$"184"mki$"185"name"186"next"187"oct$"189"open"196"read"203"rset"209"step"210"stop"211"str$"213"swap"216"then"219"tron"222"wait"223"wend"228"erm$"230"lpos", + ""135"chain"138"clear"139"close"156"error"158"field"164"gosub"169"input"171"instr"174"left$"193"print"218"troff"220"using"224"while"225"width"226"write"231"time$"232"date$"233"timer", + ""140"common"146"defdbl"147"defint"148"defsng"149"defstr"168"inkey$"170"input$"180"lprint"190"option"199"resume"200"return"201"right$"206"space$"229"csrlin", + ""198"restore"212"string$", + "", + ""195"randomize"); + +BOOL PROC reserved (TEXT CONST name, INT VAR no, type): + IF reserve is not possible COR not found within res words + THEN FALSE + ELSE no := code (this words SUB (index-1)); + type := res word or op; + TRUE + FI . + +reserve is not possible: + INT CONST len :: length (name); + len < 2 OR len > 9 . + +not found within res words: + index := pos (this words, name); + index = 0 . + +this words: + res words [len] . + +res word or op: + IF no >= first operator + THEN operator + ELSE res word FI . + +END PROC reserved; + +INT PROC reserved (TEXT CONST name): + IF reserve is not possible COR not found within res words + THEN 0 + ELSE code (this words SUB (index-1)) FI . + +reserve is not possible: + INT CONST len :: length (name); + len < 2 OR len > 9 . + +not found within res words: + index := pos (this words, name); + index = 0 . + +this words: + res words [len] . + +END PROC reserved; + +TEXT PROC res word of (INT CONST no): + INT VAR i; + FOR i FROM 2 UPTO 9 + REP index := pos (res words [i], code (no)); + IF index > 0 + THEN LEAVE res word of WITH shift (this name) FI + PER; + "" . + +this name: + subtext (res words [i], index+1, next code) . + +next code: + INT VAR c := pos (res words [i], ""127"", ""255"", index+1); + IF c = 0 + THEN length (res words [i]) + ELSE c-1 FI . + +END PROC res word of; + +BOOL PROC is bool op (INT CONST no): (* mo *) + no >= first bool op +END PROC is bool op; + +END PACKET basic types; + +PACKET basic table handling DEFINES init table, (* Autor: Heiko Indenbirken *) + put name, (* Stand: 13.08.1987/rr/mo *) + known, name of, + remember, + recognize, + table entries, + hash table, next table, + scope compulsory: (* DEF/mo *) + +LET hash length = 1024, + hash length minus one = 1023, + start of name table = 256, + table length = 4500; + +LET SYMBOL = STRUCT (INT type, ADDRESS adr, DTYPE data, TEXT dim); +LET TABLE = STRUCT (INT entries, + ROW hash length INT hash table, + ROW table length INT next, + ROW table length TEXT name table, + ROW table length SYMBOL symbol table); + +DATASPACE VAR table space; +BOUND TABLE VAR table; +INITFLAG VAR tab := FALSE; +SYMBOL CONST nilsymbol :: SYMBOL:(0, LOC 0, void type, ""); +INT VAR i; +BOOL VAR compulsory with scope :: TRUE; (* DEF/mo *) + +PROC init table: + IF NOT initialized (tab) + THEN table space := nilspace; + table := table space; + FI; + table.entries := start of name table; + FOR i FROM 1 UPTO hash length + REP table.hash table [i] := 0 PER; + compulsory with scope := TRUE; (* DEF/mo *) + +END PROC init table; + +PROC put name (TEXT CONST scope, name, INT VAR pointer): (* DEF/mo *) + IF compulsory with scope + THEN put name (scope + name, pointer) + ELIF NOT in table + THEN put name (name, pointer) + FI. + +in table: + hash (scope + name, pointer); + pointer := hash table (pointer); + WHILE not end of chain + REP IF name is found THEN LEAVE in table WITH TRUE FI; + pointer := table. next (pointer); + PER; + FALSE . + +name is found: + table.name table [pointer] = scope + name. + +not end of chain: + pointer > 0 . + +END PROC put name; + +PROC put name (TEXT CONST name, INT VAR pointer): + IF no entry in hash table + THEN create a new chain + ELSE create a new entry in chain FI; + insert name in name table . + +no entry in hash table: + INT VAR hash index; + hash (name, hash index); + table.hash table [hash index] = 0 . + +create a new chain: + table.hash table [hash index] := table.entries . + +create a new entry in chain: + pointer := table.hash table [hash index]; + REP IF name is found + THEN LEAVE put name + ELIF end of chain + THEN table.next [pointer] := table.entries; + LEAVE create a new entry in chain + ELSE pointer := next pointer FI + PER . + +name is found: + table.name table [pointer] = name. + +end of chain: + INT CONST next pointer := table.next [pointer]; + next pointer = 0 . + +insert name in name table: + IF table.entries >= table length + THEN errorstop ("volle Namenstabelle") FI; + + pointer := table.entries; + table.symbol table [pointer] := nilsymbol; + table.name table [pointer] := name; + table.next [pointer] := 0; + table.entries INCR 1 . + +END PROC put name; + +PROC hash (TEXT CONST name, INT VAR index) : + INT VAR j; + index := 0; + FOR j FROM 1 UPTO length (name) + REP addmult cyclic PER; + index INCR 1 . + +addmult cyclic : + index INCR index ; + IF index > hash length minus one + THEN wrap around FI; + index := (index + code (name SUB j)) MOD hash length minus one . + +wrap around: + index DECR hash length minus one . + +ENDPROC hash ; + +INT PROC table entries: + table.entries +END PROC table entries; + +INT PROC hash table (INT CONST n): + table.hash table [n] +END PROC hash table; + +INT PROC next table (INT CONST n): + table.next [n] +END PROC next table; + +TEXT PROC name of (INT CONST index): + IF index < 0 + THEN errorstop ("PROC name of: negativer Index"); "" + ELIF index < start of name table + THEN symbol of (index) + ELIF index <= table.entries + THEN table.name table (index) + ELSE errorstop ("PROC name of: Index größer als nametable"); + "" + FI + +END PROC name of; + +PROC recognize (INT CONST symb, type, ADDRESS CONST adr, DTYPE CONST data, TEXT CONST dim): + symbol.type := type; + symbol.adr := adr; + symbol.data := data; + symbol.dim := dim . + +symbol: table.symboltable [symb] . +END PROC recognize; + +PROC remember (INT CONST symb, INT VAR type, ADDRESS VAR adr, DTYPE VAR data, TEXT VAR dim): + SYMBOL CONST symbol := table.symboltable [symb]; + type := symbol.type; + adr := symbol.adr; + data := symbol.data; + dim := symbol.dim +END PROC remember; + +BOOL PROC known (INT CONST symb) : + table.symboltable [symb].type > 0 +END PROC known; + +PROC scope compulsory (BOOL CONST new state): (* DEF/mo *) + compulsory with scope := new state +END PROC scope compulsory; + +END PACKET basic table handling; + +PACKET basic scanner DEFINES begin scanning, (* Autor: Heiko Indenbirken *) + next symbol, (* Stand: 27.10.1987/rr/mo *) + next data, + next statement, + define chars, + scan line, + scan line no, (* F29/rr *) + get data types of input vars, (* F25/rr *) + basic error, + basic warning, + basic list, + set scope, + scanner scope: + + +LET (* S y m b o l T y p e n *) + any = 0, const = 1, var = 2, array = 3, + res word= 8, operator= 9, eos = 10, del =11, + stat no = 12, user fn = 20; (* DEF/mo *) + +LET (* S y m b o l z e i c h e n *) + less = 60, greater = 62, + less equal = 28, unequal = 29, greater equal = 30, + point = 46, eol = 13, eop = 14, + go = 163, gosub = 164, goto = 165, + sub = 235, to = 217; + +LET name chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz.0123456789!#$%", + quote = """", open bracket = "(", + comma = ",", close bracket = ")", + colon = ":", + exponent chars= "dDeE"; + +FILE VAR source file; +TEXT VAR defint chars, defstr chars, record, letter, + scope, new name; (* DEF/mo *) +REAL VAR r dummy; +INT VAR act stat no, record no, rec len, scan pos, i dummy; +BOOL VAR eol generated, at line begin, listing := FALSE; + +PROC define chars (TEXT CONST begin, end, DTYPE CONST data): + INT VAR i; + FOR i FROM code (begin) UPTO code (end) + REP IF data = int type + THEN defint chars CAT code (i) + ELIF data = text type + THEN defstr chars CAT code (i) + FI + PER . + +END PROC define chars; + + +PROC scanline (TEXT VAR line, INT VAR col): + line := record; + col := scan pos +END PROC scanline; + +INT PROC scan line no : record no END PROC scan line no; + + +PROC get data types of input vars (ROW 100 DTYPE VAR input var data, (* F25/rr *) + INT VAR number input vars) : + + TEXT VAR first var char; + INT VAR var pos := scan pos; + to begin of actual var; + REP get next input var; + skip brackets if necessary; + IF var char <> comma THEN LEAVE get data types of input vars FI; + skip comma; + PER; + + . var char : record SUB var pos + + . to begin of actual var : + WHILE pos (name chars, var char) <> 0 REP var pos DECR 1 PER; + var pos INCR 1; + number input vars := 0; + + . get next input var : + first var char := deshift (var char); + WHILE pos (name chars, var char) <> 0 REP var pos INCR 1 PER; + var pos DECR 1; + number input vars INCR 1; + input var data (number input vars) := var datatype (first var char, var char); + var pos := pos (record, ""33"", ""255"", var pos + 1); + + . skip brackets if necessary : + IF var char = open bracket + THEN INT VAR bracket counter := 1; + REP count bracket UNTIL bracket counter = 0 PER; + var pos := pos (record, ""33"", ""255"", var pos + 1); + FI; + + . count bracket : + INT CONST open := pos (record, open bracket, var pos + 1), + close := pos (record, close bracket, var pos + 1); + IF open > 0 + THEN IF close > 0 + THEN IF open > close + THEN close bracket found + ELSE open bracket found + FI; + ELSE open bracket found + FI; + ELSE IF close > 0 + THEN close bracket found + ELSE LEAVE get data types of input vars + FI; + FI; + + . open bracket found : + bracket counter INCR 1; + var pos := open; + + . close bracket found : + bracket counter DECR 1; + var pos := close; + + . skip comma : + var pos := pos (record, ""33"", ""255"", var pos + 1); + +END PROC get data types of input vars; + + +PROC begin scanning (FILE VAR basic file): + enable stop; + source file := basic file; + to first record (source file); + col (source file, 1); + IF eof (source file) + THEN errorstop ("Datei ist leer") FI; + + defint chars := ""; + defstr chars := ""; + scope := ""; (* DEF/mo *) + act stat no := 0; + read record (source file, record); + rec len := length (record); + scan pos := 0; + record no := 1; + eol generated := FALSE; + at line begin := TRUE; + IF listing + THEN line; + putline (record); + IF sysout <> "" + THEN cout (record no) + FI + ELSE cout (record no) + FI. + +END PROC begin scanning; + +PROC next statement: + IF eof (source file) + THEN errorstop (99, "") + ELSE eol generated := FALSE; + at line begin := TRUE; + down (source file); + read record (source file, record); + rec len := length (record); + scan pos := 0; + record no INCR 1; + FI; + IF listing + THEN putline (record); + IF sysout <> "" + THEN cout (record no) + FI + ELSE cout (record no) + FI. + +END PROC next statement; + +PROC next symbol (TEXT VAR name, INT VAR no, type, DTYPE VAR data): + enable stop; + clear symbol; + IF eol generated + THEN next statement FI; + + IF eol reached + THEN generate eol + ELIF at line begin CAND stat no found (* F15/rr *) + THEN generate stat no + ELSE generate chars FI . + +clear symbol: + name := ""; + no := 0; + type := any; + data := void type . + +eol reached: + scan pos := pos (record, ""33"", ""255"", scan pos+1); + scan pos = 0 . + +generate eol : + IF eof (source file) + THEN name := "EOF"; no := eop; type := eos + ELSE name := "EOL"; no := eol; type := eos FI; + eol generated := TRUE . + +stat no found: (* F15/rr *) + at line begin := FALSE; + pos ("0123456789", act char) <> 0 . + +generate stat no: (* F15/rr *) + INT CONST next scan pos := last number pos; + name := subtext (record, scan pos, next scan pos); + act stat no := int (name); + scan pos := next scan pos; + no := act stat no; type := stat no . + +last number pos : (* F15/rr *) + INT CONST high := pos (record, ""058"", ""255"", scan pos), + low := pos (record, ""032"", ""047"", scan pos); + IF high > 0 + THEN IF low > 0 + THEN min (high, low) - 1 + ELSE high - 1 + FI + ELIF low > 0 + THEN low - 1 + ELSE LENGTH record + FI . + +generate chars: + SELECT code (act char) OF + CASE 32: next symbol (name, no, type, data) (* Space *) + CASE 34: generate text denoter (* " *) + CASE 39: generate eol (* ' *) + CASE 42, 43, 45, 47, 92, 94, 61: generate operator (* *,+,-,/,\,^,=*) + CASE 60: generate less op (*<, <=, <> *) + CASE 62: generate greater op (*>, >= *) + CASE 46: treat point (* . *) + CASE 48, 49, 50, 51, 52, 53, 54, 55, 56, 57: + generate numeric const (* 0 - 9 *) + CASE 58: generate eos (* : *) + CASE 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, + 82, 83, 84, 85, 86, 87, 88, 89, 90, 97, 98, 99, 100, 101, 102, 103, + 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, + 118, 119, 120, 121, 122, (* small and large letters *) + generate res word or id + OTHERWISE generate delimiter END SELECT . + +generate text denoter: + get text const (name, data); + type := const . + +generate operator: + name := act char; no := code (name); type := operator . + +generate less op: + IF next char = "=" + THEN name := "<="; no := less equal; skip char + ELIF next char = ">" + THEN name := "<>"; no := unequal; skip char + ELSE name := "<"; no := less FI; + type := operator . + +generate greater op: + IF next char = "=" + THEN name := ">="; no := greater equal; skip char + ELSE name := ">"; no := greater; FI; + type := operator . + +treat point: + IF pos ("0123456789", next char) <> 0 + THEN generate numeric const + ELSE name := "."; + no := point; + type := del + FI. + +generate numeric const: + get numeric const (name, data); + type := const . + +last name char: + name SUB LENGTH name . + +generate eos: + name := ":"; no := eos; type := eos . + +generate res word or id: + get name chars; + IF reserved (deshift name, no, type) + THEN IF type = res word AND no = go + THEN treat go + FI + ELSE IF function name + THEN data := ftn datatype; + type := user fn + ELSE data := var datatype (deshift (name) SUB 1, last name char); + type := var or array + FI; + put name (scope, deshift name, no) + FI. + +treat go: + next symbol (new name, no, type, data); + IF no = to AND type = res word + THEN name CAT new name; + no := goto + ELIF no = sub AND type = res word + THEN name CAT new name; + no := gosub + ELSE scan error (102, name, "") + FI. + +get name chars: + TEXT VAR deshift name :: ""; + INT VAR begin of name :: scan pos; + FOR scan pos FROM scan pos UPTO rec len + WHILE name chars found + REP deshift name CAT deshifted char PER; + scan pos DECR 1; + name := subtext (record, begin of name, scan pos). + +name chars found: + pos (name chars, act char) > 0 . + +function name: + subtext (deshift name, 1, 2) = "fn" . + +ftn datatype: + IF last name char = "$" + THEN text type + ELIF last name char = "%" + THEN int type + ELSE real type FI . + +var or array: + IF array name + THEN name CAT "()"; + deshift name CAT "()"; (* F30/rr *) + array + ELSE var FI . + +array name: + next scan char = "(" . + +deshifted char: + letter := act char; + IF letter >= "A" AND letter <= "Z" + THEN code (code (letter) + 32) + ELSE letter FI . + +generate delimiter: + name := act char; no := code (name); type := del . + +next scan char: record SUB pos (record, ""33"", ""255"", scan pos+1). +next char: (record SUB scan pos + 1) . +act char: record SUB scan pos . +skip char: scan pos INCR 1 . +END PROC next symbol; + +DTYPE PROC var datatype (TEXT CONST first name char, last name char) : + + IF last name char = "!" OR last name char = "#" + THEN real type + ELIF last name char = "$" + THEN text type + ELIF last name char = "%" + THEN int type + ELIF pos (defint chars, first name char) > 0 + THEN int type + ELIF pos (defstr chars, first name char) > 0 + THEN text type + ELSE real type FI . + +END PROC var datatype; + +BOOL PROC next data (TEXT VAR data text, DTYPE VAR data type) : (* F17/rr *) + + data type := void type; + IF no more data + THEN scan pos := rec len; + data text := ""; + FALSE + ELIF quoted string + THEN get quoted string; + TRUE + ELSE get unquoted string; + TRUE + FI + + . no more data : + scan pos := pos (record, ""33"", ""255"", scan pos+1); + scan pos = 0 + + . quoted string : + (record SUB scan pos) = quote + + . get quoted string : + get text const (data text, data type); + + . get unquoted string : + INT CONST comma or colon pos 1 := position of comma or colon minus one; + data text := compress (subtext (record, scan pos, comma or colon pos 1)); + scan pos := comma or colon pos 1; + + . position of comma or colon minus one : + INT CONST colon pos := pos (record, colon, scan pos), + comma pos := pos (record, comma, scan pos); + IF colon pos > 0 + THEN IF comma pos > 0 + THEN min (colon pos, comma pos) - 1 + ELSE colon pos - 1 + FI + ELSE IF comma pos > 0 + THEN comma pos - 1 + ELSE LENGTH record + FI + FI + +END PROC next data; + +PROC get numeric const (TEXT VAR value, DTYPE VAR data): + get sign; + get const; + check datatype . + +get sign: + IF act char = "-" + THEN value := "-"; + scan pos INCR 1 + ELIF act char = "+" + THEN value := "+"; + scan pos INCR 1 + ELSE value := "" FI . + +get const: + get digits; + get point; + get digits; + get exponent . + +get digits: + FOR scan pos FROM scan pos UPTO rec len + WHILE digit found + REP value CAT act char PER . + +get point: + IF act char = "." + THEN value CAT "."; + scan pos INCR 1 + ELIF pos (exponent chars, act char) > 0 + THEN value CAT ".0" + ELSE LEAVE get const FI . + +get exponent: + IF pos (exponent chars, act char) > 0 (* F1/rr *) + THEN value CAT "e"; + scan pos INCR 1; + evtl get sign; + get digits + FI . + +evtl get sign: + IF act char = "+" OR act char = "-" + THEN value CAT act char; + scan pos INCR 1 + FI . + +digit found: + "0" <= act char AND act char <= "9" . + +check datatype: + IF act char = "%" + THEN IF integer ok (value) + THEN data := int type + ELSE scan error (2, value, "INT-Konstante nicht korrekt") FI + ELIF act char = "!" OR act char = "#" + THEN IF real ok (value) + THEN data := real type + ELSE scan error (2, value, "REAL-Konstante nicht korrekt") FI + ELIF integer ok (value) + THEN scan pos DECR 1; data := int type + ELIF real ok (value) + THEN scan pos DECR 1; + data := real type + ELSE scan error (2, value, "Numerische Konstante nicht korrekt") FI . + +act char: record SUB scan pos . +END PROC get numeric const; + +PROC get text const (TEXT VAR value, DTYPE VAR data): + INT CONST quote 1 := scan pos; + scan pos := pos (record, """", scan pos+1); + IF quote 1 < scan pos + THEN value := subtext (record, quote 1+1, scan pos-1); + data := text type + ELSE scan error (15, subtext (record, quote 1), "("" fehlt)") FI . + +END PROC get text const; + +BOOL PROC integer ok (TEXT VAR zahl): + disable stop; + i dummy := int (zahl); + IF is error + THEN clear error; + FALSE + ELIF last conversion ok + THEN zahl := ""0""0""; + replace (zahl, 1, i dummy); + TRUE + ELSE FALSE FI . + +END PROC integer ok; + +BOOL PROC real ok (TEXT VAR zahl): + disable stop; + r dummy := real (zahl); + IF is error + THEN clear error; + FALSE + ELIF last conversion ok + THEN zahl := ""0""0""0""0""0""0""0""0""; + replace (zahl, 1, r dummy); + TRUE + ELSE FALSE FI . + +END PROC real ok; + +PROC basic error (INT CONST no, TEXT CONST name, addition): + basic error ("Compiler", no, record no, act stat no, name, addition, TRUE) +END PROC basic error; + +PROC basic error (INT CONST no, TEXT CONST name, addition, BOOL CONST leave statement): + basic error ("Compiler", no, record no, act stat no, name, addition, leave statement) +END PROC basic error; + +PROC scan error (INT CONST no, TEXT CONST name, addition): + basic error ("Scanner", no, record no, act stat no, name, addition, TRUE) +END PROC scan error; + +PROC basic warning (TEXT CONST warning text): (* mo *) + basic warning (record no, act stat no, warning text) +END PROC basic warning; + +PROC basic list (BOOL CONST t): + listing := t +END PROC basic list; + +BOOL PROC basic list: + listing +END PROC basic list; + +PROC set scope (TEXT CONST new scope): (* DEF/mo *) + scope := new scope +END PROC set scope; + +TEXT PROC scanner scope: (* DEF/mo *) + scope +END PROC scanner scope; + +END PACKET basic scanner; + + +PACKET basic stat no DEFINES init stat no, (* Autor: Heiko Indenbirken *) + stat no pos, (* Stand: 27.10.1987/rr/mo *) + label pos, + all stat no: + +LET nil = ""; + +TEXT VAR found stat no :: nil; +INT VAR i, akt stat no :: 0, found no :: 0; + +PROC init stat no (FILE VAR f, INT VAR error no): (* F21/rr *) +(*Die Datei 'f' muß im 'modify-Mode' sein. *) + INT VAR line no; + akt stat no := -1; (* F28/rr *) + found no := 0; + found stat no := nil; + error no := 0; (* F21/rr *) + to first record (f); + col (f, 1); + disable stop; + FOR line no FROM 1 UPTO 4000 + REP exec (PROC (TEXT CONST, INT CONST) check, f, line no); + IF is error THEN check error FI; + IF eof (f) + THEN LEAVE init stat no + ELSE down (f) FI + PER; + +. check error : (* F21/rr *) + IF error code = 100 + THEN clear error; + error no INCR 1; + ELSE LEAVE init stat no; + FI; + +END PROC init stat no; + +PROC check (TEXT CONST record, INT CONST line no): + IF statement no vorhanden + THEN remember statement no FI . + +statement no vorhanden: (* F15/rr *) + INT CONST first number pos := pos (record, ""048"", ""057"", 1); + first number pos > 0 CAND first number pos = first non blank pos . + +first non blank pos : (* F15/rr *) + pos (record, ""033"", ""255"", 1) . + +remember statement no: + get statement no; + IF neue nummer ist groesser als vorherige + THEN akt stat no := neue nummer; + cout (neue nummer); + found no INCR 1; + found stat no CAT mki (neue nummer) + ELSE basic error ("Stat no", 81, line no, neue nummer, number, + "Letzte Zeilennummer davor: " + text (akt stat no), TRUE) + FI . + +get statement no : (* F15/rr *) + disable stop; + TEXT CONST number := subtext (record, first number pos, last number pos); + INT VAR neue nummer := int (number); + IF NOT last conversion ok OR is error + THEN clear error; + basic error ("Stat no", 80, line no, akt stat no, number, + "Die Zeilennummer muß im Bereich 0-32767 liegen", TRUE) + FI; + enable stop . + +last number pos : (* F15/rr *) + INT CONST high := pos (record, ""058"", ""255"", first number pos), + low := pos (record, ""032"", ""047"", first number pos); + IF high > 0 + THEN IF low > 0 + THEN min (high, low) - 1 + ELSE high - 1 + FI + ELIF low > 0 + THEN low - 1 + ELSE LENGTH record + FI . + +neue nummer ist groesser als vorherige: + neue nummer > akt stat no . + +END PROC check; + +INT PROC stat no pos (INT CONST stat no): + FOR i FROM found no DOWNTO 1 + REP IF (found stat no ISUB i) = stat no + THEN LEAVE stat no pos WITH i FI + PER; + 0 +END PROC stat no pos; + +INT PROC label pos (INT CONST stat no): + FOR i FROM found no DOWNTO 1 + REP IF (found stat no ISUB i) = stat no + THEN LEAVE label pos WITH i FI + PER; + basic error (8, text (stat no), nil); (* F16/rr *) + 0 +END PROC label pos; + +PROC all stat no (TEXT VAR stat no, INT VAR no): + stat no := found stat no; + no := found no +END PROC all stat no; + +END PACKET basic stat no; + +PACKET basic storage DEFINES init storage, (* Autor: Heiko Indenbirken *) + next local adr, (* Stand: 12.06.86 *) + next ref, + local adr, + local storage, + type size, + quiet type: + + + +LET ref length = 2; + +INT VAR quiet size, quiet align; +ADDRESS VAR loc adr, free loc adr; +DTYPE VAR quiet value; +identify ("QUIET", quiet size, quiet align, quiet value); + +PROC init storage: + free loc adr := LOC 0; + loc adr := LOC 0; + +END PROC init storage; + +(* Verwaltung der lokalen Addressen für Zwischenergebnisse *) +ADDRESS PROC next local adr (DTYPE CONST type): + INT VAR type len :: type size (type); + loc adr := free loc adr; + adjust (loc adr, type len); + free loc adr := loc adr + type len; + loc adr . + +END PROC next local adr; + +ADDRESS PROC next ref: + loc adr := free loc adr; + adjust (loc adr, ref length); + free loc adr := loc adr + ref length; + loc adr . + +END PROC next ref; + +ADDRESS PROC local adr: + loc adr +END PROC local adr; + +INT PROC local storage: + int (subtext (dump (free loc adr), 6)) +END PROC local storage; + +INT PROC type size (DTYPE CONST type): + IF type = int type OR type = bool type + THEN 1 + ELIF type = row type + THEN 2 + ELIF type = real type + THEN 4 + ELIF type = text type + THEN 8 + ELIF type = quiet value + THEN quiet size + ELSE errorstop ("Unbekannter DTYPE: " + dump (type)); 0 FI . + +END PROC type size; + +DTYPE PROC quiet type: + quiet value +END PROC quiet type; + +END PACKET basic storage; + +PACKET basic identify DEFINES (* Autor: Heiko Indenbirken *) + (* Stand: 20.08.1987/rr/mo *) + identify, + convert paramfield, + dump ftn, + is basic function: (* mo *) + +LET nil = ""; + +LET ENTRY = STRUCT (TEXT param, INT no, next, OPN opn, DTYPE result); + +ROW 256 ENTRY VAR ftn table; + +clear ftn table; +init ftn names; +init int operator; +init real operator; +init text operator; +init predefined funktions; + +PROC dump ftn (INT CONST n, TEXT VAR param, INT VAR no, next, + OPN VAR opn, DTYPE VAR result): + param := ftn table [n].param; + no := ftn table [n].no; + next := ftn table [n].next; + opn := ftn table [n].opn; + result := ftn table [n].result + +END PROC dump ftn; + +PROC identify (INT CONST ftn no, first, params, OPN VAR operation, BOOL VAR found): + TEXT VAR param; + INT VAR pos :: min (ftn no, 256); + convert paramfield (first, params, param); + REP IF param = ftn table [pos].param AND ftn no = ftn table [pos].no + THEN declare (params+1, ftn table [pos].result); + declare (params+1, 1); + operation := ftn table [pos].opn; + found := TRUE; + LEAVE identify + ELSE pos := ftn table [pos].next FI + UNTIL pos <= 0 PER; (* F14/rr *) + operation := nop; + found := FALSE . + +END PROC identify; + +PROC next free entry (INT VAR free pos): + FOR free pos FROM 1 UPTO 256 + REP IF ftn table [free pos].next < 0 AND ftn table [free pos].no = 0 (* mo *) + THEN LEAVE next free entry FI + PER; + errorstop ("Überlauf der Funktionstabelle") . + +END PROC next free entry; + +PROC convert paramfield (INT CONST first, params, TEXT VAR param): + INT VAR i; + param := nil; + FOR i FROM first UPTO params + REP param CAT datatype PER . + +datatype: + DTYPE CONST data :: dtype (i); + IF data = int type + THEN "I" + ELIF data = real type + THEN "R" + ELIF data = text type + THEN "T" + ELIF data = bool type + THEN "b" + ELSE errorstop ("Falscher DTYPE: " + dump (data)); + nil + FI . + +END PROC convert paramfield; + +PROC convert paramfield (TEXT CONST params, INT CONST first): + INT VAR i; + FOR i FROM first UPTO first+length (params)-1 + REP parameter (i, this type, 1, GLOB 0) PER . + +this type: + IF (params SUB i) = "I" + THEN int type + ELIF (params SUB i) = "R" + THEN real type + ELIF (params SUB i) = "T" + THEN text type + ELSE errorstop ("Unbekannter Typ: " + params); + undefined type + FI . + +END PROC convert paramfield; + +PROC init op (INT CONST ftn no, TEXT CONST param, ftn name): + IF elan opn found + THEN insert new opn in chain + ELSE errorstop ("PROC " + ftn name + " (" + param + ") nicht gefunden") FI . + +elan opn found: + OPN VAR opn; + BOOL VAR found; + convert paramfield (param, 1); + identify (ftn name, 1, length (param), opn, found); + found . + +insert new opn in chain: + INT VAR ftn pos :: ftn no; + REP IF end of chain found + THEN cat new entry in chain + ELIF free entry in chain found + THEN cover this entry + ELSE next entry FI + UNTIL ftn pos <= 0 PER . + +end of chain found: + act entry.next = 0 . + +cat new entry in chain: + INT VAR free pos; + next free entry (free pos); + act entry.next := free pos; + free entry := ENTRY:(param, ftn no, 0, opn, dtype (LENGTH param+1)); + LEAVE insert new opn in chain . + +free entry in chain found: + act entry.next = -1 . + +cover this entry: + act entry := ENTRY:(param, ftn no, 0, opn, dtype (LENGTH param+1)); + LEAVE insert new opn in chain . + +next entry: + ftn pos := act entry.next . + +act entry: ftn table [ftn pos] . +free entry: ftn table [free pos] . + +END PROC init op; + +BOOL PROC is basic function (INT CONST ftn no): (* mo *) + + pos (ftn names, code (ftn no)) <> 0 + +END PROC is basic function; + +. +clear ftn table: + INT VAR k; + FOR k FROM 1 UPTO 256 + REP ftn table [k] := ENTRY:(nil, 0,-1, nop, undefined type) PER . + +init ftn names: + TEXT CONST ftn names :: "+-*/\^<=>"28""29""30""249""251""252""253""254"" + + ""128""130""131""134""136""137""141""143""142"" + + ""153""154""155""157""159""161""166""168""170""171""172"" + + ""174""175""178""179""182""184""183""187""192"" + + ""201""202""204""205""206""207""208""211""212"" + + ""215""221""228""229""230""231""232""233""; + FOR k FROM 1 UPTO length (ftn names) + REP ftn table [ftn pos] := ENTRY:(nil, ftn pos,-1, nop, void type) PER . + +ftn pos: + code (ftn names SUB k) . + +init int operator: + init op ( 43, "II", "+"); + init op ( 45, "II", "-"); + init op ( 42, "II", "*"); + init op ( 47, "II", "/"); (* mo *) + init op ( 92, "II", "DIV"); (* mo *) + init op ( 94, "II", "^"); + init op ( 61, "II", "EQU"); + init op ( 29, "II", "UEQ"); + init op ( 60, "II", "LES"); + init op ( 28, "II", "LEQ"); + init op ( 62, "II", "GRE"); + init op ( 30, "II", "GEQ"); + init op (249, "II", "MOD"); (* mo *) + init op (251, "II", "AND"); + init op (252, "II", "OR"); + init op (253, "II", "XOR"); + init op (254, "II", "EQV"); + init op (255, "II", "IMP"). + +init real operator: + init op ( 43, "RR", "+"); + init op ( 45, "RR", "-"); + init op ( 42, "RR", "*"); + init op ( 47, "RR", "/"); + init op ( 92, "RR", "DIV"); (* mo *) + init op ( 94, "RR", "^"); + init op ( 61, "RR", "EQU"); + init op ( 29, "RR", "UEQ"); + init op ( 60, "RR", "LES"); + init op ( 28, "RR", "LEQ"); + init op ( 62, "RR", "GRE"); + init op ( 30, "RR", "GEQ"); + init op (249, "RR", "realmod"). (* mo *) + +init text operator: + init op ( 43, "TT", "+"); + init op ( 61, "TT", "EQU"); + init op ( 29, "TT", "UEQ"); + init op ( 60, "TT", "LES"); + init op ( 28, "TT", "LEQ"); + init op ( 62, "TT", "GRE"); + init op ( 30, "TT", "GEQ") . + +init predefined funktions: + init op (128, "I", "abs"); + init op (128, "R", "abs"); + init op (130, "T", "asc"); + init op (131, "R", "arctan"); + init op (131, "I", "arctan"); + init op (134, "I", "cdbl"); + init op (134, "R", "cdbl"); + init op (136, "I", "chr"); + init op (136, "R", "chr"); + init op (137, "R", "cint"); + init op (137, "I", "cint"); + init op (141, "R", "cos"); + init op (141, "I", "cos"); + init op (143, "T", "cvi"); + init op (142, "T", "cvd"); +# init op (153, "", "eof");# (* File *) + init op (154, "", "errorline"); + init op (155, "", "errorcode"); + init op (157, "R", "exp"); + init op (157, "I", "exp"); + init op (159, "R", "floor"); + init op (159, "I", "floor"); + init op (161, "I", "fre"); + init op (161, "R", "fre"); + init op (161, "T", "fre"); + init op (166, "I", "hex"); + init op (166, "R", "hex"); + init op (168, "", "incharety"); + init op (170, "I", "inchars"); + init op (170, "R", "inchars"); + init op (171, "TT", "instr"); + init op (171, "ITT", "instr"); + init op (171, "RTT", "instr"); + init op (172, "I", "ent"); + init op (172, "R", "ent"); + init op (174, "TI", "left"); + init op (174, "TR", "left"); + init op (175, "T", "length"); +# init op (178, "I", "line no");# (* File *) + init op (179, "R", "ln"); + init op (179, "I", "ln"); + init op (182, "TII", "mid"); + init op (182, "TI", "mid"); + init op (182, "TRR", "mid"); + init op (182, "TR", "mid"); + init op (183, "I", "mkd"); + init op (183, "R", "mkd"); + init op (187, "I", "oct"); + init op (187, "R", "oct"); + init op (192, "I", "pos"); + init op (192, "R", "pos"); + init op (201, "TI", "right"); + init op (201, "TR", "right"); + init op (202, "", "rnd"); (* F12/rr *) + init op (202, "I", "rnd"); + init op (202, "R", "rnd"); + init op (204, "I", "sign"); + init op (204, "R", "sign"); + init op (205, "R", "sin"); + init op (205, "I", "sin"); + init op (206, "I", "space"); + init op (206, "R", "space"); + init op (207, "I", "space"); + init op (207, "R", "space"); + init op (208, "R", "sqrt"); + init op (208, "I", "sqrt"); + init op (211, "I", "basictext"); + init op (211, "R", "basictext"); + init op (212, "IT", "string"); + init op (212, "RT", "string"); + init op (212, "II", "string"); + init op (212, "RR", "string"); + init op (212, "RI", "string"); + init op (212, "IR", "string"); + init op (215, "R", "tan"); + init op (215, "I", "tan"); + init op (221, "T", "val"); (* F18/rr *) + init op (228, "", "errormessage"); + init op (229, "", "csrlin"); + init op (230, "I", "lpos"); + init op (230, "R", "lpos"); + init op (231, "", "time"); + init op (232, "", "date"); + init op (233, "", "timer"). + +END PACKET basic identify; + +PACKET basic data handling (* Autor: R. Ruland *) + (* Stand: 23.10.87/mo *) + DEFINES init data, + data line, + data, read, + restore, + next int, + next real, + next text: + +LET (* R e s u l t T y p e n *) + stat code = 0, stat char = ""0"", + data code = 1, data char = ""1"", + text code = 2, text char = ""2"", + + int overflow = 4, + real overflow = 6; + +INT VAR type; +TEXT VAR data text :: "", number text; + +PROC init data: + + data text := "" + +END PROC init data; + + +PROC init data (TEXT VAR data, INT VAR data pos): + + data := data text; + data pos := 1 + +END PROC init data; + + +PROC restore (TEXT CONST data, INT VAR data pos, INT CONST line no): + + INT CONST data length :: LENGTH data; + data pos := 1; + WHILE data pos < data length + REP type := code (data SUB data pos); + data pos INCR 1; + SELECT type OF + CASE stat code : IF int value (data, data pos) >= line no + THEN LEAVE restore FI + CASE data code, text code : data pos INCR int value (data, data pos) + OTHERWISE : errorstop (1051, "Fehlerhaften Dateneintrag gefunden: " + text (type)) + ENDSELECT; + PER; + errorstop (1004, "RESTORE: Keine DATA-Anweisung in oder nach Zeile " + text (line no) + + " gefunden"); + +END PROC restore; + + +INT PROC next int (TEXT CONST data, INT VAR data pos): + + number text := next text (data, data pos); + disable stop; + INT VAR result := int (number text); + IF is error + THEN IF error code = int overflow THEN handle overflow FI; + ELIF NOT last conversion ok CAND number text <> "" + THEN errorstop (1013, "READ: Falscher Datentyp, " + number text + " ist kein INT") + FI; + result + + . handle overflow : + clear error; + result := result value; + IF cursor x pos <> 1 THEN next line FI; + basic out ("WARNUNG : INT-Überlauf bei READ, gefunden: " + number text); + next line; + + . result value : + IF (number text SUB 1) = "-" THEN minint ELSE maxint FI + +END PROC next int; + + +REAL PROC next real (TEXT CONST data, INT VAR data pos): + + number text := next text (data, data pos); + disable stop; + REAL VAR result := val (number text); + IF is error + THEN IF error code = real overflow OR error code = int overflow (* <- wegen Fehler in REAL PROC real (T C) *) + THEN handle overflow or underflow + FI; + ELIF NOT last conversion ok CAND number text <> "" + THEN errorstop (1013, "READ: Falscher Datentyp, " + number text + " ist kein REAL") + FI; + result + + . handle overflow or underflow : (* F23/rr *) + clear error; + IF cursor x pos <> 1 THEN next line FI; + basic out ("WARNUNG : " + overflow or underflow + " bei READ, gefunden: " + number text); + next line; + + . overflow or underflow : + IF is overflow + THEN result := sign * (max real - 0.99999999999994e120); (* <- wegen Fehler in TEXT PROC text (R C) *) + "REAL-Überlauf" + ELSE result := 0.0; + "REAL-Unterlauf" + FI + + . sign : + IF (number text SUB 1) = "-" THEN -1.0 ELSE 1.0 FI + + . is overflow : + INT VAR exponent pos := pos (number text, "E"); + IF exponent pos = 0 THEN exponent pos := pos (number text, "e") FI; + IF exponent pos = 0 + THEN TRUE + ELSE (number text SUB (exponent pos + 1)) <> "-" + FI + +END PROC next real; + + +TEXT PROC next text (TEXT CONST data, INT VAR data pos): + + INT CONST len :: int value (data, data pos); + data pos INCR len; + subtext (data, data pos-len, data pos-1) + +END PROC next text; + + +INT PROC int value (TEXT CONST data, INT VAR data pos): + + data pos INCR 2; + subtext (data, data pos-2, data pos-1) ISUB 1 + +END PROC int value; + + +PROC data line (INT CONST line no): + + data text CAT stat char; + data text CAT mki (line no) + +END PROC data line; + + +PROC data (TEXT CONST string, DTYPE VAR data type) : + + data text CAT data + mki (length (string)); + data text CAT string; + + . data : + IF data type = void type + THEN data char + ELIF data type = text type + THEN text char + ELSE errorstop (1051, "Unbekannter DTYPE: " + dump (data type)); "" + FI + +END PROC data; + + +PROC read (TEXT CONST data, INT VAR data pos, INT VAR i): + + type := code (data SUB data pos); + data pos INCR 1; + IF data pos >= LENGTH data + THEN errorstop (1004, "Keine Daten mehr für READ") + ELIF type = data code + THEN i := next int (data, data pos) + ELIF type = stat code + THEN data pos INCR 2; + read (data, data pos, i) + ELSE errorstop (1013, "READ: Falscher Datentyp, " + data string (data,data pos) + " ist kein INT") + FI; + +END PROC read; + + +PROC read (TEXT CONST data, INT VAR data pos, REAL VAR r): + + type := code (data SUB data pos); + data pos INCR 1; + IF data pos >= LENGTH data + THEN errorstop (1004, "Keine Daten mehr für READ") + ELIF type = data code + THEN r := next real (data, data pos) + ELIF type = stat code + THEN data pos INCR 2; + read (data, data pos, r) + ELSE errorstop (1013, "READ: Falscher Datentyp, " + data string (data,data pos) + " ist kein REAL") + FI; + +END PROC read; + + +PROC read (TEXT CONST data, INT VAR data pos, TEXT VAR t): + + type := code (data SUB data pos); + data pos INCR 1; + IF data pos >= LENGTH data + THEN errorstop (1004, "Keine Daten mehr für READ") + ELIF type = data code OR type = text code + THEN t := next text (data, data pos) + ELIF type = stat code + THEN data pos INCR 2; + read (data, data pos, t) + ELSE errorstop (1013, "READ: Falscher Datentyp, " + data string (data,data pos) + " ist kein TEXT") + FI; + +END PROC read; + + +TEXT PROC data string (TEXT CONST data, INT VAR data pos): + + IF type = text code + THEN """" + next text (data, data pos) + """" + ELSE "unbekannter DTYPE: " + text (type) + FI + +END PROC data string; + +END PACKET basic data handling; + + +PACKET basic odds and ends DEFINES trace, (* Autor: Heiko Indenbirken *) + start basic, (* Stand: 26.10.1987/rr/mo *) + end basic, + loop end, + basic stop: + +(* Fehlerbehandlung *) + +PROC trace (INT CONST stat no): + basic out ("[" + text (stat no) + "]") + +END PROC trace; + +(*Laufzeitprozeduren *) +PROC start basic: + set line nr (0); + initialize random (0.1); (* F26/rr *) + init output; + init input + +END PROC start basic; + +PROC end basic: + IF is error + THEN switch back to old sysout state + FI . + +END PROC end basic; + +(* Schleifenüberprüfung *) +BOOL PROC loop end (REAL CONST x, max, step) : + IF step > 0.0 + THEN x > max + ELSE x < max FI + +END PROC loop end; + +BOOL PROC loop end (INT CONST x, max, step) : + IF step > 0 + THEN x > max + ELSE x < max FI + +END PROC loop end; + +PROC basic stop (INT CONST stat no): + basic out ("STOP beendet das Programm in Zeile " + text (stat no)); + next line + +END PROC basic stop; + +END PACKET basic odds and ends + diff --git a/lang/basic/1.8.7/src/BASIC.Compiler b/lang/basic/1.8.7/src/BASIC.Compiler new file mode 100644 index 0000000..d4e4c21 --- /dev/null +++ b/lang/basic/1.8.7/src/BASIC.Compiler @@ -0,0 +1,2305 @@ +(***************************************************************************) +(* *) +(* Dritte von drei Dateien des EUMEL-BASIC-Systems *) +(* *) +(* Autor: Heiko Indenbirken *) +(* Überarbeitet von: Rudolf Ruland und Michael Overdick *) +(* *) +(* Stand: 27.10.1987 *) +(* *) +(***************************************************************************) + +PACKET basic compiler DEFINES basic, (* Autor: Heiko Indenbirken *) + basic version: (* Stand: 27.10.1987/rr/mo *) + +PROC basic version : + +putline (""13" "15" BASIC - Compiler Version 1.1 (27.10.1987) "14""); + +END PROC basic version; + +LET compiler msg = " ******* ENDE DER UEBERSETZUNG *******", + compiler err msg = " Fehler entdeckt"; + +LET (* S y m b o l T y p e n *) + any = 0, const = 1, var = 2, array = 3, denoter = 5, + res word= 8, operator= 9, eos = 10, del =11, stat no = 12, + result const = 13, (* F3/rr *) + user fn = 20; (* DEF/mo *) + +LET (* S y m b o l z e i c h e n *) + plus = 43, minus = 45, mult = 42, + div = 47, backslash = 92, exponent = 94, + equal = 61, semicolon = 59, comma = 44, + numbersign = 35, open bracket = 40, close bracket = 41, + eol = 13, eop = 14, mod op = 249; + +LET (* Reservierte Worte *) + as s = 129, base s = 132, call s = 133, chain s = 135, + clear s = 138, close s = 139, common s = 140, data s = 144, + def s = 145, defdbl s = 146, defint s = 147, defsng s = 148, + defstr s = 149, dim s = 150, else s = 151, end s = 152, + eof s = 153, error s = 156, field s = 158, for s = 160, + get s = 162, gosub s = 164, goto s = 165, if s = 167, (* F2/rr *) + input s = 169, kill s = 173, let s = 176, line in s = 177, + lprint s = 180, lset s = 181, mid s = 182, name s = 185, + next s = 186, on s = 188, open s = 189, option s = 190, + print s = 193, put s = 194, rand s = 195, read s = 196, + rem s = 197, restore s = 198, resume s = 199, return s = 200, + rset s = 203, step s = 209, stop s = 210, swap s = 213, + tab s = 214, then s = 216, to s = 217, troff s = 218, + tron s = 219, using s = 220, wait s = 222, wend s = 223, + while s = 224, width s = 225, write s = 226, not = 250, + cls s = 227, usr = 234, sub = 235; (* mo *) + +LET nil = "", + intern error = 51; + +LET SYMBOL = STRUCT (TEXT name, INT no, type, ADDRESS adr, DTYPE data); +ADDRESS CONST niladr :: LOC -4; +SYMBOL CONST nilsymbol :: SYMBOL : (nil, any, any, nil adr, void type); +SYMBOL VAR symb; +BOOL VAR found; +OPN VAR opn; + +TEXT OP NAME (SYMBOL CONST val): + IF val.type = const + THEN constant value + ELIF val.type = stat no + THEN text (val.no) + ELSE val.name FI . + +constant value: + IF val.data = int type AND length (val.name) = 2 + THEN text (val.name ISUB 1) + ELIF val.data = real type AND length (val.name) = 8 + THEN text (val.name RSUB 1) + ELSE val.name FI . + +END OP NAME; + +PROC careful error (INT CONST no, TEXT CONST name, addition): (* DEF/mo *) + IF at end of statement + THEN basic error (no, name, addition) + ELSE basic error without leaving statement + FI. + +at end of statement: + symb.type = eos. + +basic error without leaving statement: + basic error (no, name, addition, FALSE); + error no INCR 1. + +END PROC careful error; + +(* P r e c o m p i l e r *) +PROC next symbol: + symb.adr := niladr; + next symbol (symb.name, symb.no, symb.type, symb.data); + + IF symb.no = end symbol AND symb.type = res word + THEN symb.no := -symb.no; + symb.type := eos; + FI +END PROC next symbol; + +PROC skip (INT CONST symbol, type): + IF symb.type = type AND symb.no = symbol + THEN next symbol + ELSE basic error (2, NAME symb, name of (symbol) + " erwartet") FI . +END PROC skip; + +PROC get letter (SYMBOL VAR symbol): + IF symb.type = var AND (LENGTH symb.name) = 1 + THEN symbol := symb; + next symbol + ELSE basic error (2, NAME symb, "Buchstabe erwartet, " + type of (symb.type) + " gefunden") FI . + +END PROC get letter; + +PROC get var (SYMBOL VAR symbol): + IF symb.type = var + THEN variable (symbol) + ELIF symb.type = array + THEN array var (symbol) + ELSE basic error (2, NAME symb, "Variable erwartet, " + type of (symb.type) + " gefunden") FI . + +END PROC get var; + +PROC get expr (SYMBOL VAR symbol): + get expression (symbol, 0) +END PROC get expr; + +PROC get const (SYMBOL VAR symbol, DTYPE CONST data): + IF symb.type = const + THEN symbol := symb; + declare const (symbol, data); (* F3/rr *) + next symbol + ELSE basic error (2, NAME symb, "Konstante erwartet, " + type of (symb.type) + " gefunden") FI . + +END PROC get const; + +PROC get var (SYMBOL VAR symbol, DTYPE CONST data): + get var (symbol); + convert (symbol, data) +END PROC get var; + +PROC get expr (SYMBOL VAR symbol, DTYPE CONST data): + get expression (symbol, 0); + convert (symbol, data) +END PROC get expr; + +PROC get expression (SYMBOL VAR result, INT CONST last prio): + get single result; + WHILE symb.type = operator AND higher priority + REP get dyadic operand; + gen dyadic operation + PER . + +get single result: + INT VAR prio; + SELECT symb.type OF + CASE var: variable (result) + CASE array: array var (result) + CASE const: get const + CASE operator: get monadic operator + CASE res word: basic function (result) + CASE user fn: user function (result) (* DEF/mo *) + OTHERWISE get bracket END SELECT . + +get const: + result := symb; + declare const (result, result. data); (* F3/rr *) + next symbol . + +get monadic operator: + get operator; + prio := monadic op prio; (* mo *) + get monadic operand; + generate monadic operator . + +monadic op prio: (* mo *) + IF op no = not + THEN 6 + ELSE 12 + FI. + +get monadic operand: + SYMBOL VAR operand; + next symbol; + get expression (operand, prio). + +generate monadic operator: +(* Mögliche Ops: +, - und NOT *) + parameter (1, operand.data, const, operand.adr); + parameter (2, operand.data, var, next local adr (operand.data)); + parameter (3, void type, const, nil adr); + + IF op no = plus + THEN result := operand + ELIF op no = minus + THEN generate minus op + ELIF op no = not + THEN generate not op + ELSE basic error (2, op name, "Kein monadischer Operator") FI . + +generate minus op: + IF operand.data = int type + THEN apply (1, 2, int minus) + ELIF operand.data = real type + THEN apply (1, 2, real minus) + ELSE basic error (82, op name, NAME operand + " : " + dump (operand.data)) FI; + result := SYMBOL:(op name, 0, result const, local adr, operand.data) . + +generate not op: + IF operand.data = int type + THEN apply (1, 1, int not opn) + ELIF operand.data = real type + THEN apply (1, 1, real not opn) + ELSE basic error (82, op name, NAME operand + " : " + dump (operand.data)) FI; + result := SYMBOL:(op name, 0, result const, local adr, operand.data) . + +get operator: + INT CONST op no :: symb.no; + TEXT CONST op name :: symb.name . + +higher priority: + get operator; + prio := dyadic op prio; + prio > last prio . + +dyadic op prio: + IF is bool op (op no) THEN bool op prio + ELIF op no = plus OR op no = minus THEN 8 + ELIF op no = mod op THEN 9 + ELIF op no = backslash THEN 10 + ELIF op no = mult OR op no = div THEN 11 + ELIF op no = exponent THEN 13 + ELSE (* relational operator *) 7 + FI. + +bool op prio: + 256 - op no. + +get bracket: + IF symb.type = del AND symb.no = open bracket + THEN next symbol + ELSE basic error (22, NAME symb, "") FI; + get expression (result, 0); + skip (close bracket, del) . + +get dyadic operand: + next symbol; + get expression (operand, prio) . + +gen dyadic operation: + convert operands; + identify dyadic operator; + generate dyadic operator . + +convert operands: + DTYPE CONST op type :: type of operation; + convert (result, op type); + convert (operand, op type) . + +type of operation: + IF is bool op (op no) + THEN int type + ELIF result.data = operand.data + THEN result.data + ELSE real type FI . + +identify dyadic operator: + BOOL VAR local found; + OPN VAR local opn; + DTYPE VAR data; + parameter (1, result.data, const, result.adr); + parameter (2, operand.data, const, operand.adr); + identify (op no, 1, 2, local opn, local found); + IF NOT local found + THEN basic error (83, symbol of (op no), + NAME result + " : " + dump (result.data) + " und " + + NAME operand + " : " + dump (operand.data)) + ELSE data := dtype (3) FI . + +generate dyadic operator: + declare (3, var); + define (3, next local adr (data)); + apply (3, push); + apply (1, 2, local opn); + result := SYMBOL:(op name, 0, result const, local adr, data) . + +END PROC get expression; + +PROC variable (SYMBOL VAR symbol): + symbol := symb; + next symbol; + IF known (symbol.no) + THEN get adr from table + ELSE declare var (symbol, nil) FI . + +get adr from table: + TEXT VAR defined dim; + remember (symbol.no, symbol.type, symbol.adr, symbol.data, defined dim) . + +END PROC variable; + +PROC array var (SYMBOL VAR symbol field): +(* Aufbau der Dimensionsangaben in der Symboltabelle *) +(* limit 1 [limit 2]... Basis Elemente *) +(* jeweils als 2 Byte Integer/Text *) +(* Die Dimension ist dann DIM/2-2 *) + ROW 100 SYMBOL VAR indizes; + TEXT VAR limits; + INT VAR dim; + + symbol field := symb; next symbol; + get paramfield (indizes, dim, int type); + + IF known (symbol field.no) + THEN check field dim and data + ELSE declare new field FI; + generate field index . + +check field dim and data: + INT VAR type; + DTYPE VAR data; + remember (symbol field.no, type, symbol field.adr, data, limits); + + IF old dim <> dim + THEN basic error (84, symbol field.name, "Dimensioniert in " + text (old dim) + " Dimensionen, gefundene Anzahl Indizes: " + text (dim)) + ELIF NOT (symbol field.data = data) + THEN basic error (intern error, symbol field.name, dump (data) + " <=> " + dump (symbol field.data)) + ELIF NOT (symbol field.type = type) + THEN basic error (intern error, symbol field.name, "Feld erwartet, " + type of (type) + " gefunden") FI . + +old dim: (length (limits) DIV 2) - 2 . + +declare new field: + limits := dim * ""10""0"" + mki (array base) + + mki ((10 - array base + 1)**dim); + declare var (symbol field, limits) . + +generate field index: + init field subscription; + FOR j FROM 1 UPTO dim + REP increase field index; + calc index length and limit; + calculate field pointer; + symbol field.adr := REF pointer + PER . + +init field subscription: + ADDRESS VAR pointer :: next local adr (row type), + index adr :: next local adr (int type); + INT VAR j, elem length :: (limits ISUB (dim+2)) * typesize (symbol field.data), + elem limit, + elem offset :: 1 - (limits ISUB (dim+1)); + BOOL CONST base zero := elem offset = 1 . + +increase field index: + IF base zero + THEN parameter (1, int type, const, index.adr); + parameter (2, int type, const, one value); + parameter (3, int type, var, index adr); + parameter (4, void type, const, nil adr); + apply (1, 3, int add); + ELSE index adr := index.adr FI . + +index: indizes [j] . + +calc index length and limit: + elem limit := (limits ISUB j) + elem offset; + elem length := elem length DIV elem limit . + +calculate field pointer: + parameter (1, int type, const, symbol field.adr); + parameter (2, int type, const, index adr); + parameter (3, int type, elem length); + parameter (4, int type, elem limit); + parameter (5, int type, const, pointer); + parameter (6, void type, const, nil adr); + apply (1, 5, subscript); + +END PROC array var; + +PROC get paramfield (ROW 100 SYMBOL VAR params list, INT VAR no): + skip (open bracket, del); + FOR no FROM 1 UPTO 100 + REP get expression (params list [no], 0); + IF symb.type = del AND symb.no = close bracket + THEN next symbol; + LEAVE get paramfield + ELSE skip (comma, del) FI + PER . + +END PROC get paramfield; + +PROC get paramfield (ROW 100 SYMBOL VAR params list, INT VAR no, DTYPE CONST data): + skip (open bracket, del); + FOR no FROM 1 UPTO 100 + REP get expression (params list [no], 0); + convert (params list [no], data); + IF symb.type = del AND symb.no = close bracket + THEN next symbol; + LEAVE get paramfield + ELSE skip (comma, del) FI + PER . + +END PROC get paramfield; + +PROC examine access rights (ROW 100 SYMBOL VAR params list, INT CONST no): + + INT VAR j; + FOR j FROM 1 UPTO no REP + IF params list [j].type = const OR params list [j].type = result const + THEN IF access (j) = 2 + THEN basic error (103, NAME params list [j], "im " + text (j) + + ". Eintrag der Parameterliste") + FI + FI + PER + +END PROC examine access rights; + +PROC basic function (SYMBOL VAR ftn): (* Änd. 11.08.87, mo *) + init and check function; + IF symb.type = del AND symb.no = open bracket + THEN get paramfield (params list, number params); + FI; + apply function . + +init and check function: + ROW 100 SYMBOL VAR params list; + INT VAR number params :: 0; + BOOL CONST is usr :: symb.no = usr; + IF is usr + THEN check proc name + FI; + ftn := symb; + next symbol . + +check proc name: + next symbol; + IF symb.type = array + THEN symb.name := subtext (symb.name, 1, LENGTH symb.name-2) + ELIF symb.type <> var + THEN basic error (2, NAME symb, "Prozedurname erwartet") + FI. + +apply function: + OPN VAR ftn local opn; + BOOL VAR ftn found; + INT CONST result :: number params+1; + + INT VAR j; + FOR j FROM 1 UPTO number params + REP parameter (j, params list [j].data, const, params list [j].adr) PER; + IF is usr + THEN identify proc; + examine access rights (params list, number params); + ELSE identify function + FI; + + ftn.adr := next local adr (ftn.data); + + declare (result, var); + define (result, ftn.adr); + apply (result, push); + apply (1, number params, ftn local opn). + +identify proc: + identify (deshift (ftn.name), 1, number params, ftn local opn, ftn found); + ftn.data := dtype (result); + IF NOT ftn found + THEN basic error (99, ftn.name, "Parameter angegeben: " + param list (1, number params)) + ELIF ftn.data = void type + THEN basic error (5, ftn.name, "Die Prozedur liefert keinen Wert") + ELIF NOT (ftn.data = int type) AND NOT (ftn.data = real type) AND NOT (ftn.data = text type) + THEN basic error (5, ftn.name, "Der Typ des Resultats ist nicht erlaubt, gefunden: " + + dump (dtype (result))) + FI. + +identify function: + identify (ftn.no, 1, number params, ftn local opn, ftn found); + IF ftn found + THEN ftn.data := dtype (result) + ELIF is basic function (ftn.no) + THEN basic error (98, ftn.name, "Argument(e) angegeben: " + param list (1, number params)) + ELSE basic error (22, ftn.name, "Anweisung(sbestandteil) gefunden") + FI. + +END PROC basic function; + +PROC user function (SYMBOL VAR result): (* DEF/mo *) + check if function defined; + get arguments if expected; + gosub (user function label); + copy result. + +check if function defined: + TEXT CONST scope :: name of (symb.no) + "?"; + IF NOT known (symb.no) + THEN basic error (18, symb.name, "") + ELIF scanner scope = scope + THEN basic error (85, symb.name, "") + FI. + +get arguments if expected: + INT VAR param counter; + TEXT VAR dim text; + result := symb; + remember (symb.no, symb.type, result.adr, result.data, dim text); + INT VAR number of params :: LENGTH dim text DIV 2 - 1; + next symbol; + IF number of params > 0 + THEN get all arguments + ELIF symb.no = open bracket AND symb.type = del + THEN basic error (5, symb.name, "Kein Argument erwartet") + FI. + +get all arguments: + IF symb.no <> open bracket OR symb.type <> del + THEN basic error (5, NAME symb, text (number of params) + " Argument(e) erwartet") + FI; + next symbol; + FOR param counter FROM 2 UPTO number of params REP + get one argument; + skip comma; + PER; + get one argument; + skip close bracket. + +get one argument: + SYMBOL VAR ftn param; + ftn param.no := dim text ISUB param counter; + remember (ftn param.no, ftn param.type, ftn param.adr, ftn param.data, ftn param.name); + IF ftn param.type <> var + THEN basic error (intern error, name of (ftn param.no), "Parametereintrag fehlerhaft") + FI; + SYMBOL VAR expr res; + get expr (expr res, ftn param.data); + apply move (ftn param.adr, expr res.adr, ftn param.data). + +skip comma: + IF symb.no = close bracket AND symb.type = del + THEN basic error (5, symb.name, text (number of params) + " Argumente erwartet") + ELIF symb.no <> comma OR symb.type <> del + THEN basic error (2, NAME symb, " , in Argumentenliste erwartet") + FI; + next symbol. + +skip close bracket: + IF symb.no = comma AND symb.type = del + THEN basic error (5, symb.name, "Nur " + text (number of params) + " Argument(e) erwartet") + ELIF symb.no <> close bracket OR symb.type <> del + THEN basic error (2, NAME symb, " ) nach Argumentenliste erwartet") + FI; + next symbol. + +user function label: + label list [dim text ISUB 1]. + +copy result : + apply move (next local adr (result.data), result.adr, result.data); + result.adr := local adr. + +END PROC user function; + +PROC apply move (ADDRESS CONST dest adr, source adr, DTYPE CONST datype): + parameter (1, datype, var, dest adr); + parameter (2, datype, const, source adr); + parameter (3, void type, const, nil adr); + + IF datype = int type + THEN apply (1, 2, int move) + ELIF datype = real type + THEN apply (1, 2, real move) + ELIF datype = text type + THEN apply (1, 2, text move) + ELSE basic error (2, "=", "Unbekannter Datentyp: " + dump (datype)) FI . + +END PROC apply move; + +PROC convert (SYMBOL VAR symbol, DTYPE CONST to data): (* F3/rr *) + IF to data = from data + THEN + ELIF symbol.type = const + THEN declare const (symbol, to data) + ELIF to data = int type + THEN make int + ELIF to data = real type + THEN make real + ELSE basic error (13, NAME symbol, dump (to data) + " erwartet, " + dump (from data) + " gefunden") FI . + +from data : symbol.data . + +make real : + IF symbol.data = int type + THEN parameter (1, symbol.data, const, symbol.adr); + parameter (2, real type, var, next local adr (real type)); + parameter (3, void type, const, nil adr); + apply (1, 1, int to real); + symbol.adr := local adr; + symbol.data := real type + ELSE basic error (13, NAME symbol, dump (to data) + " erwartet, " + dump (from data) + " gefunden") FI . + +make int : + IF symbol.data = real type + THEN parameter (1, symbol.data, const, symbol.adr); + parameter (2, int type, var, next local adr (int type)); + parameter (3, void type, const, nil adr); + apply (1, 1, real to int); + symbol.adr := local adr; + symbol.data := int type + ELSE basic error (13, NAME symbol, dump (to data) + " erwartet, " + dump (from data) + " gefunden") FI . + +END PROC convert; + +PROC declare const (SYMBOL VAR symbol constant, DTYPE CONST data): + convert symb value; + IF new constant + THEN declare this constant + ELSE get table entry FI . + +convert symb value: + IF data = symbol constant.data + THEN LEAVE convert symb value + ELIF data = int type AND symbol constant.data = real type + THEN symbol constant.name := mki (symbol constant.name RSUB 1); + ELIF data = real type AND symbol constant.data = int type + THEN symbol constant.name := mkd (symbol constant.name ISUB 1); + ELIF data = text type AND symbol constant.data = int type + THEN symbol constant.name := text (symbol constant.name ISUB 1) + ELIF data = text type AND symbol constant.data = real type + THEN symbol constant.name := text (symbol constant.name RSUB 1) + ELSE basic error (13, NAME symbol constant, dump (data) + " erwartet, " + + dump (symbol constant.data) + " gefunden") FI; + symbol constant.data := data . + +new constant: +(* Konstanten werden wie folgt abgelegt: *) +(* INT: § HL *) +(* REAL: § MMMMMMME *) +(* TEXT: § Text *) + put name ("§ " + symbol constant.name, symbol constant.no); + NOT known (symbol constant.no) . + +declare this constant: + IF data = int type + THEN allocate denoter (symbol constant.adr, symbol constant.name ISUB 1) + ELIF data = real type + THEN allocate denoter (symbol constant.adr, symbol constant.name RSUB 1) + ELIF data = text type + THEN allocate denoter (symbol constant.adr, symbol constant.name) FI; + recognize (symbol constant.no, const, symbol constant.adr, data, nil) . + +get table entry: + INT VAR table type; + TEXT VAR table dim; + remember (symbol constant.no, table type, symbol constant.adr, symbol constant.data, table dim); + IF table dim <> nil + THEN basic error (intern error, NAME symbol constant, "Dimension in Tabelle ungleich niltext") + ELIF NOT (symbol constant.data = data) + THEN basic error (intern error, NAME symbol constant, "Falscher DTYPE in Tabelle, erw: " + dump (data) + + ", gef: " + dump (symbol constant.data)) FI . + +END PROC declare const; + +PROC declare var (SYMBOL VAR symbol var, TEXT CONST dim): (* F4/rr *) + allocate variable; + recognize (symbol var.no, symbol var.type, symbol var.adr, symbol var.data, dim) . + +allocate variable : + symbol var.adr := next local adr (symbol var.data); + IF dim <> nil + THEN INT VAR index; + ADDRESS VAR dummy; + FOR index FROM 2 UPTO no of elements + REP dummy := next local adr (symbol var.data) PER; + FI . + +no of elements: + (dim ISUB (LENGTH dim DIV 2)) . +END PROC declare var; + +PROC parameter (INT CONST p, DTYPE CONST d type, INT CONST value): + declare (p, d type); + declare (p, denoter); + define (p, value); +END PROC parameter; + +PROC apply (INT CONST first, number params, TEXT CONST name): + identify (name, first, number params, opn, found); + IF NOT found + THEN errorstop (1051, "PROC " + name + ", Parameter: " + param list (first, number params) + ", nicht gefunden!") FI; + apply (first, number params, opn) + +END PROC apply; + +PROC clear local stack : (* F4/rr *) + + define local variables; + clear index; + define (rep); index incr one; + if local storage less or equal index then goto end; + get cell address; + clear cell; + apply (rep); + define (end); + clear cell address; + + . define local variables : + LABEL VAR rep, end; + ADDRESS VAR index; + declare (rep); declare (end); + allocate variable (index, type size (int type)); + + . clear index : + parameter (1, int type, var, index); + apply (1, 1, clear); + + . index incr one : + parameter (1, int type, var, index); + apply (1, 1, incone); + + . if local storage less or equal index then goto end : + parameter (1, int type, const, loc storage); + parameter (2, int type, const, index); + apply (1, 2, lsequ); + apply (end, TRUE); + + . get cell address : + parameter (1, int type, const, LOC 2); + parameter (2, int type, const, index); + parameter (3, int type, 1); + parameter (4, int type, 16000); + parameter (5, int type, const, LOC 0); + apply (1, 5, subscript); + + . clear cell : + parameter (1, int type, var, REF LOC 0); + apply (1, 1, clear); + + . clear cell address : + parameter (1, int type, var, LOC 0); + apply (1, 1, clear); + parameter (1, int type, var, LOC 1); + apply (1, 1, clear); + +END PROC clear local stack; + +(* M a i n *) +(* ̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃ *) +(* C o m p i l e r *) +(* ***** G l o b a l e V a r i a b l en ***** *) +INT VAR end symbol :: 0, error no :: 0, act stat no :: 0, array base :: 0; +BOOL VAR basic trace, was warning; +ADDRESS VAR data pos, data text; + + +(* Globale Operationen *) +OPN VAR basic init, basic frame, basic module, ret, equal op, + int minus, real minus, int not opn, real not opn, + trace op, ln op, push, + int incr, real incr, int add, + int move, real move, text move, test, + real to int, int to real, subscript, + clear, incone, lsequ, (* F4/rr *) + basic out text; + +(* Parameter VOID *) + init ("RTN", 1, 0, ret); + +(* Parameter INT *) + declare (1, int type); + init ("intnot", 1, 1, int not opn); (* mo *) + init ("PP", 1, 1, push); + init ("LN", 1, 1, ln op); + init ("real", 1, 1, int to real); + init ("TEST", 1, 1, test); + init ("CLEAR", 1, 1, clear); + init ("INCONE", 1, 1, incone); + init ("trace", 1, 1, trace op); + +(* Parameter INT INT *) + declare (2, int type); + init ("COMPLINT", 1, 2, int minus); + init ("MOVE", 1, 2, int move); + init ("INC", 1, 2, int incr); + init ("EQU", 1, 2, equal op); + init ("LSEQU", 1, 2, lsequ); + +(* Parameter INT INT INT *) + declare (3, int type); + init ("ADD", 1, 3, int add); + +(* Paramter REAL *) + declare (1, real type); + init ("realnot", 1, 1, real not opn); (* mo *) + init ("cint", 1, 1, real to int); + +(* Parameter REAL REAL *) + declare (2, real type); + init ("COMPLREAL", 1, 2, real minus); + init ("FMOVE", 1, 2, real move); + init ("INCR", 1, 2, real incr); + +(* Parameter TEXT *) + declare (1, text type); + init ("basicout", 1, 1, basic out text); + +(* Paramter TEXT TEXT *) + declare (2, text type); + init ("TMOVE", 1, 2, text move); + +(* Parameter ADDRESS INT DENOTER DENOTER ADDRESS *) + declare (3, denoter); + declare (4, denoter); + init ("SUBSCRIPT", 1, 5, subscript); + +PROC init (TEXT CONST name, INT CONST local from, number params, OPN VAR local opn): + identify (name, local from, number params, local opn, found); + IF NOT found + THEN errorstop (1051, "PROC init (TC, IC, IC, OPN VAR): OPN für """ + name + """ nicht gefunden") FI +END PROC init; + +(* Runtime Konstanten *) + ADDRESS VAR true value, false value, niltext value, + zero value, one value, two value, three value, + comma value, int one value, real one value, + loc storage; (* F4/rr *) + +(* +++++ Globale Variablen +++++ *) + BOOL VAR proc found; + INT VAR deftype, field elems, i, params; + ROW 100 SYMBOL VAR param; + SYMBOL VAR base size, begin range, end range, expr result, field, filename, + from, len, image, label, old name, new name, + question, size, tab pos, var result; + TEXT VAR constant, field size, proc name; + +(* Label-Verwaltung *) +LET label list size = 4100; +BOUND ROW label list size LABEL VAR label list; +DATASPACE VAR label ds; +INITFLAG VAR label init :: FALSE; +INT VAR last label no; + +(* ***** I n t e r f a c e P r o z d u r e n ***** *) +PROC basic: + basic (last param) +END PROC basic; + +PROC basic (TEXT CONST basic file name): + basic (basic file name, nil) +END PROC basic; + +PROC basic (TEXT CONST basic file name, prog name): + IF NOT exists (basic file name) + THEN errorstop ("""" + basic file name + """ gibt es nicht") + ELSE FILE VAR basic file :: sequential file (modify, basic file name); (* F5/rr *) + headline (basic file, basic file name); + last param (basic file name); + basic (basic file, prog name) + FI; + +END PROC basic; + +PROC basic (FILE VAR source file, TEXT CONST prog name): + IF prog name <> nil CAND prog name is not a tag (* F5/rr *) + THEN errorstop ("unzulässiger Programmname : """ + prog name + """"); + FI; + modify (source file); (* F5/rr *) + disable stop; + init label table; + store status; + coder on (data allocation by coder); + compile (source file, progname); + restore status; + start basic prog . + +prog name is not a tag : (* F5/rr *) + LET tag = 1; + INT VAR symbol type; + TEXT VAR symbol name; + scan (prog name); + next symbol (symbol name, symbol type); + symbol name <> prog name OR symbol type <> tag . + +init label table: + IF NOT initialized (label init) + THEN label ds := nilspace; + label list := label ds; + FI . + +store status: + INT CONST source line :: line no (source file), + source col :: col (source file); + BOOL CONST check status :: check; + check on . + +restore status: + to line (source file, source line); + col (source file, source col); + IF NOT check status + THEN check off FI . + +start basic prog: + IF error no > 0 OR is error + THEN basic error end + ELSE normal end + FI; + close (source file) . + +basic error end: + coder off (FALSE, FALSE, nop); + IF is error + THEN put error; + clear error + ELSE display (""13""10""10""); (* F20/rr *) + display (text (error no) + compiler err msg); + display (""13""10""10""); + display (compiler msg); + display (""13""10""); + IF sysout <> "" + THEN line (2); + put (text (error no) + compiler err msg); + line (2); + put (compiler msg); + line + FI + FI; + show file and error . + +show file and error: (* F20/rr *) + IF anything noted CAND command dialogue + THEN noteedit (source file); + FI; + errorstop (nil) . + +normal end: + IF prog name = nil + THEN run basic proc + ELSE insert basic proc FI; + IF warnings AND was warning + THEN show file and error + FI. + +run basic proc: + coder off (FALSE, TRUE, basic frame); + display (""13""10"") . + +insert basic proc: + coder off (TRUE, TRUE, basic frame); + coder on (data allocation by coder); + coder off (FALSE, FALSE, basic init); + display (""13""10"") . + +END PROC basic; + +PROC compile (FILE VAR source file, TEXT CONST progname): + enable stop; + init compiler; + init basic prog; + + begin scanning (source file); + next symbol; + get statement group (eop); + end compiling . + +init compiler: + end symbol := 0; + error no := 0; + act stat no := 0; + array base := 0; + basic trace := FALSE; + was warning := FALSE; + + init storage; + init label; + init data; + init table . + +init label: + TEXT VAR local stat no; + INT VAR stat nos; + init stat no (source file, error no); (* F21/rr *) + IF error no > 0 THEN LEAVE compile FI; + all stat no (local stat no, stat nos); + FOR i FROM 1 UPTO stat nos + REP declare (label list [i]) PER; + last label no := stat nos. (* DEF/mo *) + +init basic prog: + LIB VAR packet; + declare (basic packet name, packet); + define (packet); + parameter (1, void type, const, nil adr); + declare (basic init); + IF progname = nil + THEN declare (basic frame) + ELSE declare (progname, 1, 0, basic frame) FI; + declare (basic module); + declare runtime const; + declare basic init; + declare basic frame; + declare basic module . + +basic packet name: + IF progname <> "" + THEN "BASIC." + progname + ELSE "BASIC" + FI. + +declare runtime const: + allocate variable (data text, type size (text type)); + allocate variable (data pos, type size (int type)); + allocate variable (loc storage, type size (int type)); (* F4/rr *) + + allocate denoter (true value, 0); + allocate denoter (false value, -1); + allocate denoter (niltext value, nil); + allocate denoter (one value, 1); + allocate denoter (two value, 2); + allocate denoter (three value, 3); + allocate denoter (real one value, 1.0); + allocate denoter (comma value, ","); + + zero value := true value; + int one value := one value . + +declare basic init: + begin module; + define (basic init, 4); + parameter (1, text type, var, data text); + parameter (2, int type, var, data pos); + apply (1, 2, "initdata"); + parameter (1, void type, const, nil adr); + apply (1, 0, ret); + end module . + +declare basic frame: + begin module; + define (basic frame, 4); + + IF prog name = nil + THEN parameter (1, void type, const, nil adr); + apply (1, 0, basic init); + FI; + + declare (1, int type); + declare (1, const); + define (1, 0); + parameter (2, void type, const, nil adr); + apply (1, 1, ln op); + + apply (1, 0, "disablestop"); + apply (1, 0, "startbasic"); + + parameter (1, int type, var, data pos); + parameter (2, int type, const, one value); + parameter (3, void type, const, nil adr); + apply (1, 2, int move); + + parameter (1, void type, const, nil adr); + apply (1, 0, basic module); + apply (1, 0, "endbasic"); + parameter (1, void type, const, nil adr); + apply (1, 0, ret); + end module . + +declare basic module: + LABEL VAR start lab; + begin module; + define (basic module); + declare (start lab); + apply (1, 0, "enablestop"); + gosub (start lab); + parameter (1, void type, const, nil adr); + apply (1, 0, "returnerror"); (* mo *) + define (start lab); + clear local stack . (* F4/rr *) + +end compiling: + parameter (1, void type, const, nil adr); + apply (1, 0, ret); + define (loc storage, local storage - 1); (* F4/rr *) + set length of local storage (basic module, max (2, local storage)); (* F4/rr *) + IF error no = 0 + THEN end module FI . + +END PROC compile; + +PROC get statement group (INT CONST new symbol): +(* 'get statement group' compiliert das ganze Programm bis zum Auftreten *) +(* von 'end symbol' *) + disable stop; + new end symbol; + get all basic lines; + old end symbol . + +new end symbol: + INT CONST old symbol :: end symbol; + end symbol := new symbol . + +old end symbol: + end symbol := old symbol . + +get all basic lines: + REP get basic line; + + IF is error + THEN error handling + ELIF symb.type = eos + THEN check this eos FI + PER . + +error handling: (* F20/rr *) + IF error in basic program + THEN error no INCR 1 + ELIF end of source file + THEN clear error; + LEAVE get all basic lines + ELIF halt from terminal + THEN LEAVE get statement group + ELSE error no INCR 1; + handle internal error; + LEAVE get statement group + FI; + clear error; + scope compulsory (TRUE); (* DEF/mo *) + set scope (""); (* DEF/mo *) + next statement; + next symbol . + +error in basic program: + errorcode = 101. + +end of source file: + errorcode = 99. + +halt from terminal: + errorcode = 1. + +handle internal error : (* F20/rr *) + TEXT VAR error :: "BASIC-Compiler ERROR"; + IF errorcode <> 0 + THEN error CAT " #" + text (errorcode) FI; + IF errorline > 0 + THEN error CAT " at " + text (errorline) FI; + error CAT " : "; + error CAT errormessage; + IF sysout <> "" THEN putline (error) FI; + note (error); + noteline; + clear error; + errorstop (error). + +check this eos: + IF symb.no = eol + THEN next symbol + ELIF symb.no = -new symbol OR symb.no = eop + THEN LEAVE get all basic lines (* mo *) + ELSE basic error (intern error, NAME symb, "EOL erwartet, " + + type of (symb.type) + " gefunden") + FI . + +END PROC get statement group; + +PROC get basic line (INT CONST new symbol): +(*Die Abbruchbedingungen werden neu gesetzt und bei Verlassen der *) +(*Prozedur zurückgesetzt. *) + disable stop; + INT CONST old symbol :: end symbol; + end symbol := new symbol; + get basic line; + end symbol := old symbol . + +END PROC get basic line; + +PROC get basic line: +(* 'get basic line' behandelt genau eine Zeile mit Zeilennummer. *) + enable stop; + IF symb.type = stat no + THEN gen stat no (symb.no) FI; + + REP get one basic statement PER . + +get one basic statement: +(* 'get one basic statement' behandelt genau ein Statement. *) + IF symb.type = eos + THEN get end of statement + ELIF symb.type = res word OR symb.type = var OR symb.type = array + THEN get one statement + ELSE basic error (2, NAME symb, type of (symb.type) + " ohne Zusammenhang") FI . + +get end of statement: + IF symb.no = eos + THEN next symbol + ELSE LEAVE get basic line FI . + +get one statement: + IF symb.type = res word + THEN get res word statement + ELIF symb.type = var OR symb.type = array + THEN let statement + FI; + skip comma if else expected; + IF symb.type <> eos + THEN basic error (2, NAME symb, "EOS erwartet, " + type of (symb.type) + " gefunden") + FI. + +skip comma if else expected: + IF end symbol = else s AND symb.type = del AND symb.no = comma + THEN next symbol; + IF symb.type <> eos OR symb.no <> -else s + THEN basic error (2, NAME symb, "ELSE erwartet") + FI + FI. + +get res word statement: + SELECT symb.no OF + CASE as s : basic error (90, symb.name, "") + CASE base s : basic error (91, symb.name, "") + CASE call s, + chain s : call statement + CASE clear s : not implemented + CASE close s : not implemented + CASE cls s : cls statement (* mo *) + CASE common s : not implemented + CASE data s : data statement + CASE def s : def statement (* mo *) + CASE defint s, + defdbl s, + defsng s, + defstr s : def type statement + CASE dim s : dim statement + CASE else s : basic error (92, symb.name, "") + CASE end s : end statement + CASE error s : error statement + CASE field s : not implemented + CASE for s : for statement + CASE get s : not implemented + CASE gosub s : gosub statement + CASE goto s : goto statement + CASE if s : if statement + CASE input s : input statement + CASE kill s : kill statement + CASE let s : let statement + CASE line in s: line statement + CASE lprint s : lprint statement (* mo *) + CASE l set s : l set statement + CASE mid s : mid statement + CASE name s : name statement + CASE next s : basic error (1, symb.name, "") + CASE on s : on statement + CASE open s : not implemented + CASE option s : option statement + CASE print s : print statement + CASE put s : not implemented + CASE rand s : randomize statement + CASE read s : read statement + CASE rem s : rem statement + CASE restore s: restore statement + CASE resume s : not implemented + CASE return s : return statement + CASE r set s : r set statement + CASE step s : basic error (93, symb.name, "") + CASE stop s : stop statement + CASE sub : basic error (101, symb.name, "") + CASE swap s : swap statement + CASE tab s : basic error (94, symb.name, "") + CASE then s : basic error (95, symb.name, "") + CASE to s : basic error (96, symb.name, "") + CASE troff s : troff statement + CASE tron s : tron statement + CASE using s : basic error (97, symb.name, "") + CASE wait s : not implemented + CASE wend s : basic error (30, symb.name, "") + CASE while s : while statement + CASE width s : width statement + CASE write s : write statement + OTHERWISE basic error (104, symb.name, "") END SELECT. + +not implemented: + basic error (100, symb.name, ""). + +call statement: +(*CALL [()] *) + next symbol; + get proc name; + get proc parameter; + apply proc . + +get proc name: + proc name := symb.name; + IF symb.type = array + THEN proc name := subtext (proc name, 1, LENGTH proc name-2) FI; + next symbol . + +get proc parameter: + params := 0; + IF symb.type = del AND symb.no = open bracket + THEN get paramfield (param, params) FI . + +apply proc: + OPN VAR proc opn; + FOR i FROM 1 UPTO params + REP parameter (i, param [i].data, const, param [i].adr) PER; + identify (deshift (proc name), 1, params, proc opn, proc found); + + IF NOT proc found + THEN basic error (99, proc name, "Parameter angegeben: " + param list (1, params)) + ELIF result found + THEN basic error (5, proc name, "Kein Resultat erlaubt (gefunden: " + dump (result data) + ")") + FI; + + examine access rights (param, params); + + parameter (params+1, void type, const, nil adr); + apply (1, params, proc opn) . + +result found: + NOT (result data = void type) . + +result data: + dtype (params+1) . + +cls statement: +(*CLS *) + next symbol; + apply (1, 0, "nextpage"). + +data statement: +(*DATA *) + DTYPE VAR const data; + data line (act stat no); + REP IF next data (constant, const data) + THEN data (constant, const data) + ELSE basic error (2, "EOL", "Daten fehlen !") FI; + + next symbol; + IF symb.type = eos + THEN LEAVE data statement + ELIF symb.type <> del OR symb.no <> comma + THEN basic error (2, NAME symb, " , erwartet") FI + PER . + +def statement: (* DEF/mo *) +(*DEF FN [(parameter list)] = *) + get function name; + store label of function; + get all params; + get function definition. + +get function name: + next symbol; + IF symb.type <> user fn + THEN treat wrong function name + ELIF LENGTH symb.name <= 2 + THEN basic error (2, symb.name, "Unerlaubter Funktionsname") + ELIF known (symb.no) + THEN basic warning ("Die Funktion """ + symb.name + """ wurde bereits definiert"); + was warning := TRUE + FI; + SYMBOL VAR function :: symb; + function.name := name of (function.no). + +treat wrong function name: + IF symb.type = var OR symb.type = array + THEN basic error (2, symb.name, "Funktionsname muß mit FN beginnen") + ELSE basic error (2, NAME symb, "Funktionsname erwartet") + FI. + +store label of function: + IF last label no < label list size + THEN last label no INCR 1 + ELSE errorstop ("Zu viele Label") + FI; + declare (label list [last label no]); + TEXT VAR dim text :: ""; + dim text CAT last label no; + recognize (function.no, user fn, niladr, function.data, dim text). + +get all params: + set scope (function.name + "?"); + next symbol; + IF symb.type = del AND symb.no = open bracket + THEN REP + try to get a param; + try to get del + UNTIL symb.no = close bracket OR + (symb.type <> del AND symb.type <> var) PER; + skip close bracket + FI. + +try to get a param: + REP + IF symb.type <> var + THEN next symbol + FI; + IF symb.type <> var + THEN careful error (2, NAME symb, "Parametervariable erwartet"); + IF symb.type <> del + THEN next symbol + FI + ELSE treat param + FI + UNTIL symb.type <> del OR symb.no = close bracket PER. + +treat param: + IF NOT known (symb.no) + THEN declare var (symb, nil); + ELIF already appeared in param list + THEN careful error (89, symb.name, ""); + FI; + dim text CAT symb.no. + +already appeared in param list: + INT VAR param counter; + FOR param counter FROM 2 UPTO LENGTH dim text DIV 2 REP + IF (dim text ISUB param counter) = symb.no + THEN LEAVE already appeared in param list WITH TRUE + FI + PER; + FALSE. + +try to get del: + IF symb.type = var + THEN next symbol + FI; + IF symb.type = var OR (symb.type = del CAND (symb.no <> comma AND symb.no <> close bracket)) + THEN careful error (2, symb.name, " , in Parameterliste erwartet") + FI. + +skip close bracket: + IF symb.type = del AND symb.no = close bracket + THEN next symbol + ELSE careful error (2, NAME symb, " ) nach Parameterliste erwartet") + FI. + +get function definition: + scope compulsory (FALSE); + skip (equal, operator); + generate forward jump; + define this label; + get expr (expr result, function.data); + recognize (function.no, user fn, expr result.adr, function.data, dim text); + goret; + define (behind); + scope compulsory (TRUE); + set scope (""). + +generate forward jump: + LABEL VAR behind; + declare (behind); + apply (behind). + +define this label: + define (label list [last label no]). + + +def type statement: +(*DEFINT/DBL/SNG/STR *) + deftype := symb.no; + next symbol; + REP get letter (begin range); + IF symb.type = operator AND symb.no = minus + THEN next symbol; + get letter (end range) + ELSE end range := begin range FI; + + IF name of (begin range.no) > name of (end range.no) + THEN basic error (87, begin range.name + "-" + end range.name, "") + ELSE define chars (name of (begin range.no), name of (end range.no), data type) FI; + + IF symb.type = eos + THEN LEAVE def type statement + ELSE skip (comma, del) FI + PER . + +data type: + SELECT deftype OF + CASE defint s: int type + CASE defstr s: text type + OTHERWISE real type ENDSELECT . + + dim statement: +(*DIM *) + next symbol; + REP get field var; + get field size; + declare field; + + IF symb.type = eos + THEN LEAVE dim statement + ELSE skip (comma, del) FI + PER . + +get field var: + IF symb.type = array + THEN IF known (symb.no) + THEN basic error (10, symb.name, "") + ELSE field := symb; + next symbol + FI + ELIF symb.type = var + THEN basic error (2, symb.name, "Dimensionsangabe fehlt") + ELSE basic error (2, NAME symb, "Feldname erwartet") + FI. + +get field size: + field size := ""; + field elems := 1; + skip (open bracket, del); + + REP get const (size, int type); + INT CONST field limit :: size.name ISUB 1; + IF field limit < array base + THEN basic error (88, NAME size, "Die Obergrenze muß >= " + + text (array base) + " sein") + ELSE field size CAT (mki (field limit)); + field elems := field elems * (field limit + 1 - array base) + FI; + + IF symb.type = del AND symb.no = close bracket + THEN next symbol; + LEAVE get field size + ELSE skip (comma, del) FI + PER . + +declare field: + field size CAT mki (array base); + field size CAT mki (field elems); + declare var (field, field size) . + +end statement: +(*END *) + next symbol; + parameter (1, void type, const, nil adr); + apply (1, 0, ret) . + +error statement: +(*ERROR *) + next symbol; + get expr (expr result, int type); + parameter (1, int type, const, expr result.adr); + parameter (2, text type, const, niltext value); + apply (1, 2, "errorstop") . + +gosub statement: +(*GOSUB *) + next symbol; + get const (label, int type); + gosub (this label) . + +goto statement : +(*GOTO *) + next symbol; + get const (label, int type); + apply (this label) . + +this label: label list [label pos (label no)] . +label no: label.name ISUB 1 . + +input statement: +(*INPUT [;]["Anfrage" ;/,] Variable [, Variable] *) + ROW 100 DTYPE VAR input var data; + INT VAR number input vars; + LABEL VAR input lab; + next symbol; + declare (input lab); + define (input lab); + get semicolon for cr lf; + get question and question mark; + apply (1, 3, "readinput"); + get input eof; + get data types of input vars (input var data, number input vars); (* F25/rr *) + check data types of input vars; (* F8/F25/rr *) + apply (1, 0, "inputok"); + apply (input lab, FALSE); + assign list of input var . (* F8/F25/rr *) + +get semicolon for cr lf: + IF symb.type = del AND symb.no = semicolon + THEN next symbol; + parameter (1, bool type, const, false value) + ELSE parameter (1, bool type, const, true value) FI . + +get question and question mark: + IF symb.type = const AND symb.data = text type + THEN get const (question, text type); + parameter (2, text type, const, question.adr); + parameter (3, bool type, const, question mark value); + next symbol + ELSE parameter (2, text type, const, niltext value); + parameter (3, bool type, const, true value); (* F7/rr *) + FI . + +question mark value: + IF symb.type = del AND symb.no = semicolon + THEN true value + ELIF symb.type = del AND symb.no = comma + THEN false value + ELSE basic error (2, NAME symb, " ; oder , erwartet"); nil adr FI . + +get input eof: + IF symb.type = res word AND symb.no = eof s + THEN next symbol; + get const (label, int type); + apply (1, 0, "inputeof"); + apply (this label, TRUE) + FI . + +check data types of input vars : (* F8/F25/rr *) + FOR i FROM 1 UPTO number input vars + REP parameter (1, int type, const, input data type); + apply (1, 1, "checkinput"); + apply (input lab, FALSE); + PER . + +input data type : (* F8/F25/rr *) + IF input var data (i) = int type THEN one value + ELIF input var data (i) = real type THEN two value + ELIF input var data (i) = text type THEN three value + ELSE zero value + FI . + +assign list of input var : (* F8/F25/rr *) + REP get var (var result); + parameter (1, var result. data, var, var result. adr); + apply (1, 1, "assigninput"); + + IF symb.type = del AND symb.no = comma + THEN next symbol + ELSE LEAVE assign list of input var FI + PER . + +kill statement: +(*KILL *) + next symbol; + get expr (filename, text type); + + parameter (1, text type, const, filename.adr); + parameter (2, quiet type, const, next local adr (int type)); + apply (2, 0, "quiet"); + apply (1, 2, "forget") . + +let statement: +(*[LET] = *) + IF symb.type = res word AND symb.no = let s + THEN next symbol FI; + get var (var result); + skip (equal, operator); + get expr (expr result, var result.data); + apply move (var result.adr, expr result.adr, var result.data). + +line statement: (* F9/rr *) +(*1. LINE INPUT [;][<"prompt string">;] *) + next symbol; + skip (input s, res word); + get semicolon; + get prompt string; + apply (1, 3, "readinput"); + assign string var result . + +get semicolon: + IF symb.type = del AND symb.no = semicolon + THEN next symbol; + parameter (1, bool type, const, false value) + ELSE parameter (1, bool type, const, true value) FI . + +get prompt string: + IF symb.type = const AND symb.data = text type + THEN get const (question, text type); + parameter (2, text type, const, question.adr); + skip (semicolon, del); + ELSE parameter (2, text type, const, niltext value); + FI; + parameter (3, bool type, const, false value) . + +assign string var result : + get var (var result, text type); + parameter (1, text type, var, var result.adr); + apply (1, 1, "assigninputline") . + +lprint statement: +(*LPRINT (cf. PRINT) *) + apply (1, 0, "switchtoprintoutfile"); + print statement; + apply (1, 0, "switchbacktooldsysoutstate"). + +l set statement: +(*LSET = *) + next symbol; + get var (var result, text type); + skip (equal, operator); + get expr (expr result, text type); + parameter (1, text type, var, var result.adr); + parameter (2, text type, const, expr result.adr); + apply (1, 2, "lset") . + +mid statement: +(*MID$ (, from [,len]) = *) + next symbol; + skip (open bracket, del); + get var (var result, text type); + skip (comma, del); + get expr (from, int type); + IF symb.type = del AND symb.no = comma + THEN next symbol; + get expr (len, int type) + ELSE len := nilsymbol FI; + skip (close bracket, del); + skip (equal, operator); + get expr (expr result, text type); + + parameter (1, text type, var, var result.adr); + parameter (2, int type, const, from.adr); + parameter (3, text type, const, expr result.adr); + IF len.data = int type + THEN parameter (4, int type, const, one value); + parameter (5, int type, const, len.adr); + parameter (6, text type, var, next local adr (text type)); + apply (3, 3, "subtext"); + parameter (3, text type, const, local adr); + FI; + apply (1, 3, "replace") . + +name statement: +(*NAME AS *) + next symbol; + get expr (old name, text type); + skip (as s, res word); + get expr (new name, text type); + parameter (1, text type, const, old name.adr); + parameter (2, text type, const, new name.adr); + apply (1, 2, "rename") . + +option statement: +(*OPTION BASE 0|1 *) + next symbol; + skip (base s, res word); + get const (base size, int type); + IF new array base > 1 + THEN basic error (105, NAME base size, "") + ELSE array base := new array base + FI. + +new array base: + base size.name ISUB 1. + +randomize statement: +(*RANDOMIZE [] *) + next symbol; + IF symb.type = eos + THEN apply (1, 0, "initrnd") + ELSE get expr (expr result, real type); + parameter (1, real type, const, expr result.adr); + apply (1, 1, "initrnd") + FI . + +read statement: +(*READ *) + next symbol; + REP get var (var result); + parameter (1, text type, const, data text); + parameter (2, int type, var, data pos); + parameter (3, var result.data, var, var result.adr); + apply (1, 3, "read"); + + IF symb.type = eos + THEN LEAVE read statement + ELSE skip (comma, del) FI + PER . + +rem statement: +(*REM *) + next statement; + symb := SYMBOL : ("", eol, eos, LOC 0, void type); + LEAVE get basic line . + +restore statement: +(*RESTORE [] *) + next symbol; + IF symb.type = eos + THEN parameter (1, int type, var, data pos); + parameter (2, int type, const, one value); + parameter (3, void type, const, nil adr); + apply (1, 2, int move); + ELSE get const (label, int type); + parameter (1, text type, const, data text); + parameter (2, int type, var, data pos); + parameter (3, int type, const, label.adr); + apply (1, 3, "restore") + FI . + +return statement : +(*RETURN *) + next symbol; + goret . + +r set statement: +(*RSET = *) + next symbol; + get var (var result, text type); + skip (equal, operator); + get expr (expr result, text type); + parameter (1, text type, var, var result.adr); + parameter (2, text type, const, expr result.adr); + apply (1, 2, "rset") . + +stop statement: +(*STOP *) + next symbol; + expr result := SYMBOL: (nil, any, const, nil adr, int type); + expr result.name CAT act stat no; + declare const (expr result, int type); + parameter (1, int type, const, expr result.adr); + apply (1, 1, "basicstop"); + parameter (1, void type, const, nil adr); + apply (1, 0, ret) . + +swap statement: +(*SWAP , *) + next symbol; + get var (var result); + parameter (1, var result.data, var, var result.adr); + DTYPE CONST first var result data :: var result.data; + skip (comma, del); + get var (var result); + IF first var result data = var result.data + THEN parameter (2, var result.data, var, var result.adr); + apply (1, 2, "swap") + ELSE basic error (106, var result.name, "gefunden: " + + dump (first var result data) + ", " + dump (var result.data)) + FI. + +troff statement: +(*TROFF *) + next symbol; + basic trace := FALSE . + +tron statement: +(*TRON *) + next symbol; + basic trace := TRUE . + +width statement: +(*WIDTH Größe *) + next symbol; + get expr (expr result, int type); + parameter (1, int type, const, expr result.adr); + apply (1, 1, "width") . + +write statement: +(*WRITE [] *) + next symbol; + + IF symb.type = eos + THEN apply (1, 0, "nextline") + ELSE write list of expr results FI . + +write list of expr results: + REP get expr (expr result); + parameter (1, expr result.data, const, expr result.adr); + apply (1, 1, "basicwrite"); + + IF symb.type = eos + THEN apply (1, 0, "nextline"); + LEAVE write list of expr results + ELSE skip (comma, del); + parameter (1, text type, const, comma value); + apply (1, 1, "basicout") + FI + PER . + +END PROC get basic line; + +PROC gen stat no (INT CONST local stat no): +(* Die Zeilennummer wird als Label definiert *) +(* Die Prozedur 'stat no' wird mit der Statementnummer aufgerufen *) + act stat no := local stat no; + define (label list [label pos (act stat no)]); + + declare (1, int type); + declare (1, const); + define (1, act stat no); + parameter (2, void type, const, nil adr); + apply (1, 1, ln op); + + IF basic trace + THEN expr result := SYMBOL: (nil, any, const, nil adr, int type); + expr result.name CAT act stat no; + declare const (expr result, int type); + parameter (1, int type, const, expr result.adr); + apply (1, 1, trace op) + FI; + next symbol . + +END PROC gen stat no; + +PROC for statement: +(*FOR = x TO y [STEP z] *) + SYMBOL VAR local var result, init val, limit val, step val; + LABEL VAR start loop, end loop; + INT CONST for stat no := act stat no, (* F29/rr *) + for scan line no := scan line no; + TEXT CONST for symb name := symb.name; + declare (start loop); + declare (end loop); + + next symbol; + get loop var; + skip (equal, operator); + get expr (init val, local var result.data); + skip (to s, res word); + get expr (limit val, local var result.data); + get step val; + + init loop var; + define (start loop); + gen check of variable; + get statement group (next s); + + IF symb.type = eos AND symb.no = -next s + THEN next var statement + ELSE define (end loop); + basic error ("Compiler", 26, for scan line no, for stat no, for symb name, "", TRUE); (* F29/rr *) + FI . + +get loop var: + get var (local var result); + IF NOT (local var result.data = int type OR local var result.data = real type) + THEN basic error (2, NAME local var result, "INT oder REAL erwartet, " + + dump (local var result.data) + " gefunden") + FI . + +get step val: + IF symb.type = res word AND symb.no = step s + THEN next symbol; + get expr (step val, local var result.data) + ELIF local var result.data = int type + THEN step val.data := int type; + step val.adr := int one value + ELSE step val.data := real type; + step val.adr := real one value + FI . + +init loop var: + IF local var result.data = int type + THEN init int loop + ELSE init real loop FI . + +init int loop: + IF limit val.type = var + THEN parameter (1, int type, var, next local adr (int type)); + parameter (2, int type, const, limit val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, int move); + limit val.adr := local adr; + FI; + IF step val.type = var + THEN parameter (1, int type, var, next local adr (int type)); + parameter (2, int type, const, step val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, int move); + step val.adr := local adr; + FI; + IF NOT (init val.no = local var result.no) + THEN parameter (1, int type, var, local var result.adr); + parameter (2, int type, const, init val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, int move) + FI . + +init real loop: + IF limit val.type = var + THEN parameter (1, real type, var, next local adr (real type)); + parameter (2, real type, const, limit val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, real move); + limit val.adr := local adr; + FI; + IF step val.type = var + THEN parameter (1, real type, var, next local adr (real type)); + parameter (2, real type, const, step val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, real move); + step val.adr := local adr; + FI; + IF NOT (init val.no = local var result.no) + THEN parameter (1, real type, var, local var result.adr); + parameter (2, real type, const, init val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, real move) + FI . + +gen check of variable: + parameter (1, local var result.data, const, local var result.adr); + parameter (2, limit val.data, const, limit val.adr); + parameter (3, step val.data, const, step val.adr); + parameter (4, bool type, const, nil adr); apply (4, nop); +(* In der nächsten Coder-Version ist eine PUSH-Angabe nop nicht nötig *) + apply (1, 3, "loopend"); + apply (end loop, TRUE) . + +next var statement: +(*NEXT [][,...] *) + next symbol; + generate loop end; + IF symb.type <> eos + THEN check next var result FI . + +check next var result: + IF symb.no = local var result.no + THEN next symbol; + IF symb.type = del AND symb.no = comma + THEN next for loop FI + ELSE basic error (86, NAME symb, local var result.name + " erwartet") FI . + +next for loop: + IF end symbol = next s + THEN symb := SYMBOL:("", -next s, eos, nil adr, void type) + ELSE basic error (1, symb.name, "") (* mo *) + FI. + +generate loop end: + parameter (1, local var result.data, var, local var result.adr); + parameter (2, step val.data, const, step val.adr); + parameter (3, void type, const, nil adr); + IF local var result.data = int type + THEN apply (1, 2, int incr) + ELSE apply (1, 2, real incr) FI; + + apply (start loop); + define (end loop) . + +END PROC for statement; + +PROC if statement : (* Änd. 11.08.87, mo *) +(* IF THEN | *) +(* [ELSE |] *) +(* IF GOTO *) +(* [ELSE |] *) + SYMBOL VAR local expr result; + next symbol; + get expr (local expr result, int type); + skip comma if there; + IF symb.type = res word AND (symb.no = then s OR symb.no = goto s) + THEN test expr result; + IF symb.no = goto s + THEN next symbol; + if goto statement + ELIF next symbol is stat no + THEN if goto statement + ELSE if then statement + FI + ELSE basic error (2, NAME symb, "THEN oder GOTO erwartet") FI . + +skip comma if there: + IF symb.no = comma AND symb.type = del + THEN next symbol + FI. + +test expr result: + parameter (1, int type, const, local expr result.adr); + parameter (2, bool type, var, nil adr); apply (2, nop); + apply (1, 1, test) . + +next symbol is stat no: + next symbol; + symb.type = const AND symb.data = int type. + +if goto statement: + SYMBOL VAR stat label; + get const (stat label, int type); + expect else if comma found; + IF symb.type = res word AND symb.no = else s + THEN apply (this label, FALSE); + treat else case + ELIF symb.type <> eos OR symb.no <> eol + THEN declare (else label); + apply (this label, FALSE); + apply (else label); + get basic line (else s); + IF symb.type = eos AND symb.no = -else s + THEN else statement + ELSE define (else label) + FI + ELSE apply (this label, FALSE) + FI. + +this label: label list [label pos (label no)] . +label no: stat label.name ISUB 1 . + +expect else if comma found: + IF symb.type = del AND symb.no = comma + THEN next symbol; + IF symb.no <> else s OR symb.type <> res word + THEN basic error (2, NAME symb, "ELSE erwartet") + FI + FI. + +treat else case: + IF next symbol is stat no + THEN get const (stat label, int type); + apply (this label) + ELSE get basic line + FI. + +if then statement: + LABEL VAR fi label; + declare (else label); + apply (else label, TRUE); + get basic line (else s); + + IF symb.type = eos AND symb.no = -else s + THEN declare (fi label); + apply (fi label); + else statement; + define (fi label) + ELSE define (else label) FI . + + +else statement: + LABEL VAR else label; + define (else label); + treat else case. + + +END PROC if statement; + +PROC on statement: +(*2. ON GOSUB *) +(*3. ON GOTO *) + LABEL VAR before case, after case, return case; + declare (before case); + declare (after case); + declare (return case); + + next symbol; + IF symb.type = res word AND symb.no = error s + THEN basic error (100, symb.name, "") + FI; + get expr (expr result, int type); + IF on gosub statement + THEN gosub (before case); + apply (after case) + ELIF NOT on goto statement + THEN basic error (2, symb.name, "GOTO oder GOSUB erwartet") FI; + + get case stat no; + define (before case); + gen case branches; + gen return case; + define (after case) . + +on gosub statement: + BOOL CONST gosub found := symb.type = res word AND symb.no = gosub s; + gosub found . + +on goto statement: + symb.type = res word AND symb.no = goto s. + +get case stat no: + TEXT VAR case stat no :: nil; + INT VAR case no :: 0; + next symbol; + REP get const (label, int type); + case no INCR 1; + case stat no CAT label.name; + + IF symb.type = eos + THEN LEAVE get case stat no + ELSE skip (comma, del) FI + PER . + +gen case branches: + computedbranch (expr result.adr, case no + 1, otherwise lab); (* F6/rr *) + apply (otherwise lab); + FOR i FROM 1 UPTO case no + REP apply (label i) PER . + +gen return case: + IF gosub found + THEN define (return case); + goret + FI . + +otherwise lab: + IF gosub found + THEN return case + ELSE after case FI . + +label i: + label list [label pos (case stat no ISUB i)] . + +END PROC on statement; + +PROC print statement: +(*PRINT [] *) +(*PRINT USING ; *) +(*PRINT #, *) +(*PRINT #, USING ; *) + next symbol; + IF symb.type = del AND symb.no = numbersign + THEN print file statement + ELSE print display statement FI . + +print file statement: + basic error (100, symb.name, "") . + +print display statement: + get format string; + print list of expr results; + reset format string . + +get format string: + IF symb.type = res word AND symb.no = using s + THEN next symbol; + get expr (image, text type); + skip (semicolon, del); + parameter (1, text type, const, image.adr); + apply (1, 1, "using"); + ELSE image := nilsymbol FI . + +reset format string: + IF image.type <> any + THEN apply (1, 0, "clearusing") FI . + +print list of expr results: + REP IF symb.type = res word AND symb.no = tab s + THEN get tabulation + ELIF symb.type = del AND symb.no = comma + THEN get next zone + ELIF symb.type = del AND symb.no = semicolon + THEN get next pos + ELIF symb.type = eos + THEN apply (1, 0, "nextline"); + LEAVE print list of expr results + ELSE get print expr result FI; + PER . + +get tabulation: + next symbol; + skip (open bracket, del); + get expr (tab pos, int type); + skip (close bracket, del); + parameter (1, int type, const, tab pos.adr); + apply (1, 1, "tab") . + +get next zone: + next symbol; + IF image.type = any + THEN apply (1, 0, "nextzone") FI; + IF symb.type = eos + THEN LEAVE print list of expr results FI . + +get next pos: + next symbol; + IF symb.type = eos + THEN LEAVE print list of expr results FI . + +get print expr result: + get expr (expr result); + parameter (1, expr result.data, const, expr result.adr); + apply (1, 1, "basicout") . + +END PROC print statement; + +PROC while statement: +(*WHILE *) + LABEL VAR while lab, wend lab; + SYMBOL VAR while expr result; + INT CONST while stat no := act stat no, (* F29/rr *) + while scan line no := scan line no; + TEXT CONST while symb name := symb.name; + next symbol; + declare (while lab); + declare (wend lab); + + define (while lab); + get expr (while expr result, int type); + parameter (1, int type, const, while expr result.adr); + parameter (2, bool type, const, nil adr); apply (2, nop); + apply (1, 1, test); + apply (wend lab, TRUE); (* 'test' vergleicht mit 0 *) + + get statement group (wend s); + IF symb.type = eos AND symb.no = -wend s + THEN wend statement + ELSE basic error ("Compiler", 29, while scan line no, while stat no, while symb name, "", TRUE) FI. (* F29/rr *) + +wend statement: +(*WEND *) + apply (while lab); + define (wend lab); + next symbol . + +END PROC while statement; + +END PACKET basic compiler + diff --git a/lang/basic/1.8.7/src/BASIC.Runtime b/lang/basic/1.8.7/src/BASIC.Runtime new file mode 100644 index 0000000..854002a --- /dev/null +++ b/lang/basic/1.8.7/src/BASIC.Runtime @@ -0,0 +1,1571 @@ +(***************************************************************************) +(* *) +(* Erste von drei Dateien des EUMEL-BASIC-Systems *) +(* *) +(* Autor: Heiko Indenbirken *) +(* Überarbeitet von: Rudolf Ruland und Michael Overdick *) +(* *) +(* Stand: 27.10.1987 *) +(* *) +(***************************************************************************) + +PACKET basic std DEFINES EQU, UEQ, (* Autor: Heiko Indenbirken *) + LES, LEQ, (* Stand: 23.10.1987/rr/mo *) + GRE, GEQ, + EQV, IMP, + ^, swap, + val, asc, cdbl, chr, + cint, cvi, cvd, fre, + hex, inchars, + instr, ent, left, + mid, mki, mkd, + oct, right, + rnd, init rnd, + space, string, + l set, r set, + int not, real not, + /, DIV, real mod, + time, timer, + arctan, cos, sin, tan, + exp, ln, floor, + sqrt: + + +INT CONST true := -1, + false := 0; + +LET real overflow = 6; + + +(*BASIC-Integervergleiche *) +INT OP EQU (INT CONST a, b): + IF a=b + THEN true + ELSE false FI +END OP EQU; + +INT OP UEQ (INT CONST a, b): + IF a=b + THEN false + ELSE true FI +END OP UEQ; + +INT OP LES (INT CONST a, b): + IF ab + THEN true + ELSE false FI +END OP GRE; + +INT OP GEQ (INT CONST a, b): + IF a>=b + THEN true + ELSE false FI +END OP GEQ; + +(*BASIC-Realvergleiche *) +INT OP EQU (REAL CONST a, b): + IF a=b + THEN true + ELSE false FI +END OP EQU; + +INT OP UEQ (REAL CONST a, b): + IF a=b + THEN false + ELSE true FI +END OP UEQ; + +INT OP LES (REAL CONST a, b): + IF ab + THEN true + ELSE false FI +END OP GRE; + +INT OP GEQ (REAL CONST a, b): + IF a>=b + THEN true + ELSE false FI +END OP GEQ; + +(*BASIC-Tesxtvergleiche *) +INT OP EQU (TEXT CONST a, b): + IF a=b + THEN true + ELSE false FI +END OP EQU; + +INT OP UEQ (TEXT CONST a, b): + IF a=b + THEN false + ELSE true FI +END OP UEQ; + +INT OP LES (TEXT CONST a, b): + IF ab + THEN true + ELSE false FI +END OP GRE; + +INT OP GEQ (TEXT CONST a, b): + IF a>=b + THEN true + ELSE false FI +END OP GEQ; + + +(*BASIC INTEGER / BOOL Operatoren *) +REAL PROC real not (REAL CONST a): (* mo *) + real (int (a) XOR -1) +END PROC real not; + +INT PROC int not (INT CONST a): (* mo *) + a XOR -1 +END PROC int not; + +INT OP EQV (INT CONST l, r): + int not (l XOR r) +END OP EQV; + +INT OP IMP (INT CONST l, r): + (l EQV r) OR r +END OP IMP; + +LET smallest significant = 5.0e-12; +REAL OP ^ (REAL CONST x, y): (* F22/rr *) + IF x > 0.0 + THEN x ** y + ELIF x = 0.0 + THEN IF y > 0.0 + THEN 0.0 + ELIF y = 0.0 + THEN 1.0 + ELSE errorstop (real overflow, ""); + max real + FI + ELSE REAL VAR floor y := floor (y + round value); + IF (abs (y - floor y) > smallest significant) + COR (floor y = 0.0 AND y <> 0.0) + THEN errorstop (1005, "bei " + text (x) + + " ^ " + text (y, 19) + + " : neg. Basis, gebr. Exponent"); + 0.0 + ELIF (floor y MOD 2.0) = 0.0 + THEN (-x) ** floor y + ELSE - ( (-x) ** floor y ) + FI + FI . + + round value : IF y >= 0.0 THEN 0.5 ELSE -0.5 FI . + +END OP ^; + +REAL OP ^ (INT CONST x, y): + real (x) ** y +END OP ^; + +REAL OP / (INT CONST l, r): (* mo *) + real (l) / real (r) +END OP /; + +INT OP DIV (REAL CONST l, r): (* mo *) + cint (l) DIV cint (r) +END OP DIV; + +REAL PROC real mod (REAL CONST l, r): (* mo *) + round (l, 0) MOD round (r, 0) +END PROC real mod; + +(* Basic Arithmetik *) +REAL VAR r swap; +PROC swap (REAL VAR left, right): + r swap := left; + left := right; + right := r swap +END PROC swap; + +INT VAR i swap; +PROC swap (INT VAR left, right): + i swap := left; + left := right; + right := i swap +END PROC swap; + +TEXT VAR t swap; +PROC swap (TEXT VAR left, right): + t swap := left; + left := right; + right := t swap +END PROC swap; + +(*Internkonvertierungen *) +INT PROC cvi (TEXT CONST v): + v ISUB 1 +END PROC cvi; + +REAL PROC cvd (TEXT CONST v): + v RSUB 1 +END PROC cvd; + +TEXT VAR i text :: 2*""0"", r text :: 8*""0""; +TEXT PROC mki (REAL CONST x): + mki (cint (x)) +END PROC mki; + +TEXT PROC mki (INT CONST i): + replace (i text, 1, i); + i text +END PROC mki; + +TEXT PROC mkd (INT CONST i): + mkd (real (i)) +END PROC mkd; + +TEXT PROC mkd (REAL CONST r): + replace (r text, 1, r); + r text +END PROC mkd; + +(*Textoperationen *) +PROC l set (TEXT VAR left, TEXT CONST right): + replace (left, 1, right) +END PROC l set; + +PROC r set (TEXT VAR left, TEXT CONST right): + replace (left, length (left)-length (right)+1, right) +END PROC r set; + +TEXT PROC left (TEXT CONST string, REAL CONST no): + left (string, cint (no)) +END PROC left; + +TEXT PROC left (TEXT CONST string, INT CONST no): + subtext (string, 1, no) +END PROC left; + +TEXT PROC right (TEXT CONST string, REAL CONST no): + right (string, cint (no)) +END PROC right; + +TEXT PROC right (TEXT CONST string, INT CONST no): + subtext (string, length (string)-no+1) +END PROC right; + +TEXT PROC mid (TEXT CONST source, REAL CONST from): + mid (source, cint (from)) +END PROC mid; + +TEXT PROC mid (TEXT CONST source, INT CONST from): + subtext (source, from) +END PROC mid; + +TEXT PROC mid (TEXT CONST source, REAL CONST from, length): + mid (source, cint (from), cint (length)) +END PROC mid; + +TEXT PROC mid (TEXT CONST source, INT CONST from, length): + subtext (source, from, from+length-1) +END PROC mid; + +TEXT PROC string (REAL CONST x, y): + string (cint (x), cint (y)) +END PROC string; + +TEXT PROC string (INT CONST x, REAL CONST y): + string (x, cint (y)) +END PROC string; + +TEXT PROC string (REAL CONST x, INT CONST y): + string (cint (x), y) +END PROC string; + +TEXT PROC string (INT CONST i, j): + i * code (j) +END PROC string; + +TEXT PROC string (REAL CONST i, TEXT CONST x): + string (cint (i), x) +END PROC string; + +TEXT PROC string (INT CONST i, TEXT CONST x): + i * (x SUB 1) +END PROC string; + +(*Konvertierungen *) + +REAL PROC val (TEXT CONST text) : (* F18/rr *) + + TEXT VAR buffer := text; + change (buffer, "d", "e"); + change (buffer, "D", "e"); + change (buffer, "E", "e"); + real (buffer) + +END PROC val; + +REAL PROC asc (TEXT CONST text): + real (code (text SUB 1)) +END PROC asc; + +TEXT PROC chr (INT CONST n): + code (n) +END PROC chr; + +TEXT PROC chr (REAL CONST n): + code (cint (n)) +END PROC chr; + +TEXT PROC hex (REAL CONST x): + hex (cint (x)) +END PROC hex; + +TEXT PROC hex (INT CONST x): + TEXT VAR value :: "12"; + replace (value, 1, x); + high byte + low byte . + +low byte: + hexdigit (code (value SUB 1) DIV 16) + hexdigit (code (value SUB 1) MOD 16) . + +high byte: + IF (value SUB 2) = ""0"" + THEN "" + ELSE hexdigit (code (value SUB 2) DIV 16) + + hexdigit (code (value SUB 2) MOD 16) + FI . + +END PROC hex; + +TEXT PROC oct (REAL CONST x): + oct (cint (x)) +END PROC oct; + +TEXT PROC oct (INT CONST x): + INT VAR number :: x AND maxint; + generate oct number; + IF x < 0 + THEN "1" + oct number + ELSE subtext (oct number, pos (oct number, "1", "7", 1)) + FI. + +generate oct number: + TEXT VAR oct number :: ""; + INT VAR digit; + FOR digit FROM 1 UPTO 5 REP + oct number := hexdigit (number MOD 8) + oct number; + number := number DIV 8 + PER. + +END PROC oct; + +TEXT PROC hexdigit (INT CONST digit): + IF 0 <= digit AND digit <= 9 + THEN code (digit + 48) + ELIF 10 <= digit AND digit <= 15 + THEN code (digit + 55) + ELSE errorstop (1051, "Hexziffer außerhalb des gültigen Bereichs"); "" FI +END PROC hexdigit; + +TEXT PROC inchars (REAL CONST n): + inchars (cint (n)) +END PROC inchars; + +TEXT PROC inchars (INT CONST n): + TEXT VAR buffer :: "", char; + INT VAR i; + FOR i FROM 1 UPTO n + REP inchar (char); + buffer CAT char + PER; + buffer + +END PROC inchars; + +(*Mathematische Prozeduren *) +REAL PROC ent (INT CONST r): + real (r) +END PROC ent; + +REAL PROC ent (REAL CONST r): + IF r >= 0.0 OR frac (r) = 0.0 + THEN floor (r) + ELSE floor (r-1.0) FI +END PROC ent; + +REAL PROC cdbl (INT CONST r): + real (r) +END PROC cdbl; + +REAL PROC cdbl (REAL CONST r): + r +END PROC cdbl; + +INT PROC cint (INT CONST r): + r +END PROC cint; + +INT PROC cint (REAL CONST r): + IF r >= 0.0 + THEN int (r+0.5) + ELSE int (r-0.5) FI +END PROC cint; + +REAL VAR last rnd :: rnd (1.0); +REAL PROC rnd (INT CONST x): + rnd (real (x)) +END PROC rnd; + +REAL PROC rnd (REAL CONST x): + IF x > 0.0 + THEN last rnd := random; + last rnd + ELIF x = 0.0 + THEN last rnd + ELSE init rnd (x); + last rnd := random; + last rnd + FI + +END PROC rnd; + +REAL PROC rnd: + rnd (1.0) +END PROC rnd; + +PROC init rnd (REAL CONST init value) : + + REAL VAR init := init value; + IF init <= -1.0 OR 1.0 <= init + THEN set exp (- decimal exponent (init) - 1, init) FI; + initialize random (init) + +END PROC init rnd; + + +REAL PROC fre (TEXT CONST dummy): + INT VAR f, u; + collect heap garbage; + storage (f, u); + + real (f - u) * 1024.0 +END PROC fre; + +REAL PROC fre (REAL CONST dummy): + fre ("") +END PROC fre; + +REAL PROC fre (INT CONST dummy): + fre ("") +END PROC fre; + +(*Inputroutinenen *) +INT PROC instr (TEXT CONST source, pattern): + pos (source, pattern) +END PROC instr; + +INT PROC instr (REAL CONST from, TEXT CONST source, pattern): + instr (cint (from), source, pattern) +END PROC instr; + +INT PROC instr (INT CONST from, TEXT CONST source, pattern): + pos (source, pattern, from) +END PROC instr; + +TEXT PROC space (REAL CONST len): + space (cint (len)) +END PROC space; + +TEXT PROC space (INT CONST len): + len * " " +END PROC space; + +TEXT PROC time: (* mo *) + subtext (time (clock (1) MOD day), 1, 8) (* hh:mm:ss *) +END PROC time; + +REAL PROC timer: + clock (0) +END PROC timer; + +REAL PROC arctan (INT CONST x): + arctan (real (x)) +END PROC arctan; + +REAL PROC cos (INT CONST x): + cos (real (x)) +END PROC cos; + +REAL PROC sin (INT CONST x): + sin (real (x)) +END PROC sin; + +REAL PROC tan (INT CONST x): + tan (real (x)) +END PROC tan; + +REAL PROC exp (INT CONST x): + exp (real (x)) +END PROC exp; + +REAL PROC ln (INT CONST x): + ln (real (x)) +END PROC ln; + +REAL PROC floor (INT CONST x): + real (x) +END PROC floor; + +REAL PROC sqrt (INT CONST x): + sqrt (real (x)) +END PROC sqrt; + +END PACKET basic std; + +PACKET basic using DEFINES using, (* Autor: Heiko Indenbirken *) + clear using, (* Stand: 05.08.1987/rr/mo *) + basic text: + + +LET exclamation point = "!", + backslash = "\", + comercial and = "&", + numbersign = "#", + plus = "+", + minus = "-", + asterisk dollar = "**$", + asterisk = "**", + dollarsign = "$$", + comma = ",", + point = ".", + caret = "^^^^", + underscore = "_", + blank = " ", + nil = "", + + number format chars = "#+-*$.^", + format chars = "!\&#+-$*."; + +TEXT VAR result, using format :: "", pre format :: ""; +INT VAR using pos :: 0; +BOOL VAR image used :: FALSE; + +PROC using (TEXT CONST format): + using format := format; + using pos := 0; + result := ""; + image used := TRUE + +END PROC using; + +PROC clear using: + using format := ""; + image used := FALSE +END PROC clear using; + +TEXT PROC next format: + pre format := ""; + IF using pos = 0 + THEN "" + ELSE search rest of format FI . + +search rest of format: + WHILE using pos <= length (using format) + REP IF at underscore + THEN using pos INCR 1; + pre format CAT akt char + ELIF at format char + THEN LEAVE next format WITH pre format + ELSE pre format CAT akt char FI; + using pos INCR 1 + PER; + using pos := 0; + pre format . + +at underscore: + akt char = underscore . + +at format char: + pos (format chars, akt char) > 0 CAND + evtl double asterisk CAND + evtl point with numbersign . + +evtl double asterisk: + akt char <> asterisk COR next char = asterisk . + +evtl point with numbersign: + akt char <> point COR next char = numbersign . + +akt char: using format SUB using pos . +next char: using format SUB using pos+1 . +END PROC next format; + +PROC init (TEXT VAR l result): + IF using pos = 0 + THEN using pos := 1; + l result := next format; + IF using pos = 0 + THEN errorstop (1005, "USING: kein Format gefunden") FI + ELSE l result := "" FI + +END PROC init; + +TEXT PROC basic text (TEXT CONST string): + IF image used + THEN using text + ELSE string FI . + +using text: + init (result); + result CAT format string; + using pos INCR 1; + result CAT next format; + result . + +format string: + IF akt char = exclamation point + THEN string SUB 1 + ELIF akt char = backslash + THEN given length string + ELIF akt char = comercial and + THEN string + ELSE errorstop (1005, "USING-Format fehlerhaft: " + using format); "" FI . + +given length string: + INT VAR len :: 2; + FOR using pos FROM using pos+1 UPTO length (using format) + REP IF akt char = "\" + THEN LEAVE given length string WITH text (string, len) FI; + len INCR 1 + UNTIL akt char <> " "PER; + errorstop (1005, "USING-Format fehlerhaft: " + using format); + "" . + +akt char: using format SUB using pos +END PROC basic text; + +TEXT PROC basic text (INT CONST number): + IF image used + THEN basic text (real (number)) + ELSE sign + text (number) FI . + +sign: + IF number >= 0 + THEN " " + ELSE "" FI . + +END PROC basic text; + +TEXT PROC basic text (REAL CONST number): + IF image used + THEN using text + ELSE normal text FI . + +normal text: +(* Bei Real Zahlen werden maximal 7 signifikante Stellen ausgegeben, *) +(* führende und nachfolgende Nullen werden unterdrückt, *) +(* der Dezimalpunkt wird im Normalformat unterdrückt *) + calculate sign; + REAL VAR mantissa := round (abs (number), 6-decimal exponent (number)); + INT CONST exp :: decimal exponent (mantissa); + + IF mantissa = 0.0 + THEN result := " 0" + ELIF exp > 6 OR exp < -7 OR (exp < 0 AND more than 7 signifikant digits) + THEN scientific notation + ELIF exp < 0 + THEN short negative notation + ELSE short positive notation FI; + result . + +more than 7 signifikant digits: + REAL VAR signifikant := mantissa; + set exp (7+exp, signifikant); + frac (signifikant) <> 0.0 . + +calculate sign: + IF number >= 0.0 + THEN result := " " + ELSE result := "-" FI . + +scientific notation: + set exp (0, mantissa); + result CAT non zero (text (mantissa, 8, 6)); + + IF exp < 0 + THEN result CAT "E-" + ELSE result CAT "E+" FI; + + IF abs (exp) > 9 + THEN result CAT text (abs (exp)) + ELSE result CAT "0"; + result CAT text (abs (exp)) + FI . + +short positive notation: + result CAT non zero (text (mantissa, 8, 6-exp)); + IF (result SUB LENGTH result) = "." + THEN delete char (result, LENGTH result) FI . + +short negative notation: + result CAT non zero (subtext (text (abs (mantissa), 9, 7), 2)).(* F13/rr *) + +using text: + init (result); + result CAT format number (subformat, number); + result CAT next format; + result . + +subformat: + INT VAR from :: using pos, to :: last format char; + subtext (using format, from, to) . + +last format char: + FOR using pos FROM using pos+1 UPTO length (using format) + REP IF non format char + THEN LEAVE last format char WITH using pos-1 FI + PER; + using pos := 0; + length (using format) . + +non format char: + IF (using format SUB using pos) = comma + THEN (using format SUB (using pos+1)) <> point + ELSE pos (numberformat chars, using format SUB using pos) = 0 FI . + +END PROC basic text; + +TEXT PROC non zero (TEXT CONST text): + INT VAR i; + FOR i FROM length (text) DOWNTO 2 + REP UNTIL (text SUB i) <> "0" PER; + subtext (text, 1, i) +END PROC non zero; + +TEXT PROC format number (TEXT CONST format, REAL CONST number): + IF no digit char + THEN errorstop (1005, "USING-Format fehlerhaft: " + using format); "" + ELIF exponent found + THEN exponent format + ELSE normal format FI . + +no digit char: + pos (format, numbersign) = 0 AND + pos (format, asterisk) = 0 AND + pos (format, dollarsign) = 0 . + +exponent found: + INT CONST exponent pos := pos (format, caret); + exponent pos > 0 . + +exponent format: + IF leading plus + THEN plus or minus + exponent field (subtext (format, 2), number, exponent pos-1) + ELIF trailing plus + THEN exponent field (format, number, exponent pos) + plus or minus + ELIF trailing minus + THEN exponent field (format, number, exponent pos) + nil or minus + ELSE blank or minus + exponent field (subtext (format, 2), number, exponent pos-1) FI . + +normal format: + IF leading numbersign + THEN number field (format, number, "", " ") + ELIF leading point + THEN number field (format, number, "", " ") + ELIF leading plus + THEN number field (format, abs (number), plus or minus, " ") + ELIF leading asterisk dollar + THEN number field (format, number, "$", "*") + ELIF leading asterisk + THEN number field (format, number, "", "*") + ELIF leading dollarsign + THEN number field (format, number, "$", " ") + ELSE errorstop (1005, "USING-Format fehlerhaft: " + using format); "" FI . + +leading numbersign: (format SUB 1) = numbersign . +leading point: (format SUB 1) = point . +leading plus: (format SUB 1) = plus . +leading asterisk dollar: subtext (format, 1, 3) = asterisk dollar . +leading asterisk: subtext (format, 1, 2) = asterisk . +leading dollarsign: subtext (format, 1, 2) = dollarsign . + +trailing minus: (format SUB LENGTH format) = minus . +trailing plus: (format SUB LENGTH format) = plus . + +plus or minus: IF number < 0.0 THEN minus ELSE plus FI . +nil or minus: IF number < 0.0 THEN minus ELSE nil FI . +blank or minus: IF number < 0.0 THEN minus ELSE blank FI . + +END PROC format number; + +TEXT PROC exponent field (TEXT CONST format, REAL CONST value, INT CONST exponent pos): + REAL VAR number := abs (value); + INT CONST point pos := pos (format, point); + calc leading and trailing; + INT CONST new exponent :: decimal exponent (value) - leading + 1; + IF abs (new exponent) >= 100 + THEN "%" + mantissa + "E" + null text (new exponent, 4) + ELSE mantissa + exponent + FI. + +calc leading and trailing: + INT VAR leading, trailing; + IF point pos = 0 + THEN leading := exponent pos-1; + trailing := 0 + ELSE leading := point pos-1; + trailing := exponent pos-point pos-1 + FI . + +mantissa: + set exp (leading - 1, number); + IF point pos = 0 + THEN subtext (text (number, leading+1, 0), 1, leading) + ELSE subtext (text (number, leading+trailing+2, trailing), 2) FI . + +exponent: + "E" + null text (new exponent, 3) . + +END PROC exponent field; + +TEXT PROC number field (TEXT CONST format, REAL CONST value, + TEXT CONST pretext, lead char): + INT CONST point pos :: pos (format, point); + calc fraction; + calc digits; + calc commata if necessary; + fill with lead chars and sign . + +calc fraction: + INT VAR fraction :: 0, i; + FOR i FROM point pos+1 UPTO length (format) + WHILE (format SUB i) = numbersign + REP fraction INCR 1 PER . + +calc digits: + TEXT VAR valuetext; + IF point pos = 0 + THEN valuetext := digits (abs (value), 0, TRUE); + delete char (valuetext, length (valuetext)) + ELSE valuetext := digits (abs (value), fraction, point pos <> 1) FI . + +calc commata if necessary: + IF comma before point + THEN insert commata FI . + +comma before point: + point pos > 0 CAND (format SUB point pos-1) = comma . + +insert commata: + i := pos (valuetext, point)-3; + WHILE i > 1 CAND (valuetext SUB i) <> " " + REP insert char (valuetext, ",", i); + i DECR 3 + PER . + +fill with lead chars and sign: + IF trailing minus + THEN fillby (pretext + valuetext, length (format)-1, lead char) + nil or minus + ELIF trailing plus + THEN fillby (pretext + valuetext, length (format)-1, lead char) + plus or minus + ELIF value < 0.0 + THEN fillby (pretext + minus + valuetext, length (format), lead char) + ELSE fillby (pretext + valuetext, length (format), lead char) FI . + + +plus or minus: IF value < 0.0 THEN minus ELSE plus FI . +nil or minus: IF value < 0.0 THEN minus ELSE nil FI . +trailing minus: (format SUB LENGTH format) = minus . +trailing plus: (format SUB LENGTH format) = plus . +END PROC numberfield; + +TEXT PROC null text (INT CONST n, digits): + TEXT VAR l result := text (abs (n), digits); + IF n < 0 + THEN replace (l result, 1, "-") + ELSE replace (l result, 1, "+") FI; + change all (l result, " ", "0"); + l result . +END PROC null text; + +TEXT PROC fillby (TEXT CONST source, INT CONST format, TEXT CONST with): + IF differenz >= 0 + THEN differenz * with + source + ELSE "%" + source FI . + +differenz: format - length (source) . +END PROC fillby; + +TEXT PROC digits (REAL CONST value, INT CONST frac, BOOL CONST null): + IF decimal exponent (value) < 0 + THEN TEXT VAR l result := text (value, frac+2, frac); + + IF null AND first char <> "0" + THEN replace (l result, 1, "0"); + l result + ELIF (NOT null AND first char = "0") OR first char = " " + THEN subtext (l result, 2) + ELSE l result FI + ELSE text (value, decimal exponent (value)+frac+2, frac) FI . + +first char: + (l result SUB 1) . + +END PROC digits; + +TEXT PROC right (TEXT CONST msg, INT CONST len): + IF length (msg) >= len + THEN subtext (msg, 1, len) + ELSE (len - length (msg)) * " " + msg FI + +END PROC right; + +END PACKET basic using; + +PACKET basic output (* Autor: R. Ruland *) + (* Stand: 28.08.1987/rr/mo *) + DEFINES basic page, + width, + init output, + basic out, + basic write, + tab, + next zone, + next line, + next page, + cursor x pos, + pos, + csrlin, + l pos, + switch to printout file, + switch back to old sysout state: + +LET zone width = 16; (* sd.ddddddEsdddb (s = sign, d = digit, b = blank) *) +LET printfile name = "BASIC LPRINT OUTPUT"; + +INT VAR screen width, x cursor, y cursor, line no; +BOOL VAR paging := FALSE, first time, + in lprint; (* mo *) +TEXT VAR buffer, output line, last sysout file, old sysout, char; + +PROC basic page (BOOL CONST status): + + paging := status + +END PROC basic page; + +BOOL PROC basic page: paging END PROC basic page; + + +PROC width (INT CONST max): + + IF max < 0 + THEN errorstop (1005, "WIDTH: negatives Angabe: " + text (max)) + ELIF max = 0 + THEN screen width := 1 + ELSE screen width := max + FI; + last sysout file := ""; + +END PROC width; + +INT PROC width : screen width END PROC width; + + +PROC init output: + + clear using; + width (max (1, x size)); + line no := 1; + output line := ""; + first time := TRUE; + in lprint := FALSE + +END PROC init output; + + +PROC basic out (INT CONST i): bas out (basic text (i) + " ") END PROC basic out; + +PROC basic out (REAL CONST r): bas out (basic text (r) + " ") END PROC basic out; + +PROC basic out (TEXT CONST t): bas out (basic text (t)) END PROC basic out; + +PROC basic write (INT CONST i): bas out (basic text (i)) END PROC basic write; + +PROC basic write (REAL CONST r): bas out (basic text (r)) END PROC basic write; + +PROC basic write (TEXT CONST t): bas out (basic text ("""" + t + """")) END PROC basic write; + + +PROC bas out (TEXT CONST msg): + + get cursor; + IF length (msg) > free + THEN IF first time + THEN first time := FALSE; + next line; + bas out (msg); + ELSE buffer := subtext (msg, 1, free); + IF sysout = "" + THEN out (buffer) + ELSE sysout write (buffer) + FI; + next line; + buffer := subtext (msg, free + 1); + bas out (buffer); + FI; + ELSE first time := TRUE; + IF sysout = "" + THEN out (msg) + ELSE sysout write (msg) + FI; + FI; + + . free : screen width - x cursor + 1 + +END PROC bas out; + + +PROC tab (INT CONST n): + + get cursor; + IF n <= 0 + THEN tab position out of range + ELIF n > screen width + THEN tab (n MOD screen width); + ELIF x cursor > n + THEN next line; + tab (n); + ELIF sysout = "" + THEN cursor (n, y cursor); + ELSE buffer := (n - x cursor) * " "; + sysout write (buffer) + FI; + + . tab position out of range : + IF x cursor <> 1 THEN next line FI; + write ("WARNUNG : TAB-Position <= 0"); + next line; + +END PROC tab; + + +PROC next zone: + + get cursor; + IF x cursor > screen width - zone width + THEN next line; + ELIF sysout = "" + THEN free TIMESOUT " "; + ELSE buffer := free * " "; + sysout write (buffer) + FI; + + . free : ((x cursor - 1) DIV zone width + 1) * zone width - x cursor + 1 + +END PROC next zone; + + +PROC next line : + + IF sysout = "" + THEN next line on screen + ELSE line; + write (""); (* generates new record *) + output line := ""; + FI; + + . next line on screen: + line no INCR 1; + IF paging CAND line no > y size + THEN IF in last line + THEN warte; + ELSE out (""13""10""); + line no := y cursor + 1; + FI; + ELIF NOT paging + THEN char := incharety; + IF char <> "" + THEN IF char = "+" + THEN paging := TRUE + ELSE type (char) + FI + FI; + out (""13""10"") + ELSE out (""13""10"") + FI + + . in last line : + get cursor; + y cursor = y size + + . warte : + cursor (x size - 2, y size); + out (">>"); + inchar (char); + IF char = ""13"" + THEN next page + ELIF char = ""10"" + THEN out (""8""8" "13""10"") + ELIF char = ""27"" + THEN clear editor buffer; + errorstop (1, "") + ELIF char = "-" + THEN out (""8""8" "13""10""); + line no := 1; + paging := FALSE; + ELSE out (""8""8" "13""10""); + line no := 1; + FI; + + . clear editor buffer: + REP UNTIL get charety = "" PER; + +END PROC next line; + + +PROC next page: + + IF sysout = "" + THEN out (""1""4"") + ELSE line + FI; + clear using; + line no := 1; + output line := ""; + +END PROC next page; + + +INT PROC pos (REAL CONST dummy): (* mo *) + + cursor x pos + +END PROC pos; + + +INT PROC pos (INT CONST dummy): (* mo *) + + cursor x pos + +END PROC pos; + + +INT PROC cursor x pos : + + get cursor; + x cursor + +END PROC cursor x pos; + + +INT PROC csrlin: (* mo *) + + get cursor; + y cursor + +END PROC csrlin; + + +PROC get cursor : + + IF sysout = "" + THEN get cursor (x cursor, y cursor); + ELSE x cursor := LENGTH output line + 1; + FI; + +END PROC get cursor; + + +INT PROC l pos (REAL CONST dummy): (* mo *) + + l pos (0) + +END PROC l pos; + + +INT PROC l pos (INT CONST dummy): (* mo *) + + INT VAR lprint position :: 1; + IF exists (printfile name) + THEN disable stop; + FILE VAR printfile :: sequential file (modify, printfile name); + IF lines (printfile) > 0 + THEN to line (printfile, lines (printfile)); + lprint position := len (printfile) + 1 + FI; + output (printfile) + FI; + lprint position + +END PROC l pos; + + +PROC switch to printout file: (* mo *) + + in lprint := TRUE; + old sysout := sysout; + careful sysout (printfile name); + +END PROC switch to printout file; + + +PROC switch back to old sysout state: (* mo *) + + IF in lprint + THEN careful sysout (old sysout); + in lprint := FALSE + FI + +END PROC switch back to old sysout state; + + +PROC sysout write (TEXT CONST string): + check sysout; + write (string); + output line CAT string. + +check sysout: + IF sysout <> last sysout file + THEN careful sysout (sysout) + FI. + +END PROC sysout write; + + +PROC careful sysout (TEXT CONST new sysout): (* mo *) + +IF new sysout <> "" + THEN disable stop; + FILE VAR outfile :: sequential file (modify, new sysout); + max line length (outfile, screen width); + last sysout file := sysout; + IF lines (outfile) > 0 + THEN to line (outfile, lines (outfile)); + read record (outfile, output line); + delete record (outfile) + ELSE output line := "" + FI; + sysout (new sysout); + write (output line); + ELSE sysout ("") +FI + +END PROC careful sysout; + +END PACKET basic output; + + +PACKET basic input (* Autor: R. Ruland *) + (* Stand: 27.10.1987/rr/mo *) + + DEFINES init input, + read input, + check input, + assign input, + assign input line, + input ok, + input eof: + + +LET comma = ",", + quote = """", + + wrong type = 1, + insufficient data = 2, + too much data = 3, + overflow = 4, + + int overflow = 4, + real overflow = 6; + +INT VAR input line pos, input error no; +BOOL VAR on terminal; +TEXT VAR input line :: "", previous input line := "", input value; + +. first quote found : (input value SUB 1) = quote +.; + +PROC init input : + + input error no := 0; + input line pos := 0; + input line := ""; + previous input line := ""; + +END PROC init input; + + +PROC read input (BOOL CONST cr lf, TEXT CONST msg, BOOL CONST question mark): + + on terminal := sysout <> "" AND sysin = ""; + check input error; + out string (msg); + IF question mark THEN out string ("? ") FI; + IF sysin <> "" + THEN getline (input line); + ELSE editget input line; + FI; + out string (input line); + IF crlf THEN out line FI; + input line pos := 0; + input error no := 0; + + . check input error : + IF input error no = 0 + THEN input line := ""; + ELSE IF sysin = "" + THEN BOOL CONST old basic page := basic page; + basic page (FALSE); + IF cursor x pos <> 1 THEN next line FI; + basic out ("?Eingabe wiederholen ! (" + error text + ")"); + next line; + basic page (old basic page); + ELSE errorstop (1080,"INPUT-Fehler (" + error text + + ") : >" + input line + "<"); + FI; + FI; + + . error text : + SELECT input error no OF + CASE wrong type : "falscher Typ" + CASE insufficient data : "zu wenig Daten" + CASE too much data : "zu viele Daten" + CASE overflow : "Überlauf" + OTHERWISE : "" + END SELECT + + . editget input line : + TEXT VAR exit char; + INT VAR x, y; + get cursor (x, y); + REP IF width - x < 1 + THEN out (""13""10""); + get cursor (x, y) + FI; + editget (input line, max text length, width - x, "", "k", exit char); + cursor (x, y); + IF exit char = ""27"k" + THEN input line := previous input line; + ELSE previous input line := input line; + LEAVE editget input line; + FI; + PER; + +END PROC read input; + + +PROC out string (TEXT CONST string) : + + basic out (string); + IF on terminal THEN out (string) FI; + +END PROC out string; + + +PROC out line : + + next line; + IF on terminal THEN out (""13""10"") FI; + +END PROC out line; + + +BOOL PROC check input (INT CONST type) : + + get next input value; + input value := compress (input value); + set conversion (TRUE); + SELECT type OF + CASE 1 : check int input + CASE 2 : check real input + CASE 3 : check text input + END SELECT; + IF NOT last conversion ok THEN input error no := wrong type FI; + input error no = 0 + + . check int input : + IF input value <> "" + THEN disable stop; + INT VAR help int value; + help int value := int (input value); + IF is error CAND error code = int overflow + THEN clear error; + input error no := overflow; + FI; + enable stop; + FI; + + . check real input : + IF input value <> "" + THEN disable stop; + REAL VAR help real value; + help real value := val (input value); + IF is error CAND (error code = real overflow + OR error code = int overflow) (* <-- Aufgrund eines Fehlers in 'real' *) + THEN clear error; + input error no := overflow; + FI; + enable stop; + FI; + + . check text input : + (* IF input value = "" THEN input error no := wrong type FI; *) + IF NOT is quoted string CAND quote found + THEN input error no := wrong type + FI; + + . is quoted string : + first quote found CAND last quote found + + . last quote found : + (input value SUB LENGTH input value) = quote + + . quote found : + pos (input value, quote) > 0 + +END PROC check input; + + +PROC assign input (INT VAR int value) : + + get next input value; + int value := int (input value); + +END PROC assign input; + +PROC assign input (REAL VAR real value) : + + get next input value; + real value := val (input value); + +END PROC assign input; + +PROC assign input (TEXT VAR string value) : + + get next input value; + input value := compress (input value); + IF first quote found + THEN string value := subtext (input value, 2, LENGTH input value -1) + ELSE string value := input value + FI; + +END PROC assign input; + +PROC assign input line (TEXT VAR string line) : + + string line := input line; + +END PROC assign input line; + + +PROC get next input value : (* F27/rr *) + + IF input line pos > LENGTH input line + THEN input value := ""; + input error no := insufficient data; + ELSE IF next non blank char = quote + THEN get quoted string + ELSE get unquoted string + FI; + FI; + + . next non blank char : + INT CONST next non blank char pos := pos (input line, ""33"", ""255"", input line pos + 1); + input line SUB next non blank char pos + + . get quoted string : + INT CONST quote pos := pos (input line, quote, next non blank char pos + 1); + IF quote pos = 0 + THEN input value := subtext (input line, next non blank char pos); + input line pos := LENGTH input line + 1; + input error no := wrong type; + ELSE input value := subtext (input line, next non blank char pos, quote pos); + input line pos := pos (input line, ""33"", ""255"", quote pos + 1); + IF input line pos = 0 + THEN input line pos := LENGTH input line + 1; + ELIF (input line SUB input line pos) <> comma + THEN input error no := wrong type; + input line pos DECR 1; + FI; + FI; + + . get unquoted string : + INT VAR comma pos := pos (input line, comma, input line pos + 1); + IF comma pos = 0 + THEN input value := subtext (input line, input line pos + 1); + input line pos := LENGTH input line + 1; + ELSE input value := subtext (input line, input line pos + 1, comma pos - 1); + input line pos := comma pos; + FI; + +END PROC get next input value; + + +BOOL PROC input ok: + + IF input line pos <= LENGTH input line + THEN input error no := too much data FI; + input line pos := 0; + input error no = 0 + +END PROC input ok; + +BOOL PROC input eof: input line = "" END PROC input eof; + + +END PACKET basic input; + +PACKET basic std using io (* Autor: R. Ruland *) + (* Stand: 26.10.87/rr/mo *) + + DEFINES init rnd: + + +PROC init rnd: + + REAL VAR init; + REP read input (TRUE, "Startwert des Zufallszahlengenerators ? ", FALSE); + UNTIL check input (2) CAND input ok PER; (* F24/rr *) + assign input (init); + init rnd (init); + +END PROC init rnd; + + +END PACKET basic std using io; + diff --git a/lang/basic/1.8.7/src/eumel coder 1.8.1 b/lang/basic/1.8.7/src/eumel coder 1.8.1 new file mode 120000 index 0000000..5fead18 --- /dev/null +++ b/lang/basic/1.8.7/src/eumel coder 1.8.1 @@ -0,0 +1 @@ +../../../../system/eumel-coder/1.8.1/src/eumel coder 1.8.1 \ No newline at end of file diff --git a/lang/basic/1.8.7/src/eumel0 codes b/lang/basic/1.8.7/src/eumel0 codes new file mode 100644 index 0000000..226014c Binary files /dev/null and b/lang/basic/1.8.7/src/eumel0 codes differ diff --git a/lang/basic/1.8.7/src/gen.BASIC b/lang/basic/1.8.7/src/gen.BASIC new file mode 100644 index 0000000..9690ae6 --- /dev/null +++ b/lang/basic/1.8.7/src/gen.BASIC @@ -0,0 +1,80 @@ +(**************************************************************************) +(* *) +(* Generatorprogramm zur Installation des EUMEL-BASIC-Systems *) +(* *) +(* Autor: Heiko Indenbirken *) +(* Überarbeitet von: Michael Overdick *) +(* *) +(* Stand: 27.08.1987 *) +(* *) +(**************************************************************************) + +LET coder name = "eumel coder 1.8.1"; + +show headline; +from archive ("BASIC.1", (coder name & "eumel0 codes") - all); +from archive ("BASIC.2", + ("BASIC.Runtime" & "BASIC.Administration" & "BASIC.Compiler") - all); +set status; +insert ("eumel coder 1.8.1"); +insert ("BASIC.Runtime"); +insert ("BASIC.Administration"); +insert ("BASIC.Compiler"); +forget (coder name & "BASIC.Runtime" + & "BASIC.Administration" & "BASIC.Compiler" & "gen.BASIC"); +restore status; +show end . + +show headline: + page; + putline (" "15"Einrichten des EUMEL-BASIC-Systems "14""); + line . + +set status: + BOOL VAR old check := check, + old warnings := warnings, + old command dialogue := command dialogue; + check off; + warnings off; + command dialogue (FALSE). + +restore status: + IF old check THEN do ("check on") ELSE do ("check off") FI; + IF old warnings THEN warnings on FI; + command dialogue (old command dialogue). + +show end: + line (2); + putline (" "15"BASIC-System installiert "14""); + line . + +PROC from archive (TEXT CONST name, THESAURUS CONST files): + IF highest entry (files) > 0 + THEN ask for archive; + archive (name); + fetch (files, archive); + release (archive); + putline ("Archiv abgemeldet !") + FI . + +ask for archive: + line; + IF no ("Archiv """ + name + """ eingelegt") + THEN errorstop ("Archive nicht bereit") FI . + +END PROC from archive; + +THESAURUS OP & (TEXT CONST left, right): + THESAURUS VAR result := empty thesaurus; + insert (result, left); + insert (result, right); + result +END OP &; + +THESAURUS OP & (THESAURUS CONST left, TEXT CONST right): + THESAURUS VAR result := left; + insert (result, right); + result +END OP &; + + diff --git a/lang/dynamo/1.8.7/doc/dynamo handbuch b/lang/dynamo/1.8.7/doc/dynamo handbuch new file mode 100644 index 0000000..4012973 --- /dev/null +++ b/lang/dynamo/1.8.7/doc/dynamo handbuch @@ -0,0 +1,1826 @@ +#block##pageblock##page (2)##setcount (1)##count per page# +#head# +#center#DYNAMO-Compiler +#center#____________________________________________________________ + +#end# +#bottom odd# +#center#____________________________________________________________ +GMD #right#DYNAMO - % +#end# +#bottom even# +#center#____________________________________________________________ +DYNAMO - % #right#GMD +#end# + +#ib#1. Einleitung#ie# + + + +Diese Handbuch beschreibt die Funktion des EUMEL-DYNAMO-Compilers in der +Version 3.3+ und seine Einschränkungen oder Änderungen gegenüber dem +DYNAMO-Sprachstandard. In keiner Weise kann diese Beschreibung eine Einfüh­ +rung in die Programmiersprache DYNAMO ersetzen! + +Die beschriebene Compilerversion enthält nun auch ein Modul zur Unterstützung von +hochauflösender Grafik durch die häufig in IBM-PC/AT-Kompatiblen eingesetzte +CGA-Grafikkarte. Dennoch ist es einfach möglich, diesen Grafikmodus auszuschal­ +ten, und somit die alte, zeichenorientierte Grafik weiter zu verwenden. + +Der DYNAMO-Compiler wurde 1983 von Robert Keil und Torsten Fröhlich (Helm­ +holtz-Gymnasium, Bonn) im Rahmen des MIKROS-Projektes am Informatik-Kolleg +der GMD entwickelt. Für Spezifikation und Betreuung der Entwicklung war Dr. Diether +Craemer verantwortlich, software-technische Unterstützung kam von Prof. John +Henize, Dr. Peter Heyderhoff, Rudolf Legde und Dipl.- Math. Lothar Oppor. Die +Grafik wurde von D.Giffeler beigesteuert. + + + + +#ib#1.1. Referenzliteratur#ie# + + + + + [1] Craemer, Diether + "Mathematisches Modellieren dynamischer Vorgänge" + e. Einf. in die Programmiersprache DYNAMO + Stuttgart, Teuber, 1985 + ISBN 3-519-02477-2 + + [2] Craemer, Diether + "Fluß und Zustand - Simulation dynamischer Vorgänge in DYNAMO" + in: LOGIN 5 (1985), Heft 1, S. 20-23 + + [3] Pugh, Alexander L. + "DYNAMO II User's Manual" + Cambridge, London 1973: MIT-Press + ISBN 0-262-66018-0 +#page# + +#ib#1.2. Die Programmiersprache DYNAMO#ie# + + + +DYNAMO wurde von einer Gruppe um Jay FORRESTER am Massachusetts Institute +of Technology (MIT) um 1960 entwickelt. Die Sprache basiert auf der #on ("i")# System +Dynamic#off ("i")# von FORRESTER. + +In DYNAMO (#on ("u")##on ("b")#Dyna#off ("b")##off ("u")#mic #on ("u")##on ("b")#Mo#off ("b")##off ("u")#delling Language) können Systeme, in denen Veränderun­ +gen kontinuierlich geschehen, modelliert und simuliert werden. + +Kontinuierliche Veränderungen von Größen werden über deren Veränderungsrate im +Wesentlichen nach folgender Gleichung berechnet + +Größe jetzt = Größe früher + DT * Veränderungsrate, + +dabei ist DT die Länge des Zeitintervalls von "früher" bis "jetzt". + +Außer diesen Gleichungen für Größen braucht man Gleichungen für die Verände­ +rungsraten, für Hilfsgrößen, zur Initialisierung von Größen, zur Definition von Konstan­ +ten und Tabellen, zu Angaben von Simulationsläufen und zur Wiedergabe von Ergeb­ +nissen in Zahlentabellen oder Diagrammen. + +Alle diese Gleichungen können einfach in der Form, wie man sie aus dem Mathema­ +tik-Unterricht der Sekundarstufe kennt, hingeschrieben werden, ohne sich Gedanken +über den Ablauf des Programms machen zu müssen. + +#on ("b")# +DYNAMO ist also eine einfache funktional-applikative, nicht-prozedurale Sprache.#off ("b")# + +Das macht ihren Reiz und ihre Leistungsfähigkeit aus, die zur Formulierung der be­ +kannten Weltmodelle von FORRESTER, MEADOWS ("Die Grenzen des Wachstums"), +PESTEL, MESAROVIC u.a. in dieser Sprache führten. + +Anwendungsgebiete der Sprache sind ökologische, gesellschaftliche, wirtschaftliche +und technische Systeme, deren dynamisches Verhalten der Modellbildner nachbilden +und studieren möchte. + +Im Allgemeinen verfolgt der Modellbildner mit seinem Modell einen Zweck (Verhaltens­ +änderung des nachgebildeten Systems), so daß auch neben gesicherten Fakten die +Wertvorstellungen des Modellbildners in das Modell eingehen. + + + + +#ib#1.3 Kurz-Einführung in die DYNAMO- +Schreibweise#ie# + + + +Die System Dynamic Methode benutzt als Analogie-Bild den Archetyp des Flusses: + + - Wasser fließt durch das Flußbett, kann in Seen gestaut und in der Ge­ + schwindigkeit durch Schleusen und Wehre reguliert werden. + + - Analog dazu "fließt" Geld auf dem Überweisungsweg, wird in Konten gestaut, + und die Liquidität kann durch Zinssätze reguliert werden. + + - Gedanken "fließen" auf Nervenbahnen, werden im Gehirn gespeichert, und + Gedankenströme werden über Synapsen reguliert. + + - Autos "fließen" über Straßen, werden auf Parkplätzen gestaut, und der Ver­ + kehrsfluß wird über Ampeln reguliert. + + - Menschen "fließen" über Wanderwege, halten sich in Wohnorten auf, und die + Bevölkerungsdynamik wird durch ein komplexes, rückgekoppeltes Zusammen­ + spiel von Ein- und Auswanderungsraten sowie Geburts- und Sterberaten + reguliert. + +Am letzten Beispiel wird deutlich, daß sich ein soziales Phänomen nur im Zusam­ +menwirken vieler netzartig miteinander verbundener Variablen beschreiben läßt (wenn +überhaupt). + +Solange jedoch einigen Variablen ZUSTANDS-CHARAKTER ("Wasserstand") und +anderen VERÄNDERUNGS-CHARAKTER ("Flußgeschwindigkeit") zugeordnet +werden kann, können die Größen für Berechnungen folgender Art verwendet werden: + + + Wasserstand jetzt = Wasserstand früher + vergangene Zeit * + (Zuflußrate - Abflußrate) + + +analog: + + Bevölkerung jetzt = Bevölkerung früher + vergangene Zeit * + (Geburtsrate - Sterberate) + + +Diese Schreibweise kann praktisch so in ein Computerprogramm übernommen wer­ +den. Mit geringfügigen Änderungen handelt es sich bei diesen Gleichungen schon um +gültige Zeilen in der Programmiersprache DYNAMO. + +In DYNAMO wird er Zeitpunkt "jetzt" durch das Anhängsel .K, der Zeitpunkt "früher" +durch das Anhängsel .J, die Zeitspanne von jetzt bis später durch das Anhängsel .KL, +die Zeitspanne von früher bis jetzt durch das Anhänsel .JK und die vergangene Zeit +mit DT (wie "Delta Tempus": Zeitdifferenz) bezeichnet. Die Variablen mit Zustands- +Charakter heißen LEVELS (Niveaus) und die Veränderungs-Charakter heißen RATES +(Veränderungsraten, Geschwindigkeiten). Die entsprechenden Gleichungen werden mit +L bzw. R gekennzeichnet. Es gib weitere Kennzeichnungen: + + C für Konstantendefinition (constant) + T für Tabellendefintion (table) + A für Hilfsgrößen (auxiliaries) + N für Anfangswerte (initial) + X für Folgezeile (extension) + PRINT für Ausgabe von Zahlen + PLOT für Ausgabe von Diagrammen + +Ein einfaches Bevölkerungsmodell könnte z.B. so geschriben werden: + + + L BEVÖLKERUNG.K=BEVÖLKERUNG.J+DT*(GEBURTENRATE.JK + X -STERBERATE.JK) + R STERBERATE.KL=5 + R GEBURTENRATE.KL=20 + N BEVÖLKERUNG=1000 + C DT=1 (jedes Jahr wird neu berechnet) + C LENGTH=60 (60 Jahre werden simuliert) + PRINT BEVÖLKERUNG + + +Für eine tiefere Einführung in DYNAMO sollte man die Referenzliteratur zu Rate +ziehen. + + + + +#ib#1.4 Eine erste, kleine Sitzung mit dem +DYNAMO-System#ie# + + + +Wir gehen davon aus, daß das DYNAMO-System in ihrer Task generiert worden ist +(siehe 2.). + + 1. Tippen Sie das obrige Programm mittels des EUMEL-Editors ab. + + 2. Verlassen Sie den Editor mit und starten Sie den DYNAMO- + Compiler durch die Eingabe des Befehls "dynamo". + + 3. Nach erfolgreichem Übersetzen sollte Ihnen nun das DYNAMO-Runtime- + System zur Verfügung stehen. Durch den Befehl 'run' wird das Programm aus­ + geführt und Sie erhalten eine Zahlenkolonne, die die Entwicklung der Bevöl­ + kerung in den zu untersuchenden 60 Jahren angibt. Falls Ihnen beim Abtippen + des Programms Fehler unterlaufen sein sollten, so kann das Programm nicht + fehlerfrei übersetzt werden. Fehlermeldunggen zur Compile-Zeit des + DYNAMO-Compilers werden im Paralleleditor angezeigt; das Programm kann + im oberen der beiden Editorfenster (in diesem befinden Sie sich auch nach + Fehlern) korrigiert werden. Danach können Sie erneut wie nach Punkt 2 ver­ + fahren. +#page# + + + +#ib#2. Generierung des DYNAMO-Compilers#ie# + + + +Der DYNAMO-Compiler, seine Funktionen und die Beispielprogramme werden auf +zwei Archiv-Disketten a#b#' 360 KB ausgeliefert. + +Zum Generieren des DYNAMO-Systems legen Sie bitte die erste Diskette in das +Dikettenlaufwerk Ihres Rechners und durch folgende Kommandozeile lesen Sie den +Generator vom Archiv und starten ihn: + + + archive ("dynamo"); fetch ("dyn.inserter", archive); run + + +Danach holt der Generator alle benötigten Dateien vom eingelegten Archiv bzw. von +dem zweiten Archiv (nachdem er Sie zum Wechseln der Diskette aufgefordert hat). +Anschließend wird der DYNAMO-Compiler insertiert. Am Ende der Generierung +werden Sie gefragt werden, ob Sie den Compiler mit Grafik#u##count ("Grafik")##e# oder ohne benutzen +wollen. Nach der Meldung "dynamo system generiert" können Sie den Compiler#foot# +#u##value ("Grafik")##e# Es kann z.Zt. nur eine CGA-Grafikkarte betrieben werden +#end# +nutzen. +#page# + + + +#ib#3. Der EUMEL-DYNAMO-Compiler#ie# + + + +Der im EUMEL-System implementierte DYNAMO-Compiler ist ein 2-Pass- +Compiler, der die DYNAMO-Programme zunächst in ELAN übersetzt. Der Vorteil +dieser Methode besteht darin, daß es möglich ist, übersetzte Programme unabhängig +vom DYNAMO-Compiler zur Ausführung bringen zu können. + +Die Notation der im folgenden aufgeführten ELAN-Prozeduren des Compilers ent­ +spricht der in den EUMEL-Handbüchern üblichen Prozedurkopf-Schreibweise. + +Als Beispiel: + + + dynamo ("dyn.grasshasenfuchs") + + +ein Beispiel für den Aufruf der Prozedur mit der Prozedurkopf-Schreibweise + + PROC dynamo (TEXT CONST filename) + +auf der Kommando-Ebene des Betriebssystems EUMEL. + +Der Prozedur 'dynamo' wird beim Aufruf der Dateiname (TEXT) 'filename' übergeben +und dadurch der Compiler auf die Datei mit dem Namen 'filename' angewendet. + + + + +#ib#3.1. Benutzung des DYNAMO-Compiler#ie# + + + +Um ein DYNAMO-Programm zu Übersetzen, gibt es grundsätzlich zwei Möglichkei­ +ten. Erst einmal kann man ein DYNAMO-Programm in ein ELAN-Programm um­ +wandeln, jedoch ohne es dabei zur Ausführung zu bringen. Dieses ELAN-Programm +kann man nun unabhängig vom eingentlichen Compiler starten. Die zweite, wohl öfter +angewendete Methode ist, ein DYNAMO-Programm in ein ELAN-Programm zu +compilieren, wobei es danach direkt ausgeführt wird. Ob danach ein ELAN- +Programm zur Verfügung stehen soll, kann der Benutzer selbst entscheiden. + + +PROC dynamo + + Zweck: Aufruf des DYNAMO-Compilers mit 'quelldatei' = 'last param', d.h. das + zu übersetzende Programm steht in der zuletzt bearbeiteten Datei. + + +PROC dynamo (TEXT CONST quelldatei) + + Zweck: Ruft den DYNAMO-Compiler für die Datei 'quelldatei' auf. Anmerkung: + Gleichbedeutend mit 'dynamo (quelltext, quelltext + ".elan", TRUE)', s. + nächste Prozedur. + + Beispiel: + + + dynamo ("dyn.grashasenfuchs") + + + Der DYNAMO-Compiler wird auf die Datei "dyn.grashasenfuchs" ange­ + wendet. + + +PROC dynamo (TEXT CONST quelldatei, zieldatei, + BOOL CONST pass2 ausfuehren) + + Zweck: Diese Prozedur startet den DYNAMO-Compiler. 'quelldatei' gibt den + Namen der Datei an, in welcher der DYNAMO-Quelltext enthalten ist, + 'zieldatei' ist der Name der Datei, die das erzeugte ELAN-Programm + beinhalten soll. Wenn 'pass2 ausfuehren' = TRUE, dann wird dieses auch + durch den ELAN-Compiler weiterverarbeitet (das Programm wird zur + Ausführung gebracht). + + Beispiel: + + + dynamo ("dyn.grashasenfuchs", + "grashasenfuchs.elanprogramm", FALSE) + + + Im obigen Beispiel wird der in der Datei "dyn.grashasenfuchs" enthaltene + DYNAMO-Quelltext in die Datei "grashasenfuchs.elanprogramm" als + ELAN-Programm geschrieben. Das ELAN-Programm wird nicht ausge­ + führt. + + +PROC erase (BOOL CONST erase option) + + Zweck: Wenn 'erase option' = TRUE, so werden die erzeugten ELAN-Programme + nach Beendigung der Ausführung gelöscht, bei 'erase option' = FALSE + bleiben sie erhalten (Voreinstellung: 'erase option' = FALSE). + + +PROC error listing (TEXT CONST fehlerdatei) + + Zweck: Falls gewünscht ist, die Fehlermeldungen, die ggf. beim Übersetzen ein­ + treten, auch in eine Datei zu schreiben, so können Sie hier unter 'fehler­ + datei' einen Dateinamen angeben. Bei der Angabe von "" wird die Umlei­ + tung in die Datei ausgeschaltet werden (Voreingestellt ist 'fehlerdatei' = + ""). + + +PROC graphic (BOOL CONST graphic option) + + Zweck: Mit dieser Prozedur läßt sich einstellen, ob bei der DYNAMO-Anweisung + PLOT die hochauflösende Grafik ('graphic option' = TRUE) oder die zei­ + chenorientierte Grafik ('grafik option' = FALSE) verwendet werden soll. Die + Voreinstellung wird bei der Installation des Compilers erfragt. + + +PROC protokoll (BOOL CONST protokoll option) + + Zweck: Bei 'protokoll option' = TRUE werden alle Textausgaben, die bei der + Laufzeit des DYNAMO-Programmes auftreten, nicht nur auf dem Bild­ + schirm dargestellt, sondern auch in eine Datei mit dem Namen "dyn.out" + protokolliert (voreingestellt ist 'protokoll option' = FALSE). Die Datei + "dyn.out" enthält auch Seitenvorschubbefehle ('\#page\#') und sollte nur mit + einem EUMEL-Printer ausgedruckt werden. + + + + +#ib#3.2. Abweichungen gegenüber dem + Sprachstandard#ie# + + + + - Die Länge der Namen ist nicht auf 7 Zeichen festgelegt, sondern praktisch be­ + liebig (32000). Dies ist eine Erweiterung; wer seine Programme auch auf ande­ + ren DYNAMO-Compilern laufen lassen will, sollte sich aber auf 7 Zeichen be­ + schränken. + + - Zahlen werden intern mit einer Mantisse von 13 Stellen abgespeichert, von denen + nur die ersten 7 bei der Ausgabe dargestellt werden. Die größte darstellbare Zahl + ist daher 9.999999999999e126. + + - Die maximale Anzahl der Gleichungen ist auf 950 festgelegt. + + - Der Compiler akzeptiert aus Gründen der besseren Lesbarkeit auch Programme, + die in Kleinschrift geschrieben sind. Dabei ist es sinnvoll, die Quellprogramme + konsistent zu halten (d.h. Groß- und Kleinschrift nicht zu vermischen). Man + sollte grundsätzlich Kleinschrift vorziehen, da diese vom Compiler auch effizienter + verarbeitet werden kann. + + - Quellprogramme dürfen eine beliebige Zahl von Leerzeilen enthalten. X - Befeh­ + le (Fortschreibungszeilen) werden davon nicht beeinflußt. + + - In der augenblicklichen Version 3.3 des Compilers gelten folgende Einschränkun­ + gen : + + 1. Bei der Verarbeitung von Array-Gleichungen werden Compilerseitig keine + Semantik-Überprüfungen auf eventuell unzureichende Initialisierung oder + Überlappung (d.h. mehrfaches Setzen desselben Elements) durchgeführt. + Defaultmäßig bekommen alle Elemente einer Array-Gleichung bei der Initiali­ + sierung den Wert '0.0' zugewiesen. + + 2. Die maximale Größe von Tables und Array-Gleichungen ist durch Verwen­ + dung des Vector-Pakets auf 4000 Elemente festgelegt. Da pro Table-Ele­ + ment aber zur Zeit eine Zeile im Zielprogramm generiert wird, sollte man dies + besser nicht ausnutzen. + + 3. Supplementary-Gleichungen werden aus Kompatibilitäts-Gründen korrekt + übersetzt, aber sonst wie Auxiliary-Gleichungen behandelt. + + 4. Print ('prtper')- und Plotperiode ('pltper') werden nur als Konstanten verarbei­ + tet. Falls Gleichungen für 'prtper' oder 'pltper' angegeben werden, so bewirken + diese keine Veränderung. + + 5. Array-Gleichungen dürfen nicht mehr als eine Dimension besitzen. + + 6. Für Gleichungen, die Makro-Aufrufe enthalten, sollten Initialisierungs (N)- + Gleichungen angegeben werden. + + + +#ib#3.3. Das DYNAMO Runtime-System#ie# + + + +Nach erfolgreicher Übersetzung wird vom Zielprogramm das Runtime-System aufge­ +rufen. In diesem Modus (das DYNAMO-Runtime-System meldet sich mit "dynamo +runtime system :") ist es möglich, Konstanten zu ändern und DynamoProgramme zur +Ausführung zu bringen. + +Im DYNAMO-Runtime-System stehen folgende Kommandos zur Verfügung (näheres +zur Notation siehe Kapitel 4, S. #to page ("Anweisungen und Funktionen")#). + + + run + + Zweck: Ausführen des übersetzten Programms + + + run + + Zweck: Ausführen des übersetzten Programms und retten des Konstantendaten­ + raums in des Datenraum mit dem Namen ".const". Existiert der + Datenraum bereits, werden die Konstanten aus dem Datenraum in den + Lauf übernommen. Somit ermöglicht der Compiler, Konstantenwerte aus + einem früheren Lauf wieder zu verwenden. + + + c =Wert [/=Wert [...]] + + Zweck: Änderung einer oder mehrerer Konstanten + + + ? + + Zweck: Anzeigen der Konstanten und ihrer Werte + + + quit + + Zweck: Verlassen des Runtime-Systems + + + help + + Zweck: Zeigt eine kurze Erklärung + + +Bei PRINT- und PLOT-Ausgaben sind folgende Kommandos möglich: + + + Nächster Bildschirm + o (Off), keine Unterbrechung der Ausgabe (nicht möglich bei hochauflösen­ + der Grafik) + e (End), Zurück zum Runtime System + p Phasendiagramm (nur bei hochauflösender Grafik möglich) + + + +#ib#3.4. Fehlermeldungen des + DYNAMO-Compilers#ie# + + + +Falls der Compiler einen Fehler im DYNAMO-Programm entdeckt, gibt er eine Feh­ +lermeldung nach dem folgenden Muster aus: +"Fehler in Zeile bei >> << : . + +Im folgenden sind alle Fehlermeldungen und Möglichkeiten zur Abhilfe aufgelistet, +sofern diese nicht klar ersichtlich sind: + + 1 GLEICHUNG DOPPELT DEFINIERT + + 2 DOPPELTE INITIALISIERUNG + + 3 FALSCHER ZEILENTYP + -> Erlaubt sind : a, c, l, n, r, s, print, plot, note, spec, *, x, macro, mend, + for, noise, run. + + 4 VERSCHACHTELTE MAKRO-DEFINITION + -> 'mend' - Befehl fehlt. + + 5 MAKRO-NAME ERWARTET + + 6 '(' ERWARTET + + 7 FORMALER PARAMETER ERWARTET + + 8 ')' NACH PARAMETERLISTE ERWARTET + + 9 BEI AUXILIARIES NUR SUBSKRIPTION MIT '.K' ERLAUBT + +10 BEI KONSTANTEN-DEFINITION NAME ERWARTET + +11 BEI LEVELS NUR SUBSKRIPTION MIT '.K' ERLAUBT + +12 BEI RATES NUR SUBSKRIPTTION MIT '.KL' ERLAUBT + +13 BEI TABLE-DEFINITIONEN KEINE SUBSKRIPTION ERLAUBT + +14 X - BEFEHL HIER NICHT ERLAUBT + +15 BEI FOR-DEFINITION NAME ERWARTET + +16 '=' NACH FOR-VARIABLE ERWARTET + +17 BEREICHSANGABE ERWARTET + +18 ',' ERWARTET + +19 LOKALE GLEICHUNG NUR IN MAKRO ERLAUBT + +20 BEI DEFINITION NAME ERWARTET + +21 '=' ERWARTET + +22 INDEX NICHT KORREKT + -> Als Index ist nur erlaubt : !, + !. + ::= "+"; "-". + +23 ')' NACH INDIZIERUNG ERWARTET + +24 PRTPER NICHT DEFINIERT + -> Wenn das Programm einen Print-Befehl enthält, muß 'prtper' (Printperiode) + als Konstante definiert werden. + +25 PLTPER NICHT DEFINIERT + -> Wenn das Programm einen Plot-Befehl enthält, muß 'pltper' (Plotperiode) + als Konstante definiert werden. + +26 '/' ODER ',' BEI PLOT ERWARTET + +27 NAME ALS PLOTPARAMETER ERWARTET + +28 DOPPELTE SCALE - ANGABE IN EINER GRUPPE + -> Wenn mehrere Plotparameter mit ',' getrennt werden (also die gleiche Ska­ + lierung erhalten), dürfen nicht mehrere feste Skalierungen angegeben wer­ + den. + +29 ERSTE SCALE - ANGABE ERWARTET + +30 ZWEITE SCALE - ANGABE ERWARTET + +31 ')' NACH SCALE - ANGABE FEHLT + +32 PRINTPARAMETER NICHT DEFINIERT + +33 PRINTPARAMETER ERWARTET + +34 TIME DARF NUR INITIALISIERT WERDEN + +35 DT NICHT DEFINIERT + +36 LENGTH NICHT DEFINIERT + +37 BEI KONSTANTEN - DEFINITION ZAHL ERWARTET + +38 BEI INITIALISIERUNG KONSTANTE ERWARTET + +39 LEVELS MUESSEN INITIALISIERT WERDEN + +40 KONSTANTE BEI TABLE ERWARTET + +41 '/' ODER "," ERWARTET + +42 TABLE - DEFINITION OHNE BENUTZUNG + +43 SIMULTANE GLEICHUNGEN + -> Bei dem Versuch, A, R, oder N - Gleichungen zu sortieren, trat eine + direkte oder indirekte Rekursion auf. + +44 FAKTOR ERWARTET + -> Erwartet : ; + ; + ; + ; + '(', , ')'; + , . + ::= '+'; '-'. + +45 TIME MUSS MIT '.J' ODER '.K' SUBSKRIBIERT WERDEN + +46 SYMBOL NICHT DEFINIERT + +47 FUNKTION NICHT DEFINIERT + +48 UNZULAESSIGE INDIZIERUNG + -> Die Indices auf beiden Seiten der Gleichung müssen immer gleich sein. + +49 FALSCHE PARAMETERANZAHL + +50 FALSCHES TRENNSYMBOL ZWISCHEN PARAMETERN + +51 ALS PARAMETER TABLE ERWARTET + +52 FALSCHER PARAMETER IN TABLEFUNKTION + +53 ZU VIELE AKTUELLE PARAMETER + +54 ')' NACH MAKROAUFRUF FEHLT + +55 REKURSIVER MAKROAUFRUF + +56 BEI N - GLEICHUNG KEINE SUBSKRIPTION ERLAUBT + +57 FALSCHE SUBSKRIPTION IN AUXILIARY - GLEICHUNG + +58 ')' ERWARTET + +59 FALSCHE SUBSKRIPTION IN LEVEL - GLEICHUNG + +60 FALSCHE SUBSKRIPTION IN RATE - GLEICHUNG + +61 FOR - VARIABLE NICHT DEFINIERT + -> Eine FOR - Variable muß vor der ersten Benutzung definiert werden. + +62 KONSTANTE ERWARTET + +63 FALSCHES REAL - FORMAT + -> Exponent fehlt + +64 GLOBALE GLEICHUNG IN MACRO NICHT ERLAUBT + +65 DOPPELTE DEFINITION BEI MEHRFACHEM MAKROAFRUF + +66 ALS NOISE - PARAMETER ZAHL ERWARTET +#page# + +#ib#4. Anweisungen und Funktionen des + EUMEL-DYNAMO-Compilers#ie# +#goal page ("Anweisungen und Funktionen")# + + +Dieses Kapitel gibt eine alphabetische Übersicht über die im EUMEL-DYNAMO- +Compiler realisierten Anweisungen und Funktionen (wertliefernde Algorithmen). + +Die Beschreibung der Anweisungen und Funktionen ist nach der DYNAMO- +Syntaxregel angegeben, wobei folgende Zeichen mit besonderer Bedeutung verwendet +werden: + + [] optionale Angabe + [...] beliebig häufige Wiederholung der letzten optionalen Angabe + < > in spitzen Klammern stehende Namen sind Variablen- bzw. Konstan­ + tennamen + steht für einen beliebigen Bezeichner gemäß der DYNAMO-Syntax + bezeichnet einen beliebigen Wert (also auch eine Ausdruck) + {} Alternative Angabe + + X DYNAMO Anweisung, kennzeichnet eine Fortsetzungsszeile der + vorhergegangenen Anweiung (S. #to page ("X")#) + +Alle Anweisungen und Funktionen werden nach dem gleichen Schema dargestellt: + + + +Funktionsname#right#Typ (Funkt. oder Anweisung) + + +Zweck: Schlagwort zur Wirkung + +Format: Beschreibung des Formates (spezielle Zeichen s.o.) + +Erklärung: kurze Beschreibung der Anweisung/Funktion + +Beispiel: Anwendung der Anweisung/Funktion + +Programm: Beispielprogramm, in welchem die Anweisung/Funktion angewendet wird. + +Referenz: Verweis auf ähnliche oder äquivalente Anweisungen/Funktionen im + Format ', Seitennummer'. + + +Eine oder mehrere dieser Felder können fehlen (z.B. wenn es keine Referenz oder +kein Beispielprogramm gibt). +#page# + + + +#ib#4.1. Übersicht über die Anweisungen und + Funktionen#ie# + + + +#goal page ("A")##ib (2)#A#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Auxiliary-Gleichung (A-Gleichung, Hilfsgleichung) + +Format: A .K=#u##count ("Ausdruck")##e# +#foot# +#u##value ("Ausdruck")##e# genaueres über die Definition eines Ausdruckes siehe [1], S. 93 +#end# + +Erklärung: Mit Hilfe von Auxiliary-Gleichungen werden Level- und Hilfsgrößen + (Auxiliaries) zum selben Zeitpunkt verknüpft. + +Beispiel: A JM.K=MM.K/MEJ + +Programm: "dyn.workfluc" + + + +#ib (2)#ABS#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Absolutbetrag + +Format: ABS() + +Erklärung: Liefert den Absolutbetrag + + + IF >= 0 THEN + + ELSE + - + END IF + +Beispiel: N X=ABS(A*2.0) + + + +#goal page ("ARCTAN")#ARCTAN#on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Arcustangens + +Format: ARCTAN() + +Erklärung: Berechnet den Arcustangens von ; Ergebnis im Bogenmaß. + +Beispiel: N X=ARCTAN(TAN(1.3)) (X = 1.3) + + +Referenz: COSD, S. #to page ("COSD")# + SIN, S. #to page ("SIN")# + SIND, S. #to page ("SIND")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAND, S. #to page ("ARCTAN")# + COS, S. #to page ("COS")# + + + +#goal page ("ARCTAND")##ib (2)#ARCTAND#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Arcustangens + +Format: ARCTAND() + +Erklärung: Berechnet den Arcustangens von ; Ergebnis im Gradmaß + +Beispiel: N X=ARCTAND(TAND(45.0)) (X = 45.0) + + +Referenz: COSD, S. #to page ("COSD")# + SIN, S. #to page ("SIN")# + SIND, S. #to page ("SIND")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + COS, S. #to page ("COS")# + ARCTAN, S. #to page ("ARCTAND")# + + + +#goalpage ("C")##ib (2)#C#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Konstantendefinition + +Format: C = + +Erklärung: Werte, die während eines Simulationslaufes gleich bleiben, können durch + die Konstantendefintion benannt werden (s. auch 'c' im Runtime- + System). + +Beispiel: C POPI=30.3 + +Programm: "dyn.wohnen" + + + +#goal page ("CLIP")##ib (2)#CLIP#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Wert nach Bedingung + +Format: CLIP(,,,) + +Erklärung: Liefert den Wert des ersten Argumentes, wenn das dritte Argument + größer oder gleich dem vierten Argument ist. Andernfalls wird der Wert + des zweiten Argumentes geliefert. + + + IF >= THEN + + ELSE + + END IF + +Beispiel: N X=CLIP(1.0,2.0,3.0,4.0) (X = 2.0) + + +Programm: "dyn.welt/forrester" + +Referenz: FIFGE, S. #to page ("FIFGE")# (äquivalente Funktion) + + + +#goalpage ("COS")#COS#on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Cosinus + +Format: COS() + +Erklärung: Es wird der Cosinus des Wertes , welcher im Bogenmaß vorlie­ + gen muß, geliefert. + +Beispiel: N X=COS(1.6) + +Referenz: COSD, S. #to page ("COSD")# + SIN, S. #to page ("SIN")# + SIND, S. #to page ("SIND")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#goal page ("COSD")##ib (2)#COSD#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Cosinus + +Format: COSD() + +Erklärung: Es wird der Cosinus des Wertes , welcher im Gradmaß vorliegen + muß, geliefert. + +Beispiel: N X=COSD(33.5) + +Referenz: COS, S. #to page ("COS")# + SIN, S. #to page ("SIN")# + SIND, S. #to page ("SIND")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#goal page ("EXP")##ib (2)#EXP#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Exponentialfunktion zur Basis e + +Format: EXP() + +Erklärung: Liefert e#u##e# + +Beispiel: N X=EXP(1.0) (X = 2.71 = e) + + +Referenz: LN, S. #to page ("LN")# (Umkehrfunktion) + + + +#goal page ("FIFGE")##ib (2)#FIFGE#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Wert nach Bedingung (#on ("u")#f#off ("u")#irst #on ("u")#if#off ("u")# #on ("u")#g#off ("u")#reater or #on ("u")#e#off ("u")#qual) + +Format: FIFGE(,,,) + +Erklärung: Liefert den Wert des ersten Argumentes, wenn das dritte Argument + größer oder gleich dem vierten Argument ist. Andernfalls wird der Wert + des zweiten Argumentes geliefert. + + + IF >= THEN + + ELSE + + END IF + +Beispiel: N X=FIFGE(1.0,2.0,3.0,4.0) (X = 2.0) + + +Referenz: CLIP, S. #to page ("CLIP")# (äquivalente Funktion) + + + +#goal page ("FIFZE")##ib (2)#FIFZE#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Wert nach Bedingung (#on ("u")#f#off ("u")#irst #on ("u")#if#off ("u")# #on ("u")#ze#off ("u")#ro) + +Format: FIFZE(,,) + +Erklärung: Wenn der Parameter den Wert 0 hat, so wird + geliefert, andernfalls + + + IF = 0 THEN + + ELSE + + END IF + +Beispiel: N X=FIFZE(1.0,2.0,3.0) (X = 2.0) + + +Referenz: SWITCH, S. #to page ("SWITCH")# + + + +#goal page ("FLOOR")##ib (2)#FLOOR#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Vorkommastellen + +Format: FLOOR() + +Erklärung: Liefert die Vorkommastellen von + +Beipiel: N X=FLOOR(3.14) (X = 3.0) + + +Referenz: FRAC, S. #to page ("FRAC")# + + + +#ib (2)#FOR#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Schleifen-Definition + +Format: FOR =, + +Erklärung: bezeichnet eine Schleifenvariable, die von bis + hochgezählt wird. Somit ist es möglich, gleiche Berechnungen + für die verschiedenen Werte einer Tabelle durchzuführen. + +Beispiel: FOR BERECHNUNGSZEITRAUM=1900,2100 + + +Programm: "dyn.bev" + + + +#goal page ("FRAC")##ib (2)#FRAC#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Nachkommastellen + +Format: FRAC() + +Erklärung: Liefert die Nachkommastellen von + +Beispiel: N X=FRAC(3.14) (X = 0.14) + + +Referenz: FLOOR, S. #to page ("FLOOR")# + + + +#goal page ("L")##ib (2)#L#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Level-Gleichung + +Format: L .K=.J+ + + +Erklärung: Die Level-Gleichung stellt einen gegenwärtigen Wert in Bezug zu + seinem Wert in der Vergangenheit und seiner Veränderungsrate in der + bis dahin vergangenen Zeit (Vergangenheitsausdruck s. [1], S. 96). + +Beispiel: L HASEN.K=CLIP(HASEN.J+DT*(HGRATE.JK + X -HSRATE.JK),0,HASEN.J,0) + +Programm: "dyn.grashasenfuchs" + + + +#goal page ("LN")##ib (2)#LN#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Logarithmus-Funktion + +Format: LN() + +Erklärung: Berechnet den natürlichen Logarithmus von + +Beispiel: N X=LN(1.0) (X = 0.0) + + +Programm: "dyn.wasseröko" + +Referenz: LOG2, S. #to page ("LOG2")# + LOG10, S. #to page ("LOG10")# + EXP, S. #to page ("EXP")# + + + +#goal page ("LOG2")##ib (2)#LOG2#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Logarithmus-Funktion + +Format: LOG2() + +Erklärung: Berechnet den Logarithmus von zur Basis 2 + +Beispiel: N X=LOG2(8.0) (X = 3.0) + + +Referenz: LN, S. #to page ("LN")# + LOG10, S. #to page ("LOG10")# + + + +#goal page ("LOG10")##ib (2)#LOG10#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Logarithmus-Funktion + +Format: LOG10() + +Erklärung: Berechnet den Logarithmus von zur Basis 10 + +Beispiel: N X=LOG10(100.0) (X = 2.0) + + +Referenz: LOG2, S. #to page ("LOG2")# + LN, S. #to page ("LN")# + EXP, S. #to page ("EXP")# + + + +#goal page ("MACRO")##ib (2)#MACRO#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Macro-Definition + +Format: MACRO ([,[...]]) + +Erklärung: Durch die Verwendung der MACRO-Anweisung können Sie einer oder + mehreren DYNAMO-Gleichungen einen Namen geben (). + Macros müssen durch MEND abgeschloßen werden und dürfen #on ("u")#nicht#off ("u")# + rekursiv aufgerufen werden (vergl. Refinements in ELAN). + +Beispiel: MACRO SMOOTH(IN,DEL) + L SMOOTH.K=SMOOTH.J+DT*(IN.J-SMOOTH.J)/DEL + N SMOOTH=IN + MEND + +Programm: "dyn.mac" (diese Datei enthält alle bisherigen Makros) + +Referenz: MEND, S. #to page ("MEND")# + + + +#goal page ("MAX")##ib (2)#MAX#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Maximum zweier Größen + +Format: MAX(,) + +Erklärung: Liefert die größere Zahl aus und + + + IF > THEN + + ELSE + + END IF + +Beispiel: N X=MAX(1.0,2.0) (X = 2.0) + + +Referenz: MIN, S. #to page ("MIN")# + + + +#goal page ("MEND")##ib (2)#MEND#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Macro-Definition + +Format: MEND + +Erklärung: MEND beendet eine Macro-Definition + +Beispiel: MACRO SMOOTH(IN,DEL) + L SMOOTH.K=SMOOTH.J+DT*(IN.J-SMOOTH.J) + X /DEL + N SMOOTH=IN + MEND + +Programm: "dyn.mac" (diese Datei enthält alle bisherigen Makros) + +Referenz: MACRO, S. #to page ("MACRO")# + + + +#goal page ("MIN")##ib (2)#MIN#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Minimum zweier Größen + +Format: MIN(,) + +Erklärung: Liefert die kleinere Zahl aus und + +Beispiel: N X=MIN(1.0,2.0) (X = 1.0) + + +Programm: "dyn.forst7" + +Referenz: MAX, S. #to page ("MAX")# + + + +#goal page ("N")##ib (2)#N#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Initialisierungsgleichung + +Format: N = + +Erklärung: Initialisert eine Variable mit dem Bezeichner auf den Wert + , d.h. es wird ihr ein Startwert zugewiesen. + +Beispiel: N X=1900 + +Programm: "dyn.grashasenfuchs" + + + +#goal page ("NOISE")##ib (2)#NOISE#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Pseudo-Zufallszahlen-Generator + +Format: NOISE() + +Erklärung: Diese Funktion liefert eine Pseudo-Zufallszahl zwischen -0.5 und +0.5 + und setzt einen neuen Startwert für den Generator fest. Der Parameter + wird nicht ausgewertet. + +Beispiel: N X=NOISE(0) + +Referenz: NORMRN, S. #to page ("NORMRN")# + + + +#goal page ("NORMRN")##ib (2)#NORMRN#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Pseudo-Zufallszahlen-Generator + +Format: NORM(,) + +Erklärung: Liefert einen Wert zwischen - * 2.4 und + + * 2.4. + +Beispiel: N X=NORM(1.0,10.0) + +Referenz: NOISE, S. #to page ("NOISE")# + + + +#ib (2)#NOTE#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Kommentar + +Format: NOTE + +Erklärung: Die Zeilen, die mit NOTE gekennzeichnet sind, werden vom Compiler als + Kommentarzeilen erkannt und nicht beachtet. NOTE-Zeilen haben nur + dokumentierenden Charakter und sind für den Programmlauf ohne jede + Bedeutung. Dennoch sollte man, wenn immer möglich, Kommentare in + sein DYNAMO-Programm einfügen, denn sie sind in DYNAMO an­ + nähernd die einzige Möglichkeit, ein Programm lesbar zu machen, damit + es auch nach längerer Zeit noch korrigiert werden kann. + +Beispiel: NOTE Dies ist eine Kommentarzeile + +Programm: "dyn.welt/forrester" + + + +#goal page ("PLOT")##ib (2)#PLOT#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Darstellen der Ergebnisse in Diagrammform + +Format: PLOT [=][(, + )][/...][,...] + +Erklärung: Durch diese Anweisung werden die Größen nach PLTPER Zeiteinheiten + in einem Diagramm ausgegeben. Die Angabe eines Druckzeichens ist + nur bei zeichenorientierten Grafik erforderlich, denn bei hochauflösender + Grafik werden die Graphen der verschiedenen Größen durch unterschied­ + liche Linientypen gezeichnet; fehlt bei der zeichenorientierten Grafik das + Druckzeichen, so werden die Graphen durch die Zahlen von 0...9 darge­ + stellt. Bei "/" werden verschiedene, bei "," gleiche Skalen benutzt. + +Beispiel: PLOT GRAS=G(995,1005)/HASEN=H(85,115) + X /FUECHS=F(15,35) + +Programm: "dyn.grashasenfuchs" + +Referenz: PRINT, S. #to page ("PRINT")# + + + +#goal page ("POWER")##ib (2)#POWER#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Potenzfunktion + +Format: POWER(,) + +Erklärung: Liefert #u##e# + +Beipiel: N X=POWER(2, 2) (X = 4) + + +Referenz: SQRT, S. #to page ("SQRT")# + + + +#goal page ("PRINT")##ib (2)#PRINT#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Darstellung der Ergebnisse in Tabellenform + +Format: PRINT [/...][,...] + +Erklärung: Durch diese Anweisung werden die Werte () nach PRTPER + Zeiteinheiten in einer Tabelle ausgegeben. Die Ausgabe kann umgeleitet + werden (s. 'protokoll'). + +Beispiel: PRINT GBEV,BEV(1),BEV(40),BEV(60),BEV(63) + X ,BEV(65),ZBEV,PRENT + +Programm: "dyn.bev" + +Referenz: PLOT, S. #to page ("PLOT")# + + + +#goal page ("R")##ib (2)#R#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Rate-Gleichung + +Format: R.KL= + +Erklärung: Eine Rate-Gleichung stellt die Veränderungsrate in Bezug zu den aktu­ + ellen Level-Größen. + +Beispiel: R FGRATE.KL=FGK*HASEN*FUECHS.K + + +Programm: "dyn.grashasenfuchs" + +Referenz: A, S. #to page ("A")# + C, S. #to page ("C")# + L, S. #to page ("L")# + + + +#ib (2)#RAMP#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Wert nach Bedingung + +Format: RAMP(,) + +Erklärung: Wenn TIME kleiner , dann liefert RAMP 0, andernfalls wird + * (TIME - ) geliefert. + + + IF TIME < THEN + 0 + ELSE + * (TIME - ) + END IF + + + +#goal page ("RUN")##ib (2)#RUN#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Überschrift + +Format: RUN <Überschrift> + +Erklärung: Gibt dem aktuellen Lauf eine Überschrift. Gleichzeitig ist + "<Überschrift>.const" der Name eines Datenraums, in dem die Kon­ + stanten dieses Laufs aufgehoben werden (s. 'run' im Runtime-System). + +Beispiel: RUN Überschrift + +Referenz: *, S. #to page ("*")# + + + +#ib (2)#S#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Supplementary-Gleichung + +Format: S .K= + +Erklärung: Gleichungen für Hilfsgrößen werden durch Supplementary-Gleichungen + ausgedrückt. + +Beispiel: S SCHADSTOFFVERHÄLTNIS.K=COZWEI.K/OZWEI.K + + + + +#ib (2)#SCLPRD#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Skalarprodukt + +Format: SCLPRD(,,,,) + +Erklärung: Liefert das Skalarprokukt der Tabellen und , + wobei und den Ausschnitt aus der ersten Tabelle + angeben und den Startindex für den Vektor in der zweiten + Tabelle angibt. + +Beispiel: GB.K=SCLPRD(BEV.K,15,44,GR,1)/2 + + +Programm: "dyn.bev" + + + +#goal page ("SIN")##ib (2)#SIN#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Sinus + +Format: SIN() + +Erklärung: Berechnet den Sinus von , welche im Bogenmaß angegeben + wird. + +Beispiel: N X=SIN(0.5) + +Referenz: COS, S. #to page ("COS")# + COSD, S. #to page ("COSD")# + SIND, S. #to page ("SIND")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#goal page ("SIND")##ib (2)#SIND#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Sinus + +Format: SIND() + +Erklärung: Berechnet den Sinus von , welche im Gradmaß angegeben wird. + +Beispiel: N X=SIND(45.0) + +Referenz: COS, S. #to page ("COS")# + SIN, S. #to page ("SIN")# + COSD, S. #to page ("COSD")# + TAN, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#ib (2)#SPEC#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Lauf-Anweisung + + DT= +Format: SPEC { LENGTH= }[/...] + PLTPER= + PRTPER= + +Erklärung: Durch die Lauf-Anweisung werden die Systemkonstanten festgesetzt. + Sie darf pro Lauf nur einmal benutzt werden. + +Beispiel: SPEC DT=1/PLTPER=1/PRTPER=1/LENGTH=2000 + + +Referenz: C, S. #to page ("C")# (SPEC kann durch C-Def. ersetzt werden) + + + +#goal page ("SQRT")##ib (2)#SQRT#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Quadratwurzel + +Format: SQRT() + +Erklärung: Berechnet die Quadratwurzel aus + +Beispiel: N X=SQRT(4.0) (X = 2.0) + + +Referenz: POWER, S. #to page ("POWER")# + + + +#ib (2)#STEP#ie (2)##on ("i")##right#Funktion#off ("i")# + +Zweck: Wert nach Bedingung + +Format: STEP(,) + +Erklärung: Ist TIME kleiner , so wird 0 geliefert, ansonsten + + + IF TIME < THEN + 0.0 + ELSE + + END IF + +Beispiel: N X=STEP(12.0,12.0) + + + +#goal page ("SUM")##ib (2)#SUM#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Summierung einer Tabelle + +Format: SUM() + +Erklärung: Liefert die Summe der Einträge in einer Tabelle + +Beispiel: A GESAMTBEV.K=SUM(BEV.K) + +Programm: "dyn.bev" + +Referenz: SUMV, S. #to page ("SUMV")# + + + +#goal page ("SUMV")##ib (2)#SUMV#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Summierung einer Tabelle + +Format: SUMV(,,) + +Erklärung: Summierung der Einträge in der Tabelle von Element bis + Element + +Beispiel: A ZBEV.K=SUMV(BEV.K,16,59) Teilbevölkerung + + +Programm: "dyn.bev" + +Referenz: SUM, S. #to page ("SUM")# + + + +#goal page ("SWITCH")##ib (2)#SWITCH#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Wert nach Bedingung + +Format: SWITCH(,,) + +Erklärung: Wenn der Parameter den Wert 0 hat, so wird + geliefert, andernfalls (gleichbedeutend mit FIFZE). + + + IF = 0 THEN + + ELSE + + END IF + +Beispiel: N X=SWITCH(1.0,2.0,3.0) (X = 2.0) + + +Referenz: FIFZE, S. #to page ("FIFZE")# + + + +#goal page ("T")##ib (2)#T#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Tabellen-Definition + +Format: T =[/[....]] + +Erklärung: Durch die T-Anweisung wird eine Tabelle definiert, die Elemente wer­ + den durch "/" getrennt hintereinander angegeben. + +Beispiel: T TABELLE=1/2/3/4/5/6/8/9/10/11/12 + + +Programm: "dyn.bev" + +Referenz: TABLE, S. #to page ("TABLE")# + TABHL, S. #to page ("TABHL")# + + + +#goal page ("TABHL")##ib (2)#TABHL#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Tabellenfunktion + +Format: TABHL(,,,) + +Erklärung: IF < THEN + () + ELIF <= AND <= THEN + TABLE (, , , ) + ELSE + () + END IF + +Beispiel: A BRMM.K=TABHL(BRMMT,MSL.K,0,5,1) + + +Programm: "dyn.welt/forrester" + +Referenz: T, S. #to page ("T")# + TABLE, S. #to page ("TABLE")# + + + +#goal page ("TABLE")##ib (2)#TABLE#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Tabellenfunktion + +Format: TABLE(,,,,) + +Erklärung: Verknüpft die Werte aus mit , wobei den + ersten und den letzten Tabelleneintrag angibt. stellt + die Schrittweite dar. + +Beispiel: T TABELLE=1/2/3/4/5 + A BEISP.K=TABLE(TABELLE,X.K,2,4,1) + +Programm: "dyn.welt/forrester" + +Referenz: T, S. #to page ("T")# + TABHL, S. #to page ("TABHL")# + + + +#goal page ("TAN")##ib (2)#TAN#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Tangens + +Format: TAN() + +Erklärung: Berechnet den Tangens von , welche im Bogenmaß angegeben + wird. + +Beispiel: N X=TAN(0.5) + +Referenz: COS, S. #to page ("COS")# + SIN, S. #to page ("SIN")# + COSD, S. #to page ("COSD")# + SIND, S. #to page ("TAN")# + TAND, S. #to page ("TAND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#goal page ("TAND")##ib (2)#TAND#ie (2)##on ("i")##right#Funktion#off ("i")# + + +Zweck: Berechnung der trigonometrischen Funktion Tangens + +Format: TAND() + +Erklärung: Berechnet den Tangens von , welche im Gradmaß angegeben + wird. + +Beispiel: N X=TAND(45.0) + +Referenz: COS, S. #to page ("COS")# + SIN, S. #to page ("SIN")# + COSD, S. #to page ("COSD")# + TAN, S. #to page ("TAN")# + SIND, S. #to page ("SIND")# + ARCTAN, S. #to page ("ARCTAN")# + ARCTAND, S. #to page ("ARCTAND")# + + + +#goalpage ("X")##ib (2)#X#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Fortsetzungszeile + +Format: X + +Erklärung: Eine in der vorangegangenen Zeile nicht beendete Anweisung wird nach + einer X-Anweisung fortgesetzt (Es können beliebig viele X-Anweisun­ + gen nacheinander folgen). + +Beispiel: T TABELLE=1/2/3/4/5/6/7/8/9/10/11/12/13/14 + X /15/16/17/18/19 + +Programm: "dyn.bev" + + + +#goal page ("*")##ib (2)#*#ie (2)##on ("i")##right#Anweisung#off ("i")# + + +Zweck: Überschrift + +Format: * <Überschrift> + +Erklärung: Gibt dem aktuellen Lauf eine Überschrift + +Beispiel: * Überschrift + +Referenz: RUN, S. #to page ("RUN")# +#page# + +#ib#5. Makros in DYNAMO#ie# + + + + +Der DYNAMO-Compiler bietet die Möglichkeit, benutzereigene Funktionen zu definie­ +ren. Makros werden ähnlich wie Refinements in ELAN in das DYNAMO-Programm +eingesetzt. Beim EUMEL-DYNAMO-Compiler werden mit "zz" beginnende Namen +generiert, so daß Sie es vermeiden sollten, eigene Namen mit "zz" beginnen zu +lassen. Weiterhin sollte man als Namen der aktuellen Parameter nicht die Namen der +formellen Parameter verwenden. + +Folgende Makros werden standardmäßig vom DYNAMO-Compiler zur Verfügung +gestellt: + + macro delay1 (in, del) Verzögerung erster Ordnung + + macro delay3 (in, del) Verzögerung dritter Ordnung + Material + + macro delay3p (in, del, ppl) Verzögerung dritter Ordnung mit + Pipeline + + macro delinf3 (in, del) Verzögerung dritter Ordnung für + Information + + macro smooth (in, del) Verzögerung erster Ordnung für + Information + + + + +#ib#5.1. Insertieren von Makros#ie# + + + + +Makros werden durch folgende Prozedur in die Compilertabelle eingetragen: + + +PROC insert macro (TEXT CONST filename): + + Zweck: Fügt die in der Datei 'filename' enthaltenen Makros in die Makrotabelle ein. + Die Datei sollte zweckmäßigerweise nur Makrodefinitionen enthalten. Es ist + - im Gegensatz zu normalen DYNAMO-Programmen - nicht nötig, die + Systemkonstanten zu definieren (die Standard-Makros sind in der Datei + "dyn.mac" enthalten; diese Datei kann beliebig ergänzt werden). + + + + +#ib#5.2. Aufbau eines Makros#ie# + + + + +Makros beginnen in DYNAMO immer mit der Anweisung MACRO (s. auch Seite #to page ("MACRO")#) +und enden mit MEND (s. Seite #to page ("MEND")#). Dazwischen steht ein Makrorumpf, bestehend +aus einer oder mehreren DYNAMO-Gleichungen. Beim Makroaufruf können, soweit +vorher definiert, Parameter angegeben werden, jedoch rekursiv aufrufen kann man +Makros nicht. + +Beispiel: MACRO SMOOTH (IN, DEL) + L SMOOTH.K = SMOOTH.J + DT * (IN.J - SMOOTH.J) + X /DEL + N SMOOTH = IN + MEND + +Lokale Variablen in Makros beginnen mit einem $-Zeichen. Der Makro-Expandierer +ersetzt das $-Zeichen durch "zz" gefolgt von einer Zahl. Aus diesem Grund sollen +eigene Namen nicht mit "zz" beginnen. + +Falls Sie eine Fehlermeldung bekommen, die sich auf einen mit "zz" beginnenden +Namen bezieht, sollten Sie den Fehler in dem entsprechenden Makro suchen. + +#on ("b")# +Achtung: #off ("b")#Makros sollten nur von fortgeschrittenden DYNAMO-Programmieren + verwendet werden, da Makros Eigenschaften von Refinements (textuelle + Ersetzung) und Prozeduren (Parameterübergabe) vereinigen. Der daraus + folgende Effekt ist nicht ganz einfach zu durchschauen. +#page# + + + +#ib#6. Erweiterung des Sprachumfangs#ie# + + + + +Während Makros in DYNAMO geschrieben werden, ist es ferner möglich, die Menge +der Funktionen mittels der Sprache ELAN zu erweitern. + +Hierbei geht man wie folgt vor: + + 1. Schreiben einer Funktion in ELAN (näheres siehe unten) + + 2. Einbinden der Funktion in die Tabellen des DYNAMO-Compilers + + 2.1. Einschreiben des Namens der Funktion, gefolgt von den Typen der Ein­ + gabeparameter in die bestehende Datei "dyn.std", wobei folgende Typen + existieren: + + r real (Datentyp REAL) + t table (Datentyp TAB) + + Abgeschlossen wird die "dyn.std"-Datei durch die Zeichensequenz "/*". + + Beispiele: + + power rr table trrrr /* + + + 2.2. Laden der Funktion(en) mittels der Prozedur 'init std ("dyn.std")' + + +Eine zur Einbindung in den DYNAMO-Compiler vorgesehene ELAN-Funktion wird +unter Beachtung gewisser Regeln erstellt: + + 1. Die deklarierten ELAN-Prozeduren dürfen nur Parameter vom Typ REAL oder + TAB besitzen oder gänzlich ohne Parameter sein. + + 2. Der Typ des Resultaten muß vom Typ REAL sein. + +Zur Manipulation von Tabellen wurde der Datentyp TAB geschaffen, auf welchen man +wie auf das Standard-Vektorpaket zugreifen kann. + +Beispiel: + + REAL PROC abs (REAL CONST a): + IF a < 0.0 THEN + -a + ELSE + a + END IF + END PROC abs; + + PROC sumv (TAB CONST tab, REAL CONST erstes, letztes): + REAL VAR summe := 0.0; + INT VAR i; + FOR i FROM int (erstes) UPTO int (letztes) REPEAT + summe INCR wert (tab, i) + END REPEAT; + summe + END PROC sumv + + + + +#ib#6.1. Für fortgeschrittende ELAN-Program­ + mierer#ie# + + + +Der Quellcode des EUMEL-DYNAMO-Compilers wird mit ausgeliefert. Daher +können Einschränkungen (s. 3.2 Abweichungen gegenüber dem Sprachstandard) +leicht beseitigt werden. Wem z.B. die Anzahl der Gleichungen (950) zu wenig ist, der +kann im Quelltext des Compilers diesen Wert (annähernd) beliebig nach oben hin +erhöhen. + diff --git a/lang/dynamo/1.8.7/doc/dynamo handbuch.index b/lang/dynamo/1.8.7/doc/dynamo handbuch.index new file mode 100644 index 0000000..af77d79 --- /dev/null +++ b/lang/dynamo/1.8.7/doc/dynamo handbuch.index @@ -0,0 +1,69 @@ +#block##pageblock##page (52)# +#head# +#center#DYNAMO-Compiler +#center#____________________________________________________________ + +#end# +#bottom odd# +#center#____________________________________________________________ +GMD #right#DYNAMO - % +#end# +#bottom even# +#center#____________________________________________________________ +DYNAMO - % #right#GMD +#end# +Anhang - Übersicht über Anweisungen und +Funktionen + + +#clear pos##l pos (0.0)##r pos (10.0)##fillchar (" ")# +#table# +A 21 +ABS 21 +ARCTAND 22 +C 23 +CLIP 23 +COSD 24 +EXP 25 +FIFGE 25 +FIFZE 26 +FLOOR 26 +FOR 27 +FRAC 27 +L 28 +LN 28 +LOG2 29 +LOG10 29 +MACRO 30 +MAX 31 +MEND 31 +MIN 32 +N 32 +NOISE 33 +NORMRN 33 +NOTE 34 +PLOT 35 +POWER 35 +PRINT 36 +R 36 +RAMP 37 +RUN 37 +S 38 +SCLPRD 38 +SIN 39 +SIND 39 +SPEC 40 +SQRT 40 +STEP 41 +SUM 41 +SUMV 42 +SWITCH 42 +T 43 +TABHL 43 +TABLE 44 +TAN 44 +TAND 45 +X 45 +* 46 +#table end# + diff --git a/lang/dynamo/1.8.7/doc/dynamo handbuch.inhalt b/lang/dynamo/1.8.7/doc/dynamo handbuch.inhalt new file mode 100644 index 0000000..2d1b1f3 --- /dev/null +++ b/lang/dynamo/1.8.7/doc/dynamo handbuch.inhalt @@ -0,0 +1,131 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#DYNAMO + + + + +#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# +#block# +#center#____________________________________________________________________________ + + Copyright 1988 + + Selbstverlag GMD + Alle Rechte vorbehalten. + Insbesondere ist die Überführung in maschinenlesbare + Form, sowie das Speichern in Informationssystemen, auch + auszugsweise, nur mit schriftlicher Genehmigung der + GMD gestattet. +#center#____________________________________________________________________________ + + + Herausgeber: + + Gesellschaft für Mathematik und Datenverarbeitung mbH + + Postfach 1240, Schloß Birlinghoven + D-5205 Sankt Augustin 1 + Telefon(02241) 14-1, Telex 8 89 469 gmd d + Telefax(02241) 14 28 89, BTX *43900\# + Teletex 2627-224135=GMDVV + + +Autor: + + Christian Szymanski + +nach Anregungen von: + + Diether Craemer, Robert Keil + +überarbeitet von: + + Thomas Müller + +Texterstellung: + + Dieser Text wurde mit der EUMEL-Textverarbeitung erstellt und aufbereitet und + mit dem Agfa Laserdrucksystem P400 gedruckt. + + + + Hinweis: + +#on("italics")# + Diese Dokumentation wurde mit größtmöglicher Sorgfalt erstellt. Dennoch wird + für die Korrektheit und Vollständigkeit der gemachten Angaben keine Gewähr + übernommen. Bei vermuteten Fehlern der Software oder der Dokumentation + bitten wir um baldige Meldung, damit eine Korrektur möglichst rasch erfolgen + kann. Anregungen und Kritik sind jederzeit willkommen.#off("italics")# +#page# +#pagenr ("%", 1")##setcount (1)##block##pageblock##count per page# +#head# +#center#DYNAMO-Compiler +#center#____________________________________________________________ + +#end# +#bottom odd# +#center#____________________________________________________________ +GMD #right#DYNAMO - % +#end# +#bottom even# +#center#____________________________________________________________ +DYNAMO - % #right#GMD +#end# + +Inhalt + + + +#clear pos##lpos (0.0)##r pos (10.0)##fillchar (" ")# +#table# +1. Einleitung 2 + 1.1. Referenzliteratur 2 + 1.2. Die Programmiersprache DYNAMO 3 + 1.3. Kurz-Einführung in die DYNAMO-Schreibweise 4 + 1.4. Eine erste, kleine Sitzung mit dem DYNAMO-System 6 + +2. Generierung des DYNAMO-Compilers 7 + +3. Der EUMEL-DYNAMO-Compiler 8 + 3.1. Benutzung des DYNAMO-Compiler 8 + 3.2. Abweichungen gegenüber dem Sprachstandard 11 + 3.3. Das DYNAMO Runtime-System 12 + 3.4. Fehlermeldungen des DYNAMO-Compilers 14 + +4. Anweisungen und Funktionen des EUMEL-DYNAMO-Compilers 19 + 4.1. Übersicht über die Anweisungen und Funktionen 21 + +5. Makros in DYNAMO 47 + 5.1. Insertieren von Makros 48 + 5.2. Aufbau eines Makros 48 + +6. Erweiterung des Sprachumfangs 50 + 6.1. Für fortgeschrittende ELAN-Programmierer 51 + +Anhang - Übersicht über Anweisungen unf Funktionen 52 +#table end# + diff --git a/lang/dynamo/1.8.7/source-disk b/lang/dynamo/1.8.7/source-disk new file mode 100644 index 0000000..e61107d --- /dev/null +++ b/lang/dynamo/1.8.7/source-disk @@ -0,0 +1 @@ +informatikpaket/01_sprachen.img diff --git "a/lang/dynamo/1.8.7/src/\"15\"TAB1\"14\"" "b/lang/dynamo/1.8.7/src/\"15\"TAB1\"14\"" new file mode 100644 index 0000000..ce88e03 Binary files /dev/null and "b/lang/dynamo/1.8.7/src/\"15\"TAB1\"14\"" differ diff --git a/lang/dynamo/1.8.7/src/dyn.33 b/lang/dynamo/1.8.7/src/dyn.33 new file mode 100644 index 0000000..a17bd55 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.33 @@ -0,0 +1,2073 @@ +(**************************************************************************) +(**************************************************************************) +(****** ******) +(****** ******) +(****** DYNAMO - III - ELAN PRECOMPILER ******) +(****** ******) +(****** ******) +(****** AUTOREN : R. Keil, ******) +(****** T. Froehlich ******) +(****** ******) +(****** VERSION : 3.3.7 ******) +(****** ******) +(****** ******) +(****** AENDERUNGEN: ******) +(****** 05.10.1983 ******) +(****** 06.05.1985 Hua&DC: forget("zzdyn.const") ******) +(****** 08.04.1986 Ley : Anpassung an 1.7.5 ******) +(****** 02.04.1987 C.Fallis & C.Rensen Einbettung in BOX ******) +(****** 18.05.1988 dc: Udi Katzirs changes ******) +(****** should declare vector eingeführt ******) +(****** 20.05.1988 dc: already used in loop body eingeführt ******) +(****** Fehlermeldung bei Ref. int index unterdrückt ******) +(****** weil sie wahrscheinlich selbst ein Fehler ist ******) +(****** 21.07.1988 Christian Szymanski ******) +(****** Ausbettung aus BOX ******) +(****** ******) +(****** ******) +(**************************************************************************) +(**************************************************************************) + + +PACKET dynamo compiler 33 DEFINES init std, dynamo, insert macro, + erase, table dump, graphic: + +(********************** T A B L E S ********************************) + +LET max tab size = 950, + max hash size = 300, + library = ""15"TAB1"14"", + tab name = ""15"TAB2"14""; + +BOOL VAR is draw := FALSE; + +TYPE TABLE = STRUCT (ROW max tab size TEXT name, init, right part, + ROW max tab size INT type, line no, pred, mac, + index, index type, + ROW max tab size BOOL in use, idef, rdef, + already used in loop body, + should declare vector, + (*18.5.88 dc: Änderung von Udi Katzir *) + ROW max hash size INT class, + INT tab size, + tab beg); + +(* already used in loop body: is set to TRUE , if that table-element has been + used to generate a line within a loop --> PROC gen loop 20.5.88 dc*) + +(* should declare vector : used when rows are declared and indicates if the*) +(* length of the row is to be taken from the index of the current variable *) + +BOUND TABLE VAR tab; + +PROC enter (TEXT CONST name, right part, INT CONST type of equ) : + INT VAR tab pos; + INT CONST hash class := hash (name); + search (name, tab pos, lmp, equtype, hash class); + table index := tab pos; + enter equ. + + enter equ : + IF not found OR subscript COR CONCR (tab).type (tabpos) = mac param + THEN enter name + ELIF type of equ = nequ + THEN enter nequ + ELIF CONCR (tab).right part (tab pos) = nt + THEN complete nequ + ELSE err (name, 1) + FI. + + equtype : + IF subscript + THEN type of equ + ELSE nil + FI. + + enter name : + CONCR (tab).tab size INCR 1; + tab size := CONCR (tab).tab size; + IF tab size > max tab size + THEN errorstop ("dynamo table overflow") + FI; + IF type of equ = nequ + THEN CONCR (tab).init (tab size) := right part; + CONCR (tab).right part (tab size) := nt + ELSE CONCR (tab).init (tab size) := nt; + CONCR (tab).right part (tab size) := right part + FI; + init element. + + init element : + CONCR (tab).name (tab size) := name; + CONCR (tab).type (tab size) := type of equ; + CONCR (tab).line no (tab size) := line no; + CONCR (tab).mac (tab size) := lmp; + CONCR (tab).index (tab size) := nil; + CONCR (tab).index type (tab size) := nil; + CONCR (tab).in use (tab size) := FALSE; + CONCR (tab).idef (tab size) := FALSE; + CONCR (tab).rdef (tab size) := FALSE; + CONCR (tab).already used in loop body (tab size) := FALSE; + CONCR (tab).pred (tab size) := CONCR (tab).class (hash class); + CONCR (tab).class (hash class) := tab size. + + enter nequ : + IF CONCR (tab).init (tab pos) <> nt + THEN err (name, 2) + FI; + CONCR (tab).init (tab pos) := right part. + + complete nequ : + CONCR (tab).right part (tab pos) := right part; + CONCR (tab).type (tab pos) := type of equ; + CONCR (tab).line no (tab pos) := line no. +END PROC enter; + +PROC test (TEXT CONST name, INT VAR tab pos, INT CONST last mp, type, + err no) : + search (name, tab pos, last mp, type); + IF not found + THEN err (err no) + FI +END PROC test; + +PROC search (TEXT CONST name, INT VAR tab pos, INT CONST last mp, type) : + search (name, tab pos, last mp, type, hash (name)) +END PROC search; + +PROC search (TEXT CONST name, INT VAR tab pos, + INT CONST last mp, type, hash class) : + not found := TRUE; + tab pos := CONCR (tab).class (hash class); + WHILE tab pos <> nil CAND name not found REP + tab pos := CONCR (tab).pred (tab pos) + PER. + + name not found : + not found := NOT (CONCR (tab).name (tab pos) = name + AND same macro AND type ok); + not found. + + same macro : + CONCR (tab).mac (tab pos) = last mp. + + type ok : + type = nil OR CONCR (tab).type (tab pos) = type. +END PROC search; + +PROC insert macro (TEXT CONST source) : + dynamo (source, ""8"", FALSE); + kill (""8""); + IF errors = nil + THEN kill (library); + copy (tab name, library) + FI +END PROC insert macro; + +PROC init std (TEXT CONST std name) : + lmp := nil; + kill (library); + tab := new (library); + FOR i FROM 1 UPTO max hash size REP + CONCR (tab).class (i) := nil + END REP; + CONCR (tab).tab size := nil; + enter std procs; + CONCR (tab).tab beg := tab size + 1. + +enter std procs : + FILE VAR std file := sequential file (input, std name); + TEXT VAR name, params; + WHILE NOT eof (std file) REP + get (std file, name); + test eof; + IF params = "()" + THEN params := "" + FI; + enter (name, params, std p) + END REP. + + test eof : + IF name = "/*" + THEN LEAVE enter std procs + ELSE get (std file, params) + FI. +END PROC init std; + +PROC next sym : + next sym (scan buf, sym, type, scan position) +END PROC next sym; + +PROC next sym (TEXT CONST buf) : + next sym (buf, sym, type, scan position) +END PROC next sym; + +PROC test open bracket (TEXT CONST sym) : + IF sym <> "(" + THEN err (sym, 6) + FI +END PROC test open bracket; + +PROC test closing bracket (TEXT CONST sym) : + IF sym <> ")" + THEN err (sym, 58) + FI +END PROC test closing bracket; + +PROC test bold (INT CONST err no) : + IF type <> bold + THEN err (err no) + FI +END PROC test bold; + +PROC test equal (INT CONST err no) : + IF sym <> "=" + THEN err (err no) + FI +END PROC test equal; + +BOOL OP IN (TEXT CONST pattern, source) : + pos (source, pattern) > nil. +END OP IN; + +PROC scan (TEXT CONST buf) : + scan buf := buf; + scan position := 1 +END PROC scan; + +PROC err (TEXT CONST a, INT CONST b) : + err (a, b, line no) +END PROC err; + +PROC err (INT CONST i) : + err (sym, i, line no) +END PROC err; + +PROC gen (TEXT CONST a) : + out buf CAT a +END PROC gen; + +PROC gen (TEXT CONST a, b) : + out buf CAT a; + out buf CAT b +END PROC gen; + +PROC gen (TEXT CONST a, b, c) : + out buf CAT a; + out buf CAT b; + out buf CAT c +END PROC gen; + +PROC gen (TEXT CONST a, b, c, d) : + out buf CAT a; + out buf CAT b; + out buf CAT c; + out buf CAT d +END PROC gen; + +PROC genln (TEXT CONST a, b, c) : + gen (a, b, c); + lf +END PROC genln; + +PROC lf : + putline (target, outbuf); + outbuf := nt +END PROC lf; + +PROC gen ln (TEXT CONST t) : + outbuf CAT t; + putline (target, outbuf); + outbuf := nt +END PROC gen ln; + +PROC erase (BOOL CONST b) : + erase option := b +END PROC erase; + +PROC dynamo (TEXT CONST s) : + TEXT VAR target name := s + ".elan"; + dynamo (s, target name, TRUE); + IF erase option + THEN kill (target name) + FI; + last param (s) +END PROC dynamo; + +PROC dynamo : + dynamo (last param) +END PROC dynamo; + +PROC graphic (BOOL CONST mode): + is draw := NOT mode +END PROC graphic; + +(********************** C O M P I L E R ************************) + +LET bold = 1, number = 2, + delimiter = 3, eol = 4, + aux = 1, rate = 2, + level = 3, nequ = 4, + mac name = 6, std p = 7, + sub init = 8, table = 9, + for = 10, mac param = 11, + const = 12, print = 1, + plot = 2, global param = 1, + none = 3, max print no = 10, + supp = 5, any = "ß"; + +FILE VAR source, target; + +ROW max print no TEXT VAR print param; + +ROW 10 TEXT VAR plot name, id; +ROW 10 INT VAR scale pointer; +ROW 10 TEXT VAR lower bound, upper bound; +ROW 10 BOOL VAR l fixed scale, u fixed scale; + +TEXT VAR buffer, left part, right part, outbuf, print buf, + headline, sym, plot buf, asterisk buffer, + macro name, noise buffer, constant, run buffer, + scan buf; + +INT VAR print param no, print line no, tab beg, type, line no, + plot line no, scale counter, plot param no, + last pos, lmp, index, (* lmp = Last Macro Position *) + index type, for index, i, tab size, expansion no, + table index, scan position, old tab beg; + +BOOL VAR k, kl, is first, fixed scale, in macro, + in loop, not found, internal, subscript, + erase option := FALSE; + +TEXT CONST nt := ""; + +INT CONST nil := 0; + + +(*$$$$$$$$$$ ZUSATZ C & C 20.2.87 eingefuegt : error listing $$$$$$$$$*) +(* Diese Prozedur erzeugt einen zweigeteilten Bildschirm, wobei *) +(* die Datei 'procsource' (d.h. das Dynamo-Quellprogramm) in der *) +(* oberen Haelfte und die Fehlerdatei 'notebook' in der unteren *) +(* Haelfte steht. *) + +PROC error listing (FILE VAR procsource) : (* C.S. 21.07.88 *) + note edit (procsource); +END PROC error listing; +(*$$$$$$$$$$$$$$$$$$$$ ENDE ZUSATZ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$*) + + +PROC dynamo (TEXT CONST source name, target name, BOOL CONST pass2) : + init dynamo; + first pass; + IF no errors + THEN second pass + ELSE error listing(source); + error stop ("") (* C.S. 21.07.88 *) + (* Falls Fehler im ersten Durchlauf gefunden wurden, wird der zweite *) + (* Durchlauf erst gar nicht durchgefuehrt, sondern das fehlerhafte *) + (* Dynamo-Programm und die Fehlerdatei werden ausgegeben . *) + FI. + + first pass : + WHILE NOT eof (source) REP + read source line; + translate line + PER; + IF NOT pass2 + THEN LEAVE dynamo + FI; + end of first pass. + + second pass : + generate initializations; + generate equations. + + generate initializations : + generate rts call; + generate noise card; + generate table part; + generate for variables; + generate variable part; + generate table init; + generate init print; + generate init plot; + generate init scale; + generate asterisk; + gen repeat. + + generate equations : + generate print line; + generate plot line; + gen equations (level); + gen equations (aux); + gen equations (supp); + gen equations (rate); + gen end repeat; + IF no errors + THEN run (target name) + ELSE error listing(source); + error stop ("") (* C.S. 21.07.88 *) + (* Falls im zweiten Durchlauf Fehler gefunden wurden, wird das *) + (* ELAN-Zielprogramm nicht ausgefuehrt, sondern das fehlerhafte *) + (* Dynamo-Quellprogramm und die Fehlerdatei werden ausgegeben . *) + FI. + + init dynamo : + kill (target name); + init tables; + source := sequential file (input, source name); + target := sequential file (output, target name); + print buf := nt; + outbuf := nt; + plot buf := nt; + noise buffer := nt; + asterisk buffer := nt; + macro name := nt; + run buffer := "zzdyn"; + line no := nil; + plot param no := nil; + last pos := nil; + lmp := nil; + index := nil; + index type := nil; + expansion no := nil; + in macro := FALSE; + internal := FALSE; + in loop := FALSE; + is first := TRUE; + tab beg := CONCR (tab).tab beg; + old tab beg := CONCR (tab).tab size + 1; + init errors. + + init tables : + kill (tab name); + copy (library, tab name); + tab := old (tab name). + + read source line : + line no INCR 1; + getline (source, buffer); + cout (line no); + scan (buffer); + next sym. + + translate line : + TEXT VAR start := sym; + next sym; + WHILE sym = " " REP next sym PER; + SELECT + pos ("a c l n r print plot note EOL spec * x macro mend for s noise run ", + start + " ") OF + CASE 1 : enter equ (TRUE, FALSE, aux, 9) + CASE 3, 31 : constant equ + CASE 5 : enter equ (TRUE, FALSE, level, 11) + CASE 7 : enter equ (FALSE, FALSE, nequ, 56) + CASE 9 : enter equ (FALSE, TRUE, rate, 12) + CASE 11 : print card + CASE 17 : plot card + CASE 22, 27 : (* comment; empty line *) + CASE 36 : gen headline + CASE 15 : enter equ (FALSE, FALSE, table, 13) + CASE 38 : continuation card + CASE 40 : macro card + CASE 46 : macro end + CASE 51 : for card + CASE 55 : enter equ (TRUE, FALSE, supp, 9) + CASE 57 : noise card + CASE 63 : run card + OTHERWISE : err (start, 3) + END SELECT. + + macro card : + IF in macro + THEN err (4) + FI; + in macro := TRUE; + get macro name; + get macro param list. + + get macro name : + IF type = bold + THEN enter (sym, nt, mac name); + CONCR (tab).line no (tab size) := nil; + macro name := sym; + lmp := tab size + ELSE err (5) + FI. + + get macro param list : + next sym; + test open bracket (sym); + next sym; + WHILE sym <> ")" REP + IF type = bold + THEN enter (sym, nt, mac param) + ELSE err (7) + FI; + next sym; + IF sym = "," + THEN next sym + FI + END REP; + test closing bracket (sym). + + macro end : + lmp := nil; + in macro := FALSE. + + constant equ : + REP + analyze constant equ; + enter (left part, constant, const); + last pos := tab size + UNTIL end of constants PER. + + analyze constant equ : + test bold (10); + left part := sym; + next sym; + test equal (21); + get constant. + + end of constants : + next sym; + test delimiter. + + get constant : + next sym; + IF NOT sym is number (constant) + THEN err (37) + FI. + + print card : + IF print buf = nt + THEN print buf := subtext (buffer, scanposition - length (sym)); + print line no := line no + ELSE print buf CAT "," + subtext (buffer, scanposition - length (sym)) + FI; + last pos := print. + + plot card : + IF plot buf = nt + THEN plot buf := subtext (buffer, scanposition - length (sym)); + plot line no := line no; + ELSE plot buf CAT "/" + subtext (buffer, scanposition - length (sym)) + FI; + last pos := plot. + + gen headline : + asterisk buffer := "asterisk (""" + subtext (buffer, 3) + """);". + + generate asterisk : + IF asterisk buffer <> nt + THEN genln (asterisk buffer) + FI. + + continuation card : + skip blanks; + TEXT CONST tail := subtext (buffer, i); + SELECT last pos OF + CASE print : print buf CAT "," + tail + CASE plot : plot buf CAT "/" + tail + CASE none : err (14) + OTHERWISE : content CAT tail + END SELECT. + + content : + IF CONCR (tab).type (last pos) = nequ + THEN CONCR (tab).init (last pos) + ELSE CONCR (tab).right part (last pos) + FI. + + skip blanks : + i := 1; + REP + i INCR 1 + UNTIL (buffer SUB i) <> " " END REP. + + for card : + REP + read for variable + UNTIL end of forlist END REP. + + end of forlist : + IF sym = "/" + THEN next sym; FALSE + ELSE TRUE + FI. + + read for variable : + TEXT VAR init; (* left part = name *) + test bold (15); (* right part = obere Grenze *) + left part := sym; (* init = untere Grenze *) + next sym; + test equal (16); + next sym; + pass ranges; + enter (left part, right part, for); + CONCR (tab).init (tab size) := init. + + pass ranges : + test number (init); + IF sym <> "," + THEN err (18) + FI; + next sym; + test number (right part). + + noise card : + IF NOT sym is number (noise buffer) + THEN err (66) + FI. + + run card : + test bold (65); + run buffer := sym. + + gen repeat : + lf; + genln ("WHILE time <= length REP");genln (" cout(int(time));"); + genln (" set time (time);"). + + gen end repeat : + genln ("UNTIL " + draw ad + "stop request PER;"); + IF plot buf <> nt + THEN genln (draw ad + "end of program;") + FI; + genln ("END PROC target program"). + + generate rts call : + genln ("forget (""zzdyn.const"",quiet);"); + genln ("run card (""", run buffer, """);"); + genln ("run time system (PROC target program);"); + lf; + genln ("PROC target program :"). + + generate noise card : + IF noise buffer <> nt + THEN genln (" initialize random (", noise buffer, ");") + FI. + + generate plot line : + IF plot buf <> nt + THEN gen plots + FI. + + gen plots : + genln (draw ad + " new plot line (time);"); + FOR i FROM 1 UPTO plot param no REP + genln (draw ad + " plot (", plot name (i), ");"); + genln ("IF " + draw ad + " stop request THEN LEAVE target program " + + "END IF;") + END REP. + + generate print line : + IF print buf <> nt + THEN gen prints + FI. + + gen prints : + genln (" new line (time);"); + FOR i FROM 1 UPTO print param no REP + genln (" print (", printparam (i), ");") + END REP. + + generate init plot : + INT VAR tab pos; + IF plot buf <> nt + THEN search ("pltper", tab pos, nil, const); + IF not found + THEN IF is draw THEN + err ("draw", 25, plot line no) + ELSE + err ("plot", 25, plot line no) + END IF + ELSE genln (draw ad + "initialize plot (""", plot buf, """);"); +(*$$$$$$$$$$$$$ ZUSATZ Februar87 C&C eingefuegt: pltper INCR 0 $$$$$$$$$*) + genln ("pltper INCR 0.0 ;"); + genln (" (* um Warnung des ELAN-Compilers zu unterdruecken *)") +(*$$$$$$$$$$$$$$$$$$$$$$$$$$ ENDE ZUSATZ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$*) + FI + FI. +END PROC dynamo; + +PROC test number (TEXT VAR content) : + SELECT type OF + CASE bold : content := sym + CASE number : content := trunc (sym) + OTHERWISE err (17) + END SELECT; + next sym +END PROC test number; + +PROC enter equ (BOOL CONST x, y, INT CONST exp type, err no) : + get left part; + enter (left part, right part, exp type); + set index; + test global; + IF incorrect time script + THEN err (err no) + FI. + + incorrect time script : + (k XOR x) OR (kl XOR y). + + set index : + INT VAR last entry := table position; + last pos := last entry; + CONCR (tab).index (last entry) := index; + CONCR (tab).index type (last entry) := index type. + + table position : + IF exp type = nequ AND index type = nil AND NOT not found + THEN table index + ELSE tab size + FI. + + test global : + IF in macro AND NOT internal + THEN search global + FI. + + search global : + INT VAR tab pos; + search (left part, tab pos, lmp, mac param); + IF not found + THEN IF left part <> macro name + THEN err (left part, 64) + FI + ELSE CONCR (tab).index (last entry) := tab pos; + CONCR (tab).index type (last entry) := -1; + CONCR (tab).index type (tab pos) := global param; + CONCR (tab).index (tab pos) := last entry + FI. + + get left part : + get name; + get time script; + get index. + + get name : + internal := sym = "$"; + IF internal + THEN next sym; + IF NOT in macro + THEN err (19) + FI + FI; + test bold (20); + left part := sym; next sym. + + get time script : + IF sym = "." + THEN process time script + ELSE k := FALSE; kl := FALSE + FI; + subscript := sym = "(". + + get index : + IF subscript + THEN process index + ELSE index := nil; + index type := nil + FI; + right part := subtext (buffer, scanposition); + test equal (21). + + process time script : + next sym; + k := sym = "k"; kl := sym = "kl"; + next sym. + + process index : + next sym; + SELECT type OF + CASE number : index := int (sym) + CASE bold : search for variable + OTHERWISE : err (22) + END SELECT; + index type := type; + next sym; + test closing bracket (sym); + next sym. + + search for variable : + test (sym, tab pos, lmp, for, 61); + index := tab pos. +END PROC enter equ; + +PROC end of first pass : + INT VAR tab pos; + init time; + search macro calls; + search system constants. + + init time : + search ("time", tab pos, nil, nequ); + IF not found + THEN enter ("time", "0.0", nequ) + FI; + enter ("time", "time.j+dt", level). + + search system constants : + sym := nt; + test ("dt", tab pos, nil, const, 35); + test ("length", tab pos, nil, const, 36). + + search macro calls : + INT VAR old tabsize := tabsize; + FOR i FROM old tabbeg UPTO old tabsize REP + IF is normal equ + THEN enter global macro params + FI + END REP; + tab size := old tabsize. + + is normal equ : + SELECT CONCR (tab).type (i) OF + CASE aux, rate, level, nequ, supp : TRUE + OTHERWISE : FALSE + END SELECT. + + enter global macro params : + enter params (CONCR (tab).right part (i), FALSE); + enter params (CONCR (tab).init (i), TRUE). +END PROC end of first pass; + +PROC enter params (TEXT CONST buf, BOOL CONST is init) : + TEXT VAR macro name; + IF pos (buf, "(") > nil + THEN read params + FI. + + read params : + scan position := 1; + REP + next sym (buf, macro name, type, scan position); + IF type = bold + THEN next sym (buf); + IF sym = "(" + THEN parameter list + FI + FI + UNTIL type = eol END REP. + + parameter list : + INT VAR act param, tab pos; + search (macro name, tab pos, nil, nil); + IF NOT not found CAND CONCR (tab).type (tab pos) = mac name + THEN read param list + FI. + + read param list : + CONCR (tab).index type (tab pos) INCR 1; + act param := tab pos; + REP + next sym (buf); + act param INCR 1; + IF CONCR (tab).type (act param) = mac param + THEN test parameter + ELSE err (macro name, 53) + FI + UNTIL end of parameter list END REP. + + test parameter : + TEXT VAR param; + IF CONCR (tab).index type (act param) = global param + THEN get global param + ELSE get actual param + FI; + content CAT param + "%". + + content : + IF is init + THEN CONCR (tab).init (act param) + ELSE CONCR (tab).right part (act param) + FI. + + get global param : + INT VAR param index; + IF type = bold + THEN enter param + FI. + + enter param : + param index := CONCR (tab).index (act param); + enter (sym, CONCR (tab).right part (param index), + CONCR (tab).type (param index)); + CONCR (tab).init (tab size) := CONCR (tab).init (param index); + CONCR (tab).index (tab size) := act param; + param := sym; + next sym (buf); + get time script. + + get actual param : + INT VAR brackets := nil; + param := nt; + REP + param CAT sym; + next sym (buf); + get time script + UNTIL end of param END REP. + + get time script : + IF sym = "." + THEN param CAT sym; + next sym (buf); + param CAT any; + next sym (buf) + FI. + + end of param : + IF brackets = nil + THEN sym IN ",)" + ELIF sym = "(" + THEN brackets INCR 1; + FALSE + ELIF sym = ")" + THEN brackets DECR 1; + TRUE + ELSE FALSE + FI. + + end of parameter list : + SELECT pos (",)", sym) OF + CASE 1 : FALSE + CASE 2 : TRUE + OTHERWISE : err (50); TRUE + END SELECT. +END PROC enter params; + +(************************* P A S S 2 ***************************) + +PROC generate init print : + INT VAR tab pos; + IF print buf <> nt + THEN test ("prtper", tab pos, nil, const, 24); + gen init + FI. + + gen init : + print param no := nil; + headline := nt; + scan (print buf); + line no := print line no; + cout (line no); + REP + get parameter + UNTIL sym <> "," END REP; + genln ("initialize print (""", headline, """);"); + (*$$$$$$$$$$$$$ ZUSATZ Februar87 C&C eingefuegt: prtper INCR 0 $$$$$$$$$$*) + genln ("prtper INCR 0.0 ;"); + genln ("(* Um Warnung des ELAN-Compilers zu unterdruecken *)"). + (*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ENDE ZUSATZ $$$$$$$$$$$$$$$$$$$$$$$*) + get parameter : + next sym; + test bold (33); + get print param. + + get print param : + test (sym, tab pos, nil, nil, 32); + enter name. + + enter name : + TEXT VAR act param := sym; + INT VAR pos := scanposition - length (sym); + test subscript (act param, 33); + print param no INCR 1; + print param (print param no) := act param; + headline CAT text (subtext (print buf, pos, scanposition - 1), 13); + headline CAT " ". +END PROC generate init print; + +PROC test subscript (TEXT VAR act param, INT CONST err no) : + INT VAR tab pos; + next sym; + IF sym = "(" + THEN test index + FI. + + test index : + next sym; + act param CAT " SUB "; + act param CAT subscript; + next sym; + test closing bracket (sym); + next sym. + + subscript : + SELECT type OF + CASE number : trunc (sym) + CASE bold : search index + OTHERWISE : err (err no); nt + END SELECT. + + search index : + test (sym, tab pos, nil, for, 61); + sym. +END PROC test subscript; + +PROC generate init scale : + IF plot buf <> nt + THEN gen plot card + FI. + + gen plot card : + scale counter := 1; + plot param no := nil; + line no := plot line no; + cout (line no); + scan (plot buf); + REP + equal scale; + different scale + UNTIL type = eol OR sym = " " END REP; + generate scales. + + equal scale : + fixed scale := FALSE; + REP + next sym; + single scale param + UNTIL sym <> "," END REP. + + different scale : + IF sym = "/" + THEN scale counter INCR 1 + ELIF type <> eol + THEN err (sym, 26, plot line no) + FI. + + generate scales : + clear scales; + gen plot scales. + + gen plot scales : + FOR i FROM 1 UPTO plot param no REPEAT + gen (draw ad + "plot scale (""", id (i), """, ", + text (scale pointer (i))); + gen (", ", lower scale, ", ", upper scale); + gen (", ", text (l fixed scale (i)), ", ", text (u fixed scale (i))); + genln (");") + END REP. + + lower scale : + IF l fixed scale (i) + THEN lower bound (i) + ELSE "9.0e126" + FI. + + upper scale : + IF u fixed scale (i) + THEN upper bound (i) + ELSE "-9.0e126" + FI. + + clear scales : + FOR i FROM scale counter+1 UPTO plot param no REP + lower bound (i) := "0.0"; + upper bound (i) := "0.0" + PER. + + single scale param : + test bold (27); + enter plot param. + + enter plot param : + TEXT VAR param := sym; + test subscript (param, 22); + plot param no INCR 1; + IF plot param no > 10 + THEN err (64); + LEAVE generate init scale + FI; + plot name (plot param no) := param; + scalepointer (plot param no) := scalecounter; + set id; + set scale. + + set id : + IF sym = "=" + THEN next sym; + id (plot param no) := (sym SUB 1); + next sym + ELSE id (plot param no) := text (plot param no - 1) + FI. + + set scale : + IF sym = "(" + THEN get plot scale; + fixed scale := TRUE + ELIF NOT fixed scale + THEN l fixed scale (scale counter) := FALSE; + u fixed scale (scale counter) := FALSE; + FI. + + get plot scale : + IF fixed scale + THEN err (28) + FI; + read scale param (lower bound, l fixed scale, 29); + IF sym <> "," + THEN err (30) + FI; + read scale param (upper bound, u fixed scale, 30); + test closing bracket (sym); + next sym. +END PROC generate init scale; + +PROC read scale param (ROW 10 TEXT VAR bound, ROW 10 BOOL VAR fixed scale, + INT CONST err no) : + TEXT VAR scale; + INT VAR tab pos; + next sym; + IF type = bold + THEN test (sym, tab pos, nil, const, 61); + bound (scale counter) := sym; + fixed scale (scale counter) := TRUE + ELIF sym is number (scale) + THEN bound (scale counter) := scale; + fixed scale (scale counter) := TRUE + ELIF sym = "*" + THEN fixed scale (scale counter) := FALSE + ELSE err (err no) + FI; + next sym +END PROC read scale param; + +BOOL PROC sym is number (TEXT VAR constant) : + constant := nt; + IF sym IN "+-" + THEN constant := sym; next sym + FI; + IF type = number + THEN constant CAT sym; + TRUE + ELSE FALSE + FI +END PROC sym is number; + +PROC gen equations (INT CONST equ type) : + INT VAR i; + gen normal equs; + end of init list; + gen index equs. + + gen normal equs : + FOR i FROM tabbeg UPTO tabsize REP + IF is normal equ + THEN generate equ + FI + END REP. + + generate equ : + declare variables (i, equ type, FALSE). + + is normal equ : + CONCR (tab).type (i) = equ type + AND NOT CONCR (tab).rdef (i) AND CONCR (tab).index type (i) <= nil + AND NOT CONCR (tab).already used in loop body(i). + + gen index equs : + FOR i FROM tabbeg UPTO tabsize REP + IF is index equ + THEN gen loop (i, equ type) + FI + END REP. + + is index equ : + CONCR (tab).type (i) = equ type AND + NOT CONCR (tab).rdef (i) AND CONCR (tab).index type (i) > nil + AND NOT CONCR (tab).already used in loop body(i). + +END PROC gen equations; + +PROC gen loop (INT CONST i, equ type) : + for index := CONCR (tab).index (i); + TEXT VAR gen buf; + SELECT CONCR (tab).index type (i) OF + CASE bold : gen for loop + CASE number : generate replace + END SELECT. + + generate replace : + INT VAR k := i; + expression (equ type, gen buf, k); + gen replace (gen buf, k, text (for index)). + + gen for loop : + gen (" FOR ", CONCR (tab).name (for index), " FROM ", + CONCR (tab).init (for index)); + genln (" UPTO ", CONCR (tab).right part (for index), " REP"); + in loop := TRUE; + IF equ type = sub init + THEN gen replace (equ type, i) + ELSE search equal indices + FI; + in loop := FALSE; + genln (" PER;"). + + search equal indices : + INT VAR j; + FOR j FROM i UPTO tab size REP + IF is same index + THEN gen replace (equ type, j); + CONCR (tab).already used in loop body(j):=TRUE + FI + END REP. + + is same index : + for index = CONCR (tab).index (j) + AND CONCR (tab).index type (j) = bold + AND CONCR (tab).type (j) = CONCR (tab).type (i) + AND NOT CONCR (tab).rdef (j) + AND NOT CONCR (tab).already used in loop body(j). + +END PROC gen loop; + +PROC gen replace (TEXT VAR gen buf, INT CONST table index) : + gen replace (gen buf, table index, CONCR (tab).name (for index)) +END PROC gen replace; + +PROC gen replace (TEXT VAR gen buf, INT CONST table index, TEXT CONST index): + gen (" replace (", CONCR (tab).name (table index), ", ", index); + genln (", ", gen buf, ");") +END PROC gen replace; + +PROC gen replace (INT CONST equ type, tabpos) : + INT VAR no := tab pos; + TEXT VAR gen buf; + expression (equ type, gen buf, no); + gen replace (gen buf, no) +END PROC gen replace; + +PROC generate for variables : + is first := TRUE; + FOR i FROM tab beg UPTO tab size REP + IF CONCR (tab).type (i) = for + THEN gen for var + FI + END REP; + end of init list. + + gen for var : + set line no (i); + IF is first + THEN gen ("INT VAR "); + is first := FALSE + ELSE continue init list + FI; + gen (CONCR (tab).name (i)). +END PROC generate for variables; + +PROC generate variable part : + generate constants; + generate variables; + generate missed inits. + + generate constants : + INT VAR i; + FOR i FROM tab beg UPTO tabsize REP + IF CONCR (tab).type (i) = const AND NOT CONCR (tab).idef (i) + THEN gen const + FI + END REP. + + generate variables : + FOR i FROM tab beg UPTO tab size REP + SELECT CONCR (tab).type (i) OF + CASE level, aux, nequ, rate : gen normal equ + END SELECT + END REP. + + generate missed inits : + FOR i FROM tab beg UPTO tab size REP + SELECT CONCR (tab).type (i) OF + CASE aux, rate : gen missed init + END SELECT; + END REP; + end of init list. + + gen missed init : + IF sub init necessary + THEN declare variables (i, sub init, TRUE) + FI. + + sub init necessary : + CONCR (tab).init (i) = nt AND + NOT CONCR (tab).idef (i) AND CONCR (tab).index type (i) <= nil. + + gen normal equ : + IF equ not yet declared + THEN declare variables (i, nequ, TRUE) + FI. + + equ not yet declared : + NOT CONCR (tab).idef (i) AND CONCR (tab).init (i) <> nt + AND CONCR (tab).index type (i) <= nil. + + gen const : + gen linefeed; + gen (" "); + gen zz (i); + gen (CONCR (tab).name (i), " := ", "constant (""", CONCR (tab).name (i)); + gen (""", ", CONCR (tab).right part (i), ")"). +END PROC generate variable part; + +PROC end of init list : + IF NOT is first + THEN is first := TRUE; + genln (";") + FI +END PROC end of init list; + +PROC gen zz (INT CONST no) : + IF CONCR (tab).mac (no) > nil + THEN gen ("zz", CONCR(tab).name (CONCR(tab).mac (no)), text (expansion no)) + FI +END PROC gen zz; + +PROC declare variables (INT CONST no, equ type, BOOL CONST is init) : + INT VAR mac no := CONCR (tab).mac (no); + IF mac no > nil + THEN gen local equs + ELSE declare variable (no, equ type, is init) + FI. + + gen local equs : + INT VAR no of expansions := CONCR (tab).indextype (mac no); + FOR expansion no FROM 1 UPTO no of expansions REP + declare variable (no, equ type, is init) + END REP. +END PROC declare variables; + +PROC declare variable (INT CONST no, exp type, BOOL CONST init) : + TEXT VAR gen buf; + INT VAR i := no; + IF (init AND NOT CONCR (tab).idef (no)) OR + (NOT init AND NOT CONCR (tab).rdef (no)) + THEN gen equ + FI. + +gen equ : + expression (exp type, gen buf, i); + IF init + THEN gen linefeed + FI; + gen (" "); + gen zz (i); + gen (CONCR (tab).name (i), " := ", gen buf); + IF NOT init + THEN genln (";") + FI +END PROC declare variable; + +PROC gen linefeed : + IF is first + THEN is first := FALSE; + gen ("REAL VAR ") + ELSE continue init list + FI +END PROC gen linefeed; + +PROC set line no (INT CONST index) : + line no := CONCR (tab).line no (index); + cout (line no) +END PROC set line no; + +PROC continue init list : + genln (","); gen (" "); +END PROC continue init list; + +PROC gen tab var : + IF is first + THEN gen ("TAB VAR "); is first := FALSE + ELSE continue init list + FI +END PROC gen tab var; + +PROC generate table part : + is first := TRUE; + FOR i FROM tabbeg UPTO tabsize REP + SELECT CONCR (tab).type (i) OF + CASE table : gen tab declaration; + gen tab init + CASE aux, rate, level : IF CONCR (tab).index type (i) = bold + THEN + IF CONCR(tab).type(i)=aux THEN + IF NOT CONCR(tab).should declare vector(i) + THEN + find maximum index for current variable + FI; + IF CONCR(tab).should declare vector(i) + THEN + gen row init + FI + ELSE + gen row init + FI (*18.5.88 dc*) + FI + END SELECT + END REP; + end of init list. + +gen tab declaration : + gen tab var; + gen (CONCR (tab).name (i), " := vector (", vec length); + genln (");"); + is first := TRUE. + +gen tab init : + INT VAR elem no := 1; + scan (CONCR (tab).right part (i)); next sym; + set line no (i); + WHILE type is number REP + gen ("replace (", CONCR (tab).name (i), ", ", text (elem no)); + genln (", ", constant, ");"); + next sym; + elem no INCR 1 + UNTIL end of constant list END REP. + + type is number : + IF sym is number (constant) + THEN TRUE + ELSE err (40); FALSE + FI. + + end of constant list : + test delimiter. + + vec length : + INT VAR p, l := 1; + FOR p FROM 2 UPTO length (CONCR (tab).right part (i)) REP + IF (CONCR (tab).right part (i) SUB p) IN ",/" + THEN l INCR 1 + FI + PER; text (l). + + gen row init : + gen tab var; + gen (CONCR (tab).name (i), " := vector (", row length, ")"). + + row length : + set line no (i); + CONCR (tab).right part (CONCR (tab).index (i)). + + find maximum index for current variable: + INT VAR maximum, place, k; + TEXT VAR name::CONCR(tab).name(i); + maximum:=int(CONCR(tab).right part(CONCR(tab).index(i))); + place:=i; + FOR k FROM tabbeg UPTO tabsize REPEAT + check maximum of index and change if needed; + CONCR(tab).should declare vector(k):=FALSE + PER; + CONCR(tab).should declare vector(place):=TRUE. + +check maximum of index and change if needed: + IF same variable CAND need to change + THEN + maximum:=int(CONCR(tab).right part(CONCR(tab).index(k))); + place:=k + FI. + +need to change: + maximum < int(CONCR(tab).right part(CONCR(tab).index(k))). + +same variable: + name =CONCR(tab).name(k) CAND CONCR(tab).index type(k) = 1. + + +END PROC generate table part; + +BOOL PROC test delimiter : + SELECT pos ("/, EOL", sym) OF + CASE 1, 2 : next sym; FALSE + CASE 3, 4 : TRUE + OTHERWISE : err (62); TRUE + END SELECT +END PROC test delimiter; + +PROC generate table init : + INT VAR i, tab pos; + FOR i FROM tabbeg UPTO tabsize REP + IF CONCR (tab).index type (i) > nil AND NOT CONCR (tab).idef (i) + THEN gen tab init + FI + END REP. + + gen tab init : + SELECT CONCR (tab).type (i) OF + CASE nequ : gen loop (i, nequ) + CASE aux, rate : gen missed table init + CASE mac name : CONCR (tab).line no (i) := nil + END SELECT. + + gen missed table init : + search (CONCR (tab).name (i), tab pos, nil, nequ); + IF not found + THEN gen loop (i, sub init) + FI. +END PROC generate table init; + +PROC sort equ (INT CONST tab pos, equ type) : + IF in loop + THEN gen replace (equ type, tab pos) + ELSE declare variable (tab pos, equ type, equ type = nequ OR + equ type = sub init) + FI +END PROC sort equ; + +PROC expression (INT CONST equtype, TEXT VAR gen buf, INT VAR no) : + TEXT VAR symbol, buf := equation; + INT VAR spos := 1, stype, tabpos; + gen buf := nt; + set line no (no); + test global equ; + compile equ; + IF CONCR (tab).mac (no) = nil + COR expansion no >= CONCR (tab).index type (CONCR (tab).mac (no)) + THEN set def flag + FI. + + test global equ : + IF CONCR (tab).index type (no) < nil + THEN replace global mac param + FI. + + replace global mac param : + INT CONST param index := CONCR (tab).index (no); + search (actual parameter (CONCR (tab).rightpart (paramindex)), + tabpos, nil, nil); + no := tabpos; + expression (type of param, gen buf, no); + LEAVE expression. + + type of param : + IF equ type = sub init + THEN CONCR (tab).type (no) + ELSE equ type + FI. + + compile equ : + IF CONCR (tab).in use (no) + THEN err (CONCR (tab).name (no), 43) + ELSE pass expression + FI. + + pass expression : + CONCR (tab).in use (no) := TRUE; + expression2 (equtype, no, spos, stype, genbuf, symbol, buf); + CONCR (tab).in use (no) := FALSE. + + equation : + IF equtype = nequ + THEN CONCR (tab).init (no) + ELSE CONCR (tab).right part (no) + FI. + + set def flag : + SELECT equtype OF + CASE nequ, sub init : CONCR (tab).idef (no) := TRUE + CASE level : test level + OTHERWISE : CONCR (tab).rdef (no) := TRUE + END SELECT. + + test level : + IF CONCR (tab).init (no) = nt AND CONCR (tab).index type (no) = nil + THEN err (CONCR (tab).name (no), 39) + FI. +END PROC expression; + +PROC expression2 (INT CONST equtype, no, INT VAR spos, stype, + TEXT VAR gen buf, symbol, buf) : + next sym (buf, symbol, stype, spos); + REP + factor (equtype, no, spos, gen buf, buf, symbol, stype) + UNTIL is no operator END REP. + + is no operator : + IF symbol IN "+-*/" + THEN gen buf CAT symbol; + next sym (buf, symbol, stype, spos); + process obelix; + FALSE + ELSE TRUE + FI. + + process obelix : + IF symbol = "*" + THEN gen buf CAT symbol; + next sym (buf, symbol, stype, spos) + FI. +END PROC expression2; + +TEXT PROC actual parameter (TEXT CONST params) : + INT VAR position := nil, old position; + FOR i FROM 1 UPTO expansion no REP + old position := position; + position := pos (params, "%", position + 1) + END REP; + subtext (params, old position + 1, position - 1). +END PROC actual parameter; + +PROC factor (INT CONST equtype, no, INT VAR spos, TEXT VAR genbuf, + buf, symbol, INT VAR stype) : + BOOL VAR dollar := symbol = "$"; + INT VAR tab pos, mac num := CONCR (tab).mac (no); + IF dollar + THEN next sym (buf, symbol, stype, spos) + FI; + SELECT stype OF + CASE number : process number + CASE bold : process quantity + CASE delimiter : process delimiter + OTHERWISE : err (symbol, 44) + END SELECT. + + process number : + gen buf CAT symbol; + next sym (buf, symbol, stype, spos). + + process quantity : + TEXT VAR name := symbol, time script; + INT VAR old spos := spos; + next sym (buf, symbol, stype, spos); + IF mac num > nil + THEN search (name, tab pos, mac num, mac param); + IF not found + THEN search (name, tab pos, mac num, nil); + IF not found + THEN search (name, tab pos, nil, nil) + FI + FI + ELSE search (name, tab pos, nil, nil) + FI; + IF is global param + THEN search (name, tab pos, macro number of param, nil) + FI; + IF not found + THEN err (name, 46) + ELSE test type + FI. + + is global param : + not found AND CONCR (tab).index (no) > nil + AND CONCR (tab).index type (no) = nil. + + macro number of param : + CONCR (tab).mac (CONCR (tab).index (no)). + + test type : + INT VAR nop; + BOOL VAR is equ := FALSE; + search table entry; + get time script; + type := CONCR (tab).type (tab pos); + SELECT type OF + CASE std p : std function + CASE table : (* nanu *) + CASE mac param : replace param + CASE mac name : macro expansion + CASE const : constant + OTHERWISE test quantity + END SELECT; + IF symbol = "(" + THEN test index + ELIF is equ + THEN gen buf CAT name + FI. + + search table entry : + IF CONCR (tab).index type (tab pos) > nil AND + CONCR (tab).type (tab pos) = n equ + THEN search correct table; + IF not found + THEN err (name, 46); + LEAVE process quantity + FI + FI. + + search correct table : + not found := TRUE; + WHILE tab pos <> nil CAND table not found REP + tab pos := CONCR (tab).pred (tab pos) + END REP. + + table not found : + not found := NOT (CONCR (tab).name (tab pos) = name + AND not in macro AND type ok); + not found. + + not in macro : + CONCR (tab).mac (tab pos) = nil. + + type ok : + type := CONCR (tab).type (tab pos); + type = aux OR type = rate OR type = level. + + test quantity : + IF CONCR (tab).mac (tab pos) > nil + THEN name := "zz" + CONCR (tab).name (CONCR (tab).mac (tab pos)) + + text (expansion no) + name + FI; + is equ := TRUE; + SELECT equtype OF + CASE nequ : initialization + CASE aux : auxiliary + CASE level : level equation + CASE sub init: substitute init + CASE supp : supplementary + OTHERWISE : rate equation + END SELECT. + + get time script : + time script := nt; + IF symbol = "." + THEN next sym (buf, time script, stype, spos); + next sym (buf, symbol, stype, spos) + FI; + BOOL VAR is any := time script = any. + + replace param : + buf := text (buf, old spos - 2) + + actual param + subtext (buf, spos - 1); + spos := old spos - 1; + next sym (buf, symbol, stype, spos); + factor (equtype, no, spos, genbuf, buf, symbol, stype); + LEAVE factor. + + actual param : + TEXT VAR param := actual parameter (content); + IF param contains time script OR is number + THEN param + ELSE param + "." + any + FI. + + param contains time script : + (param SUB (length (param))) = any. + + is number : + pos ("0123456789", param SUB (length (param))) > 0. + + content : + IF type = nequ AND CONCR (tab).index (no) = nil + THEN CONCR (tab).init (tab pos) + ELSE CONCR (tab).right part (tab pos) + FI. + + test index : + gen buf CAT "("; + gen buf CAT name; + next sym (buf, symbol, stype, spos); + gen buf CAT " SUB "; + SELECT stype OF + CASE number : int index + CASE bold : var index + OTHERWISE : err (symbol, 48) + END SELECT; + test offset; + test closing bracket (symbol); + gen buf CAT symbol; + next sym (buf, symbol, stype, spos). + + test offset : + next sym (buf, symbol, stype, spos); + IF symbol IN "+-" + THEN pass offset + FI. + + pass offset : + gen buf CAT symbol; + next sym (buf, symbol, stype, spos); + gen buf CAT trunc (symbol); + IF stype <> number + THEN err (symbol, 48) + FI; + next sym (buf, symbol, stype, spos). + + int index : +(*IF CONCR (tab).index (no) <> int (symbol) + THEN err (symbol, 48); + message("Starten Sie trotzdem das übersetzte ELAN Programm") FI;*) +(*20.5.88 dc: hier kommt eine falsche Fehlermeldung *) + gen buf CAT trunc (symbol). + + var index : + search (symbol, tab pos, mac num, for); + gen buf CAT symbol; + IF incorrect index + THEN err (symbol, 48) + FI. + + incorrect index : + not found COR CONCR (tab).name (CONCR (tab).index (no)) <> symbol. + + std function : + test open bracket (symbol); + nop := length (CONCR (tab).right part (tab pos)); + gen buf CAT (name + " ("); + IF nop > nil + THEN pass actual params + ELSE next sym (buf, symbol, stype, spos); + test closing bracket (symbol) + FI; + next sym (buf, symbol, stype, spos); + IF act param <> nop + THEN err (symbol, 49) + FI. + + pass actual params : + INT VAR table pos := tab pos, act param := nil; + REP + act param INCR 1; + IF (CONCR (tab).right part (table pos) SUB act param) = "t" + THEN test if param is table + ELSE expression2 (equtype, no, spos, stype, gen buf, symbol, buf) + FI + UNTIL no more params END REP. + + no more params : + gen buf CAT symbol; + SELECT pos (",)", symbol) OF + CASE 1 : FALSE + CASE 2 : TRUE + OTHERWISE : err (symbol, 50); TRUE + END SELECT. + + test if param is table : + next sym (buf, symbol, stype, spos); + IF s type = bold + THEN search (symbol, tab pos, mac num, nil); + IF not found + THEN err (symbol, 51) + ELSE gen table + FI + ELSE err (symbol, 52) + FI. + + gen table : + IF CONCR (tab).type (tab pos) = table + THEN gen buf CAT symbol; + next sym (buf, symbol, stype, spos) + ELIF CONCR (tab).index type (tab pos) > nil + THEN factor (equtype, no, spos, genbuf, buf, symbol, stype) + ELSE err (symbol, 52) + FI. + + macro expansion : + CONCR (tab).line no (tab pos) INCR 1; + gen buf CAT "zz"; + gen buf CAT name; + gen buf CAT text (CONCR (tab).line no (tab pos)); + gen buf CAT name; + get actual parameters. + + get actual parameters : + TEXT VAR char; + test open bracket (symbol); + get macro parameter list; + next sym (buf, symbol, stype, spos). + + get macro parameter list : + REP + get act param + UNTIL end of parameter list END REP. + + end of parameter list : + SELECT pos (",)", char) OF + CASE 1 : FALSE + CASE 2 : TRUE + OTHERWISE : TRUE + END SELECT. + + get act param : + INT VAR brackets := nil; + char := buf SUB spos; + REP + spos INCR 1; + char := buf SUB spos + UNTIL end of param END REP; + spos INCR 1. + + end of param : + IF brackets = nil + THEN char IN ",)" + ELIF char = "(" + THEN brackets INCR 1; + FALSE + ELIF char = ")" + THEN brackets DECR 1; + FALSE + ELSE FALSE + FI. + + constant : + is equ := TRUE; + CONCR (tab).idef (tab pos) := TRUE. + + initialization : + IF time script = nt OR is any + THEN IF NOT CONCR (tab).idef (tab pos) + THEN IF CONCR (tab).init (tab pos) <> nt + THEN sort equ (tab pos, equ type) + ELIF is sub init + THEN sort equ (tab pos, sub init) + ELSE err (symbol, 39) + FI + FI + ELSE err (time script, 56) + FI. + + is sub init : + CONCR (tab).init (tab pos) = nt AND correct type (type). + + auxiliary : + IF time script = aux time script OR is any + THEN IF NOT CONCR (tab).rdef (tab pos) AND type = aux + THEN sort equ (tab pos, equtype) + FI + ELSE err (time script, 57) + FI. + + aux time script : + SELECT type OF + CASE aux, level : "k" + CASE rate : "jk" + OTHERWISE : " " + END SELECT. + + level equation : + IF time script <> level time script AND NOT is any + THEN err (time script, 59) + FI. + + level time script : + SELECT type OF + CASE aux, level : "j" + CASE rate : "jk" + OTHERWISE : " " + END SELECT. + + rate equation : + IF time script <> rate time script AND NOT is any + THEN err (time script, 60) + FI. + + rate time script : + SELECT type OF + CASE aux, level : "k" + CASE rate : "jk" + OTHERWISE : " " + END SELECT. + + supplementary : + IF time script <> supp time script AND NOT is any + THEN err (time script, 57) + FI. + + supp time script : + SELECT type OF + CASE aux, level, supp : "k" + CASE rate : "jk" + OTHERWISE : " " + END SELECT. + + substitute init : + IF NOT CONCR (tab).idef (tab pos) + THEN gen sub init equ + FI. + + gen sub init equ : + IF CONCR (tab).index type (tab pos) > nil + THEN IF CONCR (tab).index type (no) = nil + THEN process index equ + FI + ELIF CONCR (tab).init (tab pos) = nt + THEN IF correct type (type) + THEN sort equ (tab pos, equtype) + FI + ELSE sort equ (tab pos, nequ) + FI. + + process index equ : + INT VAR table type := sub init; + IF type <> nequ + THEN search nequ + FI; + IF NOT CONCR (tab).idef (tab pos) AND correct type (type) + THEN end of init list; + gen loop (tab pos, table type); + CONCR (tab).idef (tab pos) := TRUE + FI. + + search nequ : + search (CONCR (tab).name (tabpos), table pos, nil, nequ); + IF NOT (not found CAND CONCR (tab).idef (tab pos)) + THEN type := nequ; + tab pos := table pos; + table type := type + FI. + + process delimiter : + genbuf CAT symbol; + SELECT pos ("(+-", symbol) OF + CASE 1 : process bracket + CASE 2, 3: process monadic operator + OTHERWISE err (symbol, 44) + END SELECT. + + process bracket : + expression2 (equtype, no, spos, stype, genbuf, symbol, buf); + test closing bracket (symbol); + gen buf CAT symbol; + next sym (buf, symbol, stype, spos); + IF symbol = "(" + THEN gen buf CAT "*"; + factor (equtype, no, spos, gen buf, buf, symbol, stype) + FI. + + process monadic operator : + next sym (buf, symbol, stype, spos); + factor (equtype, no, spos, gen buf, buf, symbol, stype). +END PROC factor; + +BOOL PROC correct type (INT CONST equ type) : + SELECT equ type OF + CASE aux, rate, nequ : TRUE + OTHERWISE : FALSE + END SELECT. +END PROC correct type; + +TEXT PROC draw ad: + IF is draw THEN "b" ELSE "" END IF +END PROC draw ad; + +(*$$$$$$$$$$$$$$$ ZUSATZ Februar 87 C&C geaendert: Ausgabe "dump" $$$$$$$$*) + +(* In dieser Prozedur wird eine Datei 'dump' angelegt, in der alle *) +(* Dynamo-Standardfunktionen, Macros und die programmspezifischen *) +(* Variablen und Konstanten eingetragen werden. *) + +PROC table dump : +IF exists ("dump") +THEN forget("dump",quiet) +FI; +FILE VAR dump := sequential file(output, "dump"); +sysout("dump"); + FOR i FROM 1 UPTO CONCR (tab).tab size REP + put (i); + put ("NAM :"); put (CONCR (tab).name (i)); + put ("RP :"); put (CONCR (tab).right part (i)); + put ("INI :"); put (CONCR (tab).init (i)); + put ("IND :"); put (CONCR (tab).index (i)); + put ("IT :"); put (CONCR (tab).index type (i)); + put ("TYP :"); put (CONCR (tab).type (i)); + line; + END REP; +sysout("") +END PROC table dump +(*$$$$$$$$$$$$$$$$$$$$ ENDE ZUSATZ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$*) +END PACKET dynamo compiler 33 + diff --git a/lang/dynamo/1.8.7/src/dyn.abnahme b/lang/dynamo/1.8.7/src/dyn.abnahme new file mode 100644 index 0000000..e8c100d --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.abnahme @@ -0,0 +1,19 @@ +NOTE +NOTE Ein einfaches Modell der Bevoelkerungsentwicklung +NOTE +L BEVOELKERUNG.K=BEVOELKERUNG.J+DT*(GEBURTENRATE.JK-STERBERATE.JK) +N BEVOELKERUNG=1000 +R GEBURTENRATE.KL=BEVOELKERUNG.K*WACHSTUMSFAKTOR +N GEBURTENRATE=10 +C WACHSTUMSFAKTOR=0.01 das heisst: 1 Prozent +R STERBERATE.KL=BEVOELKERUNG.K*STERBEFAKTOR +C STERBEFAKTOR=0.001 das heisst: 1 Promille +N STERBERATE=10 +NOTE +NOTE Simulationsparameter +NOTE +PLOT BEVOELKERUNG=B(0,2000)/GEBURTENRATE=G(0,40)/STERBERATE=S(0,6) +C DT=1 +C PLTPER=1 +C LENGTH=68 + diff --git a/lang/dynamo/1.8.7/src/dyn.bev b/lang/dynamo/1.8.7/src/dyn.bev new file mode 100644 index 0000000..5b759d3 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.bev @@ -0,0 +1,50 @@ +NOTE EIN BEVÖLKERUNGSMODELL DER BUNDESREPUBLIK DEUTSCHLAND +NOTE +NOTE ANGABEN DER GEBURTENRATEN (GR) UND STERBEQUOTIENTEN (SQ) +NOTE AUS DEM STATISTISCHEN JAHRBUCH 1982 +NOTE +FOR LJ=1,80 LEBENSJAHRE +FOR LJ2=2,80 +L BEV.K(1)=BEV.J(1)+DT*(GB.J-A.J(1)-S.J(1)) BABIES +L BEV.K(LJ2)=BEV.J(LJ2)+DT*(A.J(LJ2-1)-A.J(LJ2)-S.J(LJ2)) BEVÖLKERUNG +A A.K(LJ)=(1-SQ(LJ))*BEV.K(LJ) +A S.K(LJ)=SQ(LJ)*BEV.K(LJ) +A GB.K=SCLPRD(BEV.K,15,44,GR,1)/2 Geburten +A GBEV.K=SUM(BEV.K) Gesamtbevölkerung +A ZBEV.K=SUMV(BEV.K,16,59) zahlende Bevölkerung (in Rentenversicherung) +A PRENT.K=SUMV(BEV.K,60,80) potentielle Rentner +NOTE +N BEV(LJ)=IBEV(LJ)*1E3 +T IBEV= +X 584/585/590/609/652/728/780/843/927/980/ +X 1014/1032/1045/1049/1024/1003/986/959/929/903/ +X 884/857/850/845/841/844/854/872/854/810/ +X 756/676/722/826/829/905/1029/1062/1026/968/ +X 934/919/884/783/711/725/763/784/784/768/ +X 742/744/724/700/716/751/765/673/488/385/ +X 397/479/613/690/698/681/664/666/654/630/ +X 603/573/546/510/476/445/402/359/320/1681 +NOTE +T SQ= +X .01965/.00123/.00082/.00082/.00082/.00055/.00055/.00055/.00055/.00055/ +X .00033/.00033/.00033/.00033/.00033/.00064/.00064/.00064/.00064/.00064/ +X .00183/.00183/.00183/.00183/.00183/.00131/.00131/.00131/.00131/.00131/ +X .00152/.00152/.00152/.00152/.00152/.00193/.00193/.00193/.00193/.00193/ +X .00302/.00302/.00302/.00302/.00302/.00497/.00497/.00497/.00497/.00497/ +X .00750/.00750/.00750/.00750/.00750/.01220/.01220/.01220/.01220/.01220/ +X .01868/.01868/.01868/.01868/.01868/.03146/.03146/.03146/.03146/.03146/ +X .05206/.05206/.05206/.05206/.05206/.08241/.08241/.08241/.08241/.175 +NOTE +T GR= +X .0008/.0041/.0138/.0274/.0453/.0597/.0745/.0861/.0933/.1025/ +X .1067/.1074/.1050/.0963/.0872/.0753/.0642/.0531/.0430/.0360/ +X .0297/.0225/.0184/.0144/.0114/.0087/.0063/.0044/.0031/.0020 +NOTE +C DT=1 +C PLTPER=1 +C PRTPER=1 +N TIME=1982 +C LENGTH=2000 +NOTE PRINT GB,A(1),S(1),BEV(1),BEV(2),GR(1),GR(15),GR(30) +PRINT GBEV,BEV(1),BEV(40),BEV(60),BEV(63),BEV(65),ZBEV,PRENT + diff --git a/lang/dynamo/1.8.7/src/dyn.cob b/lang/dynamo/1.8.7/src/dyn.cob new file mode 100644 index 0000000..eabb1b8 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.cob @@ -0,0 +1,19 @@ +NOTE COBWEB MODEL 27.11.81 +L PREIS.K=PREIS.J+(DT)*K*(NACHFR.J-ANGEBOT.J) +L ANGEBOT.K=A+B*PREIS.J +A NACHFR.K=C-D*PREIS.K +NOTE B>0, D>0, K>0 +N PREIS=0 +N ANGEBOT=11 +C K=1 +C A=1. +C B=.9 +C C=12.4 +C D=1.2 +C DT=.1 +C LENGTH=10 +C PRTPER=.1 +C PLTPER=.1 +PLOT PREIS=P/NACHFR=N(1,10)/ANGEBOT=A +PRINT PREIS,ANGEBOT,NACHFR + diff --git a/lang/dynamo/1.8.7/src/dyn.const b/lang/dynamo/1.8.7/src/dyn.const new file mode 100644 index 0000000..c42ad1c Binary files /dev/null and b/lang/dynamo/1.8.7/src/dyn.const differ diff --git a/lang/dynamo/1.8.7/src/dyn.delaytest b/lang/dynamo/1.8.7/src/dyn.delaytest new file mode 100644 index 0000000..c475433 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.delaytest @@ -0,0 +1,8 @@ +NOTE GOODMAN S.248 +A Y.K=DELAY3(X,D) +C D=50 +R X.KL=TABLE(XT,TIME.K,0,125,25) +T XT=0/10/0/-10/0/10 +PLOT X=X,Y=Y(-10,10) +SPEC DT=0.5,LENGTH=125,PLTPER=2 + diff --git a/lang/dynamo/1.8.7/src/dyn.errors b/lang/dynamo/1.8.7/src/dyn.errors new file mode 100644 index 0000000..64a4f27 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.errors @@ -0,0 +1,68 @@ +gleichung doppelt definiert +doppelte initialisierung +falscher zeilentyp +verschachtelte makro-definition +makro-name erwartet +'(' erwartet +formaler parameter erwartet +')' nach parameterliste erwartet +bei auxiliaries nur subskription mit '.k' erlaubt +bei konstanten-definition name erwartet +bei levels nur subskription mit '.k' erlaubt +bei rates nur subskription mit '.kl' erlaubt +bei table-definition keine subskription erlaubt +x - befehl hier nicht erlaubt +bei for-definition name erwartet +'=' nach for-variable erwartet +bereichsangabe erwartet +',' erwartet +lokale gleichung nur in makro erlaubt +bei definition name erwartet +'=' erwartet +index nicht korrekt +')' nach indizierung erwartet +prtper nicht definiert +pltper nicht definiert +'/' oder ',' bei plot erwartet +name als plotparameter erwartet +doppelte scale-angabe in einer gruppe +erste scale-angabe erwartet +zweite scale-angabe erwartet +')' nach scale-angabe erwartet +printparameter nicht definiert +printparameter erwartet +time darf nur initialisiert werden +dt nicht definiert +length nicht definiert +bei konstanten-definition zahl erwartet +bei initialisierung konstante erwartet +levels muessen initialisiert werden +konstante bei table erwartet +'/' oder ',' erwartet +table-definition ohne benutzung +simultane gleichungen +faktor erwartet +time muss mit '.j' oder '.k' subskribiert werden +symbol nicht definiert +funktion nicht definiert +unzulaessige indizierung +falsche parameteranzahl +falsches trennsymbol zwischen parametern +als parameter table erwartet +falscher parameter in tablefunktion +zuviele aktuelle parameter +')' nach makroaufruf fehlt +rekursiver makroaufruf +bei n-gleichung keine subskription erwartet +falsche subskription in auxiliary-gleichung +')' erwartet +falsche subskription in level-gleichung +falsche subskription in rate-gleichung +for-variable nicht definiert +konstante erwartet +falsches real-format +zu viele plot-parameter +bei run-befehl dateiname erwartet +als noise-parameter zahl erwartet +plot- und draw-Anweiungen dürfen im Programm nicht gemischt werden + diff --git a/lang/dynamo/1.8.7/src/dyn.forest b/lang/dynamo/1.8.7/src/dyn.forest new file mode 100644 index 0000000..5075925 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.forest @@ -0,0 +1,47 @@ +NOTE 23.04.1985 english version 22.11.1985 +note forest management model +note +note wood standing within the forest +l wood.k=wood.j+dt*(woodgrowth.jk-harvest.jk) +n wood=startingwood +c startingwood=15000 m**3 +r woodgrowth.kl=wood.k*stocksfactor*cultivationfactor.k +c stocksfactor=0.04 growth in % of wood +a cultivationfactor.k=tabhl(tclfactor,clstate.k,0,1,0.1) +t tclfactor=0/.1/.2/.3/.4/.5/.7/.95/1/1.05/1.2 +r harvest.kl=wood.k*harvestpercent.k*0.1 +a harvestpercent.k=tabhl(tharvestpercent,ratio1.k,0.8,1.2,0.1) +t tharvestpercent=0.1/0.3/0.35/0.4/0.6 +a ratio1.k=wood.k/maxstock +c maxstock=16000 +note +note resources +l resources.k=resources.j+dt*(income.jk-clexpense.jk-draw.jk) +n resources=startresources +c startresources=100000 money units +r income.kl=wood.k*harvestpercent.k*0.1*price +c price=190 money units per cubic m +r clexpense.kl=resources.k-constdraw +r draw.kl=constdraw +c constdraw=20000 +note +note cultivationstate (clstate; dimensionless ) +l clstate.k=clstate.j+dt*(clbetter.jk-clworse.jk) +n clstate=startclstate +c startclstate=0.8 +r clbetter.kl=clbetterfactor.k*(1-clstate.k) +a clbetterfactor.k=tabhl(tclbetter,cultivationcost.k,80000,180000,100000) +t tclbetter=0.0/0.1 +a cultivationcost.k=resources.k-constdraw +r clworse.kl=clworsefactor.k*clstate.k +a clworsefactor.k=tabhl(tclworse,cultivationcost.k,0,80000,80000) +t tclworse=0.2/0 +note +note +print wood,resources,clstate +plot wood=w/resources=r/clstate=c(0,1) +c dt=1 +c length=50 +c prtper=1 +c pltper=1 + diff --git a/lang/dynamo/1.8.7/src/dyn.forst7 b/lang/dynamo/1.8.7/src/dyn.forst7 new file mode 100644 index 0000000..d767a50 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.forst7 @@ -0,0 +1,76 @@ +#papersize(20.5,61.0)# +#pagelength(59.0)# +#type("picac")# +NOTE 25.04.1985 14.30 +note forstbetriebsmodell +note +note stehender Holzvorrat +l holz.k=holz.j+dt*(zuwachs.jk-ernte.jk) +n holz=startholz +c startholz=15000 Angabe in Festmetern(fm) +r zuwachs.kl=holz.k*vorratsfaktor*pflegefaktor.k +c vorratsfaktor=0.035 Zuwachs in % von holz +a pflegefaktor.k=tabhl(tpffaktor,pfzustand.k,0,1,0.1) +t tpffaktor=.7/.7/.7/.7/.7/.8/.9/.95/1/1.05/1.2 +r ernte.kl=ernte1.k +a ernte1.k=holz.k*ernteproz.k*ernteprozfak.k +a ernteproz.k=tabhl(ternproz,ratio1.k,0.5,1.2,0.1) +t ternproz=0.02/0.025/0.03/0.03/0.03/0.035/0.06/0.08 +a ratio1.k=holz.k/maxvorrat +c maxvorrat=16000 +note +note resourcen +l resourcen.k=resourcen.j+dt*(einnahme.jk-eig.jk-pfausgaben.jk) +n resourcen=startresourcen +c startresourcen=100000 Geldeinheiten +c preis=190 Geldeinheiten pro fm +r einnahme.kl=ernte1.k*preis +r pfausgaben.kl=resourcen.k-eigenent.k +r eig.kl=eigenent.k +a anpassungsfaktor.k=tabhl(tanpass,ratio2.k,0.5,1.5,0.1) +t tanpass=.5/.55/.6/.7/.9/1/1/1/1.1/1.2/1.3 +l eigenent.k=min(eigenent.j*anpass.jk,resourcen.j) +r anpass.kl=anpassungsfaktor.k +n eigenent=eigenentstart +c eigenentstart=20000 +note +note arbeitseinheiten +note +l arbeit.k=arbeit.j+dt*(pfausgaben.jk/preisae-arbeitsverbrauch.jk) +n arbeit=startarbeit +c startarbeit=800 +c preisae=100 ( preis pro arbeitseinheit in geldeinheiten ) +r arbeitsverbrauch.kl=min(arbeit.k,notwarbeit.k) +a notwarbeit.k=tabhl(tnotwarb,pfzustand.k,0.0,1.0,0.1) +t tnotwarb=1600/1550/1500/1450/1400/1300/1150/950/800/700/600 +a ratio2.k=arbeit.k/notwarbeit.k +a ernteprozfak.k=tabhl(ternteprozfak,ratio2.k,0.2,1.6,0.2) +t ternteprozfak=.4/.5/1/2/1.05/1/.9/.7 +note +note Pflegezustand (pfzustand; dimensionslose Größe) +l pfzustand.k=pfzustand.j+dt*(pfverbess.jk-pfversch.jk) +n pfzustand=startpfzustand +c startpfzustand=0.8 +r pfverbess.kl=smooth(pfx1.k,pfverzoeg) +a pfx1.k=pfverbfaktor.k*(1-pfzustand.k) +a pfverbfaktor.k=tabhl(tpfverb,ratio2.k,.8,1.4,.2) +t tpfverb=0/0/.1/0.2 +r pfversch.kl=smooth(pfverschfaktor.k*pfzustand.k,pfverzoeg) +c pfverzoeg=2 +a pfverschfaktor.k=tabhl(tpfversch,ratio2.k,0,.8,.2) +t tpfversch=.4/.2/.1/.05/0 +note +note +note print ratio1,ratio2,eigenent,arbeit,pfzustand +plot holz=h(1e4,2e4)/eigenent=e(0,2e5)/pfzustand=P(0,1)/ratio2=2(0,5) +c dt=1 +c length=50 +note prtper=1 +c pltper=1 +run dyn.forst7 + + + + + + diff --git a/lang/dynamo/1.8.7/src/dyn.gekoppeltependel b/lang/dynamo/1.8.7/src/dyn.gekoppeltependel new file mode 100644 index 0000000..3f2a961 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.gekoppeltependel @@ -0,0 +1,19 @@ +NOTE gekoppelte pendel +L x1.k=x1.j+dt*v1.j +L x2.k=x2.j+dt*v2.j +L v1.k=v1.j+dt*(-d0/m1*x1.j-(d/m1)*(x1.j-x2.j)) +L v2.k=v2.j+dt*(-d0/m2*x2.j-(d/m2)*(x2.j-x1.j)) +N x1=a +N x2=0 +N v1=0 +N v2=0 +C a=3 +C m1=2 +C m2=2 +C d0=9 +C d=2 +C dt=0.1 +C length=50 +C pltper=0.3 +PLOT x1=1(-3,9)/x2=2(-9,3) + diff --git a/lang/dynamo/1.8.7/src/dyn.grashasenfuchs b/lang/dynamo/1.8.7/src/dyn.grashasenfuchs new file mode 100644 index 0000000..046a1e1 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.grashasenfuchs @@ -0,0 +1,42 @@ +NOTE +NOTE Raeuber-Beute-Beziehung nach VOLTERRA am Beispiel Fuchs-Hase +NOTE Aenderung: mit FUTTER und CLIP-Funktion +L GRAS.K=CLIP(GRAS.J+DT*(WACHSR.JK-FRESSR.JK),0,GRAS.J,0) +L HASEN.K=CLIP(HASEN.J+DT*(HGRATE.JK-HSRATE.JK),0,HASEN.J,0) +L FUECHS.K=CLIP(FUECHS.J+DT*(FGRATE.JK-FSRATE.JK),0,FUECHS.J,0) +R WACHSR.KL=(GPROZ/100)*GRAS.K GPROZ Wachstumsprozente +R FRESSR.KL=GFRESS*HASEN.K*GRAS.K GFRESS in: pro Hasen +R HGRATE.KL=HGK*HASEN.K*GRAS.K +R HSRATE.KL=TREFF*HASEN.K*FUECHS.K+HSTIRB*HASEN.K +R FGRATE.KL=FGK*HASEN.K*FUECHS.K +R FSRATE.KL=FSK*FUECHS.K +NOTE +NOTE Gleichgewichtsbedingungen: +NOTE HASEN=GPROZ/(100*Gfress) +NOTE +NOTE Hasengeburtenkoeffizient*GRAS=Trefferwahrscheinlichkeit*Fuechse +NOTE +Hstirb +NOTE Fuechsesterbekoeffizient=Fuechsegeburtenkoeffizient*Hasen +NOTE +N GRAS=IG +N HASEN=IH +N FUECHS=IF +C GPROZ=3 Graswachstum 3% +C GFRESS=3E-4 (Grasfressanteil) pro Hasen +C HGK=1E-3 Hasengeburtskoeff +C TREFF=4E-2 Trefferwahrscheinlichkeit +C HSTIRB=0.001 Hasensterbekoeffizient (ohne Fuechse) +C FGK=0.05 Fuechsegeburtenkoeffizient +C FSK=5 Fuechsesterbekoeffizient +C IG=1E+3 +C IH=110 +C IF=25 +NOTE +NOTE SIMULATIONSPARAMETER +NOTE +C DT=0.083 +C PLTPER=.083 monatlich, 0.083=1/12 ! +C LENGTH=5 +PLOT GRAS=G(995,1005)/HASEN=H(85,115)/FUECHS=F(15,35) + + diff --git a/lang/dynamo/1.8.7/src/dyn.help b/lang/dynamo/1.8.7/src/dyn.help new file mode 100644 index 0000000..e4f82c0 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.help @@ -0,0 +1,24 @@ + Im Dynamo Runtime-System stehen folgende Kommandos + zur Verfügung (Verlassen dieser Erklärung mit q) : + + run ...................... Ausführen des übersetzten Programms + + c =Wert .. Änderung einer oder mehrerer Konstanten + + ? ........................ Anzeige der Konstanten und ihrer Werte + + quit ..................... Verlassen des Runtime-Systems + + help ..................... Zeigt diese Erklärungen + + + Bei PRINT oder PLOT - Ausgaben sind folgende Kommandos möglich : + + + ....................... Nächster Bildschirm + + o ....................... (Off), keine Unterbrechung der Ausgabe + + e ....................... (End), Zurück zum Runtime-System + + .................... Abbruch der Ausgabe + diff --git a/lang/dynamo/1.8.7/src/dyn.inserter b/lang/dynamo/1.8.7/src/dyn.inserter new file mode 100644 index 0000000..4b0b9d5 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.inserter @@ -0,0 +1,54 @@ +put line ("DYNAMO 3.3+ wird generiert"); +line; +WHILE noch nicht alle dateien da REPEAT (* Christian Szymanski *) + hole dateien vom archiv (* 10.08.88 *) +END REPEAT; +putline ("Die Pakete werden insertiert."); +putline ("Bitte warten !"); +checkoff; +IF id(0) < 182 + THEN insert ("dyn.kleiner182") +FI ; +insert ("dyn.tool"); +insert ("dyn.33"); +insert ("dyn.vec"); +insert ("dyn.proc"); +insert ("dyn.rts"); +insert ("dyn.plot+"); +insert ("dyn.plot"); +insert ("dyn.print"); +command dialogue (TRUE); +do ("init errors (""dyn.errors"")"); +do ("init std (""dyn.std"")"); +do ("insert macro (""dyn.mac"")"); +do ("graphic (yes (""mit CGA-Grafik""))"); +putline ("dynamo-system generiert"); +check on. + +noch nicht alle dateien da: + THESAURUS VAR alle dateien := empty thesaurus; + IF id(0) < 182 THEN + insert (alle dateien,"dyn.kleiner182") + FI ; + insert (alle dateien, "dyn.tool"); + insert (alle dateien, "dyn.33"); + insert (alle dateien, "dyn.vec"); + insert (alle dateien, "dyn.proc"); + insert (alle dateien, "dyn.rts"); + insert (alle dateien, "dyn.plot+"); + insert (alle dateien, "dyn.plot"); + insert (alle dateien, "dyn.print"); + highest entry (alle dateien - all) > 0 . + +hole dateien vom archiv: + IF yes ("DYNAMO-Diskette eingelegt") THEN + archive ("dynamo"); + fetch (ALL archive - all, archive); + release (archive) + FI. + + + + + + diff --git a/lang/dynamo/1.8.7/src/dyn.mac b/lang/dynamo/1.8.7/src/dyn.mac new file mode 100644 index 0000000..03a0f9f --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.mac @@ -0,0 +1,44 @@ +macro delay1(in,del) +a delay1.k=$lv.k/del +l $lv.k=$lv.j+dt*(in.jk-delay1.j) +n $lv=del*in +mend +macro delay3(in,del) +a $dl.k=del/3 +l $lv3.k=$lv3.j+dt*($rt2.jk-delay3.j) +n $lv3=$dl*in +r $rt2.kl=$lv2.k/$dl.k +l $lv2.k=$lv2.j+dt*($rt1.jk-$rt2.jk) +n $lv2=$lv3 +r $rt1.kl=$lv1.k/$dl.k +l $lv1.k=$lv1.j+dt*(in.jk-$rt1.jk) +n $lv1=$lv3 +a delay3.k=$lv3.k/$dl.k +mend +macro delay3p(in,del,ppl) +a delay3p.k=$lv3.k/$dl.k +l $lv3.k=$lv3.j+dt*($rt2.jk-delay3p.j) +n $lv3=$dl*in +r $rt2.kl=$lv2.k/$dl.k +l $lv2.k=$lv2.j+dt*($rt1.jk-$rt2.jk) +n $lv2=$lv3 +r $rt1.kl=$lv1.k/dl.k +l $lv1.k=$lv1.j+dt*(in.jk-$rt1.jk) +n $lv1=$lv3 +a $dl.k=del/3 +a ppl.k=$lv3.k+$lv2.k+$lv1.k +mend +macro dlinf3(in,del) +l dlinf3.k=dlinf3.j+dt*($lv2.j-dlinf3.j)/$dl.j +n dlinf3=in +l $lv2.k=$lv2.j+dt*($lv1.j-$lv2.j)/$dl.j +n $lv2=in +l $lv1.k=$lv1.j+dt*(in.j-$lv1.j)/$dl.j +n $lv1=in +a $dl.k=del/3 +mend +macro smooth(in,del) +l smooth.k=smooth.j+dt*(in.j-smooth.j)/del +n smooth=in +mend + diff --git a/lang/dynamo/1.8.7/src/dyn.mehreredelays b/lang/dynamo/1.8.7/src/dyn.mehreredelays new file mode 100644 index 0000000..6eac8fe --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.mehreredelays @@ -0,0 +1,9 @@ +NOTE GOODMAN S.248 +A Y.K=DELAY3(X,D) +A Z.K=DELAY3(Y,D) +C D=50 +R X.KL=TABLE(XT,TIME.K,0,125,25) +T XT=0/10/0/-10/0/10 +PLOT X=X,Y=Y,Z=Z(-10,10) +SPEC DT=0.5,LENGTH=125,PLTPER=2 + diff --git a/lang/dynamo/1.8.7/src/dyn.natchez b/lang/dynamo/1.8.7/src/dyn.natchez new file mode 100644 index 0000000..e62c70d --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.natchez @@ -0,0 +1,14 @@ +NOTE Heiratsregeln der NATCHEZ Indianer +L SUN.K=SWITCH(0,SUN.J,STINKARD.J) +L NOBLE.K=SWITCH(0,NOBLE.J+SUN.J,STINKARD.J) +L HONORED.K=SWITCH(0,HONORED.J+NOBLE.J,STINKARD.J) +L STINKARD.K=CLIP(STINKARD.J-NOBLE.J,0,STINKARD.J-NOBLE.J,0) +N SUN=20 +N NOBLE=10 +N HONORED=10 +N STINKARD=3000 +C DT=1 +C LENGTH=17 +C PLTPER=1 +PLOT SUN=*,NOBLE=N,HONORED=H,STINKARD=S + diff --git a/lang/dynamo/1.8.7/src/dyn.oszillator b/lang/dynamo/1.8.7/src/dyn.oszillator new file mode 100644 index 0000000..3f1e815 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.oszillator @@ -0,0 +1,26 @@ +NOTE OSZILLATOR +L X.K=X.J+Y.J*DT +N X=2 +L Y.K=(Y.J+DT*(F/M-X.J*OMEGANULLQUADRAT.J))/(1+GAMMA.J*DT) +N Y=3 +C M=5 +NOTE +NOTE linearer harmonischer Oszillator mit BETA=0 und F=0 +NOTE +NOTE gedaempfter Oszillator mit BETA<>0 und F=0 +NOTE +NOTE allgemeiner Oszillator mit BETA<>0 und F=f(TIME) +C BETA=0.5 +A GAMMA.K=BETA/M +C F=0 +C K=1 +A OMEGANULLQUADRAT.K=K/M +NOTE hier heisst eine Konstante"K". DYNAMO verwechselt das nicht mit .K !! +C DT=0.01 +NOTE DT WIRD EXTRA SO KLEIN GEWAEHLT; DAMIT DIE ANNAEHERUNG GUT IST +NOTE +NOTE DAS GEHT AUF KOSTEN DER RECHENZEITEN !!! +C LENGTH=68 +C PLTPER=1 +PLOT Y + diff --git a/lang/dynamo/1.8.7/src/dyn.plot b/lang/dynamo/1.8.7/src/dyn.plot new file mode 100644 index 0000000..fe1228a --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.plot @@ -0,0 +1,235 @@ +PACKET dynamo plotter (* Änder.: C.Szymanski, 21.07.88 *) + DEFINES b initialize plot, b new plot line, b plot, b end of program, + b plot scale : + +LET maxvalue = 200, + valuepagelength = 18, + max param numb = 10; + +TYPE PLOTPARAM = STRUCT (TEXT name, id, + INT scale pointer, + REAL lower bound, upper bound, + BOOL l fixed scale, u fixed scale); + +ROW max param numb PLOTPARAM VAR plotparam;(* Enth. Plotparameter *) +ROW maxvalue REAL VAR value; (* Ausgabepuffer *) +ROW max param numb ROW 5 REAL VAR scale; (* Enth. errechnete Skalierungen *) + +BOOL VAR plt; +TEXT VAR headline; +REAL VAR pltper, nextplot; +INT VAR value no, param no, plot line no, + plot param no, line no; +INT CONST nil := 0; + +LET line1 = ".____________.____________.____________.____________.", + line2 = ". . . . ."; + +PROC plot one page : + init plot routine; + plot values. + + init plot routine : + print suppressed output; + plot line no := nil. + + plot values : + INT VAR act value := 1, i; + TEXT VAR plot buf; + line; + vdt; + line; + IF b stop request THEN LEAVE plot one page END IF; + sys page; + plot output (headline); + put scales; + WHILE act value < value no REP + put time; + gen line; + FOR i FROM 1 UPTO plot param no REP + plot single value + END REP; + plot output (plot buf + line0 + collision); + plot line no INCR 1; + act value INCR plot param no; + act value INCR 1 + END REP. + + put time : + plot buf := text (text (round (value (act value), 2)), 6). + (* Erstes Pufferelement enthaelt time *) + + gen line : + TEXT VAR line0, collision := ""; + line0 := act line. + + act line : + IF (plot line no MOD 5) = nil (* Prueft, ob gestrichelte oder durch - *) + THEN line1 (* gezogene Linie gedruckt wird *) + ELSE line2 + FI. + + plot single value : + INT VAR position := int ((x-low)*53.0/(up-low))+1; (*Interpolationsformel*) + position := limit; + IF pos ("._ ", line0 SUB position) > nil + THEN replace (line0, position, plotparam (i).id) + ELSE collision CAT plotparam (i).id + FI. + + limit : + IF position > 53 + THEN 53 + ELIF position < 1 + THEN 1 + ELSE position + FI. + + up : + scale (i) (5). (* Oberer Grenzwert (der Skalierung) *) + + low : + scale (i) (1). (* Unterer Grenzwert *) + + x : + value (act value + i). + + put scales : (* Gibt Skalierung der Variablen aus *) + INT VAR j := 1, l, scalecounter; + WHILE j <= plot param no REP + plot buf := " "; + FOR l FROM 1 UPTO 4 REP + plot buf CAT text (text (scale (j) (l)), 13) + END REP; + plot buf CAT text (scale (j) (5)); + scalecounter := plotparam (j).scalepointer; + WHILE scalecounter = plotparam (j).scalepointer REP + plot buf CAT plotparam (j).id; + j INCR 1 + UNTIL j > max param numb END REP; + plot output (plot buf) + END REP. +END PROC plot one page; + +PROC b plot scale (TEXT CONST id, INT CONST scale pointer, + REAL CONST lower bound, upper bound, + BOOL CONST l fixed scale, u fixed scale) : + (* Liest Skalierungen vom Zielprogramm ein *) + plot param no INCR 1; + plot param (plot param no).id := id; (*Variablenname *) + plot param (plot param no).scale pointer := scale pointer;(*Zeiger *) + plot param (plot param no).lower bound := lower bound; (*Obere Grenze *) + plot param (plot param no).upper bound := upper bound; (*Untere Grenze *) + plot param (plot param no).l fixed scale := l fixed scale;(*Fix-Skalierung*) + plot param (plot param no).u fixed scale := u fixed scale; +END PROC b plot scale; + +PROC gen scales : + INT VAR act param, i; (* Generiert Skalierungen fuer eine Seite *) + FOR act param FROM 1 UPTO plot param no REP + compute single scale + END REP. + + compute single scale : + REAL VAR max := plotparam(plot param(act param).scale pointer).upper bound, + min := plotparam(plot param(act param).scale pointer).lower bound; + IF min > max THEN errorstop ("invalid scale") FI; + compute extreme scales; + FOR i FROM 1 UPTO 3 REP + scale (act param) (i+1) := (scale (act param) (5) - scale (act param) (1)) + * real (i) / 4.0 + scale (act param) (1) + (* Interpolationsformel *) + END REP. + + compute extreme scales : + (* Wenn die Skalierungen nicht gegeben sind, muessen sie berechnet werden. + Zur leichteren Lesbarkeit werden die Skalierungen nach oben bzw. unten + um jeweils eine Stelle gerundet *) + scale (act param) (5) := upper limit; + scale (act param) (1) := lower limit. + + upper limit : + IF plot param (plot param (act param).scale pointer).u fixed scale + THEN max + ELSE round (floor (max) + 0.5, 0) + FI. + + lower limit : + IF plot param (plot param (act param).scale pointer).l fixed scale + THEN min + ELSE round (floor (min) - 0.5, 0) + FI. +END PROC gen scales; + +PROC b initialize plot (TEXT CONST h) : + headline := h; + pltper := get pltper; + plot line no := value pagelength; + nextplot := 0.0; + value no := nil; + line no := nil; + plot param no := nil +END PROC b initialize plot; + +PROC b new plot line (REAL CONST time) : + plt := time >= nextplot; + IF plt (* Wird vom Zielprogramm aufgerufen, um *) + THEN add (time); (* Zeilenvorschub durchzufuehren *) + line no INCR 1; + param no := nil + FI; + WHILE time >= nextplot REP (* Ist noetig, weil pltper ungleich dt sein *) + nextplot INCR pltper (* kann *) + END REP +END PROC b new plot line; + +PROC b end of program : (* Druckt am Schluss evt. noch gepufferte *) + IF plot line no = value page length AND NOT stop request (* Werte aus *) + THEN gen scales; + plot one page + FI +END PROC b end of program; + +PROC b plot (REAL CONST r) : + IF plt (* Wenn genuegend PLOT-Werte gepuffert *) + THEN get extreme value; (* sind, wird eine neue Seite gedruckt *) + add (r); + IF param no = plot param no AND line no = value pagelength + THEN gen scales; + plot one page; + value no := nil; + line no := nil + FI + FI. + + get extreme value : + (* Sucht Maximal bzw. Minimalwert, falls keine festen Skalierungs- *) + (* grenzen angegeben wurden (im Quellprogramm)*) + param no INCR 1; + INT VAR act pointer := plot param (param no).scalepointer; + set lower bound; + set upper bound. + + set lower bound : + IF NOT plot param (act pointer).l fixed scale AND + r < plot param (act pointer).lower bound + THEN plot param (act pointer).lower bound := r + FI. + + set upper bound : + IF NOT plot param (act pointer).u fixed scale AND + r > plot param (act pointer).upper bound + THEN plot param (act pointer).upper bound := r + FI. +END PROC b plot; + +PROC add (REAL CONST r) : (* Puffert PLOT-Werte *) + value no INCR 1; + value (value no) := r +END PROC add; + +END PACKET dynamo plotter; + + + + diff --git a/lang/dynamo/1.8.7/src/dyn.plot+ b/lang/dynamo/1.8.7/src/dyn.plot+ new file mode 100644 index 0000000..db04dfc --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.plot+ @@ -0,0 +1,729 @@ +PACKET graphics DEFINES graphmode, + attribut, + palette, + move, + plot, + draw line, + draw linetype, + color, + draw to: + + +(* Autor: Giffeler GD *) +(* Datum: 31.03.1988 *) +(* Schönbeck SHard *) + +INT VAR linie :: -1, farbe :: 1, dummy; + + +PROC attribut (INT CONST nr): + +(* 0..15 Vordergrundfarben fuer Textdarstellung + 0..7 Hintergrundfarben + Attribut fuer blinkende Darstellung (+128) *) + + control (-3, nr, 0, dummy) + +END PROC attribut; + + +PROC palette (INT CONST nr): + +(* Farbauswahl fuer Grafikmodi *) + + control (-4, 0, nr, dummy) + +END PROC palette; + + +PROC graphmode (INT CONST mode): + +(* 0 -> TEXT 40*25 monochrom + 2 -> 80*25 + 1 -> 40*25 farbig + 3 -> 80*25 + 7 -> 80*25 Herkules + 4 -> GRAFIK 320*200 farbig + 5 -> monochrom + 6 -> 640*200 + 64 -> Olivetti 640*400 monochrom + 72 -> kleine Schrift + 512 -> Herkules 720*348 monochrom *) + + control (-5, mode, 0, dummy) + +END PROC graphmode; + + +PROC draw linetype (INT CONST pen, color): + +(* Linienschraffur und Zeichenfarbe *) + + linie:= pen; + farbe:= color; + control (-8, linie, farbe, dummy) + +END PROC draw linetype; + + +PROC draw linetype (INT CONST nr): + +(* Ausschliessliche Aenderung der Linienschraffur *) + + linie:= nr; + control (-8, linie, farbe, dummy) + +END PROC draw linetype; + + +PROC color (INT CONST nr): + +(* Ausschliessliche Aenderung der Zeichenfarbe *) + + farbe:= nr; + control (-8, linie, farbe, dummy) + +END PROC color; + + +PROC move (INT CONST x, y): + +(* Bewegt Zeichencursor zu Koordinaten (0,0 = Links oben) *) + + control (-7, x, y, dummy) + +END PROC move; + + +PROC move (REAL CONST x, y): + + control (-7, int(x+0.5), int(y+0.5), dummy) + +END PROC move; + + +PROC draw to (INT CONST x, y): + +(* Zeichnet Gerade von momentaner Zeichencursorposition nach x,y *) + + control (-6, x, y, dummy) + +END PROC draw to; + + +PROC draw to (REAL CONST x, y): + + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC draw to; + + +PROC draw line (INT CONST x1, y1, x2, y2): + +(* Zieht eine Linie von x1,y1 nach x2,y2 *) + + plot (x1, y1); + draw to (x2, y2) + +END PROC draw line; + + +PROC draw line (REAL CONST x1, y1, x2, y2): + + plot (x1, y1); + draw to (x2, y2) + +END PROC draw line; + + +PROC plot (INT CONST x, y): + +(* Zeichnet einen Punkt *) + + control (-7, x, y, dummy); + control (-6, x, y, dummy) + +END PROC plot; + + +PROC plot (REAL CONST x, y): + + control (-7, int(x+0.5), int(y+0.5), dummy); + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC plot; + + +PROC draw to (INT CONST x, y, f): + +(* Zeichnet Gerade von momentaner Zeichencursorposition nach x,y *) + + color (f); + control (-6, x, y, dummy) + +END PROC draw to; + + +PROC draw to (REAL CONST x, y, INT CONST f): + + color (f); + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC draw to; + + +PROC draw line (INT CONST x1, y1, x2, y2, f): + +(* Zieht eine Linie von x1,y1 nach x2,y2 *) + + plot (x1, y1, f); + draw to (x2, y2) + +END PROC draw line; + + +PROC draw line (REAL CONST x1, y1, x2, y2, INT CONST f): + + plot (x1, y1, f); + draw to (x2, y2) + +END PROC draw line; + + +PROC plot (INT CONST x, y, f): + +(* Zeichnet einen Punkt mit der Farbe f (0 = schwarz) *) + + color (f); + control (-7, x, y, dummy); + control (-6, x, y, dummy) + +END PROC plot; + + +PROC plot (REAL CONST x, y, INT CONST f): + + color (f); + control (-7, int(x+0.5), int(y+0.5), dummy); + control (-6, int(x+0.5), int(y+0.5), dummy) + +END PROC plot + + +END PACKET graphics; + + +PACKET dynamo plotter plus DEFINES configurate plot, + initialize plot, + new plot line, + plot, + end of program, + stop request, + plot scale: + +(* DYNAMO Grafikausgabe *) +(* Autor : Giffeler GD *) +(* Datum : 29.04.1988, 03.06.1988 *) +(* Änder.: Christian Szymanski *) +(* 21.07.88 *) + + +LET max value = 330, + value page length = 30, + max param numb = 10, + + PARAM = ROW value page length REAL, + BIG = ROW 300 REAL, + + max devices = 3, + SWITCH = STRUCT (TEXT bezeichnung, INT on, off, + zeichenbreite, zeichenhoehe, + h offset, + x, y, breite, hoehe), + SIZE = ROW max devices SWITCH; + + +TYPE PLOTPARAM = STRUCT (TEXT name, REAL lower bound, upper bound); + + +ROW max param numb PLOTPARAM VAR plotparam; +ROW max value REAL VAR value; + +BOOL VAR plt, ende; +REAL VAR pltper, nextplot; +INT VAR value no, param no, plot line no, mode nr, plot param no, line no, + xp, yp; + +SIZE CONST table :: SIZE: + (SWITCH: ("CGA 640 * 200", 6, 2, 8, 8, 5, 4, 20, 615, 102), + SWITCH: ("HGC 720 * 348", 512, 0, 0, 0, 0, 0, 0, 0, 0), + SWITCH: ("OLI 640 * 400", 64, 2, 8, 16, 10, 4, 25, 615, 223)); + +configurate plot; (* Erster Aufruf nach der Insertierung *) + + +PROC plot one page : +INT VAR loop nr, n, m; +PARAM VAR x, y; +BIG VAR xr, yr; + + kopfzeile ("Stuetzstellen: ", TRUE); + xp:= 1; yp:= 19; + FOR loop nr FROM 1 UPTO plot param no REP + werte aus value in x und y uebertragen; + koordinatenkreuz (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe); + x raster (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe, n); + zusatzinformationen ausgeben; + spline (n, m, 1, x, y, xr, yr); + draw picture (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe, + loop nr, m, + plot param[loop nr].lower bound, + plot param[loop nr].upper bound, + xr, yr); + legende ausgeben + PER; + abbruch; + graphmode(table[mode nr].off). + +werte aus value in x und y uebertragen: +INT CONST erh :: plot param no + 1; +INT VAR z :: 1, w :: loop nr + 1; + + FOR n FROM 1 UPTO value no DIV erh REP + x[n]:= value[z]; y[n]:= value[w]; + z INCR erh; + w INCR erh + PER; + n DECR 1; + m:= n * 10. + +zusatzinformationen ausgeben: +TEXT CONST xn :: text(x[n]); + + cursor (1, 17); put (x[1]); + cursor (81 - LENGTH xn, 17); + out (xn); + cursor (74, 1). + +legende ausgeben: +INT VAR xph, yph; + + cursor (xp, yp); + put (plot param[loop nr].name + "="); + put (plot param[loop nr].lower bound); + put ("-"); + put (plot param[loop nr].upper bound); + get cursor (xph, yph); + draw line (xph * table[mode nr].zeichenbreite - 8, + yph * table[mode nr].zeichenhoehe - table[mode nr].h offset, + xph * table[mode nr].zeichenbreite + 24, + yph * table[mode nr].zeichenhoehe - table[mode nr].h offset); + IF xp > 1 THEN line ELSE cursor (40, yph) FI; + get cursor (xp, yp). + +abbruch: +TEXT VAR eingabe; + + REP + cursor (30, 1); + put (39*" "+"(+, p, e)?"); + inchar (eingabe); + SELECT code (eingabe) OF + CASE 43 : eingabe:= "" + CASE 69, 101: ende:= TRUE; eingabe:= "" + CASE 80, 112: phasendiagramm + OTHERWISE out(""7"") + END SELECT + UNTIL eingabe = "" PER + +END PROC plot one page; + + +PROC initialize plot (TEXT CONST h) : +INT VAR c :: 1, typ; +TEXT VAR sym, num; + + ende:= FALSE; + pltper:= get pltper; + plot line no:= value page length; + nextplot:= 0.0; + value no:= 0; + line no:= 0; + plot param no:= 0; + kopfzeile zerlegen. + +kopfzeile zerlegen: + scan (h); + REP + next symbol (plot param[c].name); + next symbol (sym, typ); + IF sym = "(" THEN + next symbol (num); + next symbol (sym, typ); + IF sym = ")" THEN + plot param[c].name CAT ("(" + num + ")") + FI + FI; + WHILE typ < 7 CAND NOT (sym = "(" COR sym = ",") REP + next symbol (sym, typ) + PER; + IF typ < 7 CAND sym = "(" THEN + REP next symbol (sym) + UNTIL sym = "," PER; + REP next symbol (sym, typ) + UNTIL typ > 6 COR sym = "," COR sym = "/" PER + FI; + c INCR 1 + UNTIL typ > 6 PER + +END PROC initialize plot; + + +PROC plot scale (TEXT CONST id, INT CONST scale pointer, + REAL CONST lower bound, upper bound, + BOOL CONST l fixed scale, u fixed scale) : + + plot param no INCR 1; + plot param[plot param no].lower bound:= lower bound; + plot param[plot param no].upper bound:= upper bound + +END PROC plot scale; + + +PROC new plot line (REAL CONST time) : + + plt:= time >= nextplot; + IF plt THEN + add (time); + line no INCR 1; + param no:= 0 + FI; + WHILE time >= nextplot REP + nextplot INCR pltper + PER + +END PROC new plot line; + + +PROC plot (REAL CONST r): + + IF plt THEN + param no INCR 1; + add (r); + IF NOT ende CAND param no = plot param no AND + line no = value page length THEN + plot one page; + value no:= 0; + line no:= 0 + FI + FI + +END PROC plot; + + +PROC add (REAL CONST r): + + IF NOT ende THEN + value no INCR 1; + value[value no]:= r + FI + +END PROC add; + + +PROC spline (INT CONST n, m, s, PARAM CONST x, y, BIG VAR xr, yr): + +{ Kubische Splineinterpolation 3. Grades; 2 fach Differenzierbar } +{ Quelle: Rita Schmidt, Hahn-Meitner-Institut für Kernforschung Berlin } +{ "Spline-Prozeduren" (HMI-B 220) } +{ Umsetzung & Modifikation: Giffeler GD, 13.04.1988, 22.04.1988 } + +{ n = Anzahl der Stützstellen } +{ m = Anzahl der zu berechnenden Funktionswerte } +{ s = Index des x-Startpunktes } +{ x = x-Werte der Stützstellen (linear steigend) } +{ y = y-Werte der Stützstellen } +{ xr = x-Werte der Punkte, an denen die Funktion berechnet werden } +{ soll } +{ yr = y-Werte der Punkte, an denen die Funktion berechnet werden } +{ soll } + + +INT CONST nn :: n - 1; +REAL CONST steps :: (real(nn) * (x[2] - x[1])) / real(m - 1); + +PARAM VAR q, au; +REAL VAR hi, hk, hk1, dij, dim1j; +INT VAR k, kk, j, m1, m2, m3; + + q[1]:= 0.0; + yr[1]:= x[s]; + FOR j FROM 2 UPTO m REP yr[j]:= yr[j - 1] + steps PER; + xr:= yr; + block 0; + FOR k FROM 2 UPTO nn REP block 1 PER; + FOR kk FROM 2 UPTO nn REP block 2 PER; + FOR j FROM 1 UPTO m REP block 3 PER. + +block 0: + au[1]:= (y[3] - y[2] - y[2] + y[1]) / ((x[2] - x[1]) * (x[3] - x[2])); + au[n]:= (y[n] - y[nn] - y[nn] + y[n - 2]) / + ((x[n] - x[nn]) * (x[nn] - x[n - 2])). + +block 1: +INT CONST km1 :: k - 1, kp1 :: k + 1; + + hk:= x[k] - x[km1]; + hk1:= x[kp1] - x[k]; + q[k]:= - hk1 / (hk * (q[km1] + 2.0) + 2.0 * hk1); + au[k]:= (hk * au[km1] - 6.0 * ((y[kp1] - y[k]) / hk1 - (y[k] - + y[km1]) / hk)) * q[k] / hk1. + +block 2: + k:= nn - kk + 2; + au[k]:= q[k] * au[k + 1] + au[k]. + +block 3: + zeige benutzer das du noch lebst; + IF yr[j] < x[1] THEN + m1:= 1; + m2:= 2 + ELIF yr[j] > x[n] THEN + m1:= n - 1; + m2:= n + ELSE + m1:= 1; + m2:= n; + wiederholung + FI; + dij:= x[m2] - yr[j]; + hi:= x[m2] - x[m1]; + dim1j:= x[m1] - yr[j]; + yr[j]:= 1.0 / 6.0 / hi * (au[m1] * dij ** 3 - au[m2] * dim1j ** 3 + + (6.0 * y[m1] - hi ** 2 * au[m1]) * dij - (6.0 * y[m2] - hi ** 2 + * au[m2]) * dim1j). + +wiederholung: + REP + m3:= (m2 + m1) DIV 2; + IF yr[j] >= x[m3] THEN m1:= m3 ELSE m2:= m3 FI + UNTIL m2 - m1 = 1 PER. + +zeige benutzer das du noch lebst: + cout (j) + +END PROC spline; + + +PROC phasendiagramm: +REAL VAR l :: maxreal, u :: smallreal; +BIG VAR x, y; +INT VAR i, no1, no2; + + IF plot param no > 1 THEN + partnerwahl; + werte aus value uebertragen; + kopfzeile ("Phasendiagramm", TRUE); + koordinatenkreuz (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe+50); + draw picture (table[mode nr].x, table[mode nr].y, + table[mode nr].breite, table[mode nr].hoehe+50, + 1, i-1, l, u, x, y); + legende + FI. + +partnerwahl: + kopfzeile ("Phasendiagramm", FALSE); + line (2); + FOR i FROM 1 UPTO plot param no REP + putline (text(i, 3) + " = " + plot param[i].name) + PER; + REP + cursor (1, plot param no +5); + put ("X-ACHSE:"); get (no1); + cursor (1, plot param no +5); + put ("Y-ACHSE:"); get (no2) + UNTIL no1 > 0 CAND no1 <= plot param no CAND + no2 > 0 CAND no2 <= plot param no CAND + no1 <> no2 PER. + +werte aus value uebertragen: +INT CONST erh :: plot param no + 1; +INT VAR n1 :: no1 + 1, n2 :: no2 + 1; + + FOR i FROM 1 UPTO value no DIV erh REP + x[i]:= value[n1]; + y[i]:= value[n2]; + n1 INCR erh; + n2 INCR erh + PER. + +legende: + cursor (1, 23); + putline ("X-Achse: " + plot param[no1].name); + out ("Y-Achse: " + plot param[no2].name) + +END PROC phasendiagramm; + + +PROC draw picture (INT CONST x, y, xb, yb, schraffur, m, + REAL VAR lower bound, upper bound, + BIG CONST xr, yr): + +{ Ausgabe einer Funktionskurve } +{ Autor: Giffeler GD, 22.04.1988, 27.04.1988 } + +{ x = X-Position (oben links = 0) } +{ y = Y-Position (oben links = 0) } +{ xb = Ausgabebreite } +{ yb = Ausgabehöhe } +{ schraffur = Linienschraffur (1 - 10) } +{ m = Anzahl der Funktionswerte } +{ lower bound = Unterer Grenzwert (maxreal wenn Grenze beliebig) } +{ upper bound = Oberer Grenzwert (smallreal wenn Grenze beliebig) } +{ xr = Durch SPLINE erzeugte X-Werte } +{ yr = Durch SPLINE erzeugte Y-Werte } + + +ROW 10 INT CONST linienarten :: ROW 10 INT: (-1, -256, 3855, -240, + 21845, -1, -1, -1, -1, -1); + +REAL VAR lbx :: maxreal, ubx :: smallreal; +INT VAR i; + + minimum und maximum fuer x und y berechnen; + abmessungsparameter umwandeln; + spannweite errechnen; + linienschraffur bestimmen; + eine funktion ausgeben. + +minimum und maximum fuer x und y berechnen: + FOR i FROM 1 UPTO m REP + lower bound:= min (lower bound, yr[i]); + upper bound:= max (upper bound, yr[i]); + lbx:= min (lbx, xr[i]); + ubx:= max (ubx, xr[i]) + PER. + +abmessungsparameter umwandeln: +REAL CONST xpos :: real (x), ypos :: real (y), + breite :: real (xb), hoehe :: real (yb). + +spannweite errechnen: +REAL CONST sy :: (upper bound - lower bound) / hoehe, + sx :: (ubx - lbx) / breite. + +linienschraffur bestimmen: + draw linetype (linienarten [abs(schraffur) MOD 10]). + +eine funktion ausgeben: + move (xpos + (xr[1] - lbx) / sx, + ypos + hoehe - (yr[1] - lower bound) / sy); + FOR i FROM 2 UPTO m REP + drawto (xpos + (xr[i] - lbx) / sx, + ypos + hoehe - (yr[i] - lower bound) / sy) + PER + +END PROC draw picture; + + +PROC koordinatenkreuz (INT CONST nx, ny, breite, hoehe): + + anpassung; + rahmen; + pfeil oben; + pfeil rechts. + +anpassung: +INT CONST x :: nx - 1, + y :: ny - 10, + b :: breite + 21, + h :: hoehe + 11. + +rahmen: + draw linetype (-1); + draw line (x, y, x, y + h); + draw to (x + b, y + h). + +pfeil oben: + draw line (x - 3, y + 4, x, y); + draw to (x + 3, y + 4). + +pfeil rechts: + draw line (x + b - 5, y + h - 2, x + b, y + h); + draw to (x + b - 5, y + h + 2) + +END PROC koordinatenkreuz; + + +PROC x raster (INT CONST nx, ny, breite, hoehe, anzahl): +REAL CONST y :: real (ny + hoehe + 2), + w :: real (breite) / real (anzahl); +REAL VAR s :: real (nx); +INT VAR i; + + FOR i FROM 1 UPTO anzahl REP + s INCR w; + plot (s, y) + PER + +END PROC x raster; + + +PROC configurate plot: +(* +BOOL CONST cmd :: command dialogue; +INT VAR i; + + command dialogue (TRUE); + REP + bildschirmausgabe zur auswahl + UNTIL (mode nr <= max devices AND mode nr > 0) CAND + yes ("Eingabe richtig") PER; + command dialogue (cmd). + +bildschirmausgabe zur auswahl: + page; + putline ("CONFIGURATIONSTABELLE DYNAMO GRAFIK"); + line (2); + FOR i FROM 1 UPTO max devices REP + putline (text(i)+" -- "+table[i].bezeichnung) + PER; + line (2); + put ("Modus:"); + get (mode nr) + +*) +mode nr := 1. (* CGA *) +END PROC configurate plot; + + +PROC kopfzeile (TEXT CONST message, BOOL CONST grafik): + + IF grafik THEN graphmode (table[mode nr].on) + ELSE graphmode (table[mode nr].off) FI; + out (""1""); (* C.S. 21.07.88 *) + out ("DYNAMO 3.3+"); + cursor (79 - LENGTH message, 1); + out (message) + +END PROC kopfzeile; + + +PROC end of program : + + IF NOT ende CAND (value no DIV (plot param no + 1)) > 2 THEN + plot one page + FI + +END PROC end of program; + + +BOOL PROC stop request: ende END PROC stop request + + +END PACKET dynamo plotter plus + diff --git a/lang/dynamo/1.8.7/src/dyn.print b/lang/dynamo/1.8.7/src/dyn.print new file mode 100644 index 0000000..36ea279 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.print @@ -0,0 +1,43 @@ +PACKET dynamo printer DEFINES initialize print, new line, print : + +BOOL VAR prt; +TEXT VAR headline; +REAL VAR prtper, nextprint; + +PROC initialize print (TEXT CONST h) : + headline := h; + prtper := get prtper; + nextprint := 0.0 +END PROC initialize print; + +PROC new line (REAL CONST time) : + IF time >= nextprint + THEN do lf + ELSE prt := FALSE + FI; + WHILE time >= nextprint REP + nextprint INCR prtper + PER. + + do lf : + print line; + prt := TRUE; + IF pagefeed necessary OR NOT was print + THEN vdt; + sys page; + print headline + FI; + print (time). + + print headline : + println ("TIME " + headline). +END PROC new line; + +PROC print (REAL CONST r) : + IF prt + THEN print output (text (text (round (r, 5)), 13)) + FI +END PROC print + +END PACKET dynamo printer + diff --git a/lang/dynamo/1.8.7/src/dyn.proc b/lang/dynamo/1.8.7/src/dyn.proc new file mode 100644 index 0000000..a291a48 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.proc @@ -0,0 +1,160 @@ +PACKET dynamo prozeduren DEFINES clip,fifge,switch,fifze,table,tabhl, + sclprd,sum,sumv, + noise,normrn,power, + pulse,step,ramp, + set time : +(***************************************************D.Craemer 16. 2.1983 ***) +(* uses: + type TAB (Tabellen), wert, laenge + abs + random + + globale Variablen simulationtime wird durch das DYNAMO- + Programm gesetzt und in + den Funktionen, die zeit- + lich ausgeloest werden, + benutzt + + lastpulse Zeit des letzten Pulses + + +*) + +REAL VAR simulation time,last pulse:=0.0; + +PROC set time (REAL CONST time) : + simulation time := time +END PROC set time ; + +(************************ ab hier Funktionen *******************************) +(************************ zur Wertauswahl *******************************) + +REAL PROC clip(REAL CONST p,q,r,s): + IF r>=s THEN p ELSE q FI + END PROC clip; + +REAL PROC fifge(REAL CONST p,q,r,s): + clip(p,q,r,s) + END PROC fifge; + +(* clip und fifge machen dasselbe, der Name fifge gibt die Funktion besser +wieder: first if greater or equal + = == = = *) + +REAL PROC switch (REAL CONST p,q,r): + IF r=0.0 THEN p ELSE q FI + END PROC switch; + +REAL PROC fifze (REAL CONST p,q,r): + switch(p,q,r) + END PROC fifze; + +(* Funktion switch oder fifze: first if zero + = == == *) + +(************************ ab hier Funktionen *******************************) +(************************ mit Tabellen *******************************) + +REAL PROC table (TAB CONST t, REAL CONST x, xlow, x high, xincr) : + IF x < x low OR x > x high + THEN putline("TABLE out of range: xlow="+text(xlow)+" x="+text(x)+ + " xhigh="+text(xhigh)+" xincr="+text(xincr));0.0 + ELIF x=xhigh + THEN wert(t,laenge(t)) + ELIF x=xlow + THEN wert(t,1) + ELSE deliver interpolated value + FI. + +deliver interpolated value: + INT VAR index :: int((x-xlow)/xincr)+1; + REAL VAR m :: ((wert (t, index + 1) - wert (t, index)) / x incr), + b :: wert (t, index); + + m * (x-(xlow+real(index-1)*xincr)) + b. +END PROC table; + + +REAL PROC tabhl (TAB CONST t, REAL CONST x, xlow, x high, xincr) : + IF xlow < x AND x < xhigh + THEN table(t,x,xlow,xhigh,xincr) + ELIF x <= xlow + THEN wert(t,1) + ELSE wert(t,laenge(t)) + FI +END PROC tabhl ; + +REAL PROC sclprd(TAB CONST tab1,REAL CONST erstes1,letztes1,TAB CONST tab2, + REAL CONST erstes2): +INT VAR i; +REAL VAR summe:=0.0; +FOR i FROM 0 UPTO int(letztes1-erstes1) REP + summe:=summe + wert(tab1,int(erstes1)+i)*wert(tab2,int(erstes2)+i) +PER; +summe +END PROC sclprd; + +REAL PROC sumv(TAB CONST tab, REAL CONST erstes,letztes): +REAL VAR summe:=0.0; +INT VAR i; +FOR i FROM int(erstes) UPTO int(letztes) REP + summe:=summe+wert(tab,i) +PER; +summe +END PROC sumv; + +REAL PROC sum(TAB CONST tab): + sumv(tab,1.0,real(laenge(tab))) +END PROC sum; + +(************************ ab hier Funktionen *******************************) +(************************ mit Zufallszahlen *******************************) + +REAL PROC noise(REAL CONST dummy): + random-0.5 +END PROC noise; + +REAL PROC normrn(REAL CONST mittelwert,stdvar): +REAL VAR z:=0.0; +INT VAR i; +(* Methode nach NAYLOR et al.: Computer Simulation Technique, Wiley,NY 1966*) +FOR i FROM 1 UPTO 12 REP + z:=z+random +PER; +z:=z-6.0; +mittelwert+z*stdvar +END PROC normrn; + +(************************ ab hier Funktionen *******************************) +(************************ mit Zeitausloesung ******************************) + +REAL PROC pulse(REAL CONST height,first,interval): +IF simulationtime < first THEN lastpulse:=0.0; 0.0 + ELIF abs(simulationtime-first) < smallreal THEN lastpulse:=simulationtime; + height + ELIF abs(simulationtime-(lastpulse+interval)) < smallreal THEN + lastpulse:=simulationtime; + height + ELSE 0.0 +END IF +END PROC pulse; + +REAL PROC step(REAL CONST height,steptime): + IF simulationtime 0 + THEN CONCR (constants).value (tab pos) + ELSE new constant (name, val); + val + FI. + + set system consts : + SELECT pos ("dt length prtper pltper ", name + " ") OF + CASE 1 : dt := value + CASE 4 : length := value + CASE 11 : prtper := value + CASE 18 : pltper := value + END SELECT; + value. +END PROC constant; + +PROC new constant (TEXT CONST name, REAL CONST val) : + CONCR (constants).tab size INCR 1; + IF CONCR (constants).tab size > max tab size + THEN errorstop ("ZUVIELE KONSTANTEN") + FI; + CONCR (constants).name (CONCR (constants).tab size) := name; + CONCR (constants).value (CONCR (constants).tab size) := val +END PROC new constant; + +PROC search constant (TEXT CONST name, INT VAR tab pos) : + INT VAR i; + FOR i FROM 1 UPTO CONCR (constants).tab size REP + IF name = CONCR (constants).name (i) + THEN tab pos := i; + LEAVE search constant + FI + END REP; + tab pos := 0 +END PROC search constant; + +REAL PROC get pltper : (* Reicht 'pltper' (Plotperiode) heraus *) + pltper +END PROC get pltper; + +REAL PROC get prtper : (* Reicht 'prtper' (Printperiode) heraus *) + prtper +END PROC get prtper; + +PROC scroll (BOOL CONST b) : + is scroll := b +END PROC scroll; + +PROC next sym : + next sym (sym, type) +END PROC next sym; + +PROC rts err (TEXT CONST err mess) : + outline ("FEHLER BEI >>>" + sym + "<<< : " + err mess) +END PROC rts err; + +PROC run time system (PROC target program) : + IF protocoll + THEN kill ("dyn.out"); + sysout := sequential file (output, "dyn.out") + FI; + init rts; + REP + get command; + execute command + END REP. + + get command : + TEXT VAR command; + print suppressed output; + line; + putline (" dynamo runtime system :"); + shift; + getline (command); + printline (command). + + execute command : + scanner (command); + next sym; + TEXT VAR start := sym; + skip blanks; + SELECT pos ("run rerun quit help c ? EOL ", start + " ") OF + CASE 1, 5 : run + CASE 11 : quit + CASE 16 : show ("dyn.help") + CASE 21 : const equ + CASE 23 : dump consts + CASE 25 : + OTHERWISE : rts err ("KOMMANDO UNBEKANNT") + END SELECT. + + run : + init rts; + IF type = bold OR type = delimiter + THEN run card (sym) + FI; + target program. + + quit : + IF const space name = "zzdyn.const" + THEN kill (const space name) + FI; + LEAVE runtime system. + + skip blanks : + REP + next sym + UNTIL sym <> " " END REP. + + const equ : + REAL VAR value, dummy; + INT VAR tab pos; + REP + analyze constant equ; + search constant (const name, tab pos); + IF tab pos = 0 + THEN sym := const name; + rts err ("KONSTANTE NICHT DEFINIERT") + ELSE CONCR (constants).value (tab pos) := value + FI + UNTIL end of constants END REP. + + analyze constant equ : + IF type <> bold + THEN rts err ("NAME ERWARTET") + FI; + const name := sym; + next sym; + IF sym <> "=" + THEN rts err ("^=^ ERWARTET") + FI; + get constant. + + end of constants : + next sym; + IF sym = "/" OR sym = "," + THEN next sym; FALSE + ELSE TRUE + FI. + + get constant : + next sym; + value := 1.0; + IF sym = "-" + THEN value := -1.0; next sym + ELIF sym = "+" + THEN next sym + FI; + IF type = number + THEN value := value * real (sym) + ELSE rts err ("ZAHL ERWARTET") + FI. + + dump consts : + INT VAR i; + FOR i FROM 1 UPTO CONCR (constants).tab size REP + IF (i MOD 2) = 1 + THEN line; shift + FI; + out (text (CONCR (constants).name (i), 14), " = ", + text (text (CONCR (constants).value (i)), 13)) + END REP; + line. +END PROC run time system; + +PROC shift : + out (" ") +END PROC shift; + +PROC init rts : + line no := 0; + page no := 0; + asterisk buffer := ""; + print buf := ""; + print := FALSE; + terminal stop := FALSE; + is not first := FALSE; + vdt on := TRUE +END PROC init rts; + +PROC protokoll (BOOL CONST b) : + protocoll := b +END PROC protokoll; + +PROC print line : + BOOL VAR b := print; (* Druckt Ausgabe - Puffer und *) + println (print buf); (* loescht anschliessend den Inhalt *) + print buf := ""; + print := b +END PROC print line; + +PROC print suppressed output : + IF print buf <> "" (* Druckt Ausgabe - Puffer, *) + THEN println (print buf); (* falls gefuellt *) + print buf := "" + FI +END PROC print suppressed output; + +PROC print output (TEXT CONST t) : + print buf CAT t; (* Fuellt Ausgabe - Puffer *) + print buf CAT " " +END PROC print output; + +PROC println (TEXT CONST t) : + print := TRUE; (* Verteilt Ausgabe auf Bildschirm *) + line no INCR 1; (* und Datei *) + outline (t); + IF line no = max page length + THEN line no := 0 + FI; + IF is getcharety (esc) (* bis einschl. 1.8.1: 'is incharety' *) + THEN terminal stop := TRUE + FI. +END PROC println; + +PROC outline (TEXT CONST t) : + printline (t); + putline (actual line). + + actual line : + IF LENGTH (t) > 78 + THEN text (t, 78) + ELSE t + FI. +END PROC outline; + +PROC printline (TEXT CONST t) : + IF protocoll + THEN putline (sysout, t) + FI +END PROC print line; + +PROC sys page : (* Seitenvorschub auf Bildschirm und Datei *) + IF vdt on AND NOT is scroll AND is not first + THEN page + ELSE is not first := TRUE + FI; + IF protocoll + THEN putline (sysout, "#page#") + FI; + IF asterisk buffer <> "" + THEN page no INCR 1; + println ("PAGE " + text (page no, 3) + " : " + asterisk buffer); + FI; + line no := 0 +END PROC sys page; + +BOOL PROC pagefeed necessary : + line no = 0 (* Liefert TRUE, wenn Seitenende erreicht *) +END PROC pagefeed necessary; (* ist *) + +PROC plot output (TEXT CONST t) : + println (t); (* Ausgabeprozedur fuer das Plot - Programm *) + print := FALSE +END PROC plot output; + +BOOL PROC b stop request : (* Liefert TRUE, wenn 'End'-Kommando im VDT *) + terminal stop (* - Modus gegeben wird *) +END PROC b stop request; + +BOOL PROC was print : (* Liefert TRUE, falls Druckerprogramm *) + print. (* vorher eine Zeile gedruckt hat *) +END PROC was print; + +PROC vdt : + IF vdt on AND is not first (* VDT = Video Data Termination *) + THEN do vdt (* Verhindert Scrolling des Bildschirms *) + FI. + + do vdt : + TEXT VAR t; + out ("TIPPEN SIE : '+'; 'o'; 'e' : "); + inchar (t); + out (t); + IF t = "+" (* '+' = Seitenvorschub *) + THEN + ELIF t = "o" (* 'o' = Off; VDT wird abgeschaltet *) + THEN vdt on := FALSE + ELIF t = "e" (* 'e' = End; Programm wird abgebrochen *) + THEN terminal stop := TRUE + ELSE out (""13""); vdt + FI; + line. +END PROC vdt; + +PROC asterisk (TEXT CONST t) : + asterisk buffer := t +END PROC asterisk; + +PROC out(TEXT CONST a,b,c) : + out(a); + out(b); + out(c) +END PROC out; + + +END PACKET rts; + diff --git a/lang/dynamo/1.8.7/src/dyn.ruestungswettlauf b/lang/dynamo/1.8.7/src/dyn.ruestungswettlauf new file mode 100644 index 0000000..7b7c6b1 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.ruestungswettlauf @@ -0,0 +1,32 @@ +note ruestungswettlauf nach richardson +note +note literatur: thiel "quantitaet oder begriff" S. 436 ff +note +l eigenkriegspot.k=eigenkriegspot.j+dt* +x (k*gegenkriegspot.j-a*eigenkriegspot.j+g) +l gegenkriegspot.k=gegenkriegspot.j+dt* +x (l*eigenkriegspot.j-b*gegenkriegspot.j+h) +note +note anfangswerte fuer eigenkriegspotential und gegenkriegspotential +note werden am gleichgewichtspunkt plus etwas mehrpot gegeben +note +n eigenkriegspot=(k*h+b*g)/(a*b-k*l)+mehrpot +n gegenkriegspot=(l*g+a*h)/(a*b-k*l) +note +note konstanten +note +c k=2 verteidigungskoeffizient +c l=1 " des gegners +c a=2 koeffizient fuer aufwand zur kriegsvorbereitung +c b=3 " +c g=7 koeffizient fuer aggressive absichten +c h=9 " +c mehrpot=3 stoerung des gleichgewichts durch mehr potential +plot eigenkriegspot=e,gegenkriegspot=g(unten,oben) +c dt=0.5 +c length=2050 +n time=1985 +c pltper=1 +c unten=-11 +c oben=250 + diff --git a/lang/dynamo/1.8.7/src/dyn.simon b/lang/dynamo/1.8.7/src/dyn.simon new file mode 100644 index 0000000..b911159 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.simon @@ -0,0 +1,28 @@ +NOTE Simons MODELL der sozialen Gruppe Stand: 08.03.1983 +NOTE +A INTERAKT.K=A1*FREUNDLICH.K+A2*AKTIV.K +L FREUNDLICH.K=FREUNDLICH.J+DT*(B1*(INTERAKT.J-beta*FREUNDLICH.J)) +L AKTIV.K=AKTIV.J+DT*(C1*(FREUNDLICH.J-gamma*AKTIV.J)+C2*(EINF-AKTIV.J)) +N INTERAKT=beta*A2*C2*EINF/NENNER +N AKTIV=C2*(beta-A1)*EINF/NENNER +N FREUNDLICH=A2*C2*EINF/NENNER+STOERTERM +N NENNER=-C1*A2+(beta-A1)*(C2+C1*gamma) +C STOERTERM=0.4 +C EINF=2 +NOTE +NOTE Konstanten sind alle positiv vorausgesetzt +NOTE Stabil fuer beta>a1 +C A1=1.0 +C A2=1.5 +C B1=1 +C beta=1.0 +C C1=1.4 +C C2=1.5 +C gamma=1.5 +C DT=0.1 +C LENGTH=60 +C PLTPER=0.5 +PLOT INTERAKT=i,FREUNDLICH=f,AKTIV=a(-10,10) +PRINT INTERAKT,FREUNDLICH,AKTIV +C PRTPER=0.5 + diff --git a/lang/dynamo/1.8.7/src/dyn.std b/lang/dynamo/1.8.7/src/dyn.std new file mode 100644 index 0000000..a87b66d --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.std @@ -0,0 +1,9 @@ +abs r arctan r arctand r cos r cosd r exp r floor r frac r +initializerandom r random r +ln r log2 r log10 r +max rr min rr +power rr round r +sin r sind r sqrt r tan r tand r +clip rrrr fifge rrrr switch rrr fifze rrr noise r normrn rr pulse rrr +ramp rr sclprd trrtr step rr sumv trr sum t table trrrr tabhl trrrr /* + diff --git a/lang/dynamo/1.8.7/src/dyn.steifedgl b/lang/dynamo/1.8.7/src/dyn.steifedgl new file mode 100644 index 0000000..b168fcd --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.steifedgl @@ -0,0 +1,15 @@ +NOTE STIFF EQUATIONS SIEHE: SIMULATION AUGUST 1980, SEITE 38 +L Y1.K=Y1.J+DT*(-21*Y1.J+19*Y2.J-20*Y3.J) +L Y2.K=Y2.J+DT*(+19*Y1.J-21*Y2.J+20*Y3.J) +L Y3.K=Y3.J+DT*(+40*Y1.J-40*Y2.J-40*Y3.J) +N Y1=1 +N Y2=0 +N Y3=-1 +NOTE KONSTANTEN MUESSEN GEEIGNET GEWAEHLT WERDEN: DT SEHR KLEIN +C LENGTH=20 +C DT=.01 +C PRTPER=1 +C PLTPER=1 +PRINT Y1,Y2,Y3 +PLOT Y1,Y2,Y3 + diff --git a/lang/dynamo/1.8.7/src/dyn.tool b/lang/dynamo/1.8.7/src/dyn.tool new file mode 100644 index 0000000..65769d8 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.tool @@ -0,0 +1,217 @@ +PACKET io handling DEFINES error listing, err, message, errors, init errors, + text, kill, trunc, hash, no errors : +(* Autor : R. Keil, Version vom 22.07.83, Änderung: C. Szymanski, 21.07.88 *) + +LET errmax = 67, + max hash size = 300; + +ROW errmax TEXT VAR error; +FILE VAR listfile; (* -> VERSION 3.2 *) +BOOL VAR list; +INT VAR errorno, i; + +PROC init errors (TEXT CONST fname) : + FILE VAR errorfile := sequential file (input, fname); + TEXT VAR buffer; + FOR i FROM 1 UPTO errmax WHILE NOT eof (errorfile) REP + getline (errorfile, buffer); + error (i) := buffer + END REP +END PROC init errors; + +PROC init errors : + errorno := 0 +END PROC init errors; + +PROC error listing (TEXT CONST listname) : + list := listname <> "nolist"; + IF list + THEN kill (listname); + listfile := sequential file (output, listname) + FI +END PROC error listing; + +INT PROC errors : + error no +END PROC errors; + +PROC err (TEXT CONST s, INT CONST m, line no) : + message ("Fehler in Zeile " + text (line no) + " bei >>" + s + "<< : " + + error (m)); + errorno INCR 1 +END PROC err; + +BOOL PROC no errors : + IF errors = 0 + THEN TRUE + ELSE display (text (error no) + " Fehler gefunden"13""10""); FALSE + FI +END PROC no errors; + +PROC message (TEXT CONST m) : + IF list + THEN putline (list file, m); + FI; + note (m); (* C.S. 21.07.88 *) + note line; + display (m); + display (""13""10"") +END PROC message; + +TEXT PROC text (BOOL CONST b) : + IF b + THEN "TRUE" + ELSE "FALSE" + FI +END PROC text; + +PROC kill (TEXT CONST file name) : + command dialogue (FALSE); + forget (file name); + command dialogue (TRUE) +END PROC kill; + +TEXT PROC trunc (TEXT CONST t) : + text (t, length (t) - 2) +END PROC trunc; + +INT PROC hash (TEXT CONST word) : + INT VAR qs := 0; + FOR i FROM 1 UPTO length (word) REP + qs INCR code (word SUB i) + END REP; + (qs MOD max hash size) + 1. +END PROC hash + +END PACKET io handling; + + +(************************* S C A N N E R **************************) + +PACKET scan DEFINES next sym, scanner, scanpos : + + +LET bold = 1, (* Autor : R. Keil, T. Froehlich *) + number = 2, (* Version vom 04.07.83 *) + delimiter = 3, + eol = 4; + +TEXT VAR main buf, sym; +INT VAR position, type, cc, begin pos; + +PROC nextsym (TEXT CONST buf, TEXT VAR scan sym, + INT VAR scan type, pos) : + TEXT VAR char := buf SUB pos; + cc := code (char); + IF (cc >= 97 AND cc <= 122) + THEN process lower case + ELIF cc = 46 OR is int + THEN process real + ELIF (cc >= 65 AND cc <= 90) + THEN process upper case + ELSE process delimiter + FI. + + process upper case : + scan type := bold; + scan sym := low; + next char; + WHILE (cc >= 65 AND cc <= 90) OR is int REP + scan sym CAT low; + next char + END REP. + + process lower case : + scan type := bold; + begin pos := pos; + REP + next char + UNTIL lower case char AND NOT is int END REP; + scan sym := subtext (buf, begin pos, pos - 1). + + lower case char : + cc < 97 OR cc > 122. + + process real : + process base; + process exponent; + scan type := number. + + process base : + IF cc = 46 + THEN next char; + IF is int + THEN scan sym := "0."; + process int + ELSE scan type := delimiter; + scan sym := "."; + LEAVE process real + FI + ELSE scan sym := ""; + process int; + IF cc = 46 + THEN scan sym CAT char; + next char; + IF is int + THEN process int + ELSE scan sym CAT "0" + FI + ELSE scan sym CAT ".0" + FI + FI. + + process exponent : + IF cc = 69 OR cc = 101 + THEN scan sym CAT "e"; + next char; + IF cc = 43 OR cc = 45 + THEN scan sym CAT char; next char + FI; + IF is int + THEN process int + ELSE err (char, 63, 0) + FI + FI. + + process int : + WHILE is int REP + scan sym CAT char; + next char + END REP. + +is int : + cc >= 48 AND cc <= 57. + + process delimiter : + IF cc = -1 + THEN scan sym := "EOL"; scan type := eol + ELSE scan type := delimiter; + scan sym := char + FI; + pos INCR 1. + + next char : + pos INCR 1; char := buf SUB pos; cc := code (char). + + low : + IF cc >= 65 AND cc <= 90 + THEN code (cc + 32) + ELSE char + FI. +END PROC next sym; + +PROC scanner (TEXT CONST buf) : + main buf := buf; position := 1 +END PROC scanner; + +PROC next sym (TEXT VAR sym, INT VAR type) : + next sym (main buf, sym, type, position) +END PROC next sym; + +INT PROC scanpos : + position +END PROC scanpos + +END PACKET scan + + diff --git a/lang/dynamo/1.8.7/src/dyn.vec b/lang/dynamo/1.8.7/src/dyn.vec new file mode 100644 index 0000000..0554215 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.vec @@ -0,0 +1,209 @@ +PACKET vector DEFINES TAB, :=, vector, (* Autor : H.Indenbirken *) + SUB, LENGTH, laenge, norm, (* Stand : 24.09.81 *) + nilvector, replace, =, <>, wert, + +, -, *, /, + get, put : + +LET n = 4000; + +TYPE TAB = STRUCT (INT lng, TEXT elem); +TYPE INITTAB = STRUCT (INT lng, REAL value); + +INT VAR i; +TEXT VAR t :: "12345678"; +TAB VAR v :: nilvector; + + +REAL PROC wert (TAB CONST t, INT CONST i) : + t SUB i +END PROC wert; + +OP := (TAB VAR l, TAB CONST r) : + l.lng := r.lng; + l.elem := r.elem + +END OP :=; + +OP := (TAB VAR l, INITTAB CONST r) : + l.lng := r.lng; + replace (t, 1, r.value); + l.elem := r.lng * t + +END OP :=; + +INITTAB PROC nilvector : + vector (1, 0.0) + +END PROC nilvector; + +INITTAB PROC vector (INT CONST lng, REAL CONST value) : + IF lng <= 0 + THEN errorstop ("PROC vector : lng <= 0") FI; + INITTAB : (lng, value) + +END PROC vector; + +INITTAB PROC vector (INT CONST lng) : + vector (lng, 0.0) + +END PROC vector; + +REAL OP SUB (TAB CONST v, INT CONST i) : + test ("REAL OP SUB : ", v, i); + v.elem RSUB i + +END OP SUB; + +INT OP LENGTH (TAB CONST v) : + v.lng + +END OP LENGTH; + +INT PROC laenge (TAB CONST v) : + v.lng + +END PROC laenge; + +REAL PROC norm (TAB CONST v) : + REAL VAR result :: 0.0; + FOR i FROM 1 UPTO v.lng + REP result INCR ((v.elem RSUB i)**2) PER; + sqrt (result) . + +END PROC norm; + +PROC replace (TAB VAR v, INT CONST i, REAL CONST r) : + test ("PROC replace : ", v, i); + replace (v.elem, i, r) + +END PROC replace; + +BOOL OP = (TAB CONST l, r) : + l.elem = r.elem +END OP =; + +BOOL OP <> (TAB CONST l, r) : + l.elem <> r.elem +END OP <>; + +TAB OP + (TAB CONST v) : + v +END OP +; + +TAB OP + (TAB CONST l, r) : + test ("TAB OP + : ", l, r); + v := l; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (l.elem RSUB i) + (r.elem RSUB i)) PER; + v + +END OP +; + +TAB OP - (TAB CONST a) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, - (a.elem RSUB i)) PER; + v + +END OP -; + +TAB OP - (TAB CONST l, r) : + test ("TAB OP - : ", l, r); + v := l; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (l.elem RSUB i) - (r.elem RSUB i)) PER; + v +END OP -; + +REAL OP * (TAB CONST l, r) : + test ("REAL OP * : ", l, r); + REAL VAR x :: 0.0; + FOR i FROM 1 UPTO l.lng + REP x INCR ((l.elem RSUB i) * (r.elem RSUB i)) PER; + x + +END OP *; + +TAB OP * (TAB CONST v, REAL CONST r) : + r*v + +END OP *; + +TAB OP * (REAL CONST r, TAB CONST a) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, r*(a.elem RSUB i)) PER; + v + +END OP *; + +TAB OP / (TAB CONST a, REAL CONST r) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (a.elem RSUB i)/r) PER; + v + +END OP /; + +TEXT VAR error :: ""; +PROC test (TEXT CONST proc, TAB CONST v, INT CONST i) : + IF i > v.lng + THEN error := proc; + error CAT "subscript overflow (LENGTH v="; + error CAT text (v.lng); + error CAT ", i="; + error CAT text (i); + error CAT ")"; + errorstop (error) + ELIF i < 1 + THEN error := proc; + error CAT "subscript underflow (i = "; + error CAT text (i); + error CAT ")"; + errorstop (error) + FI . + +END PROC test; + +PROC test (TEXT CONST proc, TAB CONST a, b) : + IF a.lng <> b.lng + THEN error := proc; + error CAT "LENGTH a ("; + IF a.lng <= 0 + THEN error CAT "undefined" + ELSE error CAT text (a.lng) FI; + error CAT ") <> LENGTH b ("; + error CAT text (b.lng); + error CAT ")"; + errorstop (error) + FI + +END PROC test; + +PROC get (TAB VAR v, INT CONST lng) : + v.lng := lng; + v.elem := lng * "12345678"; + REAL VAR x; + FOR i FROM 1 UPTO lng + REP get (x); + replace (v.elem, i, x) + PER . + +END PROC get; + +PROC put (TAB CONST v, INT CONST laenge, fracs) : + FOR i FROM 1 UPTO v.lng + REP put (text (v.elem RSUB i, laenge, fracs)) PER + +END PROC put; + +PROC put (TAB CONST v) : + FOR i FROM 1 UPTO v.lng + REP put (text (v.elem RSUB i)) PER + +END PROC put; + +END PACKET vector; + + + diff --git a/lang/dynamo/1.8.7/src/dyn.wachstum b/lang/dynamo/1.8.7/src/dyn.wachstum new file mode 100644 index 0000000..9f97bb9 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.wachstum @@ -0,0 +1,19 @@ +NOTE +NOTE Ein einfaches Modell des Bevoelkerungswachstums +NOTE +L BEVOELKERUNG.K=BEVOELKERUNG.J+DT*GEBURTENRATE.JK +N BEVOELKERUNG=ANFANGSBEVOELKERUNG +C ANFANGSBEVOELKERUNG=1000 +R GEBURTENRATE.KL=BEVOELKERUNG.K*WACHSTUMSFAKTOR +N GEBURTENRATE=10 +C WACHSTUMSFAKTOR=0.03 das heisst: 3 Prozent +NOTE +NOTE Simulationsparameter +NOTE +PLOT BEVOELKERUNG=B(1E3,9E4)/GEBURTENRATE=G(10,9E3) +C DT=1 +C PLTPER=5 +C LENGTH=300 + + + diff --git "a/lang/dynamo/1.8.7/src/dyn.wasser\303\266ko" "b/lang/dynamo/1.8.7/src/dyn.wasser\303\266ko" new file mode 100644 index 0000000..fe05881 --- /dev/null +++ "b/lang/dynamo/1.8.7/src/dyn.wasser\303\266ko" @@ -0,0 +1,64 @@ +n t=15 +note*** wasserökosystem nach abel und reich +note*** in: microextra 4/83 seite 34 ff +note************************************************************************ +note* hilfsgleichung fuer temperatur t +note* die zeit time in wochen + +a t.k=15+4*sin((time.k-10)*2*pi/52) temperatur t; time in wochen +c pi=3.1415 +note gleichung fuer phytoplankton p + +l p.k=p.j+dt*(p.j*(p1*n.j*t.j-p2*z.j)(100-p.j)/100) phytoplankton p +note gleichung fuer zooplankton z + +l z.k=z.j+dt*(z.j*(p3*t.j*p.j+p4*n.j-(p5*f.j+p6*b.j)-1/p.j)(30-z.j)/30) +note gleichung fuer fische f +l f.k=f.j+dt*(f.j*(p7*z.j-p8*b.j-p9/(z.j+p.j))(10-f.j)/10) + +note gleichung fuer raubfisch barsch b + +l b.k=b.j+dt*(b.j*(p10*f.j+p11*z.j-1/(p12*f.j))(0.1-b.j)/0.1) + +note **** gleichung fuer naehrstoffmenge n + +l n.k=n.j+dt*(p13-n.j*(p14*p.j-p15*z.j)) +note **** anfangswerte **************************************************** +n p=p0 +n z=z0 +n f=f0 +n b=b0 +n n=n0 +c p0=10 +c z0=3 +c f0=1 +c b0=0.01 +c n0=30 in kg/volumeneinheit bzw. Stück/volumeneinhe�[ +note ***** konstanten ******************************************************** +c p1=0.006 +c p2=1 +c p3=0.006 +c p4=0.03 +c p5=1 +c p6=100 +c p7=0.33 +c p8=100 +c p9=1E-4 +c p10=1 +c p11=1 +c p12=0.25 +c p13=10 +c p14=0.1 +c p15=0.2 +note **** simulationskonstanten ********************************************* +c dt=0.5 +c length=60 +c pltper=1 +note***** outputvariablen**************************************************** +a lp.k=ln(p.k/p0) +a lz.k=ln(z.k/z0) +a lf.k=ln(f.k/f0) +a lb.k=ln(b.k/b0) +a logn.k=ln(n.k/n0) +plot lp=p,lz=z,lf=f,lb=b,logn=n(-4,4) + diff --git a/lang/dynamo/1.8.7/src/dyn.welt-forrester b/lang/dynamo/1.8.7/src/dyn.welt-forrester new file mode 100644 index 0000000..c3f9789 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.welt-forrester @@ -0,0 +1,124 @@ +note weltmodell in der form fuer eumel dynamo 17.7.1987 +* WORLD DYNAMICS W5 +L p.k=p.j+(dt)*(br.jk-dr.jk) +N p=pi +C pi=1.65e9 +R br.kl=(p.k)*(clip(brn,brn1,swt1,time.k))*(brfm.k)*(brmm.k) +X *(brcm.k)*(brpm.k) +C brn=.04 +C brn1=.04 +C swt1=1970 +A brmm.k=tabhl(brmmt,msl.k,0,5,1) +T brmmt=1.2/1/.85/.75/.77/.7 +A msl.k=ecir.k/(ecirn) +C ecirn=1 +A ecir.k=(cir.k)*(1-ciaf.k)*(nrem.k)/(1-ciafn) +A nrem.k=table(nremt,nrfr.k,0,1,.25) +T nremt=0/.15/.5/.85/1 +A nrfr.k=nr.k/nri +L nr.k=nr.j+(dt)*(-nrur.jk) +N nr=nri +C nri=900e9 +R nrur.kl=(p.k)*(clip(nrun,nrun1,swt2,time.k))*(nrmm.k) +C nrun=1 +C nrun1=1 +C swt2=1970 +NOTE equation 42 connects here from eq. 4 to eq.9 +R dr.kl=(p.k)*(clip(drn,drn1,swt3,time.k))*(drmm.k)*(drpm.k) +X *(drfm.k)*(drcm.k) +C drn=.028 +C drn1=.028 +C swt3=1970 +A drmm.k=tabhl(drmmt,msl.k,0,5,.5) +T drmmt=3/1.8/.8/.7/.6/.53/.5/.5/.5/.5 +A drpm.k=table(drpmt,polr.k,0,60,10) +T drpmt=.92/1.3/2/3.2/4.8/6.8/9.2 +A drfm.k=tabhl(drfmt,fr.k,0,2,.25) +T drfmt=30/3/2/1.4/1/.7/.6/.5/.5 +A drcm.k=table(drcmt,cr.k,0,5,1) +T drcmt=.9/1/1.2/1.5/1.9/3 +A cr.k=(p.k)/(la*pdn) +C la=135e6 +C pdn=26.5 +A brcm.k=table(brcmt,cr.k,0,5,1) +T brcmt=1.05/1/.9/.7/.6/.55 < +A brfm.k=tabhl(brfmt,fr.k,0,4,1) +T brfmt=0/1/1.6/1.9/2 +A brpm.k=table(brpmt,polr.k,0,60,10) +T brpmt=1.02/.9/.7/.4/.25/.15/.1 +A fr.k=(fpci.k)*(fcm.k)*(fpm.k)*(clip(fc,fc1,swt7,time.k))/fn +C fc=1 +C fc1=1 +C fn=1 +C swt7=1970 +A fcm.k=table(fcmt,cr.k,0,5,1) +T fcmt=2.4/.6/.4/.3/.2 +A fpci.k=tabhl(fpcit,cira.k,0,6,1) +T fpcit=.5/1/1.4/1.7/1.9/2.05/2.2 +A cira.k=(cir.k)*(ciaf.k)/ciafn +C ciafn=.3 +A cir.k=(ci.k/p.k) +L ci.k=ci.j+(dt)*(cig.jk-cid.jk) +N ci=cii +C cii=.4e9 +R cig.kl=(p.k)*(cim.k)*(clip(cign,cign1,swt4,time.k)) +C cign=.05 +C cign1=.05 +C swt4=1970 +A cim.k=tabhl(cimt,msl.k,0,5,1) +T cimt=.1/1/1.8/2.4/2.8/3 +R cid.kl=(ci.k)*(clip(cidn,cidn1,swt5,time.k)) +C cidn=.025 +C cidn1=.025 +C swt5=1970 +A fpm.k=table(fpmt,polr.k,0,60,10) +T fpmt=1.02/.9/.65/.35/.2/.1/.05 +A polr.k=pol.k/pols +C pols=3.6e9 +L pol.k=pol.j+(dt)*(polg.jk-pola.jk) +N pol=poli +C poli=.2e9 +R polg.kl=(p.k)*(clip(poln,poln1,swt6,time.k))*(polcm.k) +C poln=1 +C poln1=1 +C swt6=1970 +A polcm.k=tabhl(polcmt,cir.k,0,5,1) +T polcmt=.05/1/3/5.4/7.4/8 +R pola.kl=pol.k/polat.k +A polat.k=table(polatt,polr.k,0,60,10) +T polatt=.6/2.5/8/11.5/15.5/20 +L ciaf.k=ciaf.j+(dt/ciaft)*((cfifr.j*ciqr.j)-ciaf.j) +N ciaf=ciaf1 +C ciaf1=.2 +C ciaft=15 +A cfifr.k=tabhl(cfifrt,fr.k,0,2,.5) +T cfifrt=1/.6/.3/.15/.1 +A ql.k=(qls)*(qlm.k)*(qlc.k)*(qlf.k)*(qlp.k) +C qls=1 +A qlm.k=tabhl(qlmt,msl.k,0,5,1) +T qlmt=.2/1/1.7/2.3/2.7/2.9 +A qlc.k=table(qlct,cr.k,0,5,.5) +T qlct=2/1.3/1/.75/.55/.45/.38/.3/.25/.22/.2 +A qlf.k=tabhl(qlft,fr.k,0,4,1) +T qlft=0/1/1.8/2.4/2.7 +A qlp.k=table(qlpt,polr.k,0,60,10) +T qlpt=1.04/.85/.6/.3/.15/.05/.02 +NOTE equation 42 located between eq. 4 and 9. +A nrmm.k=tabhl(nrmmt,msl.k,0,10,1) +T nrmmt=0/1/1.8/2.4/2.9/3.3/3.6/3.8/3.9/3.95/4 +NOTE input from eqn. 38 and 40 to eqn. 35 +A ciqr.k=tabhl(ciqrt,qlm.k/qlf.k,0,2,.5) +T ciqrt=.7/.8/1/1.5/2 +NOTE +NOTE control cards +NOTE +C dt=.1 +C length=2100 +N time=1900 +C prtper=4 +C pltper=4 +PLOT p=p(0,8e9)/polr=2(0,40)/ci=c(0,20e9)/ql=q(0,2)/nr=n(0,1e12) +note PLOT fr=f,msl=m,qlc=4,qlp=5(0,2)/ciaf=a(.2,.6) +PRINT p,nr,ci,pol,ciaf + + diff --git a/lang/dynamo/1.8.7/src/dyn.wohnen b/lang/dynamo/1.8.7/src/dyn.wohnen new file mode 100644 index 0000000..4e9b8b4 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.wohnen @@ -0,0 +1,105 @@ +note modell des wohnbaus in einer stadt +note +note siehe Goodman: Study Notes in System Dynamics, Seite 332 ff +note +note Bevölkerungs-Sektor +note +L pop.k=pop.j+dt*(imr.jk-omr.jk-ndr.jk) +N pop=popi +C popi=30.3 +note +note pop population (people) +note popi population initial value +note imr immigration rate (people/year) +note omr out-migration rate(people/year) +note +R imr.kl=nim*ammp.k*pop.k +C nim=.145 +note +note nim normal immigration (fraction/year) +note ammp attractiveness for migration multiplier perceived (dimensionless) +note +A ammp.k=smooth(amm.k,mpt) +C mpt=5 +note +note amm attractiveness for migration multiplier (dimensionless) +note mpt migrant perception time (years) +note +A amm.k=table(ammt,hr.k,0,2,.25) +T ammt=.05/.1/.2/.4/1/1.6/1.8/1.9/2 +note +note ammt attractiveness for migration multiplier table +note hr housing ratio (dimensionless) +note +A dmm.k=1/amm.k +note +note dmm departure migration multiplier (dimensionless) +note +R omr.kl=nom*dmm.k*pop.k +C nom=.02 +note +note nom normal out migration (fraction/year) +note +R ndr.kl=pop.k*drf +C drf=.025 +note +note ndr net death rate (people/year) +note drf death rate factor (fraction/year) +note************************************************************************* +note housing sector +note************************************************************************* +note +L h.k=h.j+dt*(hcr.jk-hdr.jk) +N h=hi +c hi=10 +note +note h housing (units) +note hcr housing construction rate (units/year) +note hdr housing demolition rate (units/year) +note hi initial value of houses (units) +note +R hcr.kl=nhc*hcm.k*lam.k*h.k +C nhc=.12 +note +note nhc normal housing construction (fraction/year) +note hcm housing construction multiplier (dimensionless) +note lam land availability multiplier (dimensionless) +note +A hcm.k=table(hcmt,hr.k,0,2,.25) +T hcmt=2.5/2.4/2.3/2/1/.37/.2/.1/.05 +note +A hr.k=h.k/hd.k +note +note hr housing ratio(dimensionless) +note hd housing desired (units) +note +A hd.k=pop.k*upp +C upp=.33 +note +note upp units per person (unit/person) +note +A lam.k=table(lamt,lfo.k,0,1,.25) +T lamt=1/.8/.5/.2/0 +note +note lfo land fraction occupied (dimensionless) +note +A lfo.k=H.k*lpu/land +C lpu=1 +C land=1500 +note +note lpu land per unit(acres/unit) +note land (acres) +note +R hdr.kl=h.k/alth +C alth=50 +note +note alth average lifetime of housing (years) +note*********************************************************************** +note control statements +note*********************************************************************** +note +plot h=h(0,2000)/pop=p(0,8000)/hcr=c,hdr=d(0,100) +C dt=1 +C length=200 +C pltper=2 + diff --git a/lang/dynamo/1.8.7/src/dyn.workfluc b/lang/dynamo/1.8.7/src/dyn.workfluc new file mode 100644 index 0000000..8016449 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.workfluc @@ -0,0 +1,44 @@ +NOTE +NOTE ******************************************************************* +NOTE MODEL OF WORKLOAD FLUCTUATIONS +NOTE ******************************************************************* +NOTE JOHN HENIZE 5.11.81 +NOTE ******************************************************************* +NOTE +L MM.K=MM.J+(DT)*(-MTR.J) MANPOWER IN MARKETING +N MM=4 MEN +L MP.K=MP.J+(DT)*(MTR.J) MANPOWER IN PRODUCTION +N MP=6 MEN +NOTE +L JIP.K=JIP.J+(DT)*(JS.J-JC.J) JOBS_IN_PROCESS +N JIP=6 JOBS +A JM.K=MM.K/MEJ JOBS MARKETED +C MEJ=2 MAN_MONTHS/JOB MARKETING EFFORT PER JOB +L JS.K=JS.J+(DT/SD)*(JM.J-JS.J) JOBS SOLD +N JS=JM +C SD=2 MONTH SALES DELAY +A JC.K=MP.K/AJS JOBS COMPLETED +C AJS=8 MAN_MONTH/JOB +NOTE +A MTR.K=(BA.K+PMA.K)*MTC.K MANPOWER TRANSFER RATE +A BA.K=MMJ*(JIP.K-DJIP) BACKLOG ADJUSTMENT +C DJIP=6 JOBS DESIRED JOBS IN PROCESS +C MMJ=.15 MEN PER MONTH PER JOB MEN REALLOCATED PER MONTH PER +NOTE +A MTC.K=CLIP(MMC.K,PMC.K,BA.K,0) MANPOWER TRANSFER CONSTRAINT +A MMC.K=MMR.K MARKETING MANPOWER CONSTRAINT +A MMR.K=MM.K/(MM.K+MP.K) MARKETING MANPOWER RATIO +A PMC.K=PMR.K*PMR.K PRODUCTION MANPOWER CONSTRAINT +A PMR.K=MP.K/(MM.K+MP.K) PRODUCTION MANPOWER RATIO +NOTE +A PMA.K=SWITCH(0,PMA1.K,SW) PRODUCTION MANPOWER ADJUSTMENT +C SW=0 +A PMA1.K=(DMP.K-MP.K)/MAT +A DMP.K=JS.K*AJS DESIRED MANPOWER IN PRODUCTION +C MAT=10 MONTHS MANPOWER ADJUSTMENT TIME +NOTE +C DT=.2 +C LENGTH=120 +C PLTPER=6 +PLOT MM=M,MP=P(0,10)/JIP=J(0,20) + diff --git a/lang/dynamo/1.8.7/src/dyn.wurzel b/lang/dynamo/1.8.7/src/dyn.wurzel new file mode 100644 index 0000000..7f8e6e0 --- /dev/null +++ b/lang/dynamo/1.8.7/src/dyn.wurzel @@ -0,0 +1,14 @@ +note theon von smyrnas verfahren +note +l uj.k=u.j +l u.k=u.j+2*v.j +l v.k=v.j+uj.j +n uj=1 +n u=1 +n v=1 +a wurzelzwei.k=u.k/v.k +print u,v,wurzelzwei +c dt=1 +c length=20 +c prtper=1 + diff --git a/lang/dynamo/1.8.7/src/out.world b/lang/dynamo/1.8.7/src/out.world new file mode 100644 index 0000000..39859ce --- /dev/null +++ b/lang/dynamo/1.8.7/src/out.world @@ -0,0 +1,43 @@ +PAGE 1 : WORLD DYNAMICS W5 +P=P(0,8E9)/POLR=2(0,40)/CI=C(0,20E9)/QL=Q(0,2)/NR=N(0,1000E9) + 0.0 2.000000e9 4.000000e9 6.000000e9 8.000000e9p + 0.0 10. 20. 30. 40.2 + 0.0 5.000000e9 1.000000e10 1.500000e10 2.000000e10c + 0.0 .5 1. 1.5 2.q + 0.0 2.500000e11 5.000000e11 7.500000e11 1.000000e12n +1900. 2c________p__.__q_________.____________._______n____. +1902. 2c p . q . . n . +1908. 2c p . q . . n . +1914. 2c p . q . . n . +1920. 2 c p. q . . n . +1926. 2_c__________p____________q____________.______n_____. +1932. 2 c .p .q . n . +1938. 2 c . p .q . n . +1944. 2 c . p . q . n . +1950. 2 c . p Ω§Ω§ . n . +1956. 2______c_____.______p_____.q___________.___n________. +1962. 2 c . p q . n . +1968. 2 c . p q. . n . +1974. .2 c . p. .n .q +1980. .2 c. q.p n . +1986. .2___________.c_________q_.__p_______n_.____________. +1992. . 2 . c q . p n . . +1998. . 2 . c q . p n . . +2004. .__2_________.____c_q_____._____np_____.____________. +2010. . 2 . c . n p . .q +2016. . 2 . q c . n p . . +2022. . 2 . q c . n p . . +2028. . 2 . q c n p . . +2034. ._____2______.___q____c_n_._______p____.____________. +2040. . 2 . q cn . p . . +2046. . 2 . q c . p . .n +2052. . 2 . q nc . p . . +2058. . 2 . q n c . p . . +2064. ._____2______.__q_n__c____.__p_________.____________. +2070. . 2 . q n c . p . . +2076. . 2 . qn c .p . . +2082. . 2 . qn c .p . . +2088. . 2 . q c p . .n +2094. .__2_________.qnc________p.____________.____________. +2100. . 2 .qc p . . .n + diff --git a/lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const b/lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const new file mode 100644 index 0000000..d38858b Binary files /dev/null and b/lang/dynamo/1.8.7/src/ruestungsgleichgewicht.const differ diff --git a/lang/dynamo/1.8.7/src/stabileruestung.const b/lang/dynamo/1.8.7/src/stabileruestung.const new file mode 100644 index 0000000..9d64330 Binary files /dev/null and b/lang/dynamo/1.8.7/src/stabileruestung.const differ diff --git a/lang/lisp/1.7.2/src/lisp.1 b/lang/lisp/1.7.2/src/lisp.1 new file mode 100644 index 0000000..6851947 --- /dev/null +++ b/lang/lisp/1.7.2/src/lisp.1 @@ -0,0 +1,1305 @@ +PACKET lisp heap and oblist management (* Autor: J.Durchholz *) + (* Datum: 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* hey 25.2.83 *) + initialize lisp system, + dump lisp heap, + lisp storage, + collect lisp heap garbage, + SYM, + :=, + nil, + pname, + head, + set head, + tail, + set tail, + cons, + eq, + equal, + null, + atom, + is named atom, + begin oblist dump, + next atom, + new atom, + create atom, + delete atom, + begin property list dump, + next property, + add property, + alter property, + property, + delete property, + property exists, + add flag, + flag, + delete flag, + text, + is text, + character, + is character, + sym character, + int 1, + int 2, + is int pair, + sym: + + +(* NOTE: All internal routines are prefixed by x *) + + +(***************************** heap management ****************************) + +LET + max size = 32767, + NODE = STRUCT (INT status, + head, tail); +LET HEAP = STRUCT (INT size, + ROW max size NODE node); + + +BOUND HEAP VAR heap; + + +PROC initialize lisp system (DATASPACE CONST ds): + IF type (ds) < 0 THEN + heap := ds; + x initialize oblist and heap size; + create atom ("NIL"); + create atom ("PNAME"); + ELSE + heap := ds + FI +END PROC initialize lisp system; + + +PROC dump lisp heap (FILE VAR f): + put line (f, "Groesse :" + text (CONCR (heap).size)); + line (f); + put (CONCR (heap).size); + BOOL VAR is char := FALSE; + INT VAR i; + FOR i FROM 1 UPTO CONCR (heap).size REP + cout (i); + dump ith node + PER. + +dump ith node: + put (f, text (i, 6)); + put (f, status); + put (f, head); + put (f, tail); + line (f). + +status: + SELECT ith node.status OF + CASE atomic : "ATOMIC............" + CASE non atomic : "NON ATOMIC........" + CASE oblist bone : "OBLIST BONE......." + CASE property indicator : "PROPERTY INDICATOR" + CASE property root : "PROPERTY ROOT....." + CASE flag indicator : "FLAG INDICATOR...." + CASE text data : "TEXT DATA........." + CASE character data : is char := TRUE; "CHARACTER DATA...." + CASE int data : "INT DATA.........." + OTHERWISE "????." + text (ith node.status, 6) + ".????" + END SELECT. + +head: + maybe a code + text (ith node.head, 6). + +maybe a code: + IF is char THEN + is char := FALSE; + IF ith node.head > 31 AND 128 > ith node.head THEN + " " + code (ith node.head) + " " + ELSE + " " + FI + ELSE + " " + FI. + +tail: + text (ith node.tail, 6). + +ith node: + CONCR (heap).node (i). + +END PROC dump lisp heap; + + +PROC lisp storage (INT VAR size, used): + size := max size; + used := CONCR (heap).size +END PROC lisp storage; + + +PROC collect lisp heap garbage: + mark all used nodes; + transfer all used high address nodes to unused low address nodes; + adjust all pointers to cleared high address area and unmark all nodes; + adjust size. + +mark all used nodes: + INT VAR i; + FOR i FROM 2 UPTO 28 REP + x mark (i) + PER. + +transfer all used high address nodes to unused low address nodes: + INT VAR high address :: CONCR (heap).size + 1, + low address :: 0; + REP + find next lower used high address node; + IF no used high address node found THEN + LEAVE transfer all used high address nodes to unused low address nodes + FI; + find next higher unused low address node; + IF no unused low address node found THEN + LEAVE transfer all used high address nodes to unused low address nodes + FI; + transfer high address node to low address node + PER. + +find next lower used high address node: + REP + high address DECR 1 + UNTIL high address node marked PER. + +high address node marked: + high address node.status < 0. + +no used high address node found: + low address = high address. + +find next higher unused low address node: + REP + low address INCR 1 + UNTIL low address node not marked OR low address = high address PER. + +low address node not marked: + low address node.status > 0. + +no unused low address node found : + low address = high address. + +transfer high address node to low address node: + low address node.status := high address node.status; + low address node.head := high address node.head; + low address node.tail := high address node.tail; + high address node.head := low address. + +adjust all pointers to cleared high address area and unmark all nodes: + (* 'high address' should now point to the last node of the used area *) + FOR low address FROM 1 UPTO high address REP + unmark low address node; + SELECT low address node.status OF + CASE oblist bone: adjust head + CASE atomic, + non atomic, + property indicator, + property root, + flag indicator: adjust head; adjust tail + CASE text data, character data: adjust tail + CASE int data: + OTHERWISE x lisp error ("Status " + text (low address node.status) + + " gefunden bei pointer Justage") + END SELECT + PER. + +unmark low address node: + low address node.status := - low address node.status. + +adjust head: + IF low address node.head > high address THEN + low address node.head := node (low address node.head).head + FI. + +adjust tail: + IF low address node.tail > high address THEN + low address node.tail := node (low address node.tail).head + FI. + +adjust size: + CONCR (heap).size := high address. + +low address node: + node (low address). + +high address node: + node (high address). + +node: + CONCR (heap).node. + +END PROC collect lisp heap garbage; + + +PROC x mark (INT CONST ptr): + IF node not yet marked THEN + mark node; + SELECT - ptr node.status OF + CASE oblist bone: x mark (ptr node.head) + CASE atomic, + non atomic, + property indicator, + property root, + flag indicator: x mark (ptr node.head); x mark (ptr node.tail) + CASE text data, character data: x mark (ptr node.tail) + CASE int data: + OTHERWISE error stop ("Status " + text (- ptr node.status) + + " gefunden beim Markieren") + END SELECT + FI. + + +node not yet marked: + ptr node.status > 0. + +mark node: + ptr node.status := - ptr node.status. + +ptr node: + CONCR (heap).node (ptr) + +END PROC x mark; + + +TYPE SYM = INT; + + +OP := (SYM VAR left, SYM CONST right): + CONCR (left) := CONCR (right) +END OP :=; + + +LET atomic = 1, + non atomic = 2, + oblist bone = 3, + property indicator = 4, + property root = 5, + flag indicator = 6, + text data = 7, + character data = 8, + int data = 9; + +SYM CONST nil :: SYM :(35), (* 'x initialize oblist and heap size' will *) + pname :: SYM :(44); (* place the atom NIL at node 35 and PNAME *) + (* at node 44 *) + + +(***************************** basic functions ****************************) + + +SYM PROC head (SYM CONST sym): + SELECT status of sym OF + CASE atomic: error stop ("Atome haben keinen head"); nil + CASE non atomic: SYM :(head of sym) + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type:" + + text (status of sym)); + nil + CASE text data, + character data, + int data : error stop ("Daten haben keinen head"); nil + OTHERWISE x lisp error ("Illegaler Status " + text (status of sym)); + nil + END SELECT. + +status of sym: + sym node.status. + +head of sym: + sym node.head. + +sym node: + CONCR (heap).node (CONCR (sym)) + +END PROC head; + + +SYM PROC x head (SYM CONST sym): + SYM :(CONCR (heap).node (CONCR (sym)).head) +END PROC x head; + + +PROC set head (SYM CONST sym, new head): + SELECT status of sym OF + CASE atomic: errorstop ("Atome haben keinen head") + CASE non atomic: head of sym := CONCR (new head) + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type:" + + text (status of sym)) + CASE text data, + character data, + int data : error stop ("Daten haben keinen head") + OTHERWISE x lisp error ("Illegaler Status " + text (status of sym)) + END SELECT. + +status of sym: + sym node.status. + +head of sym: + sym node.head. + +sym node: + CONCR (heap).node (CONCR (sym)). + +END PROC set head; + + +PROC x set head (SYM CONST sym, new head): + CONCR (heap).node (CONCR (sym)).head := CONCR (new head) +END PROC x set head; + + +SYM PROC tail (SYM CONST sym): + SELECT status of sym OF + CASE atomic: error stop ("Atome haben keinen tail"); nil + CASE non atomic: SYM :(tail of sym) + CASE oblist bone, + property indicator, + flag indicator : x lisp error ("Versteckter Knoten:" + + text (status of sym)); + nil + CASE text data, + character data, + int data : error stop ("Daten haben keinen tail"); nil + OTHERWISE x lisp error ("Illegaler Status: "+ text (status of sym)); + nil + END SELECT. + +status of sym: + sym node.status. + +tail of sym: + sym node.tail. + +sym node: + CONCR (heap).node (CONCR (sym)). + +END PROC tail; + + +SYM PROC x tail (SYM CONST sym): + SYM :(CONCR (heap).node (CONCR (sym)).tail) +END PROC x tail; + + +PROC set tail (SYM CONST sym, new tail): + SELECT status of sym OF + CASE atomic: error stop ("Atome haben keinen tail") + CASE non atomic: tail of sym := CONCR (new tail) + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type: " + + text (status of sym)) + CASE text data, + character data, + int data : error stop ("Daten tails sind unveraenderbar") + OTHERWISE x lisp error ("Illegaler Status: " + text (status of sym)) + END SELECT. + +status of sym: + sym node.status. + +tail of sym: + sym node.tail. + +sym node: + CONCR (heap).node (CONCR (sym)). + +END PROC set tail; + + +PROC x set tail (SYM CONST sym, new tail): + CONCR (heap).node (CONCR (sym)).tail := CONCR (new tail) +END PROC x set tail; + + +SYM PROC cons (SYM CONST head, tail): + SYM VAR result; + search free node; + result node.status := non atomic; + result node.head := CONCR (head); + result node.tail := CONCR (tail); + result. + +search free node: + IF CONCR (heap).size = max size THEN + error stop ("LISP Heap Ueberlauf"); + LEAVE cons WITH nil + ELSE + CONCR (heap).size INCR 1; + CONCR (result) := CONCR (heap).size; cout(CONCR(result)) + FI. + +result node: + CONCR (heap).node (CONCR (result)). + +END PROC cons; + + +BOOL PROC eq (SYM CONST sym 1, sym 2): + CONCR (sym 1) = CONCR (sym 2) +END PROC eq; + + +BOOL PROC equal (SYM CONST sym 1, sym 2): + eq (sym 1, sym 2) COR have same value. + +have same value: + IF sym 1 node.status <> sym 2 node.status THEN + FALSE + ELSE + SELECT sym 1 node.status OF + CASE atomic: FALSE + CASE non atomic: equal (head (sym 1), head (sym 2)) CAND + equal (tail (sym 1), tail (sym 2)) + CASE oblist bone, + property indicator, + property root, + flag indicator: x lisp error ("Versteckter Knoten, Type: " + + text (x status (sym 1))); FALSE + CASE text data: equal texts + CASE character data: sym 1 node.head = sym 2 node.head + CASE int data: sym 1 node.head = sym 2 node.head AND + sym 1 node.tail = sym 2 node.tail + OTHERWISE x lisp error ("Ilegaler Status " + text (x status (sym 1))); + FALSE + END SELECT + FI. + +equal texts: + equal length CAND equal character sequence. + +equal length: + eq (x head (sym 1), x head (sym 2)). + +equal character sequence: + SYM VAR actual sym 1 character :: sym 1, + actual sym 2 character :: sym 2; + INT VAR i; + FOR i FROM 1 UPTO sym 1 node. head REP + actual sym 1 character := x tail (actual sym 1 character); + actual sym 2 character := x tail (actual sym 2 character); + IF eq (actual sym 1 character, actual sym 2 character) THEN + LEAVE equal character sequence WITH TRUE + FI; + IF x status (actual sym 1 character) <> character data OR + x status (actual sym 2 character) <> character data THEN + x lisp error ("Ungueltiges Zeichen im text"); + LEAVE equal character sequence WITH FALSE + FI; + IF CONCR (x head (actual sym 1 character)) <> + CONCR (x head (actual sym 2 character)) THEN + LEAVE equal character sequence WITH FALSE + FI + PER; + TRUE. + +sym 1 node: + CONCR (heap).node (CONCR (sym 1)). + +sym 2 node: + CONCR (heap).node (CONCR (sym 2)). + +END PROC equal; + + +BOOL PROC null (SYM CONST sym): + CONCR (sym) = CONCR (nil) +END PROC null; + + +BOOL PROC atom (SYM CONST sym): + SELECT x status (sym) OF + CASE atomic, + text data, + character data, + int data: TRUE + CASE non atomic: FALSE + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type:" + + text (x status (sym))); TRUE + OTHERWISE x lisp error ("Illegaler Status " + + text (x status (sym))); TRUE + END SELECT +END PROC atom; + + +BOOL PROC is named atom (SYM CONST sym): + x status (sym) = atomic +END PROC is named atom; + + +(*------------------- internal heap management routines ------------------*) + + +SYM PROC x new node (INT CONST status, head, tail): + IF CONCR (heap).size = max size THEN + error stop ("LISP Heap Ueberlauf"); nil + ELSE + CONCR (heap).size INCR 1; + new node.status := status; + new node.head := head; + new node.tail := tail; + SYM :(CONCR (heap).size) + FI. + +new node: + node (CONCR (heap).size). + +node: + CONCR (heap).node. + +END PROC x new node; + + +INT PROC x status (SYM CONST sym): + CONCR (heap).node (CONCR (sym)).status +END PROC x status; + + +(**************************** oblist management ***************************) + + +(* Oblist organization: + +(NOTE: + + +-----------------+ + l l + All nodes are represented as +--------+--------+ in all comments + l l l of this packet. + +--------+--------+ + +END OF NOTE) + + +The 'oblist' (object list) is organized as follows: + + +-------------+ + l oblist bone l + +------+------+ +--> list of all atoms whose print names begin with "@" + l o l XXXX l l + +---+--+------+ l + +------------+ + +-------------+ + l oblist bone l + +------+------+ +--> list of all atoms whose print names begin with "A" + l o l XXXX l l + +---+--+------+ l + +------------+ + . + . + . + + +-------------+ + l oblist bone l + +------+------+ +--> list of all atoms whose print names begin with "Z" + l o l XXXX l l + +---+--+------+ l + +------------+ + + +These nodes with status 'oblist bone' form the oblist skeleton. As long as +the lisp heap exists, they are stored contiguously in nodes 2 - 28; they +cannot be changed directly by the user. This way of storing the oblist +skeleton allows a hashing scheme to be applied when searching for an atom +with a given name. The hash width of 27 is the smallest one thas distributes +all atoms according to their character; with a smaller hash size, two or +more lists would be merged, with the effect that some of the atom lists +would contain atoms beginning with different characters. + + +The list of all atoms whose print names begin with a certain character +is organized as follows: + + +-------------+ + l atomic l + +------+------+ + l o l o---+--> property list of first atom + +---+--+------+ + l + V + +-------------+ + l atomic l + +------+------+ + l o l o---+--> property list of 2nd atom + +---+--+------+ + l + V + . + . + . + + l + V + +-------------+ + l atomic l + +------+------+ + l o l o---+--> property list of last atom + +---+--+------+ + l + V + oblist bone where the atom list began + + +These lists cannot be acessed directly by the user, too. +*) + + + +PROC x initialize oblist and heap size: + node (1).status := text data; + node (1).head := 32 (* blank *); + node (1).tail := 1; + INT VAR i; + FOR i FROM 2 UPTO 28 REP + node (i).status := oblist bone; + node (i).head := i + PER; + CONCR (heap).size := 28. + +node: + CONCR (heap).node. + +END PROC x initialize oblist and heap size; + + +(*++++++++++++++++++++++++++++++ oblist dump +++++++++++++++++++++++++++++*) + + +SYM VAR actual oblist bone :: SYM :(0), + actual atom :: SYM :(0); + + +PROC begin oblist dump: + actual oblist bone := SYM :(2); + actual atom := SYM :(2) +END PROC begin oblist dump; + + +SYM PROC next atom: + actual atom := x head (actual atom); + WHILE no more atoms in this atom list REP + try next oblist bone + PER; + actual atom. + +no more atoms in this atom list: + (* NIL is given as last atom when 'next atom' is called repeatedly, so *) + (* it can serve as a terminator. So NIL "does not count" if it is *) + (* encountered during one of the calls. *) + IF null (actual atom) THEN + actual atom := x head (actual atom) + FI; + eq (actual atom, actual oblist bone). + +try next oblist bone: + IF actual oblist bone is last oblist bone THEN + actual atom := SYM :(2); + LEAVE next atom WITH nil + FI; + CONCR (actual oblist bone) INCR 1; + actual atom := x head (actual oblist bone). + +actual oblist bone is last oblist bone: + CONCR (actual oblist bone) = 28. + +END PROC next atom; + + +(*+++++++++++++++++++++++ atom search and creation +++++++++++++++++++++++*) + + +SYM VAR predecessor, result; + (* Variables used for communication between the internal search *) + (* procedures and the procedures calling them. *) + + +SYM PROC atom (TEXT CONST name): + x search atom (name); + IF atom not already existing THEN + nil + ELSE + result + FI. + +atom not already existing: + x status (result) = oblist bone. + +END PROC atom; + + +SYM PROC new atom (TEXT CONST name): + x search atom (name); + IF atom not already existing THEN + x create new atom (name); + FI; + result. + +atom not already existing: + x status (result) = oblist bone. + +END PROC new atom; + + +PROC create atom (TEXT CONST name): + x search atom (name); + IF atom already existing THEN + error stop ("Atom " + name + " existiert bereits") + ELSE + x create new atom (name) + FI. + +atom already existing: + x status (result) <> oblist bone. + +END PROC create atom; + + +PROC delete atom (SYM CONST atom): + IF is named atom (atom) THEN + IF null (atom) OR eq (atom, pname) THEN + error stop ("Dies Atom darf nicht geloescht werden") + ELSE + search predecessor; + delete atom from atom list + FI + ELSE + error stop ("Nur benannte Atome knnen geloescht werden") + FI. + +search predecessor: + predecessor := x head (atom); + WHILE NOT eq (x head (predecessor), atom) REP + predecessor := x head (predecessor) + PER. + +delete atom from atom list: + x set head (predecessor, x head (atom)). + +END PROC delete atom; + + +PROC x search atom (TEXT CONST name): + CONCR (result) := (code (name SUB 1) + 17) MOD 27 + 2; + (* This formula places the list of atoms beginning with "@" at the *) + (* first oblist bone, the list of atoms beginning with "A" at the *) + (* at the second one, and so on. (See also the big comment in lines *) + (* 600 - 700) *) + REP + predecessor := result; + result := x head (predecessor); + UNTIL end of atom list reached COR right atom found PER. + +end of atom list reached: + x status (result) = oblist bone. + +right atom found: + SYM VAR actual character node := property (result, pname); + IF NOT is text (actual character node) THEN + x lisp error ("Namen erwartet"); + LEAVE right atom found WITH FALSE + FI; + IF CONCR (x head (actual character node)) <> length (name) THEN + FALSE + ELSE + INT VAR i; + FOR i FROM 1 UPTO length (name) REP + to next character node; + check wether is character data node; + check wether character matches; + PER; + TRUE + FI. + +to next character node: + actual character node := x tail (actual character node). + +check wether is character data node: + IF x status (actual character node) <> character data THEN + x lisp error ("Zeichenkette erwartet"); + LEAVE right atom found WITH FALSE + FI. + +check wether character matches: + IF code (name SUB i) <> CONCR (x head (actual character node)) THEN + LEAVE right atom found WITH FALSE + FI. + +END PROC x search atom; + + +PROC x create new atom (TEXT CONST name): + (* It is necessary that 'x search atom' has been executed before *) + (* calling 'x create new atom' because this procedure relies on the *) + (* value of 'predecessor'. *) + enable stop; + SYM CONST sym name :: sym (name); + IF CONCR (heap).size + 3 > max size THEN + error stop ("LISP Heap Ueberlauf") + FI; + result := newly created atom; + x set head (predecessor, result). + +newly created atom: + x new node (atomic, CONCR (oblist bone node), CONCR (property list)). + +oblist bone node: + x head (predecessor). + +property list: + x new node (property indicator, CONCR (pname), property root node). + +property root node: + CONCR (x new node (property root, CONCR (sym name), CONCR (nil))). + +END PROC x create new atom; + + +(************************* property list handling *************************) + +(* +The property lists consist of chained units of the structure + + +--------------------+ +---------------+ + l property indicator l l property root l + +----------+---------+ +-------+-------+ + l o l o----+-->l o l o---+--> . . . + +----+-----+---------+ +---+---+-------+ + l l + V V + property id property + + +or + + +----------------+ + l flag indicator l + +--------+-------+ + l o l o---+--> . . . + +---+----+-------+ + l + V + flag id + + + +The property lists cannot be altered or read directly, too. + +For property list handling there exist procedures that insert, change, read +and delete properties resp. flags. Thus, the only thing that can be done +with any property of an atom without using these special procedures, is +comparing to or 'cons'ing with some other S-expression. +At any given time the property list of any atom (including 'NIL') contains +the property 'PNAME' giving the print name of the atom, stored as a list of +characters. This special property cannot be altered, overwritten by 'add +property' or deleted. +*) + + +(*++++++++++++++++++++++++++ property list dump ++++++++++++++++++++++++++*) + + +SYM VAR actual property list node :: nil; + + +PROC begin property list dump (SYM CONST atom): + actual property list node := x tail (atom) +END PROC begin property list dump; + + +PROC next property (SYM VAR property id, property): + IF null (actual property list node) THEN + property id := nil; + property := nil + ELSE + SELECT x status (actual property list node) OF + CASE flag indicator: get flag id + CASE property indicator: get property id and property + OTHERWISE x lisp error ("Flagge oder Eigenschaft erwartet und nicht: " + + text (x status (actual property list node))) + END SELECT + FI. + +get flag id: + property id := x head (actual property list node); + actual property list node := x tail (actual property list node); + property := nil. + +get property id and property: + property id := x head (actual property list node); + actual property list node := x tail (actual property list node); + IF x status (actual property list node) = property root THEN + property := x head (actual property list node); + actual property list node := x tail (actual property list node) + ELSE + x lisp error ("Eigenschaftswurzel erwartet, nicht:" + + text (x status (actual property list node))); + property := nil + FI. + +END PROC next property; + + +(*+++++++++++++++++++++++++++++ properties +++++++++++++++++++++++++++++++*) + + +SYM VAR last atom :: SYM :(0), + p list predecessor, + p list result; + + +PROC add property (SYM CONST atom, property id, property): + IF eq (property id, pname) THEN + errorstop ("Der PNAME eines Atoms darf nicht versteckt sein") + ELSE + IF CONCR (heap).size + 2 > max size THEN + error stop ("LISP Heap Ueberlauf"); + LEAVE add property + FI; + x set tail (atom, new property plus old property list); + IF eq (atom, last atom) AND + eq (property id, x head (p list result)) THEN + p list predecessor := atom; + p list result := x tail (atom) + FI + FI. + +new property plus old property list: + x new node (property indicator, + CONCR (property id), CONCR (property root plus old property list)). + +property root plus old property list: + x new node (property root, CONCR (property), CONCR (old property list)). + +old property list: + x tail (atom) + +END PROC add property; + + +PROC alter property (SYM CONST atom, property id, new property): + IF eq (property id, pname) THEN + error stop ("Namen kann man nicht aendern") + ELSE + x search property id (atom, property id); + IF null (p list result) THEN + error stop ("Eigenschaft existiert nicht") + ELSE + x set head (x tail (p list result), new property) + FI + FI +END PROC alter property; + + +SYM PROC property (SYM CONST atom, property id): + x search property id (atom, property id); + IF null (p list result) THEN + nil + ELSE + x head (x tail (p list result)) + FI +END PROC property; + + +PROC delete property (SYM CONST atom, property id): + IF eq (property id, pname) THEN + errorstop ("Der Name eines Atoms darf nicht geloescht werden") + ELSE + x search property id (atom, property id); + IF NOT null (p list result) THEN + x set tail (p list predecessor, x tail (x tail (p list result))); + last atom := SYM :(0) + FI + FI +END PROC delete property; + + +BOOL PROC property exists (SYM CONST atom, property id): + x search property id (atom, property id); + NOT null (p list result) +END PROC property exists; + + +PROC x search property id (SYM CONST atom, property id): + IF eq (last atom, atom) AND eq (x head (p list result), property id) THEN + LEAVE x search property id + FI; + last atom := atom; + p list predecessor := atom; + REP + p list result := x tail (p list predecessor); + IF end of property list THEN + last atom := SYM :(0); + LEAVE x search property id + FI; + SELECT x status (p list result) OF + CASE flag indicator: p list predecessor := p list result + CASE property indicator: check wether property root node follows; + IF correct property id found THEN + LEAVE x search property id + ELSE + p list predecessor := xtail (p list result) + FI + CASE property root: xlisperror("Unordentliche Eigenschaftwurzel"); + p list result := nil; + last atom := SYM :(0); + LEAVE x search property id + OTHERWISE x lisp error ("Eigenschaften erwartet und nicht: " + + text (x status (p list result))); + p list result := nil; + last atom := SYM :(0); + LEAVE x search property id + END SELECT + PER. + +end of property list: + null (p list result). + +check wether property root node follows: + IF x status (x tail (p list result)) <> property root THEN + x lisp error ("Eigenschaftswurzel erwartet"); + p list result := nil; + last atom := SYM :(0); + LEAVE x search property id + FI. + +correct property id found: + eq (x head (p list result), property id). + +END PROC x search property id; + + +(*++++++++++++++++++++++++++++++++ flags +++++++++++++++++++++++++++++++++*) + + +PROC add flag (SYM CONST atom, flag id): + enable stop; + x set tail (atom, new flag plus old property list). + +new flag plus old property list: + x new node (flag indicator, CONCR (flag id), old property list). + +old property list: + CONCR (x tail (atom)) + +END PROC add flag; + + +BOOL PROC flag (SYM CONST atom, flag id): + x search flag id (atom, flag id); + NOT null (result) +END PROC flag; + + +PROC delete flag (SYM CONST atom, flag id): + x search flag id (atom, flag id); + IF NOT (is error COR null (result)) THEN + x set tail (predecessor, x tail (result)) + FI +END PROC delete flag; + + +PROC x search flag id (SYM CONST atom, flag id): + predecessor := atom; + REP + result := x tail (predecessor); + IF end of property list THEN + LEAVE x search flag id + FI; + SELECT x status (result) OF + CASE property root, property indicator: predecessor := result + CASE flag indicator: IF correct flag id found THEN + LEAVE x search flag id + ELSE + predecessor := result + FI + OTHERWISE x lisp error ("Eigenschaften erwartet und nicht:" + + text (x status (result))); + result := nil; + LEAVE x search flag id + END SELECT + PER. + +end of property list: + null (result). + +correct flag id found: + eq (x head (result), flag id). + +END PROC x search flag id; + + +(****** Conversion of non-LISP data to LISP structures and vice versa *****) + + +TEXT PROC text (SYM CONST sym): + IF is text (sym) THEN + TEXT VAR result := ""; + SYM VAR actual node :: sym; + INT VAR i; + FOR i FROM 1 UPTO CONCR (x head (sym)) REP + actual node := x tail (actual node); + result CAT actual character + PER; + result + ELSE + error stop ("ist kein text"); + "" + FI. + +actual character: + IF x status (actual node) <> character data THEN + x lisp error ("Zeichenfolge erwartet"); + LEAVE text WITH result + FI; + code (CONCR (x head (actual node))). + +END PROC text; + + +BOOL PROC is text (SYM CONST sym): + x status (sym) = text data +END PROC is text; + + +SYM PROC sym (TEXT CONST text): + SYM VAR result :: x new node (text data, + length (text), CONCR (nil)), + actual character node :: result; + INT VAR length of text; + ignore blanks at end of text; + INT VAR i; + FOR i FROM 1 UPTO length of text REP + x set tail (actual character node, new next character node); + actual character node := x tail (actual character node) + PER; + result. + +ignore blanks at end of text: + FOR length of text FROM length (text) DOWNTO 0 REP + IF (text SUB length of text) <> " " THEN + LEAVE ignore blanks at end of text + FI + PER; + length of text := 0. + +new next character node: + x new node (character data, code (text SUB i), 1). + +END PROC sym; + + +INT PROC character (SYM CONST sym): + IF x status (sym) = character data THEN + CONCR (x head (sym)) + ELSE + error stop ("ist kein Charakter"); + -1 + FI +END PROC character; + + +BOOL PROC is character (SYM CONST sym): + x status (sym) = character data +END PROC is character; + + +SYM PROC sym character (INT CONST char): + x new node (character data, char MOD 256, 1) +END PROC sym character; + + +INT PROC int 1 (SYM CONST sym): + IF x status (sym) = int data THEN + CONCR (x head (sym)) + ELSE + error stop ("ist keine Zahl"); + -1 + FI +END PROC int 1; + + +INT PROC int 2 (SYM CONST sym): + IF x status (sym) = int data THEN + CONCR (x tail (sym)) + ELSE + error stop ("ist keine Zahl"); + -1 + FI +END PROC int 2; + + +BOOL PROC is int pair (SYM CONST sym): + x status (sym) = int data +END PROC is int pair; + + +SYM PROC sym (INT CONST int 1, int 2): + x new node (int data, int 1, int 2) +END PROC sym; + + +(********************* internal error routine *****************************) + + +PROC x lisp error (TEXT CONST error message): + error stop (""13"LISP SYSTEM FEHLER: " + error message ) +END PROC x lisp error; + + +END PACKET lisp heap and oblist management; + + + +PACKET name (* Autor: J.Durchholz *) + (* Datum: 15.06.1982 *) + DEFINES (* Version 1.1.1 *) + + name: + +TEXT PROC name (SYM CONST sym): + IF is named atom (sym) THEN + text (property (sym, pname)) + ELSE + ""15"IST_KEIN_ATOM"14"" + FI +END PROC name; + + +END PACKET name; + + + +PACKET lisp storage info (* Autor: J.Durchholz *) + (* Datum: 23.08.1982 *) + DEFINES (* Version 1.1.1 *) + + lisp storage info: + + +PROC lisp storage info: + INT VAR size, used; + lisp storage (size, used); + out (""13""10" "); + put (used); + put ("Knoten von"); + put (size); + put line ("Knoten des LISP-Heaps sind belegt!") +END PROC lisp storage info; + + +END PACKET lisp storage info; diff --git a/lang/lisp/1.7.2/src/lisp.2 b/lang/lisp/1.7.2/src/lisp.2 new file mode 100644 index 0000000..956aa5c --- /dev/null +++ b/lang/lisp/1.7.2/src/lisp.2 @@ -0,0 +1,550 @@ +PACKET character buffer (* Autor : J.Durchholz *) + (* Datum : 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* 21.2.83. hey 293, 450,97,361 *) + get char, + line nr, + init char buffer: + + +TEXT VAR buffer; +INT VAR pointer, + line; + + +INT PROC line nr: + line +END PROC line nr; + + +PROC init char buffer: + buffer := ""; + pointer := 1; + line := 0; +END PROC init char buffer; + + +PROC get char (FILE VAR f, TEXT VAR char): + IF buffer empty THEN + try to find nonempty line and put it into buffer; + char := " "; + pointer := 1 + ELSE + char := buffer SUB pointer; + pointer INCR 1 + FI. + +buffer empty: + pointer > length (buffer). + +try to find nonempty line and put it into buffer: + REP + IF eof (f) THEN + char := ""; + LEAVE get char + FI; + get line (f, buffer); + line INCR 1 + UNTIL buffer <> "" PER. + +END PROC get char; + + +END PACKET character buffer; + + + + +PACKET lisp io (* Autor: J.Durchholz *) + (* Datum: 10.09.1982 *) + DEFINES (* Version 4.1.3 *) + + put, + verbose lisp output, + get, + get all: + + +BOOL VAR verbose :: FALSE; + + +PROC verbose lisp output (BOOL CONST b): + verbose := b +END PROC verbose lisp output; + +BOOL PROC verbose lisp output: + verbose +END PROC verbose lisp output; + + +PROC put (FILE VAR f, SYM CONST sym): + IF atom (sym) THEN + put atom + ELSE + put structure + FI. + +put atom: + IF is named atom (sym) THEN + put (f, name (sym)) + ELIF is int pair (sym) THEN + put (f, int 1 (sym)) + ELIF is text (sym) THEN + IF verbose THEN + TEXT VAR buffer :: text (sym); + change all (buffer, """", """"""); + buffer CAT """"; + put (f, """" + buffer) + ELSE + write (f, text (sym)) + FI + ELIF is character (sym) THEN + IF verbose THEN + buffer := "'"; + buffer CAT code (character (sym)); + buffer CAT "'"; + put (f, buffer) + ELSE + write (f, code (character (sym))) + FI + ELSE + put (f, ""15"UNBEKANNTER_ATOM_TYP"14"") + FI. + +put structure: + put (f, "("); + SYM VAR actual node := sym; + REP + put (f, head (actual node)); + actual node := tail (actual node) + UNTIL atom (actual node) PER; + IF NOT null (actual node) THEN + put (f, "."); + put (f, actual node) + FI; + put (f, ")"). + +END PROC put; + + +PROC put (SYM CONST sym): + IF atom (sym) THEN + put atom + ELSE + put structure + FI. + +put atom: + IF is named atom (sym) THEN + put (name (sym)) + ELIF is int pair (sym) THEN + put (int 1 (sym)) + ELIF is text (sym) THEN + IF verbose THEN + TEXT VAR buffer :: text (sym); + change all (buffer, """", """"""); + buffer CAT """"; + put ("""" + buffer) + ELSE + write (text (sym)) + FI + ELIF is character (sym) THEN + IF verbose THEN + buffer := "'"; + buffer CAT code (character (sym)); + buffer CAT "'"; + put (buffer) + ELSE + out (code (character (sym))) + FI + ELSE + put (""15"UNBEKANNTER_ATOM_TYP"14"") + FI. + +put structure: + put ("("); + SYM VAR actual node := sym; + REP + put (head (actual node)); + actual node := tail (actual node) + UNTIL atom (actual node) PER; + IF NOT null (actual node) THEN + put ("."); + put (actual node) + FI; + put (")"). + +END PROC put; + + +PROC get (FILE VAR f, SYM VAR s): + initialize scanner (f); + IF NOT get s expression (s) THEN + error ("LISP-Ausdruck erwartet") + FI; + scanner postprocessing (f) +END PROC get; + + +(**************************** parser for 'get' ****************************) + + +LET end of file type = 0, + name type = 1, + text type = 2, + character type = 3, + int type = 4, + other char type = 5; + + +BOOL PROC get s expression (SYM VAR s): + (* The boolean result indicates wether the error has not occurred that *) + (* 'get next symbol' was called, but then the symbol was not expected *) + (* and thus could not be processed. *) + get next symbol; + SELECT symbol type OF + CASE end of file type: FALSE + CASE name type: s := new atom (symbol); TRUE + CASE text type: s := sym (symbol); TRUE + CASE character type: s := sym character (code (symbol)); TRUE + CASE int type: s := sym (int (symbol), -1); TRUE + CASE other char type: get structure + OTHERWISE error ("EINLESEFEHLER: unbekannter Symboltyp: " + + text (symbol type)); TRUE + END SELECT. + +get structure: + IF symbol <> "(" THEN + FALSE + ELSE + get list; + IF symbol type <> other char type OR symbol <> ")" THEN + error (">> ) << erwartet"); + FALSE + ELSE + TRUE + FI + FI. + +get list: + SYM VAR father, son; + IF get s expression (son) THEN + get list elements; + ELSE + s := nil + FI. + +get list elements: + father := cons (son, nil); + s := father; + WHILE get s expression (son) REP + set tail (father, cons (son, nil)); + father := tail (father) + PER; + IF symbol type = other char type AND symbol = "." THEN + IF get s expression (son) THEN + set tail (father, son); + get next symbol + ELSE + error ("LISP-Ausdruck nach dem Punkt erwartet") + FI + FI. + +END PROC get s expression; + + +(********************* scanner for 'get x espression' *********************) + + +FILE VAR infile; + + +PROC initialize scanner (FILE CONST f): + infile := f; + no input errors := TRUE; + init char buffer; + get char (infile, actual char) +END PROC initialize scanner; + + +PROC scanner postprocessing (FILE VAR f): + f := infile +END PROC scanner postprocessing; + + +TEXT VAR symbol; INT VAR symbol type; + + +PROC get next symbol: + skip blanks; + IF actual char = "" THEN + symbol := "DATEIENDE"; + symbol type := end of file type + ELIF is letter THEN + get name + ELIF is digit or sign THEN + get integer + ELIF is double quote THEN + get text + ELIF is single quote THEN + get character + ELSE + get other char + FI . + +is letter: + IF "a" <= actual char AND actual char <= "z" THEN + actual char := code (code (actual char) - code ("a") + code ("A")); + TRUE + ELSE + "@" <= actual char AND actual char <= "Z" + FI. + +get name: + symbol type := name type; + symbol := actual char; + REP + get char (infile, actual char); + IF is neither letter nor digit THEN + LEAVE get name + FI; + symbol CAT actual char + PER. + +is neither letter nor digit: + NOT (is letter OR is digit OR is underscore). + +is digit: + "0" <= actual char AND actual char <= "9". + +is underscore: + actual char = "_". + +is digit or sign: + is digit OR actual char = "+" OR actual char = "-". + +get integer: + symbol type := int type; + IF actual char = "+" THEN + get char (infile, actual char); + skip blanks; + symbol := actual char + ELIF actual char = "-" THEN + symbol := "-"; + get char (infile, actual char); + skip blanks; + symbol CAT actual char + ELSE + symbol := actual char + FI; + REP + get char (infile, actual char); + IF NOT is digit THEN + LEAVE get integer + FI; + symbol CAT actual char + PER. + +is double quote: + actual char = """". + +get text: + symbol := ""; + symbol type := text type; + REP + get char (infile, actual char); + IF is double quote THEN + get char (infile, actual char); + IF NOT is double quote THEN LEAVE get text + FI + ELIF actual char = "" THEN LEAVE get text (*hey*) + FI; + symbol CAT actual char + PER. + +is single quote: + actual char = "'". + +get character: + symbol type := character type; + get char (infile, symbol); + get char (infile, actual char); + IF actual char <> "'" THEN + error (">> ' << erwartet") + ELSE + get char (infile, actual char) + FI. + +get other char: + symbol type := other char type; + symbol := actual char; + get char (infile, actual char). + +END PROC get next symbol; + + +TEXT VAR actual char; + + +PROC skip blanks: + INT VAR comment depth :: 0; + WHILE is comment OR actual char = " " REP + get char (infile, actual char) + PER. + +is comment: + IF actual char = "{" THEN + comment depth INCR 1; + TRUE + ELIF actual char = "}" THEN + IF comment depth = 0 THEN + error (">> { << fehlt") + ELSE + comment depth DECR 1 + FI; + TRUE + ELSE + IF comment depth > 0 THEN + IF actual char = "" THEN + error ("DATEIENDE im Kommentar"); + FALSE + ELSE + TRUE + FI + ELSE + FALSE + FI + FI. + +END PROC skip blanks; + + +BOOL VAR no input errors; +FILE VAR errors; + + +PROC error (TEXT CONST error message): + out ("FEHLER in Zeile "); + out (text (line nr)); + out (" bei >> "); + out (symbol); + out (" << : "); + out (error message); + line; + IF no input errors THEN + no input errors := FALSE; + errors := notefile; modify(errors); + headline (errors, "Einlesefehler"); output(errors) + FI; + write (errors, "FEHLER in Zeile "); + write (errors, text (line nr)); + write (errors, " bei >> "); + write (errors, symbol); + write (errors, " << : "); + write (errors, error message); + line (errors) +END PROC error; + + +PROC get (SYM VAR sym): (*hey*) + disable stop; + FILE VAR in :: sequential file (modify, "LISP INPUT"), + out :: notefile; modify (out); + headline (out,"LISP OUTPUT"); + headline (in, "LISP INPUT"); + editable (out,in); output(out); + input (in); + get (in, sym); + WHILE NOT no input errors AND NOT is error REP + modify (errors); + headline (errors, " LISP-Fehlermeldungen"); + headline (in, " Bitte KORREKTEN LISP-Ausdruck"); + editable (errors, in); + headline (errors, "notebook"); + output (errors); + input (in); + get (in, sym) + PER; +END PROC get; + + +PROC editable (FILE VAR a,b): (*hey*) + enable stop; edit (a,b); to line (a,lines(a)); remove(a,lines(a)) +END PROC editable; + +PROC edit (FILE VAR a,b): + open editor (1, b, write acc, 1, 1, 79, 24); + open editor (2, a, write acc, 1,13, 79, 12); + edit (1) + END PROC edit; + +LET write acc = TRUE; + +PROC get all (FILE VAR f, SYM VAR sym): + get (f, sym); + skip blanks; + IF NOT eof (infile) THEN + error ("Hinter dem letzten Symbol des LISP-Ausdruck stehen noch Zeichen") + FI +END PROC get all; + + +END PACKET lisp io; + + + +PACKET lisp integer (* Autor: J.Durchholz *) + (* Datum: 30.08.1982 *) + DEFINES (* Version 1.1.2 *) + + sum, + difference, + product, + quotient, + remainder: + +SYM PROC sum (SYM CONST summand list): + INT VAR result := 0; + SYM VAR list rest := summand list; + WHILE NOT atom (list rest) REP + result INCR int 1 (head (list rest)); + list rest := tail (list rest) + PER; + IF NOT null (list rest) THEN + error stop ("Summandenliste endet falsch") + FI ; + sym (result, -1) +END PROC sum; + + +SYM PROC difference (SYM CONST minuend, subtrahend): + sym (int 1 (minuend) - int 1 (subtrahend), -1) +END PROC difference; + + +SYM PROC product (SYM CONST factor list): + INT VAR result := 1; + SYM VAR list rest := factor list; + WHILE NOT atom (list rest) REP + result := result * int 1 (head (list rest)); + list rest := tail (list rest) + PER; + IF NOT null (list rest) THEN + error stop ("Faktorenliste endet falsch") + FI; + sym (result, -1) +END PROC product; + + +SYM PROC quotient (SYM CONST dividend, divisor): + sym (int 1 (dividend) DIV int 1 (divisor), -1) +END PROC quotient; + + +SYM PROC remainder(SYM CONST dividend, divisor): + sym (int 1 (dividend) MOD int 1 (divisor), -1) +END PROC remainder; + + +END PACKET lisp integer; + diff --git a/lang/lisp/1.7.2/src/lisp.3 b/lang/lisp/1.7.2/src/lisp.3 new file mode 100644 index 0000000..dfde6db --- /dev/null +++ b/lang/lisp/1.7.2/src/lisp.3 @@ -0,0 +1,142 @@ +PACKET lisp (* Autor: J.Durchholz , P. Heyderhoff *) + (* Datum: 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + + start lisp system, + lisp heap, + insert lisp, + run lisp, + run lisp again, + lisp: + +SYM VAR run again pointer :: nil; +DATASPACE VAR insert heap :: nil space; + +PROC start lisp system (DATASPACE CONST heap): + enable stop; + initialize lisp system (heap); + forget (insert heap); + insert heap := heap +END PROC start lisp system; + + +PROC start lisp system (DATASPACE CONST heap, FILE VAR f): + start lisp system (heap); + input (f); + WHILE NOT eof (f) REP + TEXT VAR name; + get (f, name); + SYM CONST s :: new atom (name); + get (f, name); + SYM CONST property name :: new atom (name); + IF NOT null (property name) THEN + SYM VAR property; + get (f, property); + add property (s, property name, property) + FI; + PER +END PROC start lisp system; + + +PROC start lisp system (FILE VAR f): + create lisp system (f, insert heap) +END PROC start lisp system; + + +DATASPACE PROC lisp heap: + insert heap +END PROC lisp heap; + + +DATASPACE VAR run heap :: nil space; + + +PROC insert lisp: + insert lisp (last param) +END PROC insert lisp; + + +PROC insert lisp (TEXT CONST file name): + interpret (insert heap, file name) +END PROC insert lisp; + + +PROC run lisp: + run lisp (last param) +END PROC run lisp; + + +PROC run lisp (TEXT CONST file name): + forget (run heap); + run heap := insert heap; + interpret (run heap, file name) +END PROC run lisp; + + +DATASPACE VAR do heap :: nil space, + do file :: nil space; + + + +PROC interpret (DATASPACE CONST heap, TEXT CONST file name): + enable stop; + FILE VAR f :: sequential file (input, file name); + interpret (heap, f) +END PROC interpret; + + +PROC interpret (DATASPACE CONST heap, FILE VAR f): + initialize lisp system (heap); + get (f, run again pointer); + add property (new atom ("program"), new atom ("APVAL"), run again pointer); + put (evalquote (run again pointer)) +END PROC interpret; + +PROC run lisp again: + put (evalquote (run again pointer)) +END PROC run lisp again; + + +PROC get ausdruck: + enable stop; get (ausdruck) +END PROC get ausdruck; + +SYM VAR ausdruck; + +PROC lisp: + +(* HAUPT TESTPROGRAMM FUER LISP Heyderhoff 25.1.83 *) +IF NOT exists ("LISP HEAP") THEN + FILE VAR bootstrap :: sequential file (input, "lisp.bootstrap"); + create lisp system (bootstrap, new ("LISP HEAP")); + verbose lisp output (TRUE); +FI; +FILE VAR out :: notefile; output (out); +SYM VAR work; +command dialogue(FALSE); forget ("LISP INPUT"); command dialogue(TRUE); +(* bildlaenge(23); *) (* EUMEL 1.65 *) +disable stop; +REP + get (ausdruck); + IF is error THEN + handle error + ELSE + output (out); + work := evalquote (ausdruck); + IF is error THEN handle error + ELSE put (out, work) + FI + FI +PER . + +handle error: + IF text (error message, 18) = "halt from terminal" THEN + enable stop + ELSE + put (out, error message); + put ( error message); pause(20); + clear error; + FI . +END PROC lisp; +END PACKET lisp; + diff --git a/lang/lisp/1.7.2/src/lisp.4 b/lang/lisp/1.7.2/src/lisp.4 new file mode 100644 index 0000000..f36706d --- /dev/null +++ b/lang/lisp/1.7.2/src/lisp.4 @@ -0,0 +1,766 @@ +PACKET lisp heap maintenance (* Autor: J.Durchholz *) + (* Datum: 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* Testhilfe *) + create lisp system, (* hey, 02.3.83 : 121,334,542,732 *) + dump oblist: + + +PROC create lisp system (FILE VAR f, DATASPACE CONST new heap): + initialize lisp system (new heap); + input (f); + WHILE NOT eof (f) REP + TEXT VAR name; + get (f, name); + SYM CONST s :: new atom (name); + get (f, name); + SYM CONST property name :: new atom (name); + IF NOT null (property name) THEN + SYM VAR property; + get (f, property); + add property (s, property name, property) + FI + PER +END PROC create lisp system; + + +PROC dump oblist (FILE VAR f): + begin oblist dump; + REP + SYM CONST actual atom :: next atom; + put line (f, name (actual atom)); + dump property list + UNTIL null (actual atom) PER. + +dump property list: + begin property list dump (actual atom); + REP + SYM VAR id, value; + next property (id, value); + write (f, " "); + write (f, name (id)); + write (f, " "); + write (f, name (value)); + line (f) + UNTIL null (id) AND null (value) PER. + +END PROC dump oblist; + + +PROC dump oblist: + begin oblist dump; + REP + SYM CONST actual atom :: next atom; + put line (name (actual atom)); + dump property list + UNTIL null (actual atom) PER. + +dump property list: + begin property list dump (actual atom); + REP + SYM VAR id, value; + next property (id, value); + out (" "); + out (name (id)); + out (" "); + put line (name (value)); + UNTIL null (id) AND null (value) PER. + +END PROC dump oblist; + + +END PACKET lisp heap maintenance; + + + +PACKET lisp interpreter (* Autor: J.Durchholz *) + (* Datum: 27.12.1982 *) + DEFINES (* Version 3.1.7 *) + evalquote, + apply, + eval, + try: + + +(* SYM-objects used by the interpreter. They all point to constant structure + within the heap. As their address may change during garbage collection, + it must be possible to correct the references to them made by the + SYM-objects. That is the reason why they are declared VAR instead of CONST*) +SYM VAR lambda constant, + label constant, + quote constant, + function constant, + indefinite constant, + apval constant, + true constant, + false constant; + +SYM VAR errors; +BOOL VAR trace :: FALSE; + +PROC initialize constants: + lambda constant := new atom ("LAMBDA"); + label constant := new atom ("LABEL"); + quote constant := new atom ("QUOTE"); + function constant := new atom ("FUNCTION"); + indefinite constant := new atom ("INDEFINITE"); + apval constant := new atom ("APVAL"); + true constant := new atom ("T"); + false constant := new atom ("F"); + errors := new atom ("ERRORS") +END PROC initialize constants; + + +SYM PROC evalquote (SYM CONST expr): (*hey*) + enable stop; + initialize constants; + x apply ( head (expr), quote (tail (expr)), nil ) +END PROC evalquote; + + +SYM PROC quote (SYM CONST x): + IF eq (x,nil) THEN nil + ELSE set head (x, new head); set tail (x, quote (tail(x))); x + FI . +new head: + cons (quote constant, cons (head(x), nil) ) +END PROC quote; + + +SYM PROC apply (SYM CONST function, argument list, alist): + enable stop; + initialize constants; + x apply (function, argument list, alist) +END PROC apply; + + +SYM PROC x apply (SYM CONST function, argument list, alist): + IF trace THEN line; + put ("a p p l y :"); put (function); line; + put ("arguments :"); put (argument list); line; + FI; + SYM VAR new alist; + initialize for alist insertion; + reduce actual fn to lambda expression; + insert parameter evaluated argument pairs in reversed order in new alist; + function body evaluation. + +reduce actual fn to lambda expression: + SYM VAR actual fn :: function; + REP + IF is named atom (actual fn) THEN + get function from property list of actual fn + or from functional alist entry + ELIF atom (actual fn) THEN + error stop ("Eine Funktion darf kein unbenanntes Atom sein") + ELSE + IF eq (head (actual fn), lambda constant) THEN + LEAVE reduce actual fn to lambda expression + ELIF eq (head (actual fn), label constant) THEN + get function from label expression and update alist + ELSE + error stop ("Funktion ist weder Atom noch LAMBDA-/LABEL-Ausdruck") + FI + FI + PER. + +get function from property list of actual fn or from functional alist entry: + IF property exists (actual fn, function constant) THEN + get function from property list of actual fn + ELSE + get function from functional alist entry + FI. + +get function from property list of actual fn: + actual fn := property (actual fn, function constant). + +get function from functional alist entry: + SYM VAR actual alist entry; + begin alist retrieval; + REP + IF end of alist THEN + error stop ("Die Funktion " + name (actual fn) + + " ist nicht definiert") + FI; + search for next functional alist entry; + UNTIL eq (head (actual functional alist entry), actual fn) PER; + actual fn := tail (actual functional alist entry). + +get function from label expression and update alist: + actual fn := tail (actual fn); + IF atom (actual fn) COR + (NOT atom (head (actual fn)) OR atom (tail (actual fn))) COR + NOT null (tail (tail (actual fn))) THEN + error stop ("Ungueltiger LABEL-Ausdruck") + FI; + SYM VAR new alist entry; + prepare new functional alist entry; + set head (new alist entry, head (actual fn)); + actual fn := head (tail (actual fn)); + set tail (new alist entry, actual fn). + +insert parameter evaluated argument pairs in reversed order in new alist: + actual fn := tail (actual fn); + IF atom (actual fn) THEN + error stop ("Ungueltiger LAMBDA-Ausdruck") + FI; + SYM VAR parameter list rest :: head (actual fn), + argument list rest :: argument list; + actual fn := tail (actual fn); + WHILE NOT null (parameter list rest) REP + add next parameter argument pair to alist + PER; + check wether no arguments are left over. + +add next parameter argument pair to alist: + IF atom (parameter list rest) THEN + error stop ("Parameterliste endet falsch") + FI; + SYM VAR param pointer :: head (parameter list rest); + parameter list rest := tail (parameter list rest); + IF is named atom (param pointer) AND NOT null (param pointer) THEN + add parameter evaluated argument pair to alist; + advance argument list rest + ELIF atom (param pointer) THEN + error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein") + ELSE + IF eq (head (param pointer), indefinite constant) THEN + check wether is last param; + advance param pointer; + IF eq (head (param pointer), quote constant) THEN + advance param pointer; + move param pointer to parameter; + add parameter indefinite quoted argument pair to alist + ELSE + move param pointer to parameter; + add parameter indefinite evaluated argument pair to alist + FI; + argument list rest := nil + ELIF eq (head (param pointer), quote constant) THEN + advance param pointer; + move param pointer to parameter; + add parameter quoted argument pair to alist; + advance argument list rest + ELIF eq (head (param pointer), function constant) THEN + advance param pointer; + move param pointer to parameter; + add parameter functional argument pair to alist; + advance argument list rest + ELSE + error stop ("Ungueltiger Parameter") + FI + FI. + +advance param pointer: + param pointer := tail (param pointer); + IF atom (param pointer) THEN + error stop ("Ungueltiger Parameter") + FI. + +move param pointer to parameter: + IF NOT null (tail (param pointer)) THEN + error stop ("Ungueltiger Parameter") + FI; + param pointer := head (param pointer); + IF NOT atom (param pointer) OR null (param pointer) THEN + error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein") + FI. + +advance argument list rest: + argument list rest := tail (argument list rest). + +add parameter evaluated argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, x eval (actual argument, alist)). + +check wether is last param: + IF NOT null (parameter list rest) THEN + error stop ("Ein INDEFINITE-Parameter muss der letzte sein") + FI. + +add parameter indefinite quoted argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, argument list rest); + WHILE NOT atom (argument list rest) REP + argument list rest := tail (argument list rest) + PER; + IF NOT null (argument list rest) THEN + error stop ("Argumentliste endet falsch") + FI. + +add parameter indefinite evaluated argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + last evaluated argument := new alist entry; + WHILE NOT atom (argument list rest) REP + set tail (last evaluated argument, + cons (x eval (head (argument list rest), alist), nil)); + last evaluated argument := tail (last evaluated argument); + advance argument list rest + PER; + IF NOT null (argument list rest) THEN + error stop ("Argumentliste endet falsch") + FI. + +last evaluated argument: + param pointer. +(* The value of param pointer is not used further, so the *) +(* variable can be "reused" in this manner. *) + +add parameter quoted argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, actual argument). + +add parameter functional argument pair to alist: + prepare new functional alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, actual argument). + +actual argument: + IF atom (argument list rest) THEN + IF null (argument list rest) THEN + error stop ("Zuwenig Argumente") + ELSE + error stop ("Argumentliste endet falsch") + FI + FI; + head (argument list rest). + +check wether no arguments are left over: + IF NOT null (argument list rest) THEN + error stop ("Zuviele Argumente") + FI. + +function body evaluation: + IF is int pair (actual fn) THEN + predefined function evaluation + ELIF atom (actual fn) COR NOT null (tail (actual fn)) THEN + error stop ("Ungueltiger LAMBDA-Ausdruck"); nil + ELSE + x eval (head (actual fn), new alist) + FI. + +predefined function evaluation: + SELECT int 1 (actual fn) OF + CASE 0: call eval cond + CASE 1: call begin oblist dump + CASE 2: call next atom + CASE 3: call add property + CASE 4: call alter property + CASE 5: call delete property + CASE 6: call property exists + CASE 7: call property + CASE 8: call add flag + CASE 9: call flag + CASE 10: call delete flag + CASE 11: call begin property list dump + CASE 12: call next property + CASE 13: call apply + CASE 14: call eval + CASE 15: call try + CASE 16: give association list + CASE 17: call error stop + CASE 18: call head + CASE 19: call set head + CASE 20: call tail + CASE 21: call set tail + CASE 22: call cons + CASE 23: call eq + CASE 24: call get sym + CASE 25: call put sym + CASE 26: call null + CASE 27: call is atom + CASE 28: call is named atom + CASE 29: call get named atom + CASE 30: call put named atom + CASE 31: call is text + CASE 32: call get text + CASE 33: call put text + CASE 34: call is character + CASE 35: call get character + CASE 36: call put character + CASE 37: call is int + CASE 38: call get int + CASE 39: call put int + CASE 40: call sum + CASE 41: call difference + CASE 42: call product + CASE 43: call quotient + CASE 44: call remainder + CASE 45: call equal + CASE 46: call trace + CASE 47: call define + CASE 48: call set + OTHERWISE error stop("Es gibt (noch) keine LISP-Funktion mit der Nummer" + + text (int 1 (actual fn)) ); nil + END SELECT. + +call eval cond: + x eval condition (arg 1, alist). + +call begin oblist dump: + begin oblist dump; nil. + +call next atom: + next atom. + +call add property: + add property (arg 3, arg 2, arg 1); arg 1. + +call alter property: + alter property (arg 3, arg 2, arg 1); arg 1. + +call delete property: + delete property (arg 2, arg 1); nil. + +call property exists: + IF property exists(arg 2,arg 1) THEN true constant ELSE false constant FI. + +call property: + property (arg 2, arg 1). + +call add flag: + add flag (arg 2, arg 1); nil. + +call flag: + IF flag (arg 2, arg 1) THEN true constant ELSE false constant FI. + +call delete flag: + delete flag (arg 2, arg 1); nil. + +call begin property list dump: + begin property list dump (arg 1); nil. + +call next property: + SYM VAR s1, s2; next property (s1, s2); cons (s1, s2). + +call apply: + x apply (arg 3, arg 2, arg 1). + +call eval: + x eval (arg 2, arg 1). + +call try: + x try (arg 4, arg 3, arg 2, arg 1). + +give association list: + alist. + +call error stop: + error stop (text (arg 1)); nil. + +call head: + head (arg 1). + +call set head: + set head (arg 2, arg 1); arg 2. + +call tail: + tail (arg 1). + +call set tail: + set tail (arg 2, arg 1); arg 2. + +call cons: + cons (arg 2, arg 1). + +call eq: + IF eq (arg 2, arg 1) THEN true constant ELSE false constant FI. + +call get sym: + get (s1); s1. + +call put sym: + put (arg 1); arg 1. + +call null: + IF null (arg 1) THEN true constant ELSE false constant FI. + +call is atom: + IF atom (arg 1) THEN true constant ELSE false constant FI. + +call is named atom: + IF is named atom (arg 1) THEN true constant ELSE false constant FI. + +call get named atom: + TEXT VAR t; get (t); new atom (t). + +call put named atom: + put (name (arg 1)); arg 1. + +call is text: + IF is text (arg 1) THEN true constant ELSE false constant FI. + +call get text: + get (t); sym (t). + +call put text: + put (text (arg 1)); arg 1. + +call is character: + IF is character (arg 1) THEN true constant ELSE false constant FI. + +call get character: + inchar (t); sym character (code (t)). + +call put character: + out (code (character (arg 1))); arg 1. + +call is int: + IF is int pair (arg 1) THEN true constant ELSE false constant FI. + +call get int: + INT VAR i; get (i); sym (i, -1). + +call put int: + put (int 1 (arg 1)); arg 1. + +call sum: + sum (arg 1). + +call difference: + difference (arg 2, arg 1). + +call product: + product (arg 1). + +call quotient: + quotient (arg 2, arg 1). + +call remainder: + remainder(arg 2, arg 1). + +call equal: + IF equal (arg 2, arg 1) THEN true constant ELSE false constant FI. + +call trace: + trace := NOT trace; + IF trace THEN true constant ELSE false constant FI . + +call define: (*hey*) + define (arg 1) . + +call set: (*hey*) + add property (new atom ( name (arg 2)), apval constant, arg 1); arg 1 . + +arg 1: + tail (head (new alist)). + +arg 2: + tail (head (tail (new alist))). + +arg 3: + tail (head (tail (tail (new alist)))). + +arg 4: + tail (head (tail (tail (tail (new alist))))). + +END PROC x apply; + +SYM PROC define (SYM CONST x): (*hey*) + IF eq (x, nil) THEN nil + ELSE add property (new atom (name (head (head (x)))), + function constant, tail (head (x)) ); + cons (head (head (x)), define (tail (x)) ) + FI . +END PROC define; + +SYM VAR old alist :: nil; + +SYM PROC eval (SYM CONST expression, alist): + enable stop; + initialize constants; + x eval (expression, alist) +END PROC eval; + + +SYM PROC x eval (SYM CONST expression, alist): (*hey*) + IF trace THEN line; + put ("e v a l :"); put (expression); line; + IF NOT equal (alist, old alist) THEN + put ("bindings :"); old alist := alist; put (alist); line FI + FI; + IF atom (expression) THEN + IF is named atom (expression) THEN + value from property list of expression or from alist entry + ELSE + expression + FI + ELSE + x apply (head (expression), tail (expression), alist) + FI. + +value from property list of expression or from alist entry: + IF property exists (expression, apval constant) THEN + value from property list of expression + ELSE + value from alist entry + FI. + +value from property list of expression: + property (expression, apval constant). + +value from alist entry: + SYM VAR actual alist entry; + begin alist retrieval; + REP + IF end of alist THEN + error stop ("Das Atom " + name (expression) + " hat keinen Wert") + FI; + search for next alist entry + UNTIL eq (head (actual alist entry), expression) PER; + tail (actual alist entry). + +END PROC x eval; + + +SYM PROC try (SYM CONST expression list, alist, + error output, break possible): + enable stop; + initialize constants; + x try (expression list, alist, error output, break possible) +END PROC try; + + +SYM PROC x try (SYM CONST expression list, alist, + error output, break possible): + BOOL CONST output :: bool (error output), + halt enabled :: bool (break possible); + SYM VAR expr list rest :: expression list; + REP + IF null (expr list rest) THEN + LEAVE x try WITH nil + ELIF atom (expr list rest) THEN + error stop ("Ausdrucksliste fuer 'try' endet falsch") + ELSE + try evaluation of actual expression + FI; + expr list rest := tail (expr list rest) + PER; + nil. + +try evaluation of actual expression: + disable stop; + SYM VAR result :: x eval (head (expr list rest), alist); + IF is error THEN + IF error message = "halt from terminal" AND halt enabled THEN + enable stop + ELIF output THEN + put error + FI; + add property (errors, apval constant, sym (error message)); + clear error + ELSE + LEAVE x try WITH result + FI; + enable stop. + +END PROC x try; + + +SYM PROC x eval condition (SYM CONST pair list, alist): + enable stop; + SYM VAR cond pair list rest :: pair list; + REP + IF atom (cond pair list rest) THEN + error stop ("Keine 'T'-Bedingung in bedingtem Ausdruck gefunden") + FI; + check wether is correct pair; + IF true condition found THEN + LEAVE x eval condition WITH x eval (head (tail (actual pair)), alist) + FI; + cond pair list rest := tail (cond pair list rest) + PER; + nil. + +check wether is correct pair: + IF atom (actual pair) COR + atom (tail (actual pair)) COR + NOT null (tail (tail (actual pair))) THEN + error stop ("Ungueltiges Paar im bedingten Ausdruck") + FI. + +true condition found: + bool (x eval (head (actual pair), alist)). + +actual pair: + head (cond pair list rest). + +END PROC x eval condition; + + +BOOL PROC bool (SYM CONST sym): + IF eq (sym, true constant) THEN + TRUE + ELIF eq (sym, false constant) THEN + FALSE + ELSE + error stop ("'T' oder 'F' erwartet"); TRUE + FI +END PROC bool; + + +(******* a-list handling refinements used in 'x apply' and 'x eval' *******) + +(* declared within 'x apply' and 'x eval': 'actual alist entry' *) + +. + +initialize for alist insertion: + new alist := alist. + +begin alist retrieval: + SYM VAR actual alist pos :: alist. + +search for next alist entry: + WHILE NOT end of alist REP + IF atom (actual alist pos) THEN + error stop ("Bindeliste endet falsch") + FI; + actual alist entry := head (actual alist pos); + actual alist pos := tail (actual alist pos); + UNTIL is non functional alist entry PER. + +is non functional alist entry: + NOT is functional alist entry. + +search for next functional alist entry: + WHILE NOT end of alist REP + IF atom (actual alist pos) THEN + error stop ("Bindeliste endet falsch") + FI; + actual alist entry := head (actual alist pos); + actual alist pos := tail (actual alist pos); + UNTIL is functional alist entry PER; + actual alist entry := tail (actual alist entry). + +is functional alist entry: + check wether is alist entry; + null (head (actual alist entry)). + +check wether is alist entry: + IF atom (actual alist entry) THEN + error stop ("Bindelisteneintrag ist kein Paar") + FI. + +end of alist: + null (actual alist pos). + +actual functional alist entry: + actual alist entry. + +prepare new alist entry: + new alist := cons (cons (nil, nil), new alist); + new alist entry := head (new alist). + +prepare new functional alist entry: + new alist := cons (cons (nil, cons (nil, nil)), new alist); + new alist entry := tail (head (new alist)). + + +END PACKET lisp interpreter; + + diff --git a/lang/lisp/1.7.2/src/lisp.bootstrap b/lang/lisp/1.7.2/src/lisp.bootstrap new file mode 100644 index 0000000..f28aae8 --- /dev/null +++ b/lang/lisp/1.7.2/src/lisp.bootstrap @@ -0,0 +1,117 @@ +NIL APVAL +NIL +T APVAL +T +F APVAL +F +COND FUNCTION +(LAMBDA ((INDEFINITE QUOTE X)) . 0) +BEGINOBLISTDUMP FUNCTION +(LAMBDA () . 1) +NEXTATOM FUNCTION +(LAMBDA () . 2) +ADDPROPERTY FUNCTION +(LAMBDA (X X X) . 3) +ALTERPROPERTY FUNCTION +(LAMBDA (X X X) . 4) +DELETEPROPERTY FUNCTION +(LAMBDA (X X) . 5) +PROPERTYEXISTS FUNCTION +(LAMBDA (X X) . 6) +PROPERTY FUNCTION +(LAMBDA (X X) . 7) +ADDFLAG FUNCTION +(LAMBDA (X X) . 8) +FLAG FUNCTION +(LAMBDA (X X) . 9) +DELETEFLAG FUNCTION +(LAMBDA (X X) . 10) +BEGINPROPERTYLISTDUMP FUNCTION +(LAMBDA (X) . 11) +NEXTPROPERTY FUNCTION +(LAMBDA () . 12) +APPLY FUNCTION +(LAMBDA (X X X) . 13) +EVAL FUNCTION +(LAMBDA (X X) . 14) +TRY FUNCTION +(LAMBDA (X X X X) . 15) +ASSOCIATIONLIST FUNCTION +(LAMBDA () . 16) +ERRORSTOP FUNCTION +(LAMBDA (X) . 17) +HEAD FUNCTION +(LAMBDA (X) . 18) +SETHEAD FUNCTION +(LAMBDA (X X) . 19) +TAIL FUNCTION +(LAMBDA (X) . 20) +SETTAIL FUNCTION +(LAMBDA (X X) . 21) +CONS FUNCTION +(LAMBDA (X X) . 22) +EQ FUNCTION +(LAMBDA (X X) . 23) +GET FUNCTION +(LAMBDA () . 24) +PUT FUNCTION +(LAMBDA (X) . 25) +NULL FUNCTION +(LAMBDA (X) . 26) +ATOM FUNCTION +(LAMBDA (X) . 27) +NAMEDATOM FUNCTION +(LAMBDA (X) . 28) +GETATOM FUNCTION +(LAMBDA () . 29) +PUTATOM FUNCTION +(LAMBDA (X) . 30) +TEXT FUNCTION +(LAMBDA (X) . 31) +GETTEXT FUNCTION +(LAMBDA () . 32) +PUTTEXT FUNCTION +(LAMBDA (X) . 33) +CHARACTER FUNCTION +(LAMBDA (X) . 34) +GETCHARACTER FUNCTION +(LAMBDA () . 35) +PUTCHARACTER FUNCTION +(LAMBDA (X) . 36) +INT FUNCTION +(LAMBDA (X). 37) +GETINT FUNCTION +(LAMBDA () . 38) +PUTINT FUNCTION +(LAMBDA (X) . 39) +SUM FUNCTION +(LAMBDA ((INDEFINITE X)) . 40) +DIFFERENCE FUNCTION +(LAMBDA (X X). 41) +PRODUCT FUNCTION +(LAMBDA ((INDEFINITE X)). 42) +QUOTIENT FUNCTION +(LAMBDA (X X).43) +REMAINDER FUNCTION +(LAMBDA (X X).44) +EQUAL FUNCTION +(LAMBDA (X X) . 45) +TRACE FUNCTION +(LAMBDA () . 46 ) +DEFINE FUNCTION +(LAMBDA ((INDEFINITE X)) . 47 ) +SET FUNCTION +(LAMBDA (X X) . 48 ) +QUOTE FUNCTION +(LAMBDA ((QUOTE X)) X) +LIST FUNCTION +(LAMBDA ((INDEFINITE X)) X) +DO FUNCTION +(LAMBDA ((INDEFINITE X)) NIL) +PUTLIST FUNCTION +(LAMBDA ((INDEFINITE X)) + (COND + ((NULL X) NIL) + (T (DO (PUT (HEAD X)) (PUTLIST (TAIL X)))) + ) +) diff --git a/lang/lisp/1.8.7/doc/lisp handbuch b/lang/lisp/1.8.7/doc/lisp handbuch new file mode 100644 index 0000000..022c561 --- /dev/null +++ b/lang/lisp/1.8.7/doc/lisp handbuch @@ -0,0 +1,2260 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#Lisp + + + + +#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(7.0)# +#center#LISP - Handbuch +#free(2.0)# +Stand: 08.08.86 + +Installation von LISP + +begin ("LISP") +reserve ("sprachen",archive) +fetch all(archive) +insert ("lisp.1") +insert ("lisp.2") +insert ("lisp.3") +insert ("lisp.4") +global manager +begin ("lisp","LISP") +fetch ("lisp.bootstrap") +lisp +#page# +#start(2.5,1.5)# +#block# +#pageblock# +#head# +#center#LISP-Handbuch +#center#% + + +#end# + + +#center#L I S P H a n d b u c h + + +#center#Autor: John Mc.Carthy (M.I.T.1962) +#center#übersetzt und angepaßt von J.Durchholz, P.Heyderhoff +#center#Gesellschaft für Mathematik und Datenverarbeitung Sankt Augustin + + + +Inhaltsverzeichnis + + + +1. Die Sprache LISP #right##topage("p1")# + +1.1 Symbolische Ausdrücke #right##topage("p1.1")# +1.2 Elementare Funktionen #right##topage("p1.2")# +1.3 Listen Notation #right##topage("p1.3")# +1.4 Syntax und Semantik der Sprache #right##topage("p1.4")# + +2. Das LISP-Interpreter-System #right##topage("p2")# + +2.1 Die universelle LISP-Funktion "evalquote" #right##topage("p2.1")# +2.2 Anwendungsregeln und Beispiele #right##topage("p2.2")# +2.3 Variablen #right##topage("p2.3")# +2.4 Konstanten #right##topage("p2.4")# +2.5 Funktionen #right##topage("p2.5")# + +3. Erweitertes LISP #right##topage("p3")# + +3.1 Gequotete Parameter #right##topage("p3.1")# +3.2 Funktionen mit beliebig vielen Parametern #right##topage("p3.2")# +3.3 Funktionale Parameter #right##topage("p3.3")# +3.4 Prädikate und boolesche Konstanten #right##topage("p3.4")# +3.5 Unbenannte Atome #right##topage("p3.5")# +3.6 Aufruf von EUMEL aus #right##topage("p3.6")# + +4. Detailbeschreibungen #right##topage("p4")# + +4.1 Grundfunktionen #right##topage("p4.1")# +4.2 Weitere Funktionen sowie Eingabe und Ausgabe #right##topage("p4.2")# +4.3 Interpreter #right##topage("p4.3")# +4.4 Kommandoprozeduren #right##topage("p4.4")# +#page# + +1. Die Sprache LISP#goalpage("p1")# + + + +Die Sprache LISP ist primär für die Symbolmanipulation entworfen. Sie wurde für +symbolische Berechnungen in verschiedenen Gebieten der künstlichen Intelligenz +eingesetzt, u.a. für Differential- und Integralrechnung, Schaltkreistheorie, Mathemati­ +sche Logik, Spiele, etc.. + +LISP ist eine formale mathematische Sprache. Daher ist es möglich, eine genaue und +vollständige Beschreibung zu geben. Das ist der Sinn des ersten Abschnitts dieses +Handbuchs. Andere Abschnitte werden Möglichkeiten zum vorteilhaften Einsatz von +LISP und die Erweiterungen, die die Benutzung erleichtern, beschreiben. + +LISP unterscheidet sich von den meisten Programmiersprachen in drei Punkten. + +Der erste Punkt liegt in der Natur der Daten. In der Sprache LISP haben alle Daten +die Form symbolischer Ausdrücke, die wir verkürzend LISP-Ausdrücke nennen wer­ +den. LISP-Ausdrücke haben keine Längenbegrenzung und eine verzweigte Baum­ +struktur, so daß Unterausdrücke leicht isoliert werden können. In LISP wird der meiste +Speicherplatz für das Abspeichern der LISP-Ausdrücke in Form von Listenstruktu­ +ren gebraucht. + +Der zweite wichtige Teil der Sprache LISP ist die Quellsprache, die festlegt, wie die +LISP-Ausdrücke verarbeitet werden sollen. + +Drittens kann LISP als LISP-Ausdrücke geschriebene Programme interpretieren und +ausführen. Deshalb kann man die Sprache analog zu Assemblersprachen und im +Gegensatz zu den meisten anderen höheren Programmiersprachen einsetzen, um +Programme zu generieren, die gleich ausgeführt werden sollen. + + +#page# + +1.1 Symbolische Ausdrücke #goalpage("p1.1")# + + + +Ein elementarer Ausdruck ist ein Atom. + +Definition: Ein Atom ist eine Zeichenkette bestehend aus Großbuchstaben und + Ziffern. + + +Beispiele: A + APFEL + TEIL2 + EXTRALANGEZEICHENKETTEAUSBUCHSTABEN + A4B66XYZ2 + + +Diese Symbole werden atomar genannt, weil sie als Ganzes aufgefaßt werden, das +durch die LISP-Funktionen nicht weiter geteilt werden kann. A, B, und AB haben +keinerlei Beziehung zueinander, außer der, daß sie alle verschiedene Atome sind. + +Alle LISP-Ausdrücke werden aus Atomen und den Satzzeichen "(", ")" und "." +aufgebaut. Die grundlegende Operation zum Aufbau von LISP-Ausdrücken ist die, +zwei LISP-Ausdrücke zusammenzufassen, um einen größeren herzustellen. Aus den +zwei Atomen A und B kann man so den LISP-Ausdruck (A.B) bilden. + +Definition: Ein LISP-Ausdruck ist entweder ein Atom, oder aus folgenden Elemen­ + ten in dieser Reihenfolge aufgebaut: Eine öffnende Klammer, ein + LISP-Ausdruck, ein Punkt, ein LISP-Ausdruck, eine schließende + Klammer. Zwischen den Bestandteilen eines nichtatomaren LISP-Aus­ + druck können beliebig viele Leerzeichen eingestreut sein. + +Diese Definition ist rekursiv. + + +Beispiele: ATOM + (A . B) + (A . (B . C)) + ((A1 . A2) . B) + ((U . V) . (X . Y)) + ((U . V) . (X . (Y . Z))) + + +Um die Struktur solcher Ausdrücke zu verdeutlichen, wird in diesem Handbuch oft +eine graphische Darstellung gewählt. In dieser Darstellung sind die Atome weiterhin +Zeichenketten, statt der Paare steht jetzt aber ein Kasten + + + +-----+-----+ + | o | o | + +-----+-----+ + + +von dem zwei Zeiger ausgehen, die auf die graphische Darstellung des ersten bzw. +zweiten Elements des Paars zeigen. + + + +Beispiele: (A . B) +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + A B + + (A . (B . C)) +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + A +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + B C + + ((U . V) . (X . (Y . Z))) +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + +-----+-----+ +-----+-----+ + | o | o | | o | o | + +--+--+--+--+ +--+--+--+--+ + | | | | + V V V V + U V X +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + Y Z + + + + + + +#page# + +1.2 Elementare Funktionen #goalpage("p1.2")# + + +Wir werden einige elementare Funktionen auf LISP-Ausdrücken einführen. Um die +Funktionen von den LISP-Ausdrücken zu unterscheiden, werden wir Funktionsnamen +mit Klein- statt Großbuchstaben schreiben. Außerdem steht der Funktionsname +gefolgt von den Argumenten, auf die die Funktion angewendet werden soll, in Klam­ +mern eingeschlossen in einer Liste. Dabei sind die Argumente durch Blanks vonein­ +ander getrennt. + +Die erste Funktion, die wir einführen, heißt "cons". Sie hat zwei Argumente und wird +dafür benutzt, LISP-Ausdrücke aus kleineren LISP-Ausdrücken aufzubauen. + + + Funktionsaufruf: Ergebnis: + +Beispiele: (cons A B) = (A . B) + (cons (A . B) C) = ((A . B) . C) + (cons (cons A B) C) = ((A . B) . C) + + +Die Beispiele zeigen Funktionsaufrufe. Ein Funktionsaufruf ist eine Liste beginnend +mit einem Funktionsnamen, gefolgt von Argumenten. Alle Funktionsaufrufe haben ein +Ergebnis, das im Fall von LISP-Funktionen immer ein LISP-Ausdruck ist. + +In diesen Beispielen kommt nur die Funktion "cons" vor. Das letzte Beispiel ist ein +Fall von Funktionsverkettung, das heißt, als Argument steht ein Funktionsaufruf. Um +das Ergebnis eines Funktionsaufrufs zu berechnen, das Funktionsaufrufe als Argu­ +mente enthält, muß man statt dieser Argumente die Ergebnisse dieser Funktionsaufru­ +fe einsetzen, so daß man den äußeren Funktionsaufruf in einen Aufruf ohne Funk­ +tionsaufrufe als Argumente umwandelt. + + +Beispiel: (cons (cons A B) C) = (cons (A . B) C) = ((A . B) . C) + + +Es ist möglich, durch Verkettung der Funktion "cons" jeden LISP-Ausdruck aus +seinen atomaren Komponenten aufzubauen. + +Die folgenden beiden Funktionen tun das genaue Gegenteil von "cons": sie liefern +die Unterausdrücke eines gegebenen LISP-Ausdrucks. + +Die Funktion "head" hat ein Argument. Ihr Wert ist der erste Unterausdruck des +zusammengesetzen Arguments. Der "head" eines Atoms ist nicht definiert. + + +Beispiele: (head (A . B)) = A + (head (A . (B1 . B2))) = A + (head ((A1 . A2) . B)) = (A1 . A2) + (head A) ist nicht definiert + + +Die Funktion "tail" hat ebenfalls ein Argument, und sie liefert das Argument bis auf +dessen "head". + + +Beispiele: (tail (A . B)) = B + (tail (A . (B1 . B2))) = (B1 . B2) + (tail ((A1 . A2) . B)) = B + (tail A) ist nicht definiert + (head (tail (A . (B1 . B2)))) = B1 + (head (tail (A . B))) ist nicht definiert + (head (cons A B)) = A + + +Es ist bei jedem LISP-Ausdruck möglich, durch eine geeignete Verkettung von +"head" und "tail" zu jedem Atom im Ausdruck zu gelangen. + +Wenn "x" und "y" irgendwelche LISP-Ausdrücke repräsentieren, gelten die folgen­ +den Gleichungen immer: + + + (head (cons x y)) = x + (tail (cons x y)) = y + + +Außerdem gilt die folgende Gleichung für jeden nichtatomaren LISP-Ausdruck "z": + + + (cons (head z) (tail z)) = z +9 + +Die Symbole "x", "y" und "z", die wir in diesen Gleichungen benutzt haben, nennt +man Variablen. In LISP werden Variable benutzt, um LISP-Ausdrücke zu repräsentie­ +ren, und zwar repräsentiert eine Variable in einer Gleichung immer denselben +LISP-Ausdruck. Variablennamen werden wie Funktionsnamen gebildet, d.h. sie +können Kleinbuchstaben und Ziffern enthalten. + +Eine Funktion, deren Wert "wahr" oder "falsch" sein kann, wird Prädikat genannt. In +LISP werden die Werte "wahr" und "falsch" durch die Atome "T" (true) und "F" +(false) vertreten. Ein LISP-Prädikat ist also eine Funktion, deren Wert entweder "T" +oder "F" ist. + +Das Prädikat "eq" ist ein Gleichheitstest für Atome. Es ist bei nicht atomaren Argu­ +menten nicht definiert. + + +Beispiele: (eq A A) = T + (eq A B) = F + (eq A (A . B)) ist nicht definiert + (eq (A . B) B) ist nicht definiert + (eq (A . B) (A . B)) ist nicht definiert + + +Das Prädikat "atom" hat das Ergebnis ("liefert") "T", wenn sein Argument atomar ist, +und "F", wenn sein Argument zusammengesetzt ist. + + +Beispiele: (atom EXTRALANGEZEICHENKETTE) = T + (atom (U . V)) = F + (atom (head (U . V))) = T + +#page# + +1.3 Listen-Notation #goalpage("p1.3")# + + + +Alle LISP-Ausdrücke, die wir bisher gesehen haben, waren in Punkt-Notation +geschrieben. Normalerweise ist es allerdings einfacher, statt der vielen Punkte und +Klammern Listen von LISP-Ausdrücken zu schreiben, etwa in der Art (A B C XYZ). + +LISP bietet eine solche Alternative zur Punkt-Notation an: + +Definition: Die Liste (a1 a2 ... an) ist äquivalent zum LISP-Ausdruck + (a1 . (a2 . (... . (an . NIL) ... ))). + +Graphisch ausgedrückt heißt das: + + + +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + a1 +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + a2 + . + . + . + + +-----+-----+ + | o | o | + +--+--+--+--+ + | | + V V + an NIL + + + +Oft werden wir für Listen auch die graphische Form + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+--> . . . | o | o--+--> NIL + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + a1 a2 an + + +benutzen. + +Aus der Graphik wird deutlich, daß NIL als eine Art Abschlußmarkierung für Listen +dient. + +Eine leere Liste wird durch das Atom NIL dargestellt. Das Prädikat "null" liefert "T", +wenn sein Argument eine leere Liste ist, sonst "F". + + +Beispiele: (null NIL) = T + (null () ) = T + (null (A B)) = F + + +Die Listenelemente können selbst wieder Listen oder Paare in Punkt-Notation sein, +so daß Listen- und Punkt-Notation beliebig kombinierbar sind. + + + Beispiele: (A B C) = (A . (B . (C . NIL))) + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+-->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + A B C + + ((A . B) C) = ((A . B) . (C . NIL)) + + +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ + | | + V V + +-----+-----+ C + | o | o | + +--+--+--+--+ + | | + V V + A B + + ((A B) C) = ((A . (B . NIL)) . (C . NIL)) + + +-----+-----+ +-----+-----+ + | o | o--+--------------->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ + | | + | V + V C + +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ + | | + V V + A B + + (A) = (A . NIL) + + +-----+-----+ + | o | o--+--> NIL + +--+--+-----+ + | + V + A + + ((A)) = ((A . NIL) . NIL) + + +-----+-----+ + | o | o--+--> NIL + +--+--+-----+ + | + V + +-----+-----+ + | o | o--+--> NIL + +--+--+-----+ + | + V + A + + + + + +Es ist sehr hilfreich, mit den Ergebnissen der elementaren Funktionen vertraut zu +sein, wenn diese Listen als Argumente erhalten. Zwar können die Ergebnisse notfalls +immer durch Übersetzung in Punkt-Notation bestimmt werden, aber ein direktes +Verständnis ist einfacher. + + +Beispiele: (head (A B C)) = A + (tail (A B C)) = (B C) + + + (Daher auch die Namen "head" und "tail"! Frei übersetzt heißen die + beiden Funktionen "anfang" und "rest".) + + + (cons A (B C)) = (A B C) + +#page# + +1.4 Syntax und Semantik der Sprache #goalpage("p1.4")# + + + +Wir haben bisher einen Datentyp (LISP-Ausdrücke) und fünf elementare Funktionen +eingeführt. Außerdem haben wir die folgenden Eigenschaften der Sprache beschrie­ +ben: + +1. Funktions- und Variablennamen werden wie die Namen von Atomen geschrie­ + ben, außer, daß dafür Klein- statt Großbuchstaben verwendet werden. +2. Die Argumente einer Funktion folgen dieser in der Liste. Eine solche Liste von + Funktion und folgenden Argumenten heißt Funktionsaufruf und hat einen LISP- + Ausdruck als Ergebnis. +3. Funktionen können dadurch verkettet werden, daß ein Argument aus einem Funk­ + tionsaufruf selbst wieder ein Funktionsaufruf ist, dessen Argumente selbst wieder + Funktionsaufrufe sein können, usw. + +Diese Regeln erlauben es, Funktionsdefinitionen wie + + + (third x) = (head (tail (tail x))) + + +zu schreiben. "third" holt das dritte Element aus einer Liste. + +Die Klasse der Funktionen, die man auf diese Weise bilden kann, ist ziemlich be­ +schränkt und nicht sehr interessant. Eine viel größere Funktionenklasse kann man mit +Hilfe des bedingten Ausdrucks schreiben; es handelt sich dabei um eine Möglichkeit, +Verzweigungen in Funktionsdefinitionen einzubauen. + +Ein bedingter Ausdruck hat die Form + + + (cond (p1 a1) (p2 a2) ... (pn an) ) + + +Jedes pi ist ein Ausdruck, dessen Wert "T" oder "F" ist, also ein Prädikat. Die ai +sind beliebige LISP-Ausdrücke. + +Die Bedeutung eines bedingten Ausdrucks ist folgende: Wenn p1 wahr ist, ist a1 der +Wert des ganzen Ausdrucks. Wenn p1 falsch ist, wird getestet, ob p2 wahr ist; wenn +das der Fall ist, ist a2 der Wert des Ausdrucks. Die pi werden also von links nach +rechts durchgegangen, bis ein wahrer Ausdruck gefunden ist; das zugehörige ai ist +dann der Wert des bedingten Ausdrucks. Wenn kein wahres pi gefunden ist, ist der +bedingte Ausdruck nicht definiert. +Jedes pi oder ai kann selbst wieder ein LISP-Ausdruck, ein Funktionsaufruf oder ein +bedingter Ausdruck sein. + + +Beispiel: (cond ((eq (head x) A) (cons B (tail x))) (T x) ) + + +Das Prädikat "T" ist immer wahr. Man liest es am besten als "SONST". Den Wert +dieses Ausdruck erhält man, wenn man "head" von x durch B ersetzt, wenn der +gerade gleich mit A ist, und sonst erhält man x. + +Der Hauptzweck von bedingten Ausdrücken ist die rekursive Definition von Funktio­ +nen. + + +Beispiel: (firstatom x) = (cond ((atom x) x) + ( T (firstatom (head x))) + ) + + +Dies Beispiel definiert die Funktion "firstatom", die das erste Atom jedes LISP-Aus­ +drucks bestimmt. Diesen Ausdruck kann man so lesen: wenn "x" ein Atom ist, ist "x" +selbst die Antwort; sonst muß "firstatom" auf "head" von "x" angewandt werden. + +Wenn also "x" ein Atom ist, wird der erste Zweig gewählt, der "x" liefert; sonst wird +der zweite Zweig "firstatom (head x)" gewählt, weil "T" immer wahr ist. + +Die Definition von "firstatom" ist rekursiv, d.h. "firstatom" ist mit durch sich selbst +definiert. Allerdings, wenn man immerzu den "head" von irgendeinem LISP-Aus­ +druck nimmt, errreicht man irgendwann ein Atom, so daß der Prozeß immer wohlde­ +finiert ist. + +Es gibt rekursive Funktionen, die nur für bestimmte Argumente wohldefiniert sind, für +bestimmte andere dagegen unendlich rekursiv. Wenn das EUMEL-LISP-System +einen Funktionsionsaufruf mit einer solchen Funktion und "kritischen" Argumenten +interpretiert, gerät es in unendliche Rekursion, bis entweder der zur Verfügung ste­ +hende Platz im LISP-Heap ausgeschöpft ist (im Heap werden die LISP-Ausdrücke +gespeichert) oder bis der Laufzeitstack überläuft (der Laufzeitstack ist ein normaler­ +weise unsichtbarer Bestandteil des ELAN-Systems). +Wir werden jetzt die Berechnung von "(firstatom ((A . B) . C))" durchführen. Zunächst +ersetzen wir die Variable x in der Funktionsdefinition durch ((A . B) . C) und erhalten + + + (firstatom ((A . B) . C)) = + (cond ( (atom ((A . B) . C)) ((A . B) . C) ) + ( T (firstatom (head ((A . B) . C))) ) + ) + +((A . B) . C) ist kein Atom, deshalb wird daraus + + = (cond ( T (firstatom (head ((A . B) . C)))) ) + = (firstatom (head ((A . B) . C)) ) + = (firstatom (A . B)) + + + +An diesem Punkt müssen wir wieder die Definition von "firstatom" benutzen, diesmal +aber für "x" überall "(A . B)" einsetzen. + + + (firstatom (A . B)) = (cond ( (atom (A . B)) (A . B) ) + (T (firstatom (head (A . B))) ) + ) + = (cond (T (firstatom (head (A . B))) ) ) + = (firstatom (head (A . B)) ) + = (firstatom A) + = (cond ((atom A) A) + (T (firstatom (head A)) ) + ) + = A + + +Wenn in den bedingten Ausdrücken statt der LISP-Ausdrücke arithmetische Aus­ +drücke verwendet würden, könnte man damit auch numerische Rechenvorschriften +definieren, wie z.B. den Betrag einer Zahl durch + + + (abs x) = (cond ((x < 0) -x) (T x) ) + + +oder die Fakultät durch + + + (fak n) = (cond ((n = 0) 1) + (T (x * (fak (n - 1)))) + ) + + +Die Fakultät terminiert bei negativen Argumenten nicht. + +Es ist bei den meisten Mathematikern (außer den Logikern) üblich, das Wort "Funk­ +tion" nicht präzise zu verwenden und auf Ausdrücke wie "2x+y" anzuwenden. Da wir +Ausdrücke benutzen werden, die Funktionen repräsentieren, benötigen wir eine +Notation, die Funktionen und Ausdrücke unterscheidet. Dafür ist die Lambda-Nota­ +tion von Alonzo Church geeignet. +"f" soll ein Ausdruck sein, der für eine Funktion zweier ganzzahliger Variablen steht. + +Dann sollte es sinnvoll sein, den Funktionsaufruf + + + (f 3 4) + + +zu schreiben, so daß man dadurch den Wert dieses Funktionsaufrufs berechnen kann; +z.B. könnte "(summe 3 4) = 7" gelten. + +Wenn man "2x + y" als Funktion ansieht, kann man den Funktionsaufruf + + + ((2x + y) 3 4) + + +schreiben. Der Wert dieses Ausdrucks ist aber nicht eindeutig bestimmt, denn es ist +überhaupt nicht klar, ob nun "2*3+4" oder 2*4+3" gemeint ist. Eine Zeichenfolge +wie "2x + y" werden wir deshalb Ausdruck und nicht Funktion nennen. Ein Ausdruck +kann in eine Funktion umgewandelt werden, indem man die Zuordnung von Argumen­ +ten und Variablen festlegt. Bei "2x + y" könnte man beispielsweise festlegen, daß +"x" immer das erste und "y" immer das zweite Argument sein soll. +Wenn "a" ein Ausdruck in den Variablen x1, ... xn ist, dann ist + + + (lambda (x1 ... xn) a) + + +eine Funktion mit n Argumenten. Den Wert der Funktionsaufrufe mit dieser Funktion +(also der Ausdrücke der Form + + + ((lambda (x1 ... xn) a) (b1 ... bn)) + erhält man, indem man die Variablen x1 ... xn durch die n Argumente des Aufrufs +ersetzt. Beispielsweise ist + + + ((lambda (x y) (2*x + y)) (3 4)) = 2*3 + 4 = 10 , + + +während + + + ((lambda (y x) (2*x + y)) (3 4)) = 2*4 + 3 = 11 + + +ist. + +Die Variablen in einem Lambdaausdruck sind sogenannte Parameter (oder gebundene +Variable). Interessant ist, daß eine Funktion sich nicht ändert, wenn man eine Variable +systematisch durch eine andere Variable ersetzt, die nicht bereits im Lambdaausdruck +vorkommt. + + + (lambda (x y) (2*y + x)) + + +ist also dasselbe wie + + + (lambda (u v) (2*v + u)) . + + +Manchmal werden wir Ausdrücke benutzen, in denen eine Variable nicht durch das +Lambda gebunden ist. Beispielsweise ist das n in + + + (lambda (x y) (x*n + y*n)) + + +nicht gebunden. Eine solche nicht gebundene Variable nennt man frei. +Wenn für eine freie Variable vor der Benutzung kein Wert vereinbart wurde, ist der +Wert des Funktionsaufrufs nicht definiert, falls der Wert der Variablen auf das Ergeb­ +nis einen Einfluß hat. + +Die Lambdanotation reicht allein für die Definition rekursiver Funktionen nicht aus. +Neben den Variablen muß auch der Name der Funktion gebunden werden, weil er +innerhalb der Funktion für eine Zeichenfolge steht. + +Wir hatten die Funktion "firstatom" durch die Gleichung + + + (firstatom x) = (cond ((atom x) x) + (T (firstatom (head x))) + ) + + +definiert. Mit der Lambda-Notation können wir schreiben: + + + firstatom = (lambda (x) (cond ((atom x) x) + (T (firstatom (head x))) + ) ) + + + +Das Gleichheitszeichen ist in Wirklichkeit nicht Teil der LISP-Sprache, sondern eine +Krücke, die wir nicht mehr brauchen, wenn wir die richtige Schreibweise eingeführt +haben. + +Die rechte Seite der obigen Gleichung ist als Funktion nicht vollständig, da dort nichts +darauf hinweist, daß das "firstatom" im einem bedingten Ausdruck für eben die rechte +Seite steht. Deshalb ist die rechte Seite als Definition für die linke Seite ("firstatom") +noch nicht geeignet. + +Damit wir Definitionen schreiben können, in denen der Name der gerade definierten +Funktion auftaucht, führen wir die Label-Notation ein (engl. label = Marke, (Preis-) +Schildchen). Wenn "a" eine Funktion ist, und "n" ihr Name, schreiben wir "(label n +a)". + +Nun können wir die Funktion "firstatom" ohne Gleichheitszeichen schreiben: + + + (label firstatom (lambda (x) (cond ((atom x) x) + (T (firstatom (head x))) + ) ) ) + + +In dieser Definition ist "x" eine gebundene Variable und "firstatom" ein gebundener +Funktionsname. +#page# + +2. Das LISP-Interpreter-System#goalpage("p2")# + + + +2.1 Die universelle LISP-Funktion + "evalquote" #goalpage("p2.1")# + + + +Ein Interpreter oder eine allgemeine Funktion ist eine Funktion, die den Wert jedes +gegebenen Ausdrucks berechnen kann, wenn der Ausdruck in einer geeigneten Form +vorliegt. (Wenn der zu interpretierende Ausdruck einen Aufruf einer unendlich rekur­ +siven Funktion enthält, wird der Interpreter natürlich ebenfalls unendlich rekursiv.) +Wir sind jetzt in der Lage, eine allgemeine LISP-Funktion + + + (evalquote function arguments) + + +zu definieren. "evalquote" muß als erstes Argument ein LISP-Ausdruck übergeben +werden. Dieser wird als Funktion aufgefasst und auf die folgenden Argumente ange­ +wendet. + +Im Folgenden sind einige nützliche Funktionen zur Manipulation von LISP-Aus­ +drücken angegeben. Einige von ihnen werden als Hilfsfunktionen für die Definition von +"evalquote" gebraucht, die wir uns vorgenommen haben. + + + (equal x y) + + +ist ein Prädikat, das wahr ist, wenn seine Argumente gleiche LISP-Ausdrücke sind. +(Das elementare Prädikat "eq" ist ja nur für Atome definiert.) + +Die Definition von "equal" ist ein Beispiel für einen bedingten Ausdruck innerhalb +eines bedingten Ausdrucks. + + +(label equal + (lambda (x y) + (cond + ((atom x) (cond + ((atom y) (eq x y)) + (T F) + ) + ) + ((equal (head x) (head y)) (equal (tail x) (tail y))) + (T F) + ) + ) +) + + + +Folgende Funktion liefert einen LISP-Ausdruck, der gleich mit "destination" ist, +außer daß darin überall statt "old" "new" steht. + + +(changeall (destination old new)) + += (cond ((equal destination old) new) + ((atom destination) destination) + (T (cons (changeall (head destination) old new) + (changeall (tail destination) old new) + ) + ) + ) + + +Beispielsweise gilt + + +(changeall ((A . B) . C) B (X . A)) = ((A . (X . A)) . C) + + +Die folgenden Funktionen sind nützlich, wenn Listen verarbeitet werden sollen. + +1. (append x y) + hängt an die Liste "x" den LISP-Ausdruck "y". + + + (append x y) = + (cond ((null x) y) + (T (cons (head x) (append (tail x) y) )) + ) + + +2. (member list pattern) + Dies Prädikat testet, ob der LISP-Ausdruck "pattern" in der Liste "list" vor­ + kommt. + + + (member list pattern) = + (cond ((null list) F) + ((equal (head list) pattern) T) + (T (member (tail list) pattern)) + ) + + +3. (pairlist list1 list2 oldpairlist) + Diese Funktion liefert eine Liste von Paaren, die die sich entsprechenden Elemen­ + te der Listen "list1" und "list2" enthalten, und an der noch die Liste "oldpairlist" + hängt. + + + + (pairlist list1 list2 oldpairlist) = + (cond ((null list1) oldpairlist) + (T (cons (cons (head list1) (head list2)) + (pairlist (tail list1) (tail list2) oldpairlist) + ) + ) + ) + + +Beispiel: + (pairlist (A B C) (U V W) ((D . X) (E . Y)) ) = + ((A . U) (B . V) (C . W) (D . X) (E . Y)) + + +Eine solche Liste von Paaren wird auch Assoziationsliste genannt, wenn das erste +Element jedes Paars ein Atom ist, das über diese Liste mit dem zweiten Element +assoziiert ist. + +5. (association pattern associationlist) + Wenn "association list" eine Assoziationsliste wie oben beschrieben ist, liefert + "association" das Paar der Liste, dessen erstes Element "pattern" ist. Es ist also + eine Funktion zum Durchsuchen von Tabellen. + + + (association pattern alist) = + (cond ((eq (head (head alist)) pattern) (head alist)) + (T (association pattern (tail alist))) + ) + +Beispiel: + +(association B ( (A . (M N)) + (B . (HEAD X)) + (C . (QUOTE M)) + (B . (TAIL X)) + ) ) = (B . (HEAD X)) + + +(replace expr alist) + "alist" muß eine Assoziationsliste sein. "replace" produziert einen Ausdruck, der + "expr" sehr ähnlich ist, nur sind alle Atome darin durch den LISP-Ausdruck + ersetzt, mit dem sie in "alist" assoziiert sind. + + + (replace expr alist) = + (cond ((atom expr) (association expr alist)) + (T (cons (replace (head expr) alist) + (replace (tail expr) alist) + ) + ) + ) + +Beispiel: + + (replace (X SCHRIEB Y) + ((Y . (GOETZ VON BERLICHINGEN)) (X . GOETHE)) + ) + + = (GOETHE SCHRIEB (GOETZ VON BERLICHINGEN)) + + + +Die allgemeine Funktion "evalquote", die wir jetzt definieren wollen, gehorcht der +folgendem Beispiel zugrundeliegenden Regel: + + +Beispiel: + (evalquote +Funktion: (LAMBDA (X Y) (CONS (HEAD X) Y) ) +Argumente: (A B) (C D) + ) += + (apply +Funktion: (LAMBDA (X Y) (CONS (HEAD X) Y)) +Argumentliste: ((QUOTE (A B)) (QUOTE (C D))) +Bindung: NIL + ) + + +Die Argumente von "evalquote" werden also zu einer gequoteten Argumentliste von +"apply". Die QUOTE-Funktion bewirkt, daß das Argument der QUOTE-Funktion +wörtlich genommen, also nicht weiter evaluiert wird. Das dritte Argument von "apply", +das NIL ist eine leere Bindeliste zur Bindung von Parametern und Argumenten im +nächsten Schritt: + + += + (eval +Argumente: (CONS (HEAD X) Y) +Bindung: ((X.(A B)) (Y . (C D))) + ) += + (cons (head (A B)) (C D)) += + (A C D) = Ergebnis von "evalquote" . + + +"evalquote" wird hauptsächlich durch die Hilfsfunktion "apply" definiert. "apply" +berechnet Funktionsaufrufe, indem es die Argumente und die Parameter der Funktion +bindet und den Funktionsrumpf berechnet. Die Bindungen werden in einer Assozia­ +tionsliste, der Bindeliste, gespeichert. Da bedingte Ausdrücke und Konstanten formal +wie Funktionsaufrufe von Funktionen "cond" und "quote" aussehen, werden sie auch +so behandelt. + +Wir definieren also: + + + (evalquote fkt expr) = (apply fkt (quote expr) NIL) . + + +sowie : + + + (eval expr binding) = + (cond ((atom expr) (tail (association expr binding))) + (T (apply (head expr) (tail expr) binding)) + ) + + +"eval" stellt also erst fest, ob es sich um ein Atom oder um einen Funktionsaufruf +handelt. Da es nur diese beiden Möglichkeiten gibt, ist diese Einteilung vollständig. + +Atome sind immer Übersetzungen von Variablen, für die eine Bindung existieren muß, +so daß ihr Wert aus der Bindeliste geholt wird. + +Funktionsaufrufe sind immer Listen; im zweiten Zweig werden die Funktion und die +Parameterliste getrennt und an "apply" übergeben. + +Um sich die Aktionen in diesem zweiten Zweig von "eval" genauer vorstellen zu +können, ist vielleicht die in Abschnitt 1.1 beschriebene graphische Darstellungsmetho­ +de hilfreich; beispielsweise würde sich ein Lambda-Ausdruck so ausnehmen: + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+-->| o | o--+-->NIL + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + LAMBDA Parameterliste Ausdruck + + +"apply" bekommt nun von "eval" eine Funktion und eine Parameterliste sowie die +Bindeliste übergeben. Mit diesen beiden macht es folgendes: + + + (apply fn args binding) = +(cond + ((atom fn) + (cond ((eq fn HEAD) (head (eval (head args) binding))) + ((eq fn TAIL) (tail (eval (head args) binding))) + ((eq fn CONS) (cons (eval (head args) binding) + (eval (head (tail args)) binding) + ) ) + ((eq fn ATOM) (atom (eval (head args) binding))) + ((eq fn EQ) (eq (eval (head args) binding) + (eval (head (tail args)) binding) + ) ) + ((eq fn QUOTE) (head args)) + ((eq fn COND) (evalcond args binding)) + (T (apply (tail (association fn binding)) args binding)) + ) + ((eq (head fn) LABEL) + (apply (head (tail (tail fn))) + args (cons (cons (head (tail fn)) + (head (tail (tail fn))) + ) + binding) + ) ) + ((eq (head fn) LAMBDA) (eval (head (tail (tail fn))) + (pairlist (head (tail fn)) + args binding) + ) ) +) + + + + + + +Das erste Argument von "apply" ist eine Funktion (unter der Voraussetzung, daß +"quote" und "cond" als Funktionen anerkannt werden). + +Wenn es eine der elementaren Funktionen "head", "tail", "cons", "atom" oder "eq" +ist, wird die jweilige Funktion auf die Argumente angewandt, die vorher berechnet +werden. Diese Berechnung erfolgt mit "eval", das ja für Variablen Werte aus der +Bindeliste liefert und für Funktionsaufrufe das, was "apply" mit ihnen machen kann. + +Wenn es sich um "quote" handelt, wird das erste Argument unverändert geliefert +"quote" heißt ja "dies ist eine Konstante, die so, wie sie da steht, übernommen wer­ +den soll". + +Wenn es sich um "cond" handelt, wird die Funktion "eval cond" aufgerufen, doch +auch ihre Argumente werden nicht berechnet, außerdem gehört die Assoziationsliste +zu den Argumenten: + + + eval (cond condlist, binding) = + (cond ((eval (head (head condlist)) binding) + (eval (head (tail (head condlist))) binding) + ) + (T (cond (tail condlist) binding)) + ) + + + +Hier empfiehlt es sich, einen bedingten Ausdruck in graphischer Form hinzuschreiben +und die Auswertung anhand der Zeichnung nachzuvollziehen. + +Wenn die Funktion nichts von alledem ist, wird in der Bindeliste nachgesehen, ob +dies Atom nicht an eine Funktion gebunden ist; falls ja, wird eine Auswertung dieser +Funktion mit den gleichen Argumenten versucht. + +Wenn das erste Argument von "apply" kein Atom ist, muß es ein LABEL- oder ein +LAMBDA-Ausdruck sein. + +Ein LABEL-Ausdruck hat die Form + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+-->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + LABEL Name Funktion + + +Funktionsname und Definition werden in einem funktionalen Eintrag in die Bindeliste +eingefügt, so daß der Name an die Funktion gebunden ist. + +Ein LAMBDA-Ausdruck hat die Form + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+-->| o | o--+-->| o | o--+--> NIL + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + LAMBDA Parameterliste Ausdruck + + +Dabei ist die Parameterliste eine Liste von Atomen, den Parametern. Die Auswertung +läuft so ab, daß die Parameter durch "pairlist" an die Argumente gebunden werden +und mit dieser neuen Bindeliste der Ausdruck berechnet wird. + +Das EUMEL-LISP bietet eine Reihe weiterer Möglichkeiten, die erst später beschrie­ +ben werden. Hier können wir allerdings schon die folgenden Punkte abhandeln: + +1. Jede LISP-Eingabe ist ein LISP-Ausdruck. Der "head" dieses Ausdrucks wird + als Funktion aufgefaßt und auf den gequoteten "tail" des Ausdrucks, nämlich die + nicht zu evaluierenden Argumente angewandt. Die Übersetzung von Kleinbuchsta­ + ben in Großbuchstaben wird vom LISP-System übernommen. + +2. In der Theorie des reinen LISP müssen alle Funktionen außer den fünf Basisfunk­ + tionen an allen Stellen wieder definiert werden, an denen sie aufgerufen werden. + Das ist eine für die Praxis äußerst unhandliche Regelung; das EUMEL-LISP- + System kennt weitere vordefinierte Funktionen und bietet die Möglichkeit, beliebig + viele weitere Standardfunktionen einzuführen, auch solche Funktionen, deren + Argumente nicht berechnet werden (wie "quote") oder solche, die beliebig viele + Argumente haben dürfen (wie "cond"). + +3. Die Basisfunktion "eq" hat immer einen wohldefinierten Wert, dessen Bedeutung + im Fall, daß Nicht-Atome verglichen werden, im Kapitel über Listenstrukturen + erklärt wird. + +4. Außer in sehr seltenen Fällen schreibt man nicht (quote T), (quote F) oder (quote + NIL), sondern T, F und NIL. + +5. Es besteht die Möglichkeit, mit Ganzzahlen zu rechen, die als weiterer Typ von + Atomen gelten. Außerdem können TEXTe und Einzelzeichen (CHARACTERs) + gespeichert werden. + +6. Es besteht die Möglichkeit der Ein- und Ausgabe von LISP-Ausdrücken, Ganz­ + zahlen, TEXTen und CHARACTERs. + +WARNUNG: Die oben angegebenen Definitionen von "eval" und "apply" dienen nur + pädagogischen Zwecken und sind nicht das, was wirklich im Interpreter + abläuft. + Um zu entscheiden, was wirklich vor sich geht, wenn der Interpreter + aufgerufen wird, sollte man sich an die ELAN-Quellprogramme halten. +#page# + +2.2 Anwendungsregeln und Beispiele #goalpage("p2.2")# + + + +Die Funktionsweise des LISP-Interpreteres kann bequem unter Verwendung der +Funktion "trace" verfolgt werden. Der Aufruf: + + + (trace) + + +schaltet den Trace-Protokollmodus des Interpreters ein bzw. aus. + +Das folgende Beispiel ist ein LISP-Programm, das die drei Funktionen "union", +"intersection" und "member" als Standardfunktionen einführt Die Funktionen lauten +folgendermaßen: + + + (member pattern list) = (cond ((null list) F) + ((eq (head list) pattern) T) + (T (member pattern (tail list))) + ) + + (union x y) = (cond ((null x) y) + ((member (head x) y) (union (tail x) y)) + (T (cons (head x) (union (tail x) y))) + ) + + (intersection x y) = (cond ((null x) NIL) + ((member (head x) y) + (cons (head x) (intersection + (tail x) y)) + ) + (T (intersection (tail x) y)) + ) + + +Um die Funktionen als neue Standardfunktionen einzuführen, benutzen wir die Pseu­ +dofunktion "define": + + + (DEFINE + (MEMBER . (LAMBDA (PATTERN LIST) + (COND ((NULL LIST) F) + ((EQ (HEAD LIST) PATTERN) T) + (T (MEMBER PATTERN (TAIL LIST))) + ) ) ) + (UNION . (LAMBDA (X Y) + (COND ((NULL X) Y) + ((MEMBER (HEAD X) Y) (UNION (TAIL X) Y)) + (T (CONS (HEAD X) (UNION (TAIL X) Y))) + ) ) ) + (INTERSECTION . (LAMBDA (X Y) + (COND ((NULL X) NIL) + ((MEMBER (HEAD X) Y) + (CONS (HEAD X) (INTERSECTION (TAIL + X) Y)) + ) + (T (INTERSECTION (TAIL X) Y)) + ) ) ) + ) + + +Die Funktion DEFINE, liefert als Pseudofunktion nicht nur einen LISP-Ausdruck als +Ergebnis, sondern hat auch einen bleibenden Effekt, nämlich eine Veränderung im +LISP-Heap. + +DEFINE hat beliebig viele Parameter der Form (Name . Funktion) und bewirkt, daß die +Funktionen unter dem jeweiligen Namen im System verfügbar werden, also für die +weitere Programmausführung definiert werden. Das Ergebnis von DEFINE ist eine +Liste der neuen Funktionsnamen, also hier + + + (MEMBER UNION INTERSECTION) + + +Der Wert den der LISP-Interpreter bei Eingabe von + + + (intersection (a1 a2 a3) (a1 a3 a5)) + + +liefert ist (A1 A3) , + + +Die Funktion + + + (union (x y z) (u v w x)) + + +liefert (Y Z U V W X) . + + + +Es folgen einige elementare Regeln für LISP-Programme: + +1. Ein LISP-Programm besteht aus einem Funktionsaufruf. Im Beispiel ist das die + Funktion DEFINE, die ihre Parameter (beliebig viele) berechnet und ausgibt. Die + Berechnung der Parameter erfolgt dabei in der Reihenfolge der Parameter (norma­ + le LISP-Funktionen mit mehreren Parametern berechnen standardmäßig alle + Parameter, allerdings in irgendeiner Reihenfolge). + +2. LISP ist formatfrei, d.h. jedes Symbol kann in jeder Spalte stehen. Für die Bedeu­ + tung des Programms ist nur die Reihenfolge der Symbole maßgeblich. Zeilen­ + wechsel wird als Leerzeichen aufgefaßt. + +3. Atome müssen mit einem Buchstaben anfangen, damit sie nicht mit Zahlen ver­ + wechselt werden. + +4. Ein LISP-Ausdruck der Form (A B C . D) ist eine Abkürzung für (A.(B.(C.D))). + Jede andere Plazierung des Punkts ist ein Fehler (falsch wäre z.B. (A . B C) ). + +5. Eine Anzahl von Basisfuntionen existiert von Anfang an, ohne daß sie durch + DEFINE eingeführt wurden. Der Programmierer kann weitere Funktionen bleibend + oder für die Dauer eines Programmlaufs einführen; dabei ist die Reihenfolge der + neuen Funktionen gleichgültig. +#page# + +2.3 Variablen#goalpage("p2.3")# + + + +Eine Variable ist ein Symbol, das ein Argument einer Funktion repräsentiert. Man +kann also schreiben: "a + b, wobei a = 3 und b = 4". In dieser Situation ist keine +Verwechslung möglich, so daß klar ist, daß das Ergebnis 7 ist. Um zu diesem Ergeb­ +nis zu kommen, muß man die Zahlen anstelle der Variablen einsetzen und die Opera­ +tion ausführen, d.h. die Zahlen addieren. + +Ein Grund, weshalb das eindeutig ist, liegt darin, daß "a" und "b" nicht "direkt" +addiert werden können, so daß etwa "ab" entsteht. In LISP kann die Situation viel +komplizierter sein. Ein Atom kann eine Variable oder ein Atom sein. + +Sollte der zukünftige LISP-Benutzer an dieser Stelle entmutigt sein, sei ihm gesagt, +daß hier nichts Neues eingeführt wird. Dieser Abschnitt ist nur eine Wiederholung der +Überlegungen aus Abschnitt 1.4. Alles, was wir in diesem Abschnitt sagen, kann man +aus den Regeln für LISP-Ausdrücke oder aus der allgemeinen Funktion "evalquote" +ableiten. + +Der Formalismus, der in LISP die Variablen kennzeichnet, ist die Lambdanotation von +Church. Der Teil des Interpreters, der die Variablen an Werte bindet, heißt "apply". +Wenn "apply" auf eine Funktion stößt, die mit LAMBDA anfängt, wird die Variablenli­ +ste (Argumentliste) mit der Parameterliste gepaart und am Anfang der Bindeliste +eingefügt. + +Während der Berechnung des Funktionsrumpfs müssen manchmal Variablen durch +ihre Werte ersetzt werden. Das geschieht dadurch, daß ihr Wert in der Bindeliste +nachgesehen wird. Wenn eine Variable mehrmals gebunden wurde, wird die zuletzt +etablierte Bindung verwendet. Der Teil des Interpreters, der diese "Berechnungen" +und die Berechnung von Funktionsaufrufen durchführt, heißt "eval". + + + +#page# + +2.4 Konstanten#goalpage("p2.4")# + + + +Manchmal heißt es, eine Konstante stehe für sich selbst, im Gegensatz zu einer +Variablen, die für etwas anderes, nämlich ihren Wert, steht. +Dies Konzept funktioniert in LISP nicht so ohne weiteres; es ist hier sinnvoller, zu +sagen, eine Variable ist konstanter als die andere, wenn sie in einer höheren Ebene +gebunden ist und ihren Wert seltener ändert. +In LISP bleibt eine Variable im Bereich des LAMBDA konstant, von dem sie gebunden +ist. Wenn eine Variable einen festen Wert hat, unabhängig davon, was in der Bindeli­ +ste steht, wird sie (echte) Konstante genannt. Dies wird mit Hilfe der Eigenschaftsliste +(E-Liste) des Atoms erreicht. +Jedes Atom hat eine E-Liste, in der Paare von Atomen und beliebigen Strukturen +gespeichert sind. Ein Atom hat die Eigenschaft A, wenn in seiner E-Liste ein Paar +mit dem Atom A enthält; die dazugehörige "beliebige Struktur" heißt Wert dieser +Eigenschaft. +Wenn ein Atom die Eigenschaft APVAL besitzt, ist es eine Konstante, deren Wert der +Wert der Eigenschaft ist. +Konstanten können durch die Pseudofunktion + + + (set atom wert) + + +gesetzt werden; nach der Auswertung eines solchen Aufrufs hat das Atom "atom" +immer den Wert "wert" - bis zum nächsten "set". Eine interessante Klasse von +Konstanten sind solche Konstanten, die sich selbst als Wert haben. Ein Beispiel dafür +ist NIL. Der Wert dieser Konstanten ist wieder NIL. Daher kann NIL nicht als Variable +benutzt werden, da es ja eine Konstante ist. (T und F gehören ebenfalls zu dieser +Klasse). + +#page# + +2.5 Funktionen#goalpage("p2.5")# + + + +Wenn ein LISP-Ausdruck für eine Funktion steht, ist die Situation ähnlich der, in der +ein Atom für einen Wert steht. Wenn die Funktion rekursiv ist, muß sie einen Namen +bekommen. Das geht mit einem LABEL-Ausdruck, der den Namen mit der Funk­ +tionsdefinition in der Bindeliste paart. Dadurch wird der Name an die Funktionsdefini­ +tion gebunden, so wie eine Variable an ihren Wert gebunden wird. In der Praxis setzt +man LABEL selten ein. Normalerweise ist es einfacher, Name und Definition wie bei +den Konstanten zu verknüpfen. Dies geschieht mit der Pseudofunktion DEFINE, die +wir am Anfang des Kapitels benutzt haben. +Diese Funktion kann beliebig viele Parameter der Form + + + (atom . funktion) + + +haben, wobei "atom" der Name der zu definierenden Funktion "funktion" werden soll. +Sie bewirkt, daß die Definition unter der Eigenschaft FUNCTION in der E-Liste des +Atoms abgelegt wird. +#page# + +3. Erweitertes LISP#goalpage("p3")# + + +In diesem Kapitel werden wir einige Erweiterungen zum reinen LISP einführen. Zu +diesen Erweiterungen gehören Möglichkeiten für Arithmetik, Zeichenkettenverarbei­ +tung, Funktionen, die spezielle Argumente erwarten, und Ein- und Ausgabe. + +In allen Fällen handelt es sich bei den Erweiterungen um zusätzliche Funktionen. So +heißt das Kommando für die Ausgabe eines LISP-Ausdrucks PUT. Syntaktisch ist +PUT nichts anderes als eine Funktion mit einem Argument. Sie kann mit anderen +Funktionen verkettet werden, und diese Verkettung wird ganz auf die übliche Art +behandelt, zuerst Berechnung der innern, dann der äußeren Funktionsaufrufe. Ein +Ergebnis ist nur in dem trivialen Sinn vorhanden, daß PUT sein Argument wieder +liefert, also die Identität ist. + +Funktionen, die eine Aktion wie Ein- oder Ausgabe bewirken, oder die Langzeitwir­ +kung (gesehen auf die Ausführungsdauer des Programms) haben, wie DEFINE und +SET, heißen Pseudofunktionen. Es ist eine Besonderheit von LISP, daß alle Funktio­ +nen einschließlich den Pseudofunktionen ein Ergebnis haben müssen. In einigen +Fällen ist das Ergebnis trivial und kann ignoriert werden. + +In diesem Kapitel beschreiben wir verschiedene Erweiterungen der Sprache LISP, die +im System fest enthalten sind. + + +#page# + +3.1 Gequotete Parameter #goalpage("p3.1")# + + + +Bevor ein Argument an eine Funktion übergeben wird, wird erst sein Wert in der +Bindeliste nachgesehen, d.h. es wird nicht der Name der Variablen übergeben, son­ +dern ihr Wert. Wenn das Argument als Konstante behandelt werden soll, muß es +ge"quotet" werden, d.h. statt "argument" steht (quote argument). Wenn ein Argument +einer Funktion immer als Konstante behandelt werden soll, ist es bequemer, das +Argument nicht jedesmal zu quoten. Das EUMEL-LISP-System erlaubt, in diesem +Fall den formalen Parameter in der Funktionsdefinition bereits zu quoten. + +Dieser Mechanismus wurde auch benutzt, um QUOTE zu implementieren; die Funk­ +tion lautet + + + quote = (lambda ((QUOTE x)) x) + + + + +#page# + +3.2 Funktionen mit beliebig vielen + Argumenten #goalpage("p3.2")# + + + +Ein Beispiel ist "list", das beliebig viele Argumente haben kann, die zu einer Liste +zusammengefaßt werden. Da eine Funktion nur eine feste Anzahl von Parametern +haben kann, eine Funktion mit beliebig vielen Argumenten aber gewiß keine feste +Anzahl von Argumenten hat, werden die beliebig vielen Argumente zu einer Liste +zusammengefaßt und ein einziger Parameter wird an diese Liste gebunden. Da "list" +genau diese Liste liefern soll, wird diese Funktion ebenfalls zu einer "Identität": + + + list = (lambda ((INDEFINITE x)) x) + + +Solche Parameter werden durch INDEFINITE gekennzeichnet. Sie können auch ge­ +quotet werden, indem man (INDEFINITE QUOTE parameter) schreibt; das wirkt so, als +wären alle Argumente, die diesem Parameter zugeordnet werden, einzeln gequotet +worden. + + + evalquote = (lambda (fkt (INDEFINITE QUOTE expr)) + (apply fkt expr NIL) ) + + + +#page# + +3.3 Funktionale Parameter #goalpage("p3.3")# + + + +In der Mathematik gibt es Funktionen, die andere Funktionen als Argument haben. In +der Algebra könnte man die Funktion "(operation operator a b)" definieren, wobei +"operator" ein funktionales Argument ist, das die Operation festlegt, die auf "a" und +"b" ausgeführt werden soll. Beispielsweise gilt + + + operation (+ 3 4) = 7 + operation (* 3 4) = 12 + + +In LISP sind funktionale Argumente sehr nützlich. Eine wichtige Funktion mit einem +Argument ist MAPLIST. Ihre Definition ist + + + (LAMBDA (LIST (FUNCTION FN)) + (COND ((NULL LIST) NIL) + (T (CONS (FN (HEAD LIST)) (MAPLIST (TAIL LIST) FN))) + ) ) + + +Diese Funktion nimmt eine Liste und eine Funktion als Argument und wendet die +Funktion auf die Listenelemente an. + + +#page# + +3.4 Prädikate und boolesche Konstanten #goalpage("p3.4")# + + + +Die booleschen Werte sind, wie in Kapitel 1 gesagt, T und F. Bei LISP-Ausdrücken +müßte daraus (quote T) und (quote F) werden, aber da die APVALs dieser Atome +wieder den Wert T und F haben, ist das quoten nicht nötig. + +Prädikate sind Funktionen, die T oder F als Ergebnis haben; es gibt also keine forma­ +len Unterschiede zwischen anderen Funktionen und Prädikaten. + +Daher ist es durchaus möglich, daß eine Funktion einen Wert liefert, der weder T +noch F ist, daß aber durch einen bedingten Ausdruck an dieser Stelle ein boolescher +Ausdruck verlangt wird. In diesem Fall ist die Wirkung des Ausdrucks nicht definiert. + +Das Prädikat EQ hat folgendes Verhalten: +1. Wenn seine Argumente verschieden sind, ist das Ergebnis F. +2. Wenn die Argumente dasselbe Atom sind, ist das Ergebnis T. +3. Wenn die Argumente gleich, aber nicht atomar sind, ist das Ergebnis T oder F, je + nachdem, ob sie ein und dasselbe Objekt im Heap sind oder nicht. + +#page# + +3.5 Unbenannte Atome #goalpage("p3.5")# + + + +Die meisten Atome im EUMEL-LISP haben einen Namen, der sie bei Ein- und +Ausgabeoperationen identifiziert. +Es gibt aber auch Atome, die keinen Namen haben und stattdessen durch ihre Werte +repräsentiert werden. Momentan sind das Ganzzahlen und Zeichenketten (TEXTe); +auch die booleschen Werte kann man in einem weiteren Sinn dazurechnen. + + + + +3.5.1 Ganzzahlen + + + +Im EUMEL-LISP gibt es Funktionen, die Basisoperationen und Tests durchführen. + +Ganzzahlen haben folgende Eigenschaften: + +1. Eine Ganzzahl besteht aus einem optionalen Vorzeichen und einer Folge von + Ziffern; zwischen Vorzeichen und Ziffern können Leerzeichen stehen. +2. Der Wert einer Ganzzahl liegt zwischen -32768 und 32767 (minint und maxint). +3. Eine Ganzzahl kann überall dort stehen, wo ein Atom stehen kann, außer als + Parameter. +4. Ganzzahlen sind Konstanten; sie brauchen also nicht gequotet werden. +#page# + +3.5.2 Arithmetische Funktionen und Prädikate + + + +Es folgt eine Liste aller arithmetischen Funktionen. +Wenn ein Argument einer dieser Zahlen keine Ganzzahl ist, erfolgt eine Fehlermel­ +dung. + + (sum x1 ... xn) liefert die Summe der xi; wenn keine Argumente gege­ + ben werden, wird 0 geliefert. + (difference x y) liefert die Differenz von x und y. + (product x1 ... xn) liefert das Produkt seiner Argumente; wenn + keine Argumente gegeben werden, wird 1 + geliefert. + (quotient x y) liefert den Quotienten von x und y, ohne den + Rest zu berücksichtigen. + (remainder x y) liefert den Rest der Division von x und y. + (getint) liest eine Zahl vom Bildschirm ein und + liefert sie. + (putint x) gibt x auf den Bildschirm aus. Identitäts funktion. + + + + + +3.5.3 Zeichenkettenverarbeitung + + + +Im Moment ist nur Zeichenketten-Ein- und Ausgabe implementiert. +Die Ausgabe löst bei Argumenten, die keine Zeichenketten sind, eine Fehlermeldung +aus. + + (gettext) liest eine Zeichenkette ein und liefert sie. + (puttext x) gibt eine Zeichenkette aus. + + + + +3.5.4 Test auf Gleichheit + + + + (equal x y) testet, ob x und y vom gleichen Typ sind, und wenn ja, ob sie gleich + sind. +#page# + +3.6 Aufruf von EUMEL aus #goalpage("p3.6")# + + +Bevor man den LISP-Interpreter benutzen kann, muß er folgendermaßen implemen­ +tiert werden: + +archive ("lisp") +fetch all (archive) +release (archive) +check off +insert ("lisp.1") +insert ("lisp.2") +insert ("lisp.3") +insert ("lisp.4") +check on + + +Das LISP-System verfügt über einen Heap, in dem alle LISP-Ausdrücke gespei­ +chert sind. Standardmäßig enthält der Heap eine Reihe von Funktionen, die nicht in +den LISP-Programmen definiert werden müssen (Übersichten über die Standardfunk­ +tionen siehe Kapitel 3.5). + +Mit + lisp + +wird das LISP-System im EUMEL-Dialog gestartet. In einem Eingabefenster wird +mit Hilfe des Paralleleditors eine LISP-EINGABE-Möglichkeit angeboten. Die Aus­ +gabe erfolgt in dem LISP-AUSGABE-Fenster. +Das LISP-System kann folgendermaßen verlassen werden: + break lisp . + +Statt dieser direkten Art der Benutzung der LISP-Maschine ist auch eine an ELAN +angelehnte Art mit den Prozeduren "run lisp", insert lisp" usw. vorgesehen: + +Mit + + run lisp (TEXT CONST dateiname) + +wird eine Kopie des Heaps angelegt, das Programm aus der Datei "dateiname" in die +Kopie eingelesen und gestartet. Durch diesen Kopiermechanismus wird der Original­ +heap vor Zusammenbrüchen des LISP-Systems geschützt. + + insert lisp (TEXT CONST dateiname) + +bewirkt dasselbe wie "run lisp"; allerdings wird jetzt direkt auf dem Originalheap +gearbeitet. Dadurch sind alle Änderungen im Heap, die das Programm verursacht +(meist Definition von Funktionen durch DEFINE) bleibend, aber auch ein Zusammen­ +bruch ist insoweit endgültig, als das LISP-System jetzt neu gestartet werden muß. +Das geschieht mit + + start lisp system (DATASPACE CONST dsname) + +"dsname" gibt dabei den Datenraum an, der die zum Hochfahren notwendigen Daten +enthält. Solche Daten im richtigen Format enthält der Datenraum "lisp.bootstrap". +Wenn der zuletzt benutzte Heap mit nicht mehr durch LISP-Programme erreich­ +bare Strukturen vollgestopft ist, schafft die Prozedur + + collect lisp heap garbage + +Abhilfe; mit + + lisp storage info + +kann man den Erfolg kontrollieren. +#page# + +4. Detailbeschreibungen#goalpage("p4")# + + + + + +4.1 Grundfunktionen #goalpage("p4.1")# + + + +Die Datei "lisp.1" enthält ein Paket, das die Grundlage des LISP-Systems bildet. Es +implementiert + + - die primitiven LISP-Funktionen wie "cons", "null", etc., + - die Verwaltung des Heaps, in dem die LISP-Strukturen und die Objektliste + (Oblist) gespeichert sind, + - einen Datentyp SYM, dessen Wertevorrat aus Zeigern auf die im Heap gespei­ + cherten Strukturen besteht, + - Funktionen zur Konversion allgemeiner Daten in LISP-Strukturen (bisher reali­ + siert: TEXT <--> SYM und INT <--> SYM). + +Durch die Implementation der Basisoperationen als exportierte und damit allgemein +verfügbare ELAN-Prozeduren ist es möglich, LISP-Strukturen durch ELAN-Prog­ +ramme zu manipulieren; insbesonders können ELAN- und LISP-Programme über +diese Strukturen miteinander kommunizieren. + +Anmerkung: +Wenn Eigenschaften von "SYM"-Objekten beschrieben werden, sind immer die +Eigenschaften der Strukturen gemeint, auf die die Objekte zeigen, wenn nichts ande­ +res angegeben wird. + + +Es werden folgende Prozeduren exportiert: + + PROC initialize lisp system (DATASPACE CONST new heap): + "new heap" ist der neue Datenraum, in dem der LISP-Heap ab sofort geführt + wird. + Vorsicht: Beim Wechsel zu einem neuen Datenraum sind die Werte der + SYM-Variablen, die auf Strukturen im alten Heap zeigen, natürlich wertlos! + + PROC dump lisp heap (FILE VAR f): + In "f" wird ein Dump des Heaps erstellt. Dieser Dump ist nur mit Kenntnis des + Programmtextes aus "lisp 1" verständlich; er wird hier nicht beschrieben. + + PROC lisp storage (INT VAR size, used): + Nach dem Aufruf gibt "size" die maximal verfügbare Anzahl von Knoten an, + während "used" die Anzahl der tatsächlich von LISP-Strukturen belegten + Knoten enthält. Zu diesen Strukturen können auch solche zählen, die nicht mehr + durch "head" oder "tail" etc. erreichbar sind. + + PROC collect lisp heap garbage: + Löscht die im LISP-Heap nicht mehr durch "atom (TEXT CONST)", "proper­ + ty", "head" und "tail" erreichbaren Strukturen. Es werden auch alle nur von + ELAN-Programmen aus über SYM-Variable erreichbare Strukturen gelöscht, so + daß die Werte dieser Variablen undefiniert werden. + Die Müllabfuhr wird von keiner Prozedur dieses Pakets aufgerufen, d.h. der + Benutzer, der ELAN-Programme einsetzt, braucht nicht alle Strukturen in den + Eigenschaftslisten von Atomen aufzubauen, um sie vor einer versehentlichen + Löschung durch die Müllabfuhr zu schützen, vorausgesetzt, er ruft sie nicht + selbst auf. Er muß allerdings darauf achten, daß im Heap noch genug Platz + bleibt. + + OP := (SYM VAR left, SYM CONST right): + Nach der Zuweisung zeigt "left" auf die gleiche Struktur wie vorher "right". + + SYM CONST nil, pname; + Zwei Konstanten, die dem LISP-System ständig zur Verfügung stehen müs­ + sen. Ihre Drucknamen sind "NIL" bzw. "PNAME" (vgl. Schlußbemerkungen) + + SYM PROC head (SYM CONST sym): + Entspricht der im Handbuch beschriebenen Funktion "head". + + SYM PROC tail (SYM CONST sym): + Entspricht der im Handbuch beschriebenen Funktion "tail". + + SYM PROC cons (SYM CONST head, tail): + Liefert einen SYM-Wert "zeiger" auf eine neue Struktur. Es gilt: + head ("zeiger") = "head" und tail ("zeiger") = "tail". + + BOOL PROC eq (SYM CONST sym 1, sym 2): + Prüft, ob "sym 1" und "sym 2" auf dieselbe Struktur zeigen. Das ist genau dann + der Fall, wenn sie durch Zuweisung auseinander hervorgegangen sind oder wenn + sie auf das gleiche benannte Atom zeigen. + + BOOL PROC equal (SYM CONST sym 1, sym 2): + Prüft, ob "sym 1" und "sym 2" dieselbe Struktur haben; "dieselbe Struktur" + braucht aber nicht "Identität" zu bedeuten, wie "eq" das verlangt. + Umgewandelte TEXTe und INTs werden richtig verglichen (siehe "sym (INT + CONST)" und "sym (TEXT CONST)"). + + BOOL PROC null (SYM CONST sym): + Prüft, ob "sym" gleich der Konstanten "NIL" ist (entspricht + eq ("sym", "NIL"), ist aber schneller). + + BOOL PROC atom (SYM CONST sym): + Prüft, ob "sym" ein ( benanntes oder unbenanntes) Atom ist. + + BOOL PROC is named atom (SYM CONST sym): + Prüft, ob "sym" ein benanntes Atom ist. + + PROC begin oblist dump: + Vorbereitung für "next atom". + + SYM PROC next atom: + Liefert das nächste Atom aus der Objektliste. In der Objektliste sind alle benann­ + ten Atome, die der Heap enthält, aufgeführt (bis auf Ausnahmen; s."delete + atom"). "NIL" wird immer als letzte Atom geliefert. + + SYM PROC atom (TEXT CONST name): + Liefert einen Zeiger auf das Atom mit dem Namen "name". Wenn kein solches + Atom in der Objektliste vorhanden ist, wird "NIL" geliefert. + + SYM PROC new atom (TEXT CONST name): + Liefert einen Zeiger auf das Atom mit dem Namen "name". Wenn kein solches + Atom in der Objektliste vorhanden ist, wird ein neues mit diesem Namen in sie + eingefügt. + + PROC create atom (TEXT CONST name): + Fügt ein Atom mit dem Namen "name" in die Objektliste ein. Wenn ein solches + Atom bereits existiert, wird stattdessen eine Fehlermeldung ausgegeben. + + PROC delete atom (SYM CONST atom): + Streicht das Atom "atom" aus der Objektliste. + + PROC begin property list dump (SYM CONST atom): + Vorbereitung für "next property". + + PROC next property (SYM VAR property id, property): + Liefert die nächste Eigenschaft aus der Eigenschaftsliste des zuletzt durch + "begin property list dump" vorbereiteten Atoms. Wenn es sich bei der Eigen­ + schaft um eine Flagge handelt, wird "property" auf "NIL" gesetzt; wenn es keine + nächste Eigenschaft mehr gibt, werden "property" und "property id" auf "NIL" + gesetzt. + Der Dump der Eigenschaftsliste beeinträchtigt die "Verwendbarkeit" des Atoms in + keiner Weise; es ist während des Dumps sogar möglich, Eigenschaften und + Flaggen zu lesen. Wenn während des Dumps Eigenschaften oder Flaggen geän­ + dert oder geschrieben werden, ist mit fehlerhaften Dumpergebnissen zu rechnen. + + PROC add property (SYM CONST atom, property id, property): + "property id" muß ein benanntes Atom sein. Führt eine neue Eigenschaft mit der + Bezeichnung "property id" und dem Wert "property" ein. Wenn bereits eine + Eigenschaft mit der gleichen Bezeichnung existiert, wird die alte Version über­ + deckt, ist aber weiter vorhanden. + + PROC alter property (SYM CONST atom, property id, property): + Bringt die Eigenschaft mit der Bezeichnung "property id" auf den neuen Wert + "property". Wenn eine Eigenschaft mit dieser Bezeichnung noch nicht existiert, + wird eine Fehlermeldung ausgegeben. + + BOOL PROC property exists (SYM CONST atom, property id): + Prüft, ob das Atom eine Eigenschaft mit der Bezeichnung "property id" besitzt. + + SYM PROC property (SYM CONST atom, property id): + Liefert den Wert der gerade sichtbaren Eigenschaft des Atoms, die die Bezeich­ + nung "property id" hat. Falls die Eigenschaft nicht existiert, wird "NIL" geliefert. + + PROC delete property (SYM CONST atom, property id): + Löscht den gerade sichtbaren Wert der Eigenschaft des Atoms, die die Bezeich­ + nung "property id" hat. Wenn eine ältere Version dieser Eigenschaft durch "add + property" überdeckt wurde, wird diese jetzt wieder sichtbar. Jede Eigenschaft + bildet also für jedes Atom einen Stapel (Stack). + + PROC add flag (SYM CONST atom, flag id): + Das Atom "atom" erhält die Flagge "flag id". Ein Atom kann dieselbe Flagge + durchaus mehrmals haben. + + BOOL PROC flag (SYM CONST atom, flag id): + Prüft, ob "atom" mindestens eine Flagge "flag id" hat. + + PROC delete flag (SYM CONST atom, flag id): + Löscht eine Flagge "flag id" von "atom". Wenn keine Flagge existiert, wird + nichts getan. + + SYM PROC sym (TEXT CONST text): + Konvertiert "text" in ein unbenanntes Atom und liefert einen Zeiger auf dies + Atom. + + TEXT PROC text (SYM CONST sym): + Konvertiert "sym" in einen TEXT zurück, wenn es sich um einen konvertierten + TEXT handelt; wenn nicht, wird eine Fehlermeldung ausgegeben. + + BOOL PROC is text (SYM CONST sym): + Prüft, ob "sym" ein konvertierter TEXT ist. + + SYM PROC sym character (TEXT CONST text): + "text" muß genau ein Zeichen enthalten. Das Zeichen wird in ein + CHARACTER-Objekt im Heap konvertiert und ein Zeiger auf dies Objekt gelie­ + fert. + + INT PROC character (SYM CONST sym): + "sym" muß auf ein CHARACTER-Objekt zeigen. Geliefert wird der Code des + dort gespeicherten Zeichens. + + SYM PROC sym (INT CONST i 1, i 2): + Konvertiert "i 1" und "i 2" in ein unbenanntes Atom und liefert einen Zeiger + darauf. + + INT PROC int 1 (SYM CONST sym): + INT PROC int 2 (SYM CONST sym): + Holt die Werte der ersten bzw. zweiten Ganzzahl aus "sym", wenn es sich um + ein konvertiertes INT-Paar handelt; wenn nicht, wird eine Fehlermeldung ausge­ + geben. + + BOOL PROC is int pair (SYM CONST sym): + Prüft, ob "sym" ein konvertiertes INT-Paar ist. + + +Prozedurübergreifende Aussagen über das Paket "lisp.1": + + - Es gibt benannte und unbenannte Atome. + + - Die unbenannten Atome sind Konversionsprodukte. + + - Vor dem ersten Aufruf von "delete atom" sind alle benannten Atome in der Ob­ + jektliste enthalten; d.h. sie können alle durch "begin oblist dump" und wiederhol­ + ten Aufruf von "next atom" erreicht werden. + + - Jedes benannte Atom hat genau einen Namen, der immer gleich bleibt. Der + Name ist als Eigenschaft mit der Bezeichnung "pname" in der Eigenschaftsliste + gespeichert. "add property", "alter property" und "delete property" geben des­ + halb eine Fehlermeldung aus, statt ihre normalen Aktionen durchzuführen, wenn + ihnen als Eigenschaftsbezeichnung "pname" übergeben wird. + + - Es gibt keine zwei Atome, die denselben Namen haben; dadurch reduziert sich + die bei "eq" angegebene Fallunterscheidung auf einen Fall. + + - Es kann durchaus zwei unbenannte Atome mit gleichen Werten geben, die von + "eq" nicht als gleich anerkannt werden, weil sie in verschiedenen Strukturen + gespeichert sind. "equal" achtet nicht auf die Position, sondern auf die Werte + der zu vergleichenden Strukturen. + + - Mehrfache Zugriffe auf die gleiche Eigenschaft desselben Atoms werden so opti­ + miert, daß die Eigenschaftsliste nur beim ersten Zugriff (meist durch "property + exists") durchsucht werden muß. + + + +#page# + +4.2 Weitere Funktionen sowie Eingabe und + Ausgabe #goalpage("p4.2")# + + + +Die Datei "lisp.2" enthält diverse Pakete, die die Verbindung vom LISP-System zur +normalen EUMEL-Umgebung bilden. Momentan sind das Ein- und Ausgabe und +(exemplarisch) die fünf Grundrechenarten für Ganzzahlen. + +Die Ein- und Ausgabe von LISP-Strukturen wird durch das Paket namens "lisp io" +mit den folgenden Prozeduren ermöglicht: + + PROC get (FILE VAR f, SYM VAR sym): + Nach dem Aufruf zeigt "sym" auf eine neue aus "f" eingelesene Struktur. + In der ersten und hinter der letzten Zeile des S-Ausdrucks dürfen keine weiteren + Daten stehen. + + PROC get all (FILE VAR f, SYM VAR sym): + Wie "get (FILE V, SYM V)", nur daß die Datei nichts als den S-Ausdruck ent­ + halten darf. + + PROC get (SYM VAR sym): + Es wird mit "get all" ein S-Audruck von einer Scratch-Datei eingelesen, die + dem Benutzer vorher zum Editieren angeboten wird. Bei Einlesefehlern wird die + Datei zu Korrigieren angeboten, bis keine Fehler mehr auftreten. + + PROC put (FILE VAR f, SYM CONST sym): + Wenn "sym" ein Ganzzahlpaar ist, wird die erste Zahl ausgegeben; wenn es ein + konvertierter TEXT ist, wird der ursprüngliche TEXT wieder ausgegeben; bei + einem benannten Atom oder einer allgemeinen LISP-Struktur wird ein S-Aus­ + druck ausgegeben. + + PROC put (SYM CONST sym): + Wie "put (FILE V, SYM CONST), außer daß die Augabe direkt auf den Bildschirm + erfolgt. + + +Das Paket "lisp int" enthält die Prozeduren + + SYM PROC sum (SYM CONST summandenliste); + Erwartet eine Liste von "int pair"-Summanden und liefert deren Summe. + + SYM PROC difference (SYM CONST minuend, subtrahend): + Liefert die Differenz der Parameter. + + SYM PROC product (SYM CONST faktorenliste): + Liefert das Produkt der Listenelemente. + + SYM PROC quotient (SYM CONST dividend, divisor): + Liefert den Quotienten der Parameter. + + SYM PROC remainder (SYM CONST dividend, divisor): + Liefert den Rest. + +#page# + +4.3 Interpreter #goalpage("p4.3")# + + +Die Datei "lisp.3" enthält das Paket "lisp interpreter", das die Prozedur + + SYM PROC evalquote (SYM CONST expression) + +exportiert. Es handelt sich dabei um den im EUMEL-LISP-Handbuch beschriebe­ +nen Interpreter. + +Wenn "expression" ein LISP-Ausdruck ist, liefert die Prozedur den Wert des Aus­ +drucks (vorausgesetzt, der LISP-Heap ist vorbereitet, siehe lisp.1). + +Wirkungsweise: +"evalquote" ruft im Wesentlichen die Prozedur "eval" auf. +"eval" erwartet als Argumente einen solchen LISP-Ausdruck wie "evalquote", benö­ +tigt aber zusätzlich eine sog. Bindeliste. In einer Bindeliste sind durch LAMBDA- und +LABEL-Ausdrücke bereits gebundene Variable und ihre Werte gespeichert. Die +Manipulation der Bindeliste ist durch eine Reihe von Refinements, die am Schluß des +Pakets stehen, realisiert. + +Da bisher noch keine LAMBDA- oder LABEL-Ausdrücke verarbeitet wurden, über­ +gibt "evalquote" die leere Bindeliste. + +Wirkungsweise von + + SYM PROC eval (SYM CONST expression, association list): + +"eval" kann als erstes Argument ein Atom oder eine zusammengesetzte Struktur +erhalten. + +Atome werden als Variable aufgefaßt, deren Wert in der Bindeliste aufzusuchen ist. +Vor der Konsultation der Bindeliste wird allerdings noch nach der Eigenschaft APVAL +des Atoms gesehen; wenn sie vorhanden ist, handelt es sich um eine Konstante wie +NIL, T oder F, die einen festen Wert hat, nämlich den Wert dieser Eigenschaft. Da +diese Konstanten sich selbst als Wert haben, gilt "eval (NIL, Bindeliste) = NIL" +(entsprechend für "T" und "F"). + +Wenn das erste Arugment von "eval" zusammengesetzt ist, wird angenommen, daß +es sich um einen Funktionsaufruf der Form + + + +-----+-----+ + | o | o--+--> Argumentliste + +--+--+-----+ + | + V + Funktion + + +handelt. Die Bestandteile "Funktion" und "Argumentliste" werden mit der Bindeliste +übergeben an: + + SYM PROC apply (SYM CONST function, arguments, association list): + +"apply" hat die Aufgabe, die Argumente durch "eval" berechnen zu lassen (das +unterbleibt allerdings unter bestimmten Umständen) und die Berechnungergebnisse an +die Parameter der Funktion zu binden; zum Schluß muß der Wert des Funktions­ +rumpfs in Abhängigkeit von diesen neuen Bindungen als Ergebnis der gesamten +Prozedur "apply" berechnet werden; diese Berechnung geschieht wieder durch +"eval". + +Nur in einem LAMBDA-Ausdruck ist direkt bekannt, wo die Parameterliste steht.So­ +lange das nicht der Fall ist, muß entweder ein LABEL-Ausdruck oder ein Atom +vorliegen. +Ein LABEL-Ausdruck hat die Form + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+--->| o | o--+--->| o | NIL | + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + LABEL Name Funktion + + +Da der Name für die Dauer der Auswertung des Funktionsrumpfs an die Funktion +gebunden sein muß, wird dis Paar als funktionaler Bindelisteneintrag gespeichert. +Funktionale und nichtfunktionale Bindelisteneinträge sind eindeutig unterschieden. + +Nach dem Abspeichern wird wieder getestet, ob die Funktion diesmal ein +LAMBDA-Ausdruck ist; wenn nicht, wird ein weiterer Schritt zum "Ablättern" von +LABELs und Atomen versucht, usw. + +Wenn die Funktion ein Atom ist, werden analog zu den Vorgängen in "eval" erst die +Eigenschaftsliste und dann die Bindeliste durchsucht. + +Ist die Eigenschaft FUNCTION in der Eigenschaftsliste vorhanden, ist der Wert der +Eigenschaft die (evtl. weiter "abzublätternde") Funktion; ist die Eigenschaft nicht +vorhanden, muß das Atom an eine Funktion gebunden sein, die dann aus der Binde­ +liste geholt werden kann. + +Da alle Funktionen (auch die Standardfunktionen) letztendlich als LAMBDA-Aus­ +drücke definiert sind, kommt "apply" auf diese Weise zuletzt zu einem LAMBDA- +Ausdruck. + +Ein LAMBDA-Ausdruck hat die Form + + + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+--->| o | o--+--->| | | + +--+--+-----+ +--+--+-----+ +-----+-----+ + | | + V V + LAMBDA Parameterliste + + +Als nächster Schritt werden die Argumente für die zu berechnende Funktion an die +Parameter der Parameterliste gebunden, d.h. es werden Parameter-Argument-Paare +in die Bindeliste eingetragen. + +Die Methode des Eintrags ist je nach Art des Parameters unterschiedlich. Es gibt die +folgenden Arten von Parametern: + + + 1. | + | + V + Name + + + "Name" ist hier - wie bei den restlichen Fällen - der Name des Parame­ + ters. Diese Art von Parametern ist der Normalfall; die Argumente, die einem + solchen Parameter entsprechen, werden durch "eval" berechnet und zusammen + mit dem Parameter in einem Bindelisteneintrag gespeichert. + + + 2. | + | + V + +-----+-----+ +-----+-----+ + | o | o--+--->| o | NIL + + +--+--+-----+ +--+--+-----+ + | | + V V + QUOTE Name + + + In diesem Fall wird das Argument ohne weitere Verarbeitung in die Bindeliste + übernommen. Die Wirkung ist die gleiche, als wäre das Argument durch + "(QUOTE ... )" eingeschlossen. + + + 3. | + | + V + +-----+-----+ +-----+-----+ + | o | o--+--->| o | NIL | + +--+--+-----+ +--+--+-----+ + | | + V V + FUNCTION Name + + + Hier wird ein funktionaler Bindelisteneintrag erzeugt, so daß "Name" im Funk­ + tionsrumpf als Name einer Funktion auftreten kann. + + + 4. | + | + V + +-----+-----+ +-----+-----+ + | o | o--+--->| o | NIL | + +--+--+-----+ +--+--+-----+ + | | + V V + INDEFINITE Name + + + Dies ist ein Parameter, der beliebig viele berechnete Argumente aufnehmen + kann. Der Einfachheit halber werden die Ergebnisse zu einer Liste zusammen­ + gefaßt und mit "Name" in einen Bindelisteneintrag gesteckt. + + + 5. | + | + V + +-----+-----+ +-----+-----+ +-----+-----+ + | o | o--+--->| o | o--+--->| o | NIL | + +--+--+-----+ +--+--+-----+ +--+--+-----+ + | | | + V V V + INDEFINITE QUOTE Name + + + Dieser Parameter kann wie der in Fall 4. aufgeführte beliebig viele Argumente + aufnehmen, die zu einer Liste zusammengefaßt werden. Im Gegensatz zu 4. + wird aber wie bei 2. nichts durch "eval" berechnet, sondern die Argumente so + wie sie vorkommen übernommen. + +Auf einen Parameter der Form 4. oder 5. darf kein weiterer Parameter folgen, weil +solch ein Parameter alle restlichen Argumente verbraucht. Solchen Parametern darf - +als Ausnahme - auch kein Argument entsprechen; dann werden sie an die leere +Liste (d.h. NIL) gebunden. + +Der letzte Kasten in der Beschreibung des LAMBDA-Ausdrucks ist mit Absicht leer +geblieben; er kann eine der Formen + + + +-----+-----+ +----------+----------+ + | o | NIL | oder | Ganzzahl | XXXXXXXX | + +--+--+-----+ +----------+----------+ + | + V + Funktionsrumpf + + +annehmen. + +Die erste Form heißt, daß die Funktion durch Berechnung des Funktionsrumpfs mittels +"eval" berechnet werden soll; die zweite Form bewirkt den Aufruf einer der Standard­ +funktionen, je nachdem, welche Funktionsnummer bei "Ganzzahl" steht. In diesem +zweiten Fall werden die Argumente aber nicht durch den Namen des Parameters +identifiziert, sondern durch die Position des Eintrags in der Bindeliste. Dieser Pro­ +grammteil hängt also wesentlich von der Reihenfolge ab, in der die Bindelisteneinträ­ +ge, die bei der Parameter-Argument-Zuordnung entstehen, in die Bindeliste einge­ +fügt werden. Zur Zeit ist das die Umkehrung der Reihenfolge der Parameter. + +Die Namen der Refinements "arg 1", "arg 2", "arg 3" beziehen sich auch nicht auf +die Position des Arguments in der Argumentsliste, sondern auf die Position des +Eintrags in der Bindeliste. + +#page# + +4.4 Kommandoprozeduren #goalpage("p4.4")# + + + +Die Datei "lisp.4" enthält eine Reihe von Prozeduren, mit denen der LISP-Interpre­ +ter ähnlich wie der ELAN-Compiler aufgerufen werden kann. + +Die Prozedur + + start lisp system + +ermöglicht das erneute Starten des LISP-Systems, oder wenn "übersetzte" Pro­ +gramme, die in einem Heap einer anderen Task liegen, in dieser Task verarbeitet +werden sollen. + +Die Prozedur + + lisp + +stellt die LISP-Maschine in einem Doppelfenster im Bildschirmdialog zur Verfügung. +Bei der erstmaligen Benutzung muß die Datei "lisp.bootstrap" vorhanden sein. + +Die Prozedur + + break lisp + +koppelt die LISP-Task vom Benutzer-Terminal ab und baut das Doppelfenster für +den Bildschirmdialog neu auf. + + +Die Prozedur + + run lisp + +bewirkt, daß ein LISP-Programm eingelesen und ausgeführt wird; nach der Ausfüh­ +rung wird das Ergebnis der Berechnung ausgegeben. Diese Operationen werden auf +einer Kopie des Heaps ausgeführt, so daß Änderungen keine Dauerwirkung haben. +Mit + + run lisp again + +wird das zuletzt eingelesene Programm noch einmal gestartet; da dafür die gleiche +Kopie des Heaps wie bei "run" benutzt wird, kann das Ergebnis diesmal anders sein. + + insert lisp + +wirkt wie "run lisp", außer daß diesmal alle Änderungen, die durch das Einlesen und +Ausführen im Heap entstehen, dauerhaft sind. + + + PROC start lisp system (DATASPACE CONST heap): + Eine Kopie von "heap" wird der neue LISP-Heap. Wenn es sich um "nilspa­ + ce" handelt, werden einige organisatorische Strukturen im Heap aufgebaut und + die Atome "NIL" und "PNAME" erzeugt. + + PROC start lisp system (DATASPACE CONST heap, FILE VAR f): + Zunächst wird "start lisp system (heap)" gegeben. + Danach werden die Eigenschaftsbeschreibungen aus "f" in Strukturen im Heap + umgesetzt. + + Jede Beschreibung in "f" muß mit dem Zeilenanfang beginnen und kann sich + über mehrere Zeilen erstrecken. Jede Beschreibung besteht aus den Elementen + + wobei der Name einer Eigenschaft (i.a. APVAL oder FUNCTION) + und ein beliebiger S-Ausdruck sein müssen. Die drei Elemente müs­ + sen jeweils durch mindestens ein Leerzeichen getrennt sein. + + Wenn das Atom nicht existiert, wird es erzeugt; danach wird + unter in der Eigenschaftsliste eingetragen. + + Wenn NIL ist, muß wegfallen; dann wird nichts in die + Eigenschaftsliste eingetragen. + + DATASPACE PROC lisp heap: + Liefert den LISP-Heap. Das ist manchmal für Sicherheitskopien etc. nützlich. + Die durch "run lisp" erzeugten Kopien sind nicht zugänglich. + + PROC run lisp: + Ruft "run lisp (last param)" auf. + + PROC run lisp (TEXT CONST file name): + Das in der Datei "file name" stehende LISP-Programm (d.h. der dort stehende + in einen S-Ausdruck übersetzte M-Ausdruck) wird in eine neue Kopie des + LISP-Heaps eingelesen und ausgeführt. Evtl. vorher durch "run lisp" erzeugte + Kopien des Heaps werden vorher gelöscht. + + Wenn das Programm syntaktisch nicht korrekt ist, wird es im Paralleleditor zur + Korrektur angeboten. + + PROC run lisp again: + Führt das zuletzt eingelesene Programm noch einmal im gleichen Heap aus. + + PROC insert lisp: + Ruft "insert lisp (last param)" auf. + + PROC insert lisp (TEXT CONST file name): + Wirkt wie "run lisp (file name)", nur daß alle Operationen auf dem Originalheap + ausgeführt werden. Auch "run lisp again" wirkt nun nicht mehr auf der Kopie. + diff --git a/lang/lisp/1.8.7/source-disk b/lang/lisp/1.8.7/source-disk new file mode 100644 index 0000000..e61107d --- /dev/null +++ b/lang/lisp/1.8.7/source-disk @@ -0,0 +1 @@ +informatikpaket/01_sprachen.img diff --git "a/lang/lisp/1.8.7/src/\"15\"TAB2\"14\"" "b/lang/lisp/1.8.7/src/\"15\"TAB2\"14\"" new file mode 100644 index 0000000..654b374 Binary files /dev/null and "b/lang/lisp/1.8.7/src/\"15\"TAB2\"14\"" differ diff --git a/lang/lisp/1.8.7/src/lisp.1 b/lang/lisp/1.8.7/src/lisp.1 new file mode 100644 index 0000000..32a9c27 --- /dev/null +++ b/lang/lisp/1.8.7/src/lisp.1 @@ -0,0 +1,1306 @@ +PACKET lisp heap and oblist management (* Autor: J.Durchholz *) + (* Datum: 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* hey 25.2.83 *) + initialize lisp system, + dump lisp heap, + lisp storage, + collect lisp heap garbage, + SYM, + :=, + nil, + pname, + head, + set head, + tail, + set tail, + cons, + eq, + equal, + null, + atom, + is named atom, + begin oblist dump, + next atom, + new atom, + create atom, + delete atom, + begin property list dump, + next property, + add property, + alter property, + property, + delete property, + property exists, + add flag, + flag, + delete flag, + text, + is text, + character, + is character, + sym character, + int 1, + int 2, + is int pair, + sym: + + +(* NOTE: All internal routines are prefixed by x *) + + +(***************************** heap management ****************************) + +LET + max size = 32767, + NODE = STRUCT (INT status, + head, tail); +LET HEAP = STRUCT (INT size, + ROW max size NODE node); + + +BOUND HEAP VAR heap; + + +PROC initialize lisp system (DATASPACE CONST ds): + IF type (ds) < 0 THEN + heap := ds; + x initialize oblist and heap size; + create atom ("NIL"); + create atom ("PNAME"); + ELSE + heap := ds + FI +END PROC initialize lisp system; + + +PROC dump lisp heap (FILE VAR f): + put line (f, "Groesse :" + text (CONCR (heap).size)); + line (f); + put (CONCR (heap).size); + BOOL VAR is char := FALSE; + INT VAR i; + FOR i FROM 1 UPTO CONCR (heap).size REP + cout (i); + dump ith node + PER. + +dump ith node: + put (f, text (i, 6)); + put (f, status); + put (f, head); + put (f, tail); + line (f). + +status: + SELECT ith node.status OF + CASE atomic : "ATOMIC............" + CASE non atomic : "NON ATOMIC........" + CASE oblist bone : "OBLIST BONE......." + CASE property indicator : "PROPERTY INDICATOR" + CASE property root : "PROPERTY ROOT....." + CASE flag indicator : "FLAG INDICATOR...." + CASE text data : "TEXT DATA........." + CASE character data : is char := TRUE; "CHARACTER DATA...." + CASE int data : "INT DATA.........." + OTHERWISE "????." + text (ith node.status, 6) + ".????" + END SELECT. + +head: + maybe a code + text (ith node.head, 6). + +maybe a code: + IF is char THEN + is char := FALSE; + IF ith node.head > 31 AND 128 > ith node.head THEN + " " + code (ith node.head) + " " + ELSE + " " + FI + ELSE + " " + FI. + +tail: + text (ith node.tail, 6). + +ith node: + CONCR (heap).node (i). + +END PROC dump lisp heap; + + +PROC lisp storage (INT VAR size, used): + size := max size; + used := CONCR (heap).size +END PROC lisp storage; + + +PROC collect lisp heap garbage: + mark all used nodes; + transfer all used high address nodes to unused low address nodes; + adjust all pointers to cleared high address area and unmark all nodes; + adjust size. + +mark all used nodes: + INT VAR i; + FOR i FROM 2 UPTO 28 REP + x mark (i) + PER. + +transfer all used high address nodes to unused low address nodes: + INT VAR high address :: CONCR (heap).size + 1, + low address :: 0; + REP + find next lower used high address node; + IF no used high address node found THEN + LEAVE transfer all used high address nodes to unused low address nodes + FI; + find next higher unused low address node; + IF no unused low address node found THEN + LEAVE transfer all used high address nodes to unused low address nodes + FI; + transfer high address node to low address node + PER. + +find next lower used high address node: + REP + high address DECR 1 + UNTIL high address node marked PER. + +high address node marked: + high address node.status < 0. + +no used high address node found: + low address = high address. + +find next higher unused low address node: + REP + low address INCR 1 + UNTIL low address node not marked OR low address = high address PER. + +low address node not marked: + low address node.status > 0. + +no unused low address node found : + low address = high address. + +transfer high address node to low address node: + low address node.status := high address node.status; + low address node.head := high address node.head; + low address node.tail := high address node.tail; + high address node.head := low address. + +adjust all pointers to cleared high address area and unmark all nodes: + (* 'high address' should now point to the last node of the used area *) + FOR low address FROM 1 UPTO high address REP + unmark low address node; + SELECT low address node.status OF + CASE oblist bone: adjust head + CASE atomic, + non atomic, + property indicator, + property root, + flag indicator: adjust head; adjust tail + CASE text data, character data: adjust tail + CASE int data: + OTHERWISE x lisp error ("Status " + text (low address node.status) + + " gefunden bei pointer Justage") + END SELECT + PER. + +unmark low address node: + low address node.status := - low address node.status. + +adjust head: + IF low address node.head > high address THEN + low address node.head := node (low address node.head).head + FI. + +adjust tail: + IF low address node.tail > high address THEN + low address node.tail := node (low address node.tail).head + FI. + +adjust size: + CONCR (heap).size := high address. + +low address node: + node (low address). + +high address node: + node (high address). + +node: + CONCR (heap).node. + +END PROC collect lisp heap garbage; + + +PROC x mark (INT CONST ptr): + IF node not yet marked THEN + mark node; + SELECT - ptr node.status OF + CASE oblist bone: x mark (ptr node.head) + CASE atomic, + non atomic, + property indicator, + property root, + flag indicator: x mark (ptr node.head); x mark (ptr node.tail) + CASE text data, character data: x mark (ptr node.tail) + CASE int data: + OTHERWISE error stop ("Status " + text (- ptr node.status) + + " gefunden beim Markieren") + END SELECT + FI. + + +node not yet marked: + ptr node.status > 0. + +mark node: + ptr node.status := - ptr node.status. + +ptr node: + CONCR (heap).node (ptr) + +END PROC x mark; + + +TYPE SYM = INT; + + +OP := (SYM VAR left, SYM CONST right): + CONCR (left) := CONCR (right) +END OP :=; + + +LET atomic = 1, + non atomic = 2, + oblist bone = 3, + property indicator = 4, + property root = 5, + flag indicator = 6, + text data = 7, + character data = 8, + int data = 9; + +SYM CONST nil :: SYM :(35), (* 'x initialize oblist and heap size' will *) + pname :: SYM :(44); (* place the atom NIL at node 35 and PNAME *) + (* at node 44 *) + + +(***************************** basic functions ****************************) + + +SYM PROC head (SYM CONST sym): + SELECT status of sym OF + CASE atomic: error stop ("Atome haben keinen head"); nil + CASE non atomic: SYM :(head of sym) + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type:" + + text (status of sym)); + nil + CASE text data, + character data, + int data : error stop ("Daten haben keinen head"); nil + OTHERWISE x lisp error ("Illegaler Status " + text (status of sym)); + nil + END SELECT. + +status of sym: + sym node.status. + +head of sym: + sym node.head. + +sym node: + CONCR (heap).node (CONCR (sym)) + +END PROC head; + + +SYM PROC x head (SYM CONST sym): + SYM :(CONCR (heap).node (CONCR (sym)).head) +END PROC x head; + + +PROC set head (SYM CONST sym, new head): + SELECT status of sym OF + CASE atomic: errorstop ("Atome haben keinen head") + CASE non atomic: head of sym := CONCR (new head) + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type:" + + text (status of sym)) + CASE text data, + character data, + int data : error stop ("Daten haben keinen head") + OTHERWISE x lisp error ("Illegaler Status " + text (status of sym)) + END SELECT. + +status of sym: + sym node.status. + +head of sym: + sym node.head. + +sym node: + CONCR (heap).node (CONCR (sym)). + +END PROC set head; + + +PROC x set head (SYM CONST sym, new head): + CONCR (heap).node (CONCR (sym)).head := CONCR (new head) +END PROC x set head; + + +SYM PROC tail (SYM CONST sym): + SELECT status of sym OF + CASE atomic: error stop ("Atome haben keinen tail"); nil + CASE non atomic: SYM :(tail of sym) + CASE oblist bone, + property indicator, + flag indicator : x lisp error ("Versteckter Knoten:" + + text (status of sym)); + nil + CASE text data, + character data, + int data : error stop ("Daten haben keinen tail"); nil + OTHERWISE x lisp error ("Illegaler Status: "+ text (status of sym)); + nil + END SELECT. + +status of sym: + sym node.status. + +tail of sym: + sym node.tail. + +sym node: + CONCR (heap).node (CONCR (sym)). + +END PROC tail; + + +SYM PROC x tail (SYM CONST sym): + SYM :(CONCR (heap).node (CONCR (sym)).tail) +END PROC x tail; + + +PROC set tail (SYM CONST sym, new tail): + SELECT status of sym OF + CASE atomic: error stop ("Atome haben keinen tail") + CASE non atomic: tail of sym := CONCR (new tail) + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type: " + + text (status of sym)) + CASE text data, + character data, + int data : error stop ("Daten tails sind unveraenderbar") + OTHERWISE x lisp error ("Illegaler Status: " + text (status of sym)) + END SELECT. + +status of sym: + sym node.status. + +tail of sym: + sym node.tail. + +sym node: + CONCR (heap).node (CONCR (sym)). + +END PROC set tail; + + +PROC x set tail (SYM CONST sym, new tail): + CONCR (heap).node (CONCR (sym)).tail := CONCR (new tail) +END PROC x set tail; + + +SYM PROC cons (SYM CONST head, tail): + SYM VAR result; + search free node; + result node.status := non atomic; + result node.head := CONCR (head); + result node.tail := CONCR (tail); + result. + +search free node: + IF CONCR (heap).size = max size THEN + error stop ("LISP Heap Ueberlauf"); + LEAVE cons WITH nil + ELSE + CONCR (heap).size INCR 1; + CONCR (result) := CONCR (heap).size; cout(CONCR(result)) + FI. + +result node: + CONCR (heap).node (CONCR (result)). + +END PROC cons; + + +BOOL PROC eq (SYM CONST sym 1, sym 2): + CONCR (sym 1) = CONCR (sym 2) +END PROC eq; + + +BOOL PROC equal (SYM CONST sym 1, sym 2): + eq (sym 1, sym 2) COR have same value. + +have same value: + IF sym 1 node.status <> sym 2 node.status THEN + FALSE + ELSE + SELECT sym 1 node.status OF + CASE atomic: FALSE + CASE non atomic: equal (head (sym 1), head (sym 2)) CAND + equal (tail (sym 1), tail (sym 2)) + CASE oblist bone, + property indicator, + property root, + flag indicator: x lisp error ("Versteckter Knoten, Type: " + + text (x status (sym 1))); FALSE + CASE text data: equal texts + CASE character data: sym 1 node.head = sym 2 node.head + CASE int data: sym 1 node.head = sym 2 node.head AND + sym 1 node.tail = sym 2 node.tail + OTHERWISE x lisp error ("Ilegaler Status " + text (x status (sym 1))); + FALSE + END SELECT + FI. + +equal texts: + equal length CAND equal character sequence. + +equal length: + eq (x head (sym 1), x head (sym 2)). + +equal character sequence: + SYM VAR actual sym 1 character :: sym 1, + actual sym 2 character :: sym 2; + INT VAR i; + FOR i FROM 1 UPTO sym 1 node. head REP + actual sym 1 character := x tail (actual sym 1 character); + actual sym 2 character := x tail (actual sym 2 character); + IF eq (actual sym 1 character, actual sym 2 character) THEN + LEAVE equal character sequence WITH TRUE + FI; + IF x status (actual sym 1 character) <> character data OR + x status (actual sym 2 character) <> character data THEN + x lisp error ("Ungueltiges Zeichen im text"); + LEAVE equal character sequence WITH FALSE + FI; + IF CONCR (x head (actual sym 1 character)) <> + CONCR (x head (actual sym 2 character)) THEN + LEAVE equal character sequence WITH FALSE + FI + PER; + TRUE. + +sym 1 node: + CONCR (heap).node (CONCR (sym 1)). + +sym 2 node: + CONCR (heap).node (CONCR (sym 2)). + +END PROC equal; + + +BOOL PROC null (SYM CONST sym): + CONCR (sym) = CONCR (nil) +END PROC null; + + +BOOL PROC atom (SYM CONST sym): + SELECT x status (sym) OF + CASE atomic, + text data, + character data, + int data: TRUE + CASE non atomic: FALSE + CASE oblist bone, + property indicator, + property root, + flag indicator : x lisp error ("Versteckter Knoten, Type:" + + text (x status (sym))); TRUE + OTHERWISE x lisp error ("Illegaler Status " + + text (x status (sym))); TRUE + END SELECT +END PROC atom; + + +BOOL PROC is named atom (SYM CONST sym): + x status (sym) = atomic +END PROC is named atom; + + +(*------------------- internal heap management routines ------------------*) + + +SYM PROC x new node (INT CONST status, head, tail): + IF CONCR (heap).size = max size THEN + error stop ("LISP Heap Ueberlauf"); nil + ELSE + CONCR (heap).size INCR 1; + new node.status := status; + new node.head := head; + new node.tail := tail; + SYM :(CONCR (heap).size) + FI. + +new node: + node (CONCR (heap).size). + +node: + CONCR (heap).node. + +END PROC x new node; + + +INT PROC x status (SYM CONST sym): + CONCR (heap).node (CONCR (sym)).status +END PROC x status; + + +(**************************** oblist management ***************************) + + +(* Oblist organization: + +(NOTE: + + +-----------------+ + l l + All nodes are represented as +--------+--------+ in all comments + l l l of this packet. + +--------+--------+ + +END OF NOTE) + + +The 'oblist' (object list) is organized as follows: + + +-------------+ + l oblist bone l + +------+------+ +--> list of all atoms whose print names begin with "§" + l o l XXXX l l + +---+--+------+ l + +------------+ + +-------------+ + l oblist bone l + +------+------+ +--> list of all atoms whose print names begin with "A" + l o l XXXX l l + +---+--+------+ l + +------------+ + . + . + . + + +-------------+ + l oblist bone l + +------+------+ +--> list of all atoms whose print names begin with "Z" + l o l XXXX l l + +---+--+------+ l + +------------+ + + +These nodes with status 'oblist bone' form the oblist skeleton. As long as +the lisp heap exists, they are stored contiguously in nodes 2 - 28; they +cannot be changed directly by the user. This way of storing the oblist +skeleton allows a hashing scheme to be applied when searching for an atom +with a given name. The hash width of 27 is the smallest one thas distributes +all atoms according to their character; with a smaller hash size, two or +more lists would be merged, with the effect that some of the atom lists +would contain atoms beginning with different characters. + + +The list of all atoms whose print names begin with a certain character +is organized as follows: + + +-------------+ + l atomic l + +------+------+ + l o l o---+--> property list of first atom + +---+--+------+ + l + V + +-------------+ + l atomic l + +------+------+ + l o l o---+--> property list of 2nd atom + +---+--+------+ + l + V + . + . + . + + l + V + +-------------+ + l atomic l + +------+------+ + l o l o---+--> property list of last atom + +---+--+------+ + l + V + oblist bone where the atom list began + + +These lists cannot be acessed directly by the user, too. +*) + + + +PROC x initialize oblist and heap size: + node (1).status := text data; + node (1).head := 32 (* blank *); + node (1).tail := 1; + INT VAR i; + FOR i FROM 2 UPTO 28 REP + node (i).status := oblist bone; + node (i).head := i + PER; + CONCR (heap).size := 28. + +node: + CONCR (heap).node. + +END PROC x initialize oblist and heap size; + + +(*++++++++++++++++++++++++++++++ oblist dump +++++++++++++++++++++++++++++*) + + +SYM VAR actual oblist bone :: SYM :(0), + actual atom :: SYM :(0); + + +PROC begin oblist dump: + actual oblist bone := SYM :(2); + actual atom := SYM :(2) +END PROC begin oblist dump; + + +SYM PROC next atom: + actual atom := x head (actual atom); + WHILE no more atoms in this atom list REP + try next oblist bone + PER; + actual atom. + +no more atoms in this atom list: + (* NIL is given as last atom when 'next atom' is called repeatedly, so *) + (* it can serve as a terminator. So NIL "does not count" if it is *) + (* encountered during one of the calls. *) + IF null (actual atom) THEN + actual atom := x head (actual atom) + FI; + eq (actual atom, actual oblist bone). + +try next oblist bone: + IF actual oblist bone is last oblist bone THEN + actual atom := SYM :(2); + LEAVE next atom WITH nil + FI; + CONCR (actual oblist bone) INCR 1; + actual atom := x head (actual oblist bone). + +actual oblist bone is last oblist bone: + CONCR (actual oblist bone) = 28. + +END PROC next atom; + + +(*+++++++++++++++++++++++ atom search and creation +++++++++++++++++++++++*) + + +SYM VAR predecessor, result; + (* Variables used for communication between the internal search *) + (* procedures and the procedures calling them. *) + + +SYM PROC atom (TEXT CONST name): + x search atom (name); + IF atom not already existing THEN + nil + ELSE + result + FI. + +atom not already existing: + x status (result) = oblist bone. + +END PROC atom; + + +SYM PROC new atom (TEXT CONST name): + x search atom (name); + IF atom not already existing THEN + x create new atom (name); + FI; + result. + +atom not already existing: + x status (result) = oblist bone. + +END PROC new atom; + + +PROC create atom (TEXT CONST name): + x search atom (name); + IF atom already existing THEN + error stop ("Atom " + name + " existiert bereits") + ELSE + x create new atom (name) + FI. + +atom already existing: + x status (result) <> oblist bone. + +END PROC create atom; + + +PROC delete atom (SYM CONST atom): + IF is named atom (atom) THEN + IF null (atom) OR eq (atom, pname) THEN + error stop ("Dies Atom darf nicht geloescht werden") + ELSE + search predecessor; + delete atom from atom list + FI + ELSE + error stop ("Nur benannte Atome können geloescht werden") + FI. + +search predecessor: + predecessor := x head (atom); + WHILE NOT eq (x head (predecessor), atom) REP + predecessor := x head (predecessor) + PER. + +delete atom from atom list: + x set head (predecessor, x head (atom)). + +END PROC delete atom; + + +PROC x search atom (TEXT CONST name): + CONCR (result) := (code (name SUB 1) + 17) MOD 27 + 2; + (* This formula places the list of atoms beginning with "§" at the *) + (* first oblist bone, the list of atoms beginning with "A" at the *) + (* at the second one, and so on. (See also the big comment in lines *) + (* 600 - 700) *) + REP + predecessor := result; + result := x head (predecessor); + UNTIL end of atom list reached COR right atom found PER. + +end of atom list reached: + x status (result) = oblist bone. + +right atom found: + SYM VAR actual character node := property (result, pname); + IF NOT is text (actual character node) THEN + x lisp error ("Namen erwartet"); + LEAVE right atom found WITH FALSE + FI; + IF CONCR (x head (actual character node)) <> length (name) THEN + FALSE + ELSE + INT VAR i; + FOR i FROM 1 UPTO length (name) REP + to next character node; + check wether is character data node; + check wether character matches; + PER; + TRUE + FI. + +to next character node: + actual character node := x tail (actual character node). + +check wether is character data node: + IF x status (actual character node) <> character data THEN + x lisp error ("Zeichenkette erwartet"); + LEAVE right atom found WITH FALSE + FI. + +check wether character matches: + IF code (name SUB i) <> CONCR (x head (actual character node)) THEN + LEAVE right atom found WITH FALSE + FI. + +END PROC x search atom; + + +PROC x create new atom (TEXT CONST name): + (* It is necessary that 'x search atom' has been executed before *) + (* calling 'x create new atom' because this procedure relies on the *) + (* value of 'predecessor'. *) + enable stop; + SYM CONST sym name :: sym (name); + IF CONCR (heap).size + 3 > max size THEN + error stop ("LISP Heap Ueberlauf") + FI; + result := newly created atom; + x set head (predecessor, result). + +newly created atom: + x new node (atomic, CONCR (oblist bone node), CONCR (property list)). + +oblist bone node: + x head (predecessor). + +property list: + x new node (property indicator, CONCR (pname), property root node). + +property root node: + CONCR (x new node (property root, CONCR (sym name), CONCR (nil))). + +END PROC x create new atom; + + +(************************* property list handling *************************) + +(* +The property lists consist of chained units of the structure + + +--------------------+ +---------------+ + l property indicator l l property root l + +----------+---------+ +-------+-------+ + l o l o----+-->l o l o---+--> . . . + +----+-----+---------+ +---+---+-------+ + l l + V V + property id property + + +or + + +----------------+ + l flag indicator l + +--------+-------+ + l o l o---+--> . . . + +---+----+-------+ + l + V + flag id + + + +The property lists cannot be altered or read directly, too. + +For property list handling there exist procedures that insert, change, read +and delete properties resp. flags. Thus, the only thing that can be done +with any property of an atom without using these special procedures, is +comparing to or 'cons'ing with some other S-expression. +At any given time the property list of any atom (including 'NIL') contains +the property 'PNAME' giving the print name of the atom, stored as a list of +characters. This special property cannot be altered, overwritten by 'add +property' or deleted. +*) + + +(*++++++++++++++++++++++++++ property list dump ++++++++++++++++++++++++++*) + + +SYM VAR actual property list node :: nil; + + +PROC begin property list dump (SYM CONST atom): + actual property list node := x tail (atom) +END PROC begin property list dump; + + +PROC next property (SYM VAR property id, property): + IF null (actual property list node) THEN + property id := nil; + property := nil + ELSE + SELECT x status (actual property list node) OF + CASE flag indicator: get flag id + CASE property indicator: get property id and property + OTHERWISE x lisp error ("Flagge oder Eigenschaft erwartet und nicht: " + + text (x status (actual property list node))) + END SELECT + FI. + +get flag id: + property id := x head (actual property list node); + actual property list node := x tail (actual property list node); + property := nil. + +get property id and property: + property id := x head (actual property list node); + actual property list node := x tail (actual property list node); + IF x status (actual property list node) = property root THEN + property := x head (actual property list node); + actual property list node := x tail (actual property list node) + ELSE + x lisp error ("Eigenschaftswurzel erwartet, nicht:" + + text (x status (actual property list node))); + property := nil + FI. + +END PROC next property; + + +(*+++++++++++++++++++++++++++++ properties +++++++++++++++++++++++++++++++*) + + +SYM VAR last atom :: SYM :(0), + p list predecessor, + p list result; + + +PROC add property (SYM CONST atom, property id, property): + IF eq (property id, pname) THEN + errorstop ("Der PNAME eines Atoms darf nicht versteckt sein") + ELSE + IF CONCR (heap).size + 2 > max size THEN + error stop ("LISP Heap Ueberlauf"); + LEAVE add property + FI; + x set tail (atom, new property plus old property list); + IF eq (atom, last atom) AND + eq (property id, x head (p list result)) THEN + p list predecessor := atom; + p list result := x tail (atom) + FI + FI. + +new property plus old property list: + x new node (property indicator, + CONCR (property id), CONCR (property root plus old property list)). + +property root plus old property list: + x new node (property root, CONCR (property), CONCR (old property list)). + +old property list: + x tail (atom) + +END PROC add property; + + +PROC alter property (SYM CONST atom, property id, new property): + IF eq (property id, pname) THEN + error stop ("Namen kann man nicht aendern") + ELSE + x search property id (atom, property id); + IF null (p list result) THEN + error stop ("Eigenschaft existiert nicht") + ELSE + x set head (x tail (p list result), new property) + FI + FI +END PROC alter property; + + +SYM PROC property (SYM CONST atom, property id): + x search property id (atom, property id); + IF null (p list result) THEN + nil + ELSE + x head (x tail (p list result)) + FI +END PROC property; + + +PROC delete property (SYM CONST atom, property id): + IF eq (property id, pname) THEN + errorstop ("Der Name eines Atoms darf nicht geloescht werden") + ELSE + x search property id (atom, property id); + IF NOT null (p list result) THEN + x set tail (p list predecessor, x tail (x tail (p list result))); + last atom := SYM :(0) + FI + FI +END PROC delete property; + + +BOOL PROC property exists (SYM CONST atom, property id): + x search property id (atom, property id); + NOT null (p list result) +END PROC property exists; + + +PROC x search property id (SYM CONST atom, property id): + IF eq (last atom, atom) AND eq (x head (p list result), property id) THEN + LEAVE x search property id + FI; + last atom := atom; + p list predecessor := atom; + REP + p list result := x tail (p list predecessor); + IF end of property list THEN + last atom := SYM :(0); + LEAVE x search property id + FI; + SELECT x status (p list result) OF + CASE flag indicator: p list predecessor := p list result + CASE property indicator: check wether property root node follows; + IF correct property id found THEN + LEAVE x search property id + ELSE + p list predecessor := xtail (p list result) + FI + CASE property root: xlisperror("Unordentliche Eigenschaftwurzel"); + p list result := nil; + last atom := SYM :(0); + LEAVE x search property id + OTHERWISE x lisp error ("Eigenschaften erwartet und nicht: " + + text (x status (p list result))); + p list result := nil; + last atom := SYM :(0); + LEAVE x search property id + END SELECT + PER. + +end of property list: + null (p list result). + +check wether property root node follows: + IF x status (x tail (p list result)) <> property root THEN + x lisp error ("Eigenschaftswurzel erwartet"); + p list result := nil; + last atom := SYM :(0); + LEAVE x search property id + FI. + +correct property id found: + eq (x head (p list result), property id). + +END PROC x search property id; + + +(*++++++++++++++++++++++++++++++++ flags +++++++++++++++++++++++++++++++++*) + + +PROC add flag (SYM CONST atom, flag id): + enable stop; + x set tail (atom, new flag plus old property list). + +new flag plus old property list: + x new node (flag indicator, CONCR (flag id), old property list). + +old property list: + CONCR (x tail (atom)) + +END PROC add flag; + + +BOOL PROC flag (SYM CONST atom, flag id): + x search flag id (atom, flag id); + NOT null (result) +END PROC flag; + + +PROC delete flag (SYM CONST atom, flag id): + x search flag id (atom, flag id); + IF NOT (is error COR null (result)) THEN + x set tail (predecessor, x tail (result)) + FI +END PROC delete flag; + + +PROC x search flag id (SYM CONST atom, flag id): + predecessor := atom; + REP + result := x tail (predecessor); + IF end of property list THEN + LEAVE x search flag id + FI; + SELECT x status (result) OF + CASE property root, property indicator: predecessor := result + CASE flag indicator: IF correct flag id found THEN + LEAVE x search flag id + ELSE + predecessor := result + FI + OTHERWISE x lisp error ("Eigenschaften erwartet und nicht:" + + text (x status (result))); + result := nil; + LEAVE x search flag id + END SELECT + PER. + +end of property list: + null (result). + +correct flag id found: + eq (x head (result), flag id). + +END PROC x search flag id; + + +(****** Conversion of non-LISP data to LISP structures and vice versa *****) + + +TEXT PROC text (SYM CONST sym): + IF is text (sym) THEN + TEXT VAR result := ""; + SYM VAR actual node :: sym; + INT VAR i; + FOR i FROM 1 UPTO CONCR (x head (sym)) REP + actual node := x tail (actual node); + result CAT actual character + PER; + result + ELSE + error stop ("ist kein text"); + "" + FI. + +actual character: + IF x status (actual node) <> character data THEN + x lisp error ("Zeichenfolge erwartet"); + LEAVE text WITH result + FI; + code (CONCR (x head (actual node))). + +END PROC text; + + +BOOL PROC is text (SYM CONST sym): + x status (sym) = text data +END PROC is text; + + +SYM PROC sym (TEXT CONST text): + SYM VAR result :: x new node (text data, + length (text), CONCR (nil)), + actual character node :: result; + INT VAR length of text; + ignore blanks at end of text; + INT VAR i; + FOR i FROM 1 UPTO length of text REP + x set tail (actual character node, new next character node); + actual character node := x tail (actual character node) + PER; + result. + +ignore blanks at end of text: + FOR length of text FROM length (text) DOWNTO 0 REP + IF (text SUB length of text) <> " " THEN + LEAVE ignore blanks at end of text + FI + PER; + length of text := 0. + +new next character node: + x new node (character data, code (text SUB i), 1). + +END PROC sym; + + +INT PROC character (SYM CONST sym): + IF x status (sym) = character data THEN + CONCR (x head (sym)) + ELSE + error stop ("ist kein Charakter"); + -1 + FI +END PROC character; + + +BOOL PROC is character (SYM CONST sym): + x status (sym) = character data +END PROC is character; + + +SYM PROC sym character (INT CONST char): + x new node (character data, char MOD 256, 1) +END PROC sym character; + + +INT PROC int 1 (SYM CONST sym): + IF x status (sym) = int data THEN + CONCR (x head (sym)) + ELSE + error stop ("ist keine Zahl"); + -1 + FI +END PROC int 1; + + +INT PROC int 2 (SYM CONST sym): + IF x status (sym) = int data THEN + CONCR (x tail (sym)) + ELSE + error stop ("ist keine Zahl"); + -1 + FI +END PROC int 2; + + +BOOL PROC is int pair (SYM CONST sym): + x status (sym) = int data +END PROC is int pair; + + +SYM PROC sym (INT CONST int 1, int 2): + x new node (int data, int 1, int 2) +END PROC sym; + + +(********************* internal error routine *****************************) + + +PROC x lisp error (TEXT CONST error message): + error stop (""13"LISP SYSTEM FEHLER: " + error message ) +END PROC x lisp error; + + +END PACKET lisp heap and oblist management; + + + +PACKET name (* Autor: J.Durchholz *) + (* Datum: 15.06.1982 *) + DEFINES (* Version 1.1.1 *) + + name: + +TEXT PROC name (SYM CONST sym): + IF is named atom (sym) THEN + text (property (sym, pname)) + ELSE + ""15"IST_KEIN_ATOM"14"" + FI +END PROC name; + + +END PACKET name; + + + +PACKET lisp storage info (* Autor: J.Durchholz *) + (* Datum: 23.08.1982 *) + DEFINES (* Version 1.1.1 *) + + lisp storage info: + + +PROC lisp storage info: + INT VAR size, used; + lisp storage (size, used); + out (""13""10" "); + put (used); + put ("Knoten von"); + put (size); + put line ("Knoten des LISP-Heaps sind belegt!") +END PROC lisp storage info; + + +END PACKET lisp storage info; + diff --git a/lang/lisp/1.8.7/src/lisp.2 b/lang/lisp/1.8.7/src/lisp.2 new file mode 100644 index 0000000..28e6924 --- /dev/null +++ b/lang/lisp/1.8.7/src/lisp.2 @@ -0,0 +1,584 @@ +PACKET character buffer (* Autor : J.Durchholz *) + (* Datum : 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* 21.2.83. hey 293, 450,97,361 *) + get char, + line nr, + init char buffer: + + +TEXT VAR buffer; +INT VAR pointer, + line; + + +INT PROC line nr: + line +END PROC line nr; + + +PROC init char buffer: + buffer := ""; + pointer := 1; + line := 0; +END PROC init char buffer; + + +PROC get char (FILE VAR f, TEXT VAR char): + IF buffer empty THEN + try to find nonempty line and put it into buffer; + char := " "; + pointer := 1 + ELSE + char := buffer SUB pointer; + pointer INCR 1 + FI. + +buffer empty: + pointer > length (buffer). + +try to find nonempty line and put it into buffer: + REP + IF eof (f) THEN + char := ""; + LEAVE get char + FI; + get line (f, buffer); + line INCR 1 + UNTIL buffer <> "" PER. + +END PROC get char; + + +END PACKET character buffer; + + + + +PACKET lisp io (* Autor: J.Durchholz *) + (* Datum: 10.09.1982 *) + DEFINES (* Version 4.1.3 *) + (* Änderung: notebook *) + put, note, (* 13.3.86 I. Ley *) + verbose lisp output, + get, + get all: + + +BOOL VAR verbose :: FALSE; + + +PROC verbose lisp output (BOOL CONST b): + verbose := b +END PROC verbose lisp output; + +BOOL PROC verbose lisp output: + verbose +END PROC verbose lisp output; + + +PROC put (SYM CONST sym): + IF atom (sym) THEN + put atom + ELSE + put structure + FI. + +put atom: + IF is named atom (sym) THEN + put (name (sym)) + ELIF is int pair (sym) THEN + put (int 1 (sym)) + ELIF is text (sym) THEN + IF verbose THEN + TEXT VAR buffer :: text (sym); + change all (buffer, """", """"""); + buffer CAT """"; + put ("""" + buffer) + ELSE + write (text (sym)) + FI + ELIF is character (sym) THEN + IF verbose THEN + buffer := "'"; + buffer CAT code (character (sym)); + buffer CAT "'"; + put (buffer) + ELSE + out (code (character (sym))) + FI + ELSE + put (""15"UNBEKANNTER_ATOM_TYP"14"") + FI. + +put structure: + put ("("); + SYM VAR actual node := sym; + REP + put (head (actual node)); + actual node := tail (actual node) + UNTIL atom (actual node) PER; + IF NOT null (actual node) THEN + put ("."); + put (actual node) + FI; + put (")"). + +END PROC put; + +PROC put (FILE VAR f, SYM CONST sym): + IF atom (sym) THEN + put atom + ELSE + put structure + FI. + +put atom: + IF is named atom (sym) THEN + put (f, name (sym)) + ELIF is int pair (sym) THEN + put (f, int 1 (sym)) + ELIF is text (sym) THEN + IF verbose THEN + TEXT VAR buffer :: text (sym); + change all (buffer, """", """"""); + buffer CAT """"; + put (f, """" + buffer) + ELSE + put (f, text (sym)) + FI + ELIF is character (sym) THEN + IF verbose THEN + buffer := "'"; + buffer CAT code (character (sym)); + buffer CAT "'"; + put (f, buffer) + ELSE + put (f, code (character (sym))) + FI + ELSE + put ( f, ""15"UNBEKANNTER_ATOM_TYP"14"") + FI. + +put structure: + put (f, "("); + SYM VAR actual node := sym; + REP + put (f, head (actual node)); + actual node := tail (actual node) + UNTIL atom (actual node) PER; + IF NOT null (actual node) THEN + put (f, "."); + put (f, actual node) + FI; + put (f, ")"). + +END PROC put; + + PROC note (SYM CONST sym): + IF atom (sym) THEN + note atom + ELSE + note structure + FI. + +note atom: + IF is named atom (sym) THEN + note ( name (sym)) + ELIF is int pair (sym) THEN + note (int 1 (sym)) + ELIF is text (sym) THEN + IF verbose THEN + TEXT VAR buffer :: text (sym); + change all (buffer, """", """"""); + buffer CAT """"; + note ( """" + buffer) + ELSE + note ( text (sym)) + FI + ELIF is character (sym) THEN + IF verbose THEN + buffer := "'"; + buffer CAT code (character (sym)); + buffer CAT "'"; + note ( buffer) + ELSE + note ( code (character (sym))) + FI + ELSE + note ( ""15"UNBEKANNTER_ATOM_TYP"14"") + FI. + +note structure: + note ( "("); + SYM VAR actual node := sym; + REP + note ( head (actual node)); + actual node := tail (actual node) + UNTIL atom (actual node) PER; + IF NOT null (actual node) THEN + note ( "."); + note ( actual node) + FI; + note ( ")"). + +END PROC note; + +PROC get (FILE VAR f, SYM VAR s): + initialize scanner (f); + IF NOT get s expression (s) THEN + error ("LISP-Ausdruck erwartet") + FI; + scanner postprocessing (f) +END PROC get; + + +(**************************** parser for 'get' ****************************) + + +LET end of file type = 0, + name type = 1, + text type = 2, + character type = 3, + int type = 4, + other char type = 5; + + +BOOL PROC get s expression (SYM VAR s): + (* The boolean result indicates wether the error has not occurred that *) + (* 'get next symbol' was called, but then the symbol was not expected *) + (* and thus could not be processed. *) + get next symbol; + SELECT symbol type OF + CASE end of file type: FALSE + CASE name type: s := new atom (symbol); TRUE + CASE text type: s := sym (symbol); TRUE + CASE character type: s := sym character (code (symbol)); TRUE + CASE int type: s := sym (int (symbol), -1); TRUE + CASE other char type: get structure + OTHERWISE error ("EINLESEFEHLER: unbekannter Symboltyp: " + + text (symbol type)); TRUE + END SELECT. + +get structure: + IF symbol <> "(" THEN + FALSE + ELSE + get list; + IF symbol type <> other char type OR symbol <> ")" THEN + error (">> ) << erwartet"); + FALSE + ELSE + TRUE + FI + FI. + +get list: + SYM VAR father, son; + IF get s expression (son) THEN + get list elements; + ELSE + s := nil + FI. + +get list elements: + father := cons (son, nil); + s := father; + WHILE get s expression (son) REP + set tail (father, cons (son, nil)); + father := tail (father) + PER; + IF symbol type = other char type AND symbol = "." THEN + IF get s expression (son) THEN + set tail (father, son); + get next symbol + ELSE + error ("LISP-Ausdruck nach dem Punkt erwartet") + FI + FI. + +END PROC get s expression; + + +(********************* scanner for 'get x espression' *********************) + + +FILE VAR infile; + + +PROC initialize scanner (FILE CONST f): + infile := f; + no input errors := TRUE; + init char buffer; + get char (infile, actual char) +END PROC initialize scanner; + + +PROC scanner postprocessing (FILE VAR f): + f := infile +END PROC scanner postprocessing; + + +TEXT VAR symbol; INT VAR symbol type; + + +PROC get next symbol: + skip blanks; + IF actual char = "" THEN + symbol := "DATEIENDE"; + symbol type := end of file type + ELIF is letter THEN + get name + ELIF is digit or sign THEN + get integer + ELIF is double quote THEN + get text + ELIF is single quote THEN + get character + ELSE + get other char + FI . + +is letter: + IF "a" <= actual char AND actual char <= "z" THEN + actual char := code (code (actual char) - code ("a") + code ("A")); + TRUE + ELSE + "§" <= actual char AND actual char <= "Z" + FI. + +get name: + symbol type := name type; + symbol := actual char; + REP + get char (infile, actual char); + IF is neither letter nor digit THEN + LEAVE get name + FI; + symbol CAT actual char + PER. + +is neither letter nor digit: + NOT (is letter OR is digit OR is underscore). + +is digit: + "0" <= actual char AND actual char <= "9". + +is underscore: + actual char = "_". + +is digit or sign: + is digit OR actual char = "+" OR actual char = "-". + +get integer: + symbol type := int type; + IF actual char = "+" THEN + get char (infile, actual char); + skip blanks; + symbol := actual char + ELIF actual char = "-" THEN + symbol := "-"; + get char (infile, actual char); + skip blanks; + symbol CAT actual char + ELSE + symbol := actual char + FI; + REP + get char (infile, actual char); + IF NOT is digit THEN + LEAVE get integer + FI; + symbol CAT actual char + PER. + +is double quote: + actual char = """". + +get text: + symbol := ""; + symbol type := text type; + REP + get char (infile, actual char); + IF is double quote THEN + get char (infile, actual char); + IF NOT is double quote THEN LEAVE get text + FI + ELIF actual char = "" THEN LEAVE get text (*hey*) + FI; + symbol CAT actual char + PER. + +is single quote: + actual char = "'". + +get character: + symbol type := character type; + get char (infile, symbol); + get char (infile, actual char); + IF actual char <> "'" THEN + error (">> ' << erwartet") + ELSE + get char (infile, actual char) + FI. + +get other char: + symbol type := other char type; + symbol := actual char; + get char (infile, actual char). + +END PROC get next symbol; + + +TEXT VAR actual char; + + +PROC skip blanks: + INT VAR comment depth :: 0; + WHILE is comment OR actual char = " " REP + get char (infile, actual char) + PER. + +is comment: + IF actual char = "{" THEN + comment depth INCR 1; + TRUE + ELIF actual char = "}" THEN + IF comment depth = 0 THEN + error (">> { << fehlt") + ELSE + comment depth DECR 1 + FI; + TRUE + ELSE + IF comment depth > 0 THEN + IF actual char = "" THEN + error ("DATEIENDE im Kommentar"); + FALSE + ELSE + TRUE + FI + ELSE + FALSE + FI + FI. + +END PROC skip blanks; + + +BOOL VAR no input errors; +FILE VAR errors; + + +PROC error (TEXT CONST error message): + out ("FEHLER in Zeile "); + out (text (line nr)); + out (" bei >> "); + out (symbol); + out (" << : "); + out (error message); + line; + IF no input errors THEN + no input errors := FALSE; + errors := notefile; modify(errors); + headline (errors, "Einlesefehler"); output(errors) + FI; + write (errors, "FEHLER in Zeile "); + write (errors, text (line nr)); + write (errors, " bei >> "); + write (errors, symbol); + write (errors, " << : "); + write (errors, error message); + line (errors) +END PROC error; + + +PROC get (SYM VAR sym): (*hey*) + disable stop; + FILE VAR in :: sequential file (modify, "LISP INPUT"), + out :: notefile; modify (out); + headline (out,"LISP OUTPUT"); + headline (in, "LISP INPUT"); + noteedit (in); + input (in); + get (in, sym); + WHILE NOT no input errors AND NOT is error REP + modify (errors); + headline (errors, " LISP-Fehlermeldungen"); + headline (in, " Bitte KORREKTEN LISP-Ausdruck"); + noteedit (in); + headline (errors, "notebook"); + input (in); + get (in, sym) + PER; +END PROC get; + + +PROC get all (FILE VAR f, SYM VAR sym): + get (f, sym); + skip blanks; + IF NOT eof (infile) THEN + error ("Hinter dem letzten Symbol des LISP-Ausdruck stehen noch Zeichen") + FI +END PROC get all; + + +END PACKET lisp io; + + + +PACKET lisp integer (* Autor: J.Durchholz *) + (* Datum: 30.08.1982 *) + DEFINES (* Version 1.1.2 *) + + sum, + difference, + product, + quotient, + remainder: + +SYM PROC sum (SYM CONST summand list): + INT VAR result := 0; + SYM VAR list rest := summand list; + WHILE NOT atom (list rest) REP + result INCR int 1 (head (list rest)); + list rest := tail (list rest) + PER; + IF NOT null (list rest) THEN + error stop ("Summandenliste endet falsch") + FI ; + sym (result, -1) +END PROC sum; + + +SYM PROC difference (SYM CONST minuend, subtrahend): + sym (int 1 (minuend) - int 1 (subtrahend), -1) +END PROC difference; + + +SYM PROC product (SYM CONST factor list): + INT VAR result := 1; + SYM VAR list rest := factor list; + WHILE NOT atom (list rest) REP + result := result * int 1 (head (list rest)); + list rest := tail (list rest) + PER; + IF NOT null (list rest) THEN + error stop ("Faktorenliste endet falsch") + FI; + sym (result, -1) +END PROC product; + + +SYM PROC quotient (SYM CONST dividend, divisor): + sym (int 1 (dividend) DIV int 1 (divisor), -1) +END PROC quotient; + + +SYM PROC remainder(SYM CONST dividend, divisor): + sym (int 1 (dividend) MOD int 1 (divisor), -1) +END PROC remainder; + + +END PACKET lisp integer; + diff --git a/lang/lisp/1.8.7/src/lisp.3 b/lang/lisp/1.8.7/src/lisp.3 new file mode 100644 index 0000000..a93463c --- /dev/null +++ b/lang/lisp/1.8.7/src/lisp.3 @@ -0,0 +1,767 @@ +PACKET lisp heap maintenance (* Autor: J.Durchholz *) + (* Datum: 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* Testhilfe *) + create lisp system, (* hey, 02.3.83 : 121,334,542,732 *) + dump oblist: + + +PROC create lisp system (FILE VAR f, DATASPACE CONST new heap): + initialize lisp system (new heap); + input (f); + WHILE NOT eof (f) REP + TEXT VAR name; + get (f, name); + SYM CONST s :: new atom (name); + get (f, name); + SYM CONST property name :: new atom (name); + IF NOT null (property name) THEN + SYM VAR property; + get (f, property); + add property (s, property name, property) + FI + PER +END PROC create lisp system; + + +PROC dump oblist (FILE VAR f): + begin oblist dump; + REP + SYM CONST actual atom :: next atom; + put line (f, name (actual atom)); + dump property list + UNTIL null (actual atom) PER. + +dump property list: + begin property list dump (actual atom); + REP + SYM VAR id, value; + next property (id, value); + write (f, " "); + write (f, name (id)); + write (f, " "); + write (f, name (value)); + line (f) + UNTIL null (id) AND null (value) PER. + +END PROC dump oblist; + + +PROC dump oblist: + begin oblist dump; + REP + SYM CONST actual atom :: next atom; + put line (name (actual atom)); + dump property list + UNTIL null (actual atom) PER. + +dump property list: + begin property list dump (actual atom); + REP + SYM VAR id, value; + next property (id, value); + out (" "); + out (name (id)); + out (" "); + put line (name (value)); + UNTIL null (id) AND null (value) PER. + +END PROC dump oblist; + + +END PACKET lisp heap maintenance; + + + +PACKET lisp interpreter (* Autor: J.Durchholz *) + (* Datum: 27.12.1982 *) + DEFINES (* Version 3.1.7 *) + evalquote, + apply, + eval, + try: + + +(* SYM-objects used by the interpreter. They all point to constant structure + within the heap. As their address may change during garbage collection, + it must be possible to correct the references to them made by the + SYM-objects. That is the reason why they are declared VAR instead of CONST*) +SYM VAR lambda constant, + label constant, + quote constant, + function constant, + indefinite constant, + apval constant, + true constant, + false constant; + +SYM VAR errors; +BOOL VAR trace :: FALSE; + +PROC initialize constants: + lambda constant := new atom ("LAMBDA"); + label constant := new atom ("LABEL"); + quote constant := new atom ("QUOTE"); + function constant := new atom ("FUNCTION"); + indefinite constant := new atom ("INDEFINITE"); + apval constant := new atom ("APVAL"); + true constant := new atom ("T"); + false constant := new atom ("F"); + errors := new atom ("ERRORS") +END PROC initialize constants; + + +SYM PROC evalquote (SYM CONST expr): (*hey*) + enable stop; + initialize constants; + x apply ( head (expr), quote (tail (expr)), nil ) +END PROC evalquote; + + +SYM PROC quote (SYM CONST x): + IF eq (x,nil) THEN nil + ELSE set head (x, new head); set tail (x, quote (tail(x))); x + FI . +new head: + cons (quote constant, cons (head(x), nil) ) +END PROC quote; + + +SYM PROC apply (SYM CONST function, argument list, alist): + enable stop; + initialize constants; + x apply (function, argument list, alist) +END PROC apply; + + +SYM PROC x apply (SYM CONST function, argument list, alist): + IF trace THEN line; + put ("a p p l y :"); put (function); line; + put ("arguments :"); put (argument list); line; + FI; + SYM VAR new alist; + initialize for alist insertion; + reduce actual fn to lambda expression; + insert parameter evaluated argument pairs in reversed order in new alist; + function body evaluation. + +reduce actual fn to lambda expression: + SYM VAR actual fn :: function; + REP + IF is named atom (actual fn) THEN + get function from property list of actual fn + or from functional alist entry + ELIF atom (actual fn) THEN + error stop ("Eine Funktion darf kein unbenanntes Atom sein") + ELSE + IF eq (head (actual fn), lambda constant) THEN + LEAVE reduce actual fn to lambda expression + ELIF eq (head (actual fn), label constant) THEN + get function from label expression and update alist + ELSE + error stop ("Funktion ist weder Atom noch LAMBDA-/LABEL-Ausdruck") + FI + FI + PER. + +get function from property list of actual fn or from functional alist entry: + IF property exists (actual fn, function constant) THEN + get function from property list of actual fn + ELSE + get function from functional alist entry + FI. + +get function from property list of actual fn: + actual fn := property (actual fn, function constant). + +get function from functional alist entry: + SYM VAR actual alist entry; + begin alist retrieval; + REP + IF end of alist THEN + error stop ("Die Funktion " + name (actual fn) + + " ist nicht definiert") + FI; + search for next functional alist entry; + UNTIL eq (head (actual functional alist entry), actual fn) PER; + actual fn := tail (actual functional alist entry). + +get function from label expression and update alist: + actual fn := tail (actual fn); + IF atom (actual fn) COR + (NOT atom (head (actual fn)) OR atom (tail (actual fn))) COR + NOT null (tail (tail (actual fn))) THEN + error stop ("Ungueltiger LABEL-Ausdruck") + FI; + SYM VAR new alist entry; + prepare new functional alist entry; + set head (new alist entry, head (actual fn)); + actual fn := head (tail (actual fn)); + set tail (new alist entry, actual fn). + +insert parameter evaluated argument pairs in reversed order in new alist: + actual fn := tail (actual fn); + IF atom (actual fn) THEN + error stop ("Ungueltiger LAMBDA-Ausdruck") + FI; + SYM VAR parameter list rest :: head (actual fn), + argument list rest :: argument list; + actual fn := tail (actual fn); + WHILE NOT null (parameter list rest) REP + add next parameter argument pair to alist + PER; + check wether no arguments are left over. + +add next parameter argument pair to alist: + IF atom (parameter list rest) THEN + error stop ("Parameterliste endet falsch") + FI; + SYM VAR param pointer :: head (parameter list rest); + parameter list rest := tail (parameter list rest); + IF is named atom (param pointer) AND NOT null (param pointer) THEN + add parameter evaluated argument pair to alist; + advance argument list rest + ELIF atom (param pointer) THEN + error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein") + ELSE + IF eq (head (param pointer), indefinite constant) THEN + check wether is last param; + advance param pointer; + IF eq (head (param pointer), quote constant) THEN + advance param pointer; + move param pointer to parameter; + add parameter indefinite quoted argument pair to alist + ELSE + move param pointer to parameter; + add parameter indefinite evaluated argument pair to alist + FI; + argument list rest := nil + ELIF eq (head (param pointer), quote constant) THEN + advance param pointer; + move param pointer to parameter; + add parameter quoted argument pair to alist; + advance argument list rest + ELIF eq (head (param pointer), function constant) THEN + advance param pointer; + move param pointer to parameter; + add parameter functional argument pair to alist; + advance argument list rest + ELSE + error stop ("Ungueltiger Parameter") + FI + FI. + +advance param pointer: + param pointer := tail (param pointer); + IF atom (param pointer) THEN + error stop ("Ungueltiger Parameter") + FI. + +move param pointer to parameter: + IF NOT null (tail (param pointer)) THEN + error stop ("Ungueltiger Parameter") + FI; + param pointer := head (param pointer); + IF NOT atom (param pointer) OR null (param pointer) THEN + error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein") + FI. + +advance argument list rest: + argument list rest := tail (argument list rest). + +add parameter evaluated argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, x eval (actual argument, alist)). + +check wether is last param: + IF NOT null (parameter list rest) THEN + error stop ("Ein INDEFINITE-Parameter muss der letzte sein") + FI. + +add parameter indefinite quoted argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, argument list rest); + WHILE NOT atom (argument list rest) REP + argument list rest := tail (argument list rest) + PER; + IF NOT null (argument list rest) THEN + error stop ("Argumentliste endet falsch") + FI. + +add parameter indefinite evaluated argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + last evaluated argument := new alist entry; + WHILE NOT atom (argument list rest) REP + set tail (last evaluated argument, + cons (x eval (head (argument list rest), alist), nil)); + last evaluated argument := tail (last evaluated argument); + advance argument list rest + PER; + IF NOT null (argument list rest) THEN + error stop ("Argumentliste endet falsch") + FI. + +last evaluated argument: + param pointer. +(* The value of param pointer is not used further, so the *) +(* variable can be "reused" in this manner. *) + +add parameter quoted argument pair to alist: + prepare new alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, actual argument). + +add parameter functional argument pair to alist: + prepare new functional alist entry; + set head (new alist entry, param pointer); + set tail (new alist entry, actual argument). + +actual argument: + IF atom (argument list rest) THEN + IF null (argument list rest) THEN + error stop ("Zuwenig Argumente") + ELSE + error stop ("Argumentliste endet falsch") + FI + FI; + head (argument list rest). + +check wether no arguments are left over: + IF NOT null (argument list rest) THEN + error stop ("Zuviele Argumente") + FI. + +function body evaluation: + IF is int pair (actual fn) THEN + predefined function evaluation + ELIF atom (actual fn) COR NOT null (tail (actual fn)) THEN + error stop ("Ungueltiger LAMBDA-Ausdruck"); nil + ELSE + x eval (head (actual fn), new alist) + FI. + +predefined function evaluation: + SELECT int 1 (actual fn) OF + CASE 0: call eval cond + CASE 1: call begin oblist dump + CASE 2: call next atom + CASE 3: call add property + CASE 4: call alter property + CASE 5: call delete property + CASE 6: call property exists + CASE 7: call property + CASE 8: call add flag + CASE 9: call flag + CASE 10: call delete flag + CASE 11: call begin property list dump + CASE 12: call next property + CASE 13: call apply + CASE 14: call eval + CASE 15: call try + CASE 16: give association list + CASE 17: call error stop + CASE 18: call head + CASE 19: call set head + CASE 20: call tail + CASE 21: call set tail + CASE 22: call cons + CASE 23: call eq + CASE 24: call get sym + CASE 25: call put sym + CASE 26: call null + CASE 27: call is atom + CASE 28: call is named atom + CASE 29: call get named atom + CASE 30: call put named atom + CASE 31: call is text + CASE 32: call get text + CASE 33: call put text + CASE 34: call is character + CASE 35: call get character + CASE 36: call put character + CASE 37: call is int + CASE 38: call get int + CASE 39: call put int + CASE 40: call sum + CASE 41: call difference + CASE 42: call product + CASE 43: call quotient + CASE 44: call remainder + CASE 45: call equal + CASE 46: call trace + CASE 47: call define + CASE 48: call set + OTHERWISE error stop("Es gibt (noch) keine LISP-Funktion mit der Nummer" + + text (int 1 (actual fn)) ); nil + END SELECT. + +call eval cond: + x eval condition (arg 1, alist). + +call begin oblist dump: + begin oblist dump; nil. + +call next atom: + next atom. + +call add property: + add property (arg 3, arg 2, arg 1); arg 1. + +call alter property: + alter property (arg 3, arg 2, arg 1); arg 1. + +call delete property: + delete property (arg 2, arg 1); nil. + +call property exists: + IF property exists(arg 2,arg 1) THEN true constant ELSE false constant FI. + +call property: + property (arg 2, arg 1). + +call add flag: + add flag (arg 2, arg 1); nil. + +call flag: + IF flag (arg 2, arg 1) THEN true constant ELSE false constant FI. + +call delete flag: + delete flag (arg 2, arg 1); nil. + +call begin property list dump: + begin property list dump (arg 1); nil. + +call next property: + SYM VAR s1, s2; next property (s1, s2); cons (s1, s2). + +call apply: + x apply (arg 3, arg 2, arg 1). + +call eval: + x eval (arg 2, arg 1). + +call try: + x try (arg 4, arg 3, arg 2, arg 1). + +give association list: + alist. + +call error stop: + error stop (text (arg 1)); nil. + +call head: + head (arg 1). + +call set head: + set head (arg 2, arg 1); arg 2. + +call tail: + tail (arg 1). + +call set tail: + set tail (arg 2, arg 1); arg 2. + +call cons: + cons (arg 2, arg 1). + +call eq: + IF eq (arg 2, arg 1) THEN true constant ELSE false constant FI. + +call get sym: + get (s1); s1. + +call put sym: + put (arg 1); arg 1. + +call null: + IF null (arg 1) THEN true constant ELSE false constant FI. + +call is atom: + IF atom (arg 1) THEN true constant ELSE false constant FI. + +call is named atom: + IF is named atom (arg 1) THEN true constant ELSE false constant FI. + +call get named atom: + TEXT VAR t; get (t); new atom (t). + +call put named atom: + put (name (arg 1)); arg 1. + +call is text: + IF is text (arg 1) THEN true constant ELSE false constant FI. + +call get text: + get (t); sym (t). + +call put text: + put (text (arg 1)); arg 1. + +call is character: + IF is character (arg 1) THEN true constant ELSE false constant FI. + +call get character: + inchar (t); sym character (code (t)). + +call put character: + out (code (character (arg 1))); arg 1. + +call is int: + IF is int pair (arg 1) THEN true constant ELSE false constant FI. + +call get int: + INT VAR i; get (i); sym (i, -1). + +call put int: + put (int 1 (arg 1)); arg 1. + +call sum: + sum (arg 1). + +call difference: + difference (arg 2, arg 1). + +call product: + product (arg 1). + +call quotient: + quotient (arg 2, arg 1). + +call remainder: + remainder(arg 2, arg 1). + +call equal: + IF equal (arg 2, arg 1) THEN true constant ELSE false constant FI. + +call trace: + trace := NOT trace; + IF trace THEN true constant ELSE false constant FI . + +call define: (*hey*) + define (arg 1) . + +call set: (*hey*) + add property (new atom ( name (arg 2)), apval constant, arg 1); arg 1 . + +arg 1: + tail (head (new alist)). + +arg 2: + tail (head (tail (new alist))). + +arg 3: + tail (head (tail (tail (new alist)))). + +arg 4: + tail (head (tail (tail (tail (new alist))))). + +END PROC x apply; + +SYM PROC define (SYM CONST x): (*hey*) + IF eq (x, nil) THEN nil + ELSE add property (new atom (name (head (head (x)))), + function constant, tail (head (x)) ); + cons (head (head (x)), define (tail (x)) ) + FI . +END PROC define; + +SYM VAR old alist :: nil; + +SYM PROC eval (SYM CONST expression, alist): + enable stop; + initialize constants; + x eval (expression, alist) +END PROC eval; + + +SYM PROC x eval (SYM CONST expression, alist): (*hey*) + IF trace THEN line; + put ("e v a l :"); put (expression); line; + IF NOT equal (alist, old alist) THEN + put ("bindings :"); old alist := alist; put (alist); line FI + FI; + IF atom (expression) THEN + IF is named atom (expression) THEN + value from property list of expression or from alist entry + ELSE + expression + FI + ELSE + x apply (head (expression), tail (expression), alist) + FI. + +value from property list of expression or from alist entry: + IF property exists (expression, apval constant) THEN + value from property list of expression + ELSE + value from alist entry + FI. + +value from property list of expression: + property (expression, apval constant). + +value from alist entry: + SYM VAR actual alist entry; + begin alist retrieval; + REP + IF end of alist THEN + error stop ("Das Atom " + name (expression) + " hat keinen Wert") + FI; + search for next alist entry + UNTIL eq (head (actual alist entry), expression) PER; + tail (actual alist entry). + +END PROC x eval; + + +SYM PROC try (SYM CONST expression list, alist, + error output, break possible): + enable stop; + initialize constants; + x try (expression list, alist, error output, break possible) +END PROC try; + + +SYM PROC x try (SYM CONST expression list, alist, + error output, break possible): + BOOL CONST output :: bool (error output), + halt enabled :: bool (break possible); + SYM VAR expr list rest :: expression list; + REP + IF null (expr list rest) THEN + LEAVE x try WITH nil + ELIF atom (expr list rest) THEN + error stop ("Ausdrucksliste fuer 'try' endet falsch") + ELSE + try evaluation of actual expression + FI; + expr list rest := tail (expr list rest) + PER; + nil. + +try evaluation of actual expression: + disable stop; + SYM VAR result :: x eval (head (expr list rest), alist); + IF is error THEN + IF error message = "halt from terminal" AND halt enabled THEN + enable stop + ELIF output THEN + put error + FI; + add property (errors, apval constant, sym (error message)); + clear error + ELSE + LEAVE x try WITH result + FI; + enable stop. + +END PROC x try; + + +SYM PROC x eval condition (SYM CONST pair list, alist): + enable stop; + SYM VAR cond pair list rest :: pair list; + REP + IF atom (cond pair list rest) THEN + error stop ("Keine 'T'-Bedingung in bedingtem Ausdruck gefunden") + FI; + check wether is correct pair; + IF true condition found THEN + LEAVE x eval condition WITH x eval (head (tail (actual pair)), alist) + FI; + cond pair list rest := tail (cond pair list rest) + PER; + nil. + +check wether is correct pair: + IF atom (actual pair) COR + atom (tail (actual pair)) COR + NOT null (tail (tail (actual pair))) THEN + error stop ("Ungueltiges Paar im bedingten Ausdruck") + FI. + +true condition found: + bool (x eval (head (actual pair), alist)). + +actual pair: + head (cond pair list rest). + +END PROC x eval condition; + + +BOOL PROC bool (SYM CONST sym): + IF eq (sym, true constant) THEN + TRUE + ELIF eq (sym, false constant) THEN + FALSE + ELSE + error stop ("'T' oder 'F' erwartet"); TRUE + FI +END PROC bool; + + +(******* a-list handling refinements used in 'x apply' and 'x eval' *******) + +(* declared within 'x apply' and 'x eval': 'actual alist entry' *) + +. + +initialize for alist insertion: + new alist := alist. + +begin alist retrieval: + SYM VAR actual alist pos :: alist. + +search for next alist entry: + WHILE NOT end of alist REP + IF atom (actual alist pos) THEN + error stop ("Bindeliste endet falsch") + FI; + actual alist entry := head (actual alist pos); + actual alist pos := tail (actual alist pos); + UNTIL is non functional alist entry PER. + +is non functional alist entry: + NOT is functional alist entry. + +search for next functional alist entry: + WHILE NOT end of alist REP + IF atom (actual alist pos) THEN + error stop ("Bindeliste endet falsch") + FI; + actual alist entry := head (actual alist pos); + actual alist pos := tail (actual alist pos); + UNTIL is functional alist entry PER; + actual alist entry := tail (actual alist entry). + +is functional alist entry: + check wether is alist entry; + null (head (actual alist entry)). + +check wether is alist entry: + IF atom (actual alist entry) THEN + error stop ("Bindelisteneintrag ist kein Paar") + FI. + +end of alist: + null (actual alist pos). + +actual functional alist entry: + actual alist entry. + +prepare new alist entry: + new alist := cons (cons (nil, nil), new alist); + new alist entry := head (new alist). + +prepare new functional alist entry: + new alist := cons (cons (nil, cons (nil, nil)), new alist); + new alist entry := tail (head (new alist)). + + +END PACKET lisp interpreter; + + + diff --git a/lang/lisp/1.8.7/src/lisp.4 b/lang/lisp/1.8.7/src/lisp.4 new file mode 100644 index 0000000..0733dcd --- /dev/null +++ b/lang/lisp/1.8.7/src/lisp.4 @@ -0,0 +1,143 @@ +PACKET lisp (* Autor: J.Durchholz , P. Heyderhoff *) + (* Datum: 09.05.1984 *) + DEFINES (* Version 1.7.2 *) + (* Änderung: notebook *) + (* 13.3.86 I. Ley *) + (* Änderung: start lisp system *) + (* 25.3.86 I. Ley *) + (* Anpassung an ELAN-Compiler Version 1.7.5 *) + (* 8.4.86 I. Ley *) + start lisp system, + lisp heap, + insert lisp, + run lisp, + run lisp again, + lisp, + break lisp: + +SYM VAR run again pointer :: nil; +DATASPACE VAR insert heap :: nil space; + +PROC start lisp system (DATASPACE CONST heap): + enable stop; + initialize lisp system (heap); + forget (insert heap); + insert heap := heap +END PROC start lisp system; + + +PROC start lisp system (DATASPACE CONST heap, FILE VAR f): + enable stop; + create lisp system (f, heap); + forget (insert heap); + insert heap := heap +END PROC start lisp system; + + +PROC start lisp system (FILE VAR f): + create lisp system (f, insert heap) +END PROC start lisp system; + + +DATASPACE PROC lisp heap: + insert heap +END PROC lisp heap; + + +DATASPACE VAR run heap :: nil space; + + +PROC insert lisp: + insert lisp (last param) +END PROC insert lisp; + + +PROC insert lisp (TEXT CONST file name): + interpret (insert heap, file name) +END PROC insert lisp; + + +PROC run lisp: + run lisp (last param) +END PROC run lisp; + + +PROC run lisp (TEXT CONST file name): + forget (run heap); + run heap := insert heap; + interpret (run heap, file name) +END PROC run lisp; + + +PROC interpret (DATASPACE CONST heap, TEXT CONST file name): + enable stop; + FILE VAR f :: sequential file (input, file name); + interpret (heap, f) +END PROC interpret; + + +PROC interpret (DATASPACE CONST heap, FILE VAR f): + initialize lisp system (heap); + get (f, run again pointer); + add property (new atom ("program"), new atom ("APVAL"), run again pointer); + put (evalquote (run again pointer)) +END PROC interpret; + +PROC run lisp again: + put (evalquote (run again pointer)) +END PROC run lisp again; + + +PROC get ausdruck: + enable stop; get (ausdruck) +END PROC get ausdruck; + +SYM VAR ausdruck; + +PROC lisp: + +(* HAUPT TESTPROGRAMM FUER LISP Heyderhoff 25.1.83 *) +IF NOT exists ("LISP HEAP") THEN + FILE VAR bootstrap :: sequential file (input, "lisp.bootstrap"); + create lisp system (bootstrap, new ("LISP HEAP")); + verbose lisp output (TRUE); +FI; +SYM VAR work; +command dialogue(FALSE); forget ("LISP INPUT"); command dialogue(TRUE); +(* bildlaenge(23); *) (* EUMEL 1.65 *) +disable stop; +REP + get (ausdruck); + IF is error THEN + handle error + ELSE + work := evalquote (ausdruck); + IF is error THEN handle error + ELSE note (work) + FI + FI +PER . + +handle error: + IF text (error message, 18) = "halt from terminal" THEN + enable stop + ELSE + note (error message); + put ( error message); pause(20); + clear error; + FI . +END PROC lisp; + +PROC break lisp: + break; + page; + quit; + FILE VAR in :: sequential file (modify, "LISP INPUT"), + out :: notefile; modify (out); + headline (out,"LISP OUTPUT"); + headline (in, "LISP INPUT"); + noteedit (in); +END PROC break lisp + +END PACKET lisp; + diff --git a/lang/lisp/1.8.7/src/lisp.bootstrap b/lang/lisp/1.8.7/src/lisp.bootstrap new file mode 100644 index 0000000..37efbde --- /dev/null +++ b/lang/lisp/1.8.7/src/lisp.bootstrap @@ -0,0 +1,118 @@ +NIL APVAL +NIL +T APVAL +T +F APVAL +F +COND FUNCTION +(LAMBDA ((INDEFINITE QUOTE X)) . 0) +BEGINOBLISTDUMP FUNCTION +(LAMBDA () . 1) +NEXTATOM FUNCTION +(LAMBDA () . 2) +ADDPROPERTY FUNCTION +(LAMBDA (X X X) . 3) +ALTERPROPERTY FUNCTION +(LAMBDA (X X X) . 4) +DELETEPROPERTY FUNCTION +(LAMBDA (X X) . 5) +PROPERTYEXISTS FUNCTION +(LAMBDA (X X) . 6) +PROPERTY FUNCTION +(LAMBDA (X X) . 7) +ADDFLAG FUNCTION +(LAMBDA (X X) . 8) +FLAG FUNCTION +(LAMBDA (X X) . 9) +DELETEFLAG FUNCTION +(LAMBDA (X X) . 10) +BEGINPROPERTYLISTDUMP FUNCTION +(LAMBDA (X) . 11) +NEXTPROPERTY FUNCTION +(LAMBDA () . 12) +APPLY FUNCTION +(LAMBDA (X X X) . 13) +EVAL FUNCTION +(LAMBDA (X X) . 14) +TRY FUNCTION +(LAMBDA (X X X X) . 15) +ASSOCIATIONLIST FUNCTION +(LAMBDA () . 16) +ERRORSTOP FUNCTION +(LAMBDA (X) . 17) +HEAD FUNCTION +(LAMBDA (X) . 18) +SETHEAD FUNCTION +(LAMBDA (X X) . 19) +TAIL FUNCTION +(LAMBDA (X) . 20) +SETTAIL FUNCTION +(LAMBDA (X X) . 21) +CONS FUNCTION +(LAMBDA (X X) . 22) +EQ FUNCTION +(LAMBDA (X X) . 23) +GET FUNCTION +(LAMBDA () . 24) +PUT FUNCTION +(LAMBDA (X) . 25) +NULL FUNCTION +(LAMBDA (X) . 26) +ATOM FUNCTION +(LAMBDA (X) . 27) +NAMEDATOM FUNCTION +(LAMBDA (X) . 28) +GETATOM FUNCTION +(LAMBDA () . 29) +PUTATOM FUNCTION +(LAMBDA (X) . 30) +TEXT FUNCTION +(LAMBDA (X) . 31) +GETTEXT FUNCTION +(LAMBDA () . 32) +PUTTEXT FUNCTION +(LAMBDA (X) . 33) +CHARACTER FUNCTION +(LAMBDA (X) . 34) +GETCHARACTER FUNCTION +(LAMBDA () . 35) +PUTCHARACTER FUNCTION +(LAMBDA (X) . 36) +INT FUNCTION +(LAMBDA (X). 37) +GETINT FUNCTION +(LAMBDA () . 38) +PUTINT FUNCTION +(LAMBDA (X) . 39) +SUM FUNCTION +(LAMBDA ((INDEFINITE X)) . 40) +DIFFERENCE FUNCTION +(LAMBDA (X X). 41) +PRODUCT FUNCTION +(LAMBDA ((INDEFINITE X)). 42) +QUOTIENT FUNCTION +(LAMBDA (X X).43) +REMAINDER FUNCTION +(LAMBDA (X X).44) +EQUAL FUNCTION +(LAMBDA (X X) . 45) +TRACE FUNCTION +(LAMBDA () . 46 ) +DEFINE FUNCTION +(LAMBDA ((INDEFINITE X)) . 47 ) +SET FUNCTION +(LAMBDA (X X) . 48 ) +QUOTE FUNCTION +(LAMBDA ((QUOTE X)) X) +LIST FUNCTION +(LAMBDA ((INDEFINITE X)) X) +DO FUNCTION +(LAMBDA ((INDEFINITE X)) NIL) +PUTLIST FUNCTION +(LAMBDA ((INDEFINITE X)) + (COND + ((NULL X) NIL) + (T (DO (PUT (HEAD X)) (PUTLIST (TAIL X)))) + ) +) + diff --git a/lang/prolog/1.8.7/doc/prolog handbuch b/lang/prolog/1.8.7/doc/prolog handbuch new file mode 100644 index 0000000..ea7c6a5 --- /dev/null +++ b/lang/prolog/1.8.7/doc/prolog handbuch @@ -0,0 +1,581 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#Prolog + + + + +#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# + +Dr.P.Heyderhoff 12.03.1987 +GMD.F2.G2 + + + + + + + E L A N - P R O L O G + _____________________ + + (Die Fachsprache der künstlichen Intelligenz) + +#on("u")#Benutzungsanleitung und technische Beschreibung#off("u")# + + +Elan-Prolog ist eine Computersprache der fünften Generation, die für +die Praxis der Programmierung und die Lehre in Informatik eine neue +Dimension erschließt. Für den professionellen Programmierer eröffnet sie +neue Möglichkeiten, mächtige Anwendungen, wie Expertensysteme und andere +neuartige Systeme der Wissensverarbeitung zu entwickeln. + +Elan-Prolog unterscheidet sich grundsätzlich von üblichen konventionellen +Programmiersprachen. In Sprachen wie Elan und Pascal muß der Programmierer +genau angeben, wie ein gewünschtes Ergebnis errechnet werden soll. Um was es +sich dabei handelt, steht bestenfalls dann in der Dokumentation. Ganz anders +ist es in Prolog. PROLOG steht für PROgrammieren in LOgik und basiert auf +dem Prädikaten-Kalkül, der bekanntesten Form der formalen Logik. Also in +Prolog schreibt der Programmierer hin, worin das Problem besteht. Er bedient +sich dabei dieser formalen Logik. Prolog versucht dann eine Lösung zu +finden. Der Lösungsweg ist dabei im Programm nicht vorgeschrieben. Das +entlastet den Programmierer, und er kann seine ganze Kraft auf die logische +Beschreibung des Problems konzentrieren. + +Elan-Prolog ist ein interpretatives System, das voll kompatibel ist mit dem +Edinburgh Standard Prolog und in in komfortabler Weise in das Betriebssystem +Eumel eingebettet ist. + +Eigenschaftes von Elan-Prolog: + +- Syntax gemäß dem Edinburgh Standard Prolog nach Clocksin-Mellish + +- Interpretierendes System mit inkrementellem Einpass-Compiler + +- Interaktiver Mehrfenster-Texteditor des Eumelsystems + +- Zugriff auf Elan-Prozeduren als Prolog-Regeln + +- Geschwindigkeit ca. 100 LIPS auf IBM/PC-XT + +- optionale dynamische Ablaufverfolgung + +- Erklärungskomponente + +- Eingabe und Ausgabe von Prolog-Ausdrücken und Klartext + +- Programmiert und dokumentiert in ELAN (über 2000 Zeilen) + +- daher besonders für den Informatik-Unterricht geeignet +#page# +#on("u")#Beschränkungen des Elan-Prolog:#off("u")# + +Folgende Beschränkungen gelten für die Implementierung von Elan-Prolog im +Eumel-Systems: + +- Maximal 16000 Fakten und Regeln + +- Maximal 16000 Terme zur Konstruktion von Ausdrücken, Listen und Regeln + +- Maximal 800 Variablenbindungen + +- Maximal 800 Einträge im Beweisbaum + +- Maximal 4000 Bezeichner für Atome und Variablen + +- Maximal 16000 Buchstaben für alle Bezeichner zusammen + + +Wie sieht ein Prolog-Programm aus? + +Ein Prolog-Programm besteht aus + + - Fakten über Objekte und ihre Beziehungen + + - Regeln über Objekte und ihre Beziehungen + +und besonders wichtig: + + - Der Benutzer kann Prolog über die Fakten und Regeln ausfragen. + +Fakten aus einer Wissensbasis, nämlich dem Prolog-Programm, sind z.B.: + + enthaelt (wisky, aethanol). + +Das wird gelesen als: "Wisky enthält Aethanol.". Grundzüge der sehr +einfachen Syntax lassen sich hieran erklären. Ein Faktum wird geschrieben +wie in diesem Beispiel: + + - Erst kommt der Name der Relation, geschrieben wie ein Elan-Name in + kleinen Buchstaben. + + - Dann folgt in runden Klammern und durch Kommata getrennt eine Liste + von Objektnamen. + + - Zum Schluß steht ein Punkt. + +Regeln sind Problembeschreibungen in der Form von logischen Ausdrücken der +symbolischen Logik, wie z.B. die folgende Regel: + + bewirkt (A, B, kopfschmerz) :- enthaelt (A, aethanol), + enthaelt (B, aspirin ). + +Das wird gelesen als: "Wenn man eine Droge A, die Aethanol enthält, +und eine Droge B, die Aspirin enthält gleichzeitig einnimmt, dann bewirkt +das Kopfschmerzen." Wie man sieht werden logische Variablen mit großen +Buchstaben (wie Elan-Operatoren) geschrieben. Das Zeichen ":-" steht für das +logische Wenn, und das Komma(",") für die logische Konjunktion. Die logische +Disjunktion wird durch Semikolon(";") ausgedrückt. +#page# +Neben der hiermit vorgestellten Prefix-Schreibweise für Relationen gibt es in +ELAN-Prolog auch noch eine Infix-Schreibweise für zweistellige Relationen. +Hierbei werden die Relationen als Infix-Operatoren in großen +Buchstaben geschrieben (wie in ELAN) und zwischen die beiden Operanden +gesetzt. Als Operatoren sind auch die in Elan üblichen Operatoren + + ( +, -, *, /, MOD, =, <, >, <=, >=, <> ) +zulässig. + +In Infixausdrücken (wie z.B. 2+3*4) gelten die bekannten Vorrangregeln. Auch +Klammern sind zulässig. Selbstdefinierte Operatoren haben niedrigste +Priorität. + +Obiges Beispiel in Infix-Schreibweise: + + wisky ENTHAELT aethanol. + + bewirkt (A, B, kopfschmerz) :- A ENTHAELT aethanol, + B ENTHAELT aspirin. + + +Objekte in Prolog können Atome oder Listen sein. Für Atome gibt es zwei +Schreibweisen: + + - genau so wie Elan-Bezeichner, also bestehend aus kleinen Buchstaben + und Blanks. Dabei werden die Blanks eliminiert. + + - genauso wie Elan-Texte, nämlich in Gänsefüßchen eingeschlossen. + +Für Listen von Objekten gibt es wiederrum zwei Schreibweisen, wie folgende +zwei unterschiedlichen Notationen des gleichen Beispiels zeigen: + + - [ das, ist, [ zum, beispiel ], eine, liste ] + + - [ das, ist, [ zum | [ beispiel | [] ] ], eine, liste ] + +Im zweiten Fall ist die als drittes Element in der Gesamtlisten enthaltene +Teilliste mit dem Konstruktor "|" und der leeren Liste "[]" zusammengesetzt. +Die Grundoperationen, die aus der Programmiersprache LISP bekannt sind, +können als Prolog-Fakten unmittelbar wie folgt definiert werden: + + eq (X, X). + head ([X|Y], X). + tail ([X|Y], Y). + cons (X, Y, [X|Y]). +#page# +#on("u")#Standard - Operatoren von Elan-Prolog:#off("u")# + +Im System sind nur ganz wenige Standardoperatoren eingebaut. Es sind die +folgenden Fakten: + + - ! . der CUT-Operator schaltet des Backtracking ab. + + - bye. beendet die prolog Anwendung. + + - listing. zeigt alle insertierten Regeln. + + - listing (X). zeigt alle insertierten Regeln über X. + + - call (X). X wird ausgeführt. + + - write (X). das an X gebundenen Prolog-Objekts wird ausgegeben, + writeq (X). und wenn nicht eindeutig, gequotet, + put (X). das Zeichen, dessen ASCII-Code X ist wird ausgegeben, + name (X,[Y]). unifiziert das Atom X mit der Liste seiner Buchstaben. + + - read (X). ein Objekt wird gelesen und an die Variable gebunden. + get0 (X). das nächste Zeichen wird gelesen, + get (X). das nächste druckbare Zeichen wird gelesen, + + - X = Y . Die an X und Y gebundenen Objekte sind gleich, + X <> Y . sie sind ungleich, + X <= Y . sie sind kleiner oder gleich, + X == Y . sie sind wörtlich gleich, + X =.. [F|A] . X ist der Term mit Funktor F und Argumentliste A. + + - X + Y . sie sollen addiert, + X - Y . subtrahiert, + X * Y . multipliziert, + X / Y . dividiert, + X MOD Y . der Divisionsrest soll ermittelt werden, + die Auswertung geschieht durch den 'is'-Operators. + + - X IS EXPR . Das Ergebnis des arithmetischen Ausdrucks EXPR wird + gebildet und mit X unifiziert. + + - incr (X). der arithmetische Wert von X wird um eins erhöht. + + - assertz ([X]). insertiert die Regel X am Ende einfügend. + asserta ([Χ]). insertiert die Regel X am Anfang einfügend. + retract ([X]). entfernt die Regel X wieder. + clause (X,[Y]). holt die Regel Y mit dem Kopf X aus der Knowledgebase. + + - functor (X,Y,Z) Y ist der Funktor von X und Z ist seine Arität. + arg (X,Y,Z). Z ist das x-te Argument der Funktion Y. + + - elan (X). Ausführung der insertierten ELAN-Prozedur X + elan (X,Y). Ausführung von X mit dem TEXT-CONST-Parameter Y + + - elan(trace,on). schaltet den dynamischen Ablaufverfolger ein und + elan(trace,off) schaltet ihn wieder ab. + + - elan(consult,X) lädt das Prologprogramm aus der Datei namens X hinzu. + elan(reconsult,X) ersetzt das Prologprogramm aus der Datei X. + elan(abolish,X) entfernt alle Regeln mit dem Namen X. +#page# +#on("u")#Das Dialogverhalten von Elan-Prolog:#off("u")# + +Elan-Prolog wird, sobald es in das Eumel-System insertiert ist, als Prozedur +mit dem Namen "prolog" und einem optionalen TEXT-Parameter aufgerufen. Der +Textparameter enthält den Namen einer Datei, die ein Prolog-Programm enthält, +das geladen werden soll. Fehlt der Parameter, wird, wie üblich, die zuletzt +bearbeitete Datei genommen. Im Prolog-Dialog können später weitere +Prolog-Programme mit der Prozedur namens "consult" hinzugeladen werden. + +Also +einfachster Aufruf: prolog ("") + +Antwort: ?- +Beispiel-Eingabe: 3 = 3 +Antwort: yes + ?- +Eingabe: 4 = -5 +Antwort: no + ?- + +Besondere Dialogkommandos: + + ?- +Eingabe: ? +Antwort z.B.: 13.5 SEC + ?- +Eingabe: listing +Antwort: { zeigt alle aktuell verfügbaren Regeln } + ?- +Eingabe: {ESCAPE} q +Ausgabe: gib kommando: + +Eingabe: prolog again +Ausgabe: ?- +Eingabe: [sum, permute] {in eckigen Klammern!} + { konsultiert diese beiden Dateien } +Antwort z.B.: 25 rules inserted. + ?- +Eingabe: [-sum, -permute] + { löscht und rekonsultiert aus diesen Dateien } +Antwort z.B.: 25 rules inserted. + +Eingabe: {ESCAPE} {ESCAPE} +Antwort: gib kommado: +Elan-Eingabe z.B.: show ("standard") + { zeigt die Datei dieses Namens } + ?- + +Auf diese Weise können bequem Eumel-Kommandos gegeben werden. Die +Umschaltung vom Prolog- zum Eumelmonitor-Betrieb erfolgt durch die Tasten +{ESCAPE},{ESCAPE} und {RETURN}. Wie üblich ist das zuletzt verwendete +Kommando auch im Prolog-Dialog mit dem Escapekommando "{ESCAPE} k" +wiederzubekommen. Das Kommando "{ESCAPE} q" beendet den Dialog. +#page# +#on("u")#Ausprobieren der Prolog-Programmbeispiele:#off("u")# + +Zum Ausprobieren sind die Prologbeispiele "eq", "permute" und "mann" +beigefügt. + +Beispiel: ?- +Eingabe: [permute] {in eckigen Klammern!} +Antwort: 5 rules inserted. + ?- +Eingabe: marquise(X) +Antwort: beautiful marquise your beautiful eyes make me die of love +Eingabe: {Semicolon} +Antwort: your beautiful eyes beautiful marquise make me die of love + { usw } +Eingabe: {Return} +Antwort: ?- + +Jede #on("u")#Eingabe von Semicolon#off("u")# liefert als Antwort die nächste Permutation. Wenn +eine andere Taste gedrückt wird, bricht die Ausgabe weiterer Ergebnisse ab. + +#on("u")#Eingabe von Fragezeichen#off("u")# liefert neben der Angabe der benötigten +Rechenzeit eine Erklärung der letzten Antwort durch Ausgabe aller zu dieser +Antwort führenden Schlußfolgerungen. Dabei wird der Beweisbaum in Form einer +Einrückstruktur dargestellt. Die Einrückung stellt die Erklärungstiefe dar. + + +#on("u")#Benutzung von Prolog von Elan-Programmen aus#off("u")# + +Wenn man Prolog als Unterprogramm von Elan aus aufrufen will, geht man +folgendermaßen vor: + +1. Laden einer Wissensbasis, + die in einer Datei namens z.B."permute" bereitsteht: + + push ("bye"13""); + prolog ("permute"); + + +2. Abfragen an diese Wissensbasis: + + TEXT VAR query, answer; + query:= "marquise (X)"; + IF prolog ( query, answer) + THEN put (answer) + ELSE put ("NO") + FI; + +In diesem Anwendungsbeispiel liefert die Ausgabeanweisung 'put (answer)': + + beautiful marquise your beatiful eyes make me die of love + +#page# +#on("u")#Literatur:#off("u")# + + +1.) W.F.Clocksin, C.S.Mellish: + Programming in Prolog + Springer 1984 + +2.) M.H.van Emden: + An interpreting algorithm for prolog programs + in Implementations of Prolog, Ellis Herwood Ltd, 1984 + +3.) Alain Colmerauer: + Prolog in 10 Figures + Communications of the ACM December 1985 + +4.) J. Cohen: + Describing Prolog by its Interpretation and Compilation + Communications of the ACM December 1985 + +5.) Alain Colmerauer: + Les system q ou un formalisme pour alalyser et synthetiser des phrases + sur ordinateur. + Intern.Rep. 43, Departement d'informatique. Universite de Montreal + Sept. 1970 +#page# +(*************************************************************************) +(* *) +(* Elan-Prolog *) +(* *) +(* Programm-Beispiele: *) +(* *) +(****************** standard (nach Clocksin-Mellish) ********************) + +abolish (X) :- elan (abolish, X). +append ([], X, X) :- !. +append ([X|Y], Z, [X|W]) :- append (Y, Z, W). +atom (X) :- functor (X, Y, 0). +atomic (X) :- atom (X); integer (X). +consult (X) :- elan (consult, X). +end :- bye. +fail :- []. +findall (X, Y, Z) :- tell ("$$"), write ("("), findall (X,Y); + write (")"), told, see ("$$"), read (Z), + seen, elan (forget, "$$"). +findall (X, Y) :- call (Y), writeq (X), write (","), []. +integer (X) :- functor (X, Y, -1). +listing (X). +member (X, [X|Z]). +member (X, [Y|Z]) :- member (X, Z). +nl :- elan (line). +non var (X) :- var (X), !, []; . +not (X) :- call (X), !, []; . +notrace :- elan (trace, off). +reconsult (X) :- elan (reconsult, X). +repeat. +repeat :- repeat. +see (X) :- elan (sysin, X). +seen :- elan (sysin, ""). +tab (X) :- tab(X,1). +tab (X,Y) :- Y<=X, !, put (32), incr(Y), tab(X,Y);. +tell (X) :- elan (sysout, X). +told :- elan (sysout, ""). +trace :- elan (trace, on). +true. +< (X, Y) :- <= (X, Y), <> (X, Y). +> (X, Y) :- <= (Y, X). +>= (X, Y) :- < (Y, X). +#page# +(**************************** sum ***********************************) + +suc (0, 1). suc (1, 2). suc (2, 3). suc (3, 4). suc (4, 5). +suc (5, 6). suc (6, 7). suc (7, 8). suc (8, 9). +sum (0, X, X). +sum (X, Y, Z):- suc (V, X), sum (V, Y, W), suc (W, Z). +plus (X, [0,0], X):- !. +plus (X, Y, Z):- plus one (V, Y), plus (X, V, W), !, plus one (W, Z). +plus one ([X, Y], [V, W]):- suc (Y, W), X = V, !; + Y = 9, suc (X, V), W = 0. +treereverse (X,Y):- rev (X,Y), !; rev (Y,X), !. +rev ([], []). +rev ([X|Y], Z):- X <> [H|T], rev (Y, W), !, append (W, [X], Z); + rev (X, V), rev (Y, W), !, append (W, [V], Z). + +(**************************** permute ************************************) + +permute ([], []). +permute ([E|X], Z):- + permute (X, Y), insert (E, Y, Z). +insert (E, X, [E|X]). +insert (E, [F|X], [F|Y]):- + insert (E, X, Y). +marquise(RESULT):- + permute (["beautiful marquise", + "your beautiful eyes", + "make me", + "die", + "of love" + ], + RESULT). + +(**************************** puzzle ************************************) + + {Solution: 9,5,6,7,0,8,2} +puzzle:- repeat, permute ((9,8,7,6,5,2,0), SENDMORY), + write (SENDMORY), + puzzle (SENDMORY, SEND, MORE, MONEY), + elan (line), + write (SEND), write (+), + write (MORE), write (=), + write (MONEY). + +puzzle([S,E,N,D,O,R,Y], SEND, MORE, MONEY):- + SEND IS ((S * 10 + E) * 10 + N) * 10 + D, + MORE IS ((10 + O) * 10 + R) * 10 + E, + MONEY IS (((10 + O) * 10 + N) * 10 + E) * 10 + Y, + MONEY IS SEND + MORE. + +permute ([], []). +permute ([E|X], Z):- permute (X, Y), insert (E, Y, Z). + +insert (E, X, [E|X]). +insert (E, [F|X], [F|Y]):- insert (E, X, Y). + +repeat. +repeat:- repeat. +#page# +(**************************** prieks ***********************************) + +ist priek (bo priek). +ist priek (ki priek). +ist priek (bla priek). + +WER GNASELT WEN :- population (B), + member ([WEN, WER, _], B), + bedingungen (B). + +WER KNAUDERT WEN:- population (B), + member ([WER, _, WEN], B), + bedingungen (B). + +population (B):- sind prieks (U, V, W), + sind knauderarten (R, S, T), + B = [ [drausla puemfe, U, R], + [glessla puemfe, V, S], + [hapla puemfe, W, T] ]. + +sind prieks (X,Y,Z):- ist priek (G), + ist priek (H), H<>G, + ist priek (I), I<>G, I<>H, !, + permute ([G,H,I], [X,Y,Z]). + +sind knauderarten (X,Y,Z):- ist knauderart (G), + ist knauderart (H), H<>G, + ist knauderart (I), I<>G, I<>H, !, + permute ([G,H,I],[X,Y,Z]). + +ist knauderart (an). +ist knauderart (ab). +ist knauderart (ueber). + +bedingungen (B):- not member ([hapla puemfe,ki priek,_],B) , + not member ([hapla puemfe,_,ueber],B) , + not member ([drausla puemfe,bo priek,_],B) , + not member ([_,bo priek,ab],B) , + noch ne bedingung (B) , + weitere bedingungen (B) , !. + +weitere bedingungen (B):- not member([_,ki priek,ueber],B), + not member([_,bo priek,ueber],B) + ; + member([drausla puemfe,_,an],B). + +noch ne bedingung (B):- not member ([drausla puemfe,ki priek,_],B) + ; + not member ([glessla puemfe,_,ueber],B). + +permute ([], []). +permute (X, [Y|Z]):- delete (Y ,X, E), permute (E, Z). +delete (X, [X|Z], Z). +delete (X, [Y|Z], [Y|E]):- delete (X, Z, E). +member (X, [X|Z]). +member (X, [Y|Z]):- member (X, Z). +not member (X, []). +not member (X, [Y|Z]):- X <> Y, not member (X,Z). +#page# +(**************************** calc ************************************) + +{ CALC evaluates arithmetic expressions with store } + +calc:- eval ([], RS), write (result store), write (RS), nl. + +eval (SI, SO):- + read (CALC), nonvar (CALC), eval member (CALC, SI, SO). + +eval member (CALC, SI, SO):- + member (CALC, [stop,end,bye,eof]), SO=SI; + eval (CALC,I,SI,ST), write (I), eval (ST,SO); + write (error in), write (CALC), nl, eval (SI, SO). + +eval (I, I, S, S):- integer (I). +eval (N, I, S, S):- atom (N), eval atom (N, I, S). + +eval atom (N, I, S):- + member (N=I, S); + write ("error: Cell"), write (N), + write("not found in store. 0 substituted."), nl, I=0. + +eval ( L+R,I,SI,SO):- eval (L,J,SI,ST), eval (R,K,ST,SO), I IS J+K. +eval ( L-R,I,SI,SO):- eval (L,J,SI,ST), eval (R,K,ST,SO), I IS J-K. +eval ( L*R,I,SI,SO):- eval (L,J,SI,ST), eval (R,K,ST,SO), I IS J*K. +eval ( L/R,I,SI,SO):- eval (L,J,SI,ST), eval (R,K,ST,SO), I IS J/K. + +eval (N=O, I, SI, SO):- + atom (N), eval (O,I,SI,ST), eval repl (N,I,ST,SO). + +eval repl (N, I, [], [=(N,I)]). +eval repl (N, I, [=(N,_)|S], [=(N,I)|S]). +eval repl (N, I, [=(M,J)|SI], [=(M,J)|SO]):- eval repl (N, I, SI, SO). + diff --git a/lang/prolog/1.8.7/source-disk b/lang/prolog/1.8.7/source-disk new file mode 100644 index 0000000..e61107d --- /dev/null +++ b/lang/prolog/1.8.7/source-disk @@ -0,0 +1 @@ +informatikpaket/01_sprachen.img diff --git a/lang/prolog/1.8.7/src/calc b/lang/prolog/1.8.7/src/calc new file mode 100644 index 0000000..0ed11af --- /dev/null +++ b/lang/prolog/1.8.7/src/calc @@ -0,0 +1,32 @@ +{ CALC evaluates arithmetic expressions with store } + +calc:- eval ([], RS), write (result store), write (RS), nl. + +eval (SI, SO):- + read (CALC), nonvar (CALC), eval member (CALC, SI, SO). + +eval member (CALC, SI, SO):- + member (CALC, [stop,end,bye,eof]), SO=SI; + eval (CALC,I,SI,ST), write (I), eval (ST,SO); + write (error in), write (CALC), nl, eval (SI, SO). + +eval (I, I, S, S):- integer (I). +eval (N, I, S, S):- atom (N), eval atom (N, I, S). + +eval atom (N, I, S):- + member (N=I, S); + write ("error: Cell"), write (N), + write("not found in store. 0 substituted."), nl, I=0. + +eval ( L+R,I,SI,SO):- eval (L,J,SI,ST), eval (R,K,ST,SO), I IS J+K. +eval ( L-R,I,SI,SO):- eval (L,J,SI,ST), eval (R,K,ST,SO), I IS J-K. +eval ( L*R,I,SI,SO):- eval (L,J,SI,ST), eval (R,K,ST,SO), I IS J*K. +eval ( L/R,I,SI,SO):- eval (L,J,SI,ST), eval (R,K,ST,SO), I IS J/K. + +eval (N=O, I, SI, SO):- + atom (N), eval (O,I,SI,ST), eval repl (N,I,ST,SO). + +eval repl (N, I, [], [=(N,I)]). +eval repl (N, I, [=(N,_)|S], [=(N,I)|S]). +eval repl (N, I, [=(M,J)|SI], [=(M,J)|SO]):- eval repl (N, I, SI, SO). + diff --git a/lang/prolog/1.8.7/src/family b/lang/prolog/1.8.7/src/family new file mode 100644 index 0000000..8419cc6 --- /dev/null +++ b/lang/prolog/1.8.7/src/family @@ -0,0 +1,29 @@ + +mann(jürgen). mann(detlef). mann (frank). mann (peter). mann(jochen). +frau(gaby). frau(yvonne). frau(sinha). frau(rita). frau(viktoria). +frau(adelheid). +vater(gaby, peter). vater(yvonne, peter). vater(frank, peter). +mutter(gaby, rita). mutter(yvonne, rita). mutter(frank, rita). +mutter(rita,viktoria). +vater(jürgen, heinz). mutter(jürgen, natalie). +vater(kalle, heinz). mutter(kalle, natalie). +mann(gaby, jürgen). mann(yvonne, detlef). mann(sinha,frank). +mann(rita, peter). mann(adelheid, jochen). +frau(X,Y) :- mann (Y,X). +großmutter(X,Y):- mutter(X,H), mutter(H,Y); vater(X,H), mutter(H,Y). +sohn(X,Y):- vater(Y,X), mann(Y); mutter(Y,X), mann(Y) . +tochter(X,Y):- vater(Y,X), frau(Y); mutter(Y,X), frau(Y). +geschwister(X,Y):-vater(X,A),vater(Y,A),mutter(X,B),mutter(Y,B),<>(X,Y). +bruder(X,Y):- geschwister(X,Y), mann(Y). +schwester(X,Y):- geschwister(X,Y), frau(Y). +schwager(X,Y):- mann(X,Z), bruder(Z,Y); frau(X,Z), bruder(Z,Y). +schwägerin(X,Y):-mann(X,Z),schwester(Z,Y);frau(X,Y),schwester(Z,Y). +freund (X,Y):- mann(Y), mann(X), <>(X,Y); + mann(Y), frau(X), mann(Z,Y), <>(X,Z); + mann(Y), frau(X), !, mann(Z,Y), []; + mann(Y), frau(X). +freundin (X,Y):- frau(Y), frau(X), <>(X,Y); + frau(Y), mann(X), mann(Y,Z), <>(X,Z); + frau(Y), mann(X), !, mann(Y,Z), []; + frau(Y), mann(X). + diff --git a/lang/prolog/1.8.7/src/permute b/lang/prolog/1.8.7/src/permute new file mode 100644 index 0000000..54f8fee --- /dev/null +++ b/lang/prolog/1.8.7/src/permute @@ -0,0 +1,15 @@ +permute ([], []). +permute ([E|X], Z):- + permute (X, Y), insert (E, Y, Z). +insert (E, X, [E|X]). +insert (E, [F|X], [F|Y]):- + insert (E, X, Y). +marquise(RESULT):- + permute (["beautiful marquise", + "your beautiful eyes", + "make me", + "die", + "of love" + ], + RESULT). + diff --git a/lang/prolog/1.8.7/src/prieks b/lang/prolog/1.8.7/src/prieks new file mode 100644 index 0000000..372ec9d --- /dev/null +++ b/lang/prolog/1.8.7/src/prieks @@ -0,0 +1,58 @@ + +ist priek (bo priek). +ist priek (ki priek). +ist priek (bla priek). + +WER GNASELT WEN :- population (B), + member ([WEN, WER, _], B), + bedingungen (B). + +WER KNAUDERT WEN:- population (B), + member ([WER, _, WEN], B), + bedingungen (B). + +population (B):- sind prieks (U, V, W), + sind knauderarten (R, S, T), + B = [ [drausla puemfe, U, R], + [glessla puemfe, V, S], + [hapla puemfe, W, T] ]. + +sind prieks (X,Y,Z):- ist priek (G), + ist priek (H), H<>G, + ist priek (I), I<>G, I<>H, !, + permute ([G,H,I], [X,Y,Z]). + +sind knauderarten (X,Y,Z):- ist knauderart (G), + ist knauderart (H), H<>G, + ist knauderart (I), I<>G, I<>H, !, + permute ([G,H,I],[X,Y,Z]). + +ist knauderart (an). +ist knauderart (ab). +ist knauderart (ueber). + +bedingungen (B):- not member ([hapla puemfe,ki priek,_],B) , + not member ([hapla puemfe,_,ueber],B) , + not member ([drausla puemfe,bo priek,_],B) , + not member ([_,bo priek,ab],B) , + noch ne bedingung (B) , + weitere bedingungen (B) , !. + +weitere bedingungen (B):- not member([_,ki priek,ueber],B), + not member([_,bo priek,ueber],B) + ; + member([drausla puemfe,_,an],B). + +noch ne bedingung (B):- not member ([drausla puemfe,ki priek,_],B) + ; + not member ([glessla puemfe,_,ueber],B). + +permute ([], []). +permute (X, [Y|Z]):- delete (Y ,X, E), permute (E, Z). +delete (X, [X|Z], Z). +delete (X, [Y|Z], [Y|E]):- delete (X, Z, E). +member (X, [X|Z]). +member (X, [Y|Z]):- member (X, Z). +not member (X, []). +not member (X, [Y|Z]):- X <> Y, not member (X,Z). + diff --git a/lang/prolog/1.8.7/src/prolog b/lang/prolog/1.8.7/src/prolog new file mode 100644 index 0000000..7ac2e6a --- /dev/null +++ b/lang/prolog/1.8.7/src/prolog @@ -0,0 +1,2488 @@ +PACKET prolog (* Autor: P.Heyderhoff *) +DEFINES (* Date: 03.07.1987 *) + prolog, prolog again: + +{ GLOBALS } + +LET { Stacksize parameter } + limit = 800; + +LET { nil-POINTER } + nil = 0; + +LET { bootstrap rules } + boot = """|"".""!"".""MOD"".""-"".""+"".""*"".""/"".bye.listing. +call(X).write(X).writeq(X).read(X).get(X).get0(X).put(X).incr(X). +assertz(X).asserta(X).retract(X).var(X). +X IS Y.X=X.X<>Y.X<=Y.X==Y.X=..Y.clause(X,_).name(X,Y). +arg(X,Y,Z).functor(X,Y,Z).elan(X).elan(X,Y)"; + +LET { bootstrap symbols, see: boot } + cons=1, cut=2, mod=3, {TOKEN: minus=4, plus=5, times=6, slash=7} + bye=8, list=9, call=10, xpar=11, + writ=12, wriq=13, read=14, get=15, get0=16, put0=17, + incr=18, ass=19, assa=20, retr=21, vari=22, + is=23, ypar=24, dif=26, leq=27, eq=28, univ=29, clau=30, claupar=31, + nam=32, argi=33, zpar=34, func=35, + elan=36, build ins=33; + +LET { TOKENS } + stroke=1, exclamation=2, colon=3, minus=4, plus=5, times=6, slash=7, + underscore=8, less=9, equal=10, uneq=11, grt=12, eqeq=13, + eqdotdot=14, period=15, comma=17, semicolon=18, + open paren=19, close paren=20, open bracket=21, close bracket=22, + end of input=23, boldvar=24, number=25, identifier=26; + +LET { SYMBOLTYPES } + tag=1, bold=2, num=3, tex=4, operator=5, delimiter=6, end of file=7, + within com=8, within tex=9; + +INT CONST integer:= -1, var:= -2; + +LET TOKEN = INT; + +LET SYMBOLTYPE = INT; + +LET SYMBOL = INT; +LET SYMBOLTABLE = THESAURUS; + +LET TERMS = INT; +{ LET TERMSCELL = STRUCT (TERM first, + TERMS rest); } +LET TERM = STRUCT (SYMBOL symbol, + TERMS arguments, + INT arity); + +LET CLAUSES = INT; +{ LET CLAUSESCELL = STRUCT (TERMS first, + CLAUSES rest); } +LET FRAME = INT; +LET FRAMECELL = STRUCT (TERM call, + FRAME father, + TERMS subgoals, { remaining } + ENVIRONMENT environment, + EXPRESSIONS reset, + CLAUSES rest { potential rules }, + FRAME level ); + +LET ENVIRONMENT = INT; +LET ENVIRONMENTCELL = STRUCT (SUBSTITUTION first, + ENVIRONMENT rest); +LET SUBSTITUTION = STRUCT (TERM variable, + TERM substitute, + FRAME others); + +LET FRAMESTACK = STRUCT (FRAME frame, goalframe, removed goal, + INT last tp, last kp, last fp, last np); + +LET EXPRESSIONS = INT; + +LET EXPRESSION = STRUCT (TERM term, + FRAME index); + +TEXT VAR tcsymbol, tcarguments, tcarity, tcrest; INT VAR tp; + +TEXT VAR kcfirst, kcrest; INT VAR kp; + +ROW limit FRAMECELL VAR fc; INT VAR fp; + +ROW limit ENVIRONMENTCELL VAR nc; INT VAR np; + +ROW limit FRAMESTACK VAR fsc; INT VAR fsp; + +ROW limit EXPRESSION VAR ec; INT VAR ep; + +ROW limit CLAUSES VAR freec; INT VAR freep; + +SYMBOL VAR look ahead value; +TEXT VAR look ahead symbol, ahead symbol; +BOOL VAR look ahead empty, ahead empty; +INT VAR look ahead token, ahead symboltype; + +SYMBOL VAR pattern; + +TERMS VAR ts; + +TERM VAR t, t2, t3; + +CLAUSES VAR k, kl, knowledge base, candidates; + +FRAME VAR root, cut level, res frame; + +SYMBOLTABLE VAR symboltable, reset symboltable; + +FILE VAR file; + +BOOL VAR from file, tracing, testing, found, quoting, free of errors, finish; + +INT VAR i, j, reset tp, reset kp, reset freep, anonym value, + inference level, inference count, rule count; + +TEXT VAR command; + +REAL VAR start time:= 0.0; + +PROC init globals: + tp := nil; kp:= nil; + tracing:= FALSE; + testing:= FALSE; + symboltable:= empty thesaurus; + reset symboltable:= symboltable; + reset tp:= nil; + reset kp:= nil; + reset freep:= nil; + knowledge base:= nil; + from file:= FALSE; + inference count:= 0; + tcsymbol:=""; + tcarguments:=""; + tcarity:=""; + tcrest:=""; + kcfirst:=""; + kcrest:=""; + quoting:= TRUE +ENDPROC init globals; + +PROC init prooftree: + root := nil; + freep:= reset freep; + fp:= nil; fsp:= nil; np:= nil; ep:= nil; tp:= reset tp; kp:= reset kp; + symboltable:= reset symboltable; + free of errors:= TRUE; + candidates:= nil; + new (fp, root); + fc(root):= FRAMECELL:(t, nil, nil, nil, nil, nil, 0); + anonym value:= 0; + collect heap garbage; + finish:= FALSE +ENDPROC init proof tree; + +PROC prolog (TEXT CONST knowledge): + line; + last param (knowledge); + init globals; + bootstrap; + IF exists (knowledge) THEN consult (knowledge) FI; + IF free of errors + THEN prolog again + FI; + last param (knowledge). + + bootstrap: + TERMS VAR clauses:= nil; + init proof tree; + look ahead empty:= TRUE; ahead empty:= TRUE; + scan (boot); + WHILE look ahead <> end of input + REP read clause; + assertz (clauses); + clauses:= nil + PER; + reset tp:= tp; + reset kp:= kp; + reset symboltable:= symboltable. + + read clause: + TERM VAR term; + read term (term); + IF look ahead = period + THEN remove token + FI; + insert term in clauses. + + insert term in clauses: + TERMS VAR tmp; + new tp (tmp); + replace(tcsymbol,tmp,term.symbol); + replace(tcarguments,tmp,term.arguments); + replace(tcarity,tmp,term.arity); + replace(tcrest,tmp, clauses); + clauses:= tmp. + + remove token: + look ahead empty:= TRUE. + +ENDPROC prolog; + +BOOL PROC prolog (TEXT CONST query, TEXT VAR answer): + disable stop; + init prooftree; + read goals; + BOOL VAR result:= NOT prove; + answer is value of last variable; + result . + + read goals: + scan (query); + look ahead empty:= TRUE; ahead empty:= TRUE; + from file:= FALSE; + fc(root).subgoals:= nil; + read terms (fc(root).subgoals); + IF look ahead = period + THEN remove token + FI; + IF look ahead <> end of input + THEN syntax error ("unexpected characters after last goal") + FI. + + answer is value of last variable: + IF fc(root).environment <> nil + THEN + value (nc(fc(root).environment).first.variable, t, root); + file:= sequential file (output, "$$"); + sysout ("$$"); + write term backward (t); + sysout (""); + input (file); + getline (file, answer); + forget ("$$", quiet) + ELSE answer:= "" + FI . + + remove token: + look ahead empty:= TRUE. + +ENDPROC prolog; + +PROC prolog again: + disable stop; + lernsequenz auf taste legen ("q","bye"13""); + write (""13""10""5"?- "); + REP + init proof tree; + initiate read terms (fc(root).subgoals, "-"); + read goals; + prove goals; + UNTIL finish + PER; + lernsequenz auf taste legen ("q","break"13""). + + read goals: + IF is error + THEN c:= "?" + ELIF look ahead = open bracket + THEN remove token; + read consult list + ELSE read terms (fc(root).subgoals); + IF look ahead = period + THEN remove token + FI; + IF look ahead <> end of input + THEN syntax error ("unexpected characters after last goal") + FI + FI. + + prove goals: + IF tracing THEN inference level:= 0; line FI; + inference count:= 0; + start time:= clock (0); + REP + IF c <> "?" CAND prove + THEN IF tracing THEN line FI; + write (" no"13""10""5"?- "); + LEAVE prove goals + ELSE IF tracing THEN inference level:= 0 FI; + get cursor (i,j); IF i > 1 THEN line FI; + IF is error + THEN put error; clear error; putline (""4""{cleop}); + free of errors:= FALSE; + sysout (""); sysin (""); + putline ("type '?' to get explanations"); + putline ("type ';' to try next alternative"); + putline ("type any other key to stop") + ELSE write answers + FI; + get cursor (i, j); + write (""10""10""13""5"?- "); + getchar (c); + TEXT VAR c; + SELECT pos ("?;",c) OF + CASE 1: write ("?"); + inform + CASE 2: write (""13""5""3""3""); + get cursor (j, k); + cursor (i, k); + putline (";"); + OTHERWISE IF c >= " " COR c = ""27"" THEN push (c) FI; + LEAVE prove goals + END SELECT; + IF tracing THEN line FI; + IF is error + THEN put error; clear error; putline (""4""{cleop}) + FI + FI + PER. + + write answers: + write (" "); + IF fc(root).environment = nil + THEN IF free of errors THEN put ("yes") ELSE put ("no") FI + ELSE write environment list (root) + FI. + + remove token: + look ahead empty:= TRUE. + +ENDPROC prolog again; + +PROC prolog: prolog (last param) ENDPROC prolog; + +BOOL PROC prove: + enable stop; + initialize prove; + find potential candidates. + + handle remaining subgoals: + { all subgoals to the left are solved } + IF subgoals remain + THEN get candidates + ELSE LEAVE prove WITH FALSE + FI. + + find potential candidates: + REP try one candidate PER; TRUE. + + try one candidate: + { all candidates tried do not unify with the current goal } + IF head of one candidate unifies with the current goal + THEN push frame; + handle remaining subgoals + ELSE backtrack to the parent of the current goal + FI. + + backtrack to the parent of the current goal: + { none of the candidates unify with the current goal } + IF prooftree exhausted + THEN LEAVE prove WITH TRUE + ELSE pop frame + FI. + + prooftree exhausted: fsp = 1. + + initialize prove: + TERM VAR curr call; + FRAME VAR curr frame, top frame; + EXPRESSIONS VAR last ep; + IF fsp = nil + THEN curr frame:= root; + push frame; + handle remaining subgoals + ELSE IF tracing THEN line FI; + backtrack to the parent of the current goal + FI. + + head of one candidate unifies with the current goal: + son { curr frame is the resulting next son }. + + subgoals remain: + select frame {(curr frame, curr call)}. + + push frame: + fsp INCR 1; + fsc(fsp).frame:= curr frame; + fsc(fsp).goalframe:= nil; + fsc(fsp).last tp:= tp; + fsc(fsp).last kp:= kp; + fsc(fsp).last fp:= fp; + fsc(fsp).last np:= np. + + pop frame: + { fsp <> nil } + top frame:= fsc(fsp).frame; + curr frame:= fc(top frame).father; + reinsert current call as subgoal; + curr call:= fc(top frame).call; + candidates:= fc(top frame).rest; + cut level:= fc(top frame).level; + tp:= fsc(fsp).last tp; + kp:= fsc(fsp).last kp; + fp:= fsc(fsp).last fp; + np:= fsc(fsp).last np; + fsp DECR 1; + IF tracing CAND inference level > 0 CAND NOT testing + THEN write (""13""5""3""5""); inference level DECR 1 + FI; + undo bindings (fc(top frame).reset). + + reinsert current call as subgoal: + IF fsc(fsp).goalframe <> nil + THEN fc(fsc(fsp).goalframe).subgoals:= fsc(fsp).removed goal + FI. + + select frame: + REP + IF next call + THEN LEAVE select frame WITH TRUE + FI; + curr frame:= fc(curr frame).father + UNTIL curr frame = nil PER; + FALSE. + + next call: + ts:= fc(curr frame).subgoals; + IF ts = nil + THEN FALSE + ELSE remove subgoals; TRUE + FI. + + remove subgoals: + curr call:= TERM:(tcsymbolISUBts, tcargumentsISUBts, tcarityISUBts); + fc(curr frame).subgoals:= (tcrestISUB(ts)) ; + fsc(fsp).goalframe:= curr frame; + fsc(fsp).removed goal:= ts. + + get candidates: + initialize clauses; + WHILE more knowledge + REP find next clause candidate in knowledge base PER + { candidates = a list of clauses which may be unifiable with curr call } . + + initialize clauses: + fc(curr frame).level:= cut level; + cut level:= curr frame; + IF curr call.arity = var + THEN IF bound (curr call, curr frame, curr call, ts) THEN FI; + IF curr call.arity = var + THEN take goal itself as candidate; LEAVE get candidates + FI + FI; + k:= knowledge base; + found:= FALSE; + candidates:= nil. + + take goal itself as candidate: + new kp (candidates); + replace (kcfirst, candidates, goal itself); + replace (kcrest, candidates, nil). + + goal itself: + new tp (ts); + replace(tcsymbol,ts,curr call.symbol); + replace(tcarguments,ts, curr call.arguments); + replace(tcarity,ts, curr call.arity); + replace(tcrest,ts, nil); + ts. + + find next clause candidate in knowledge base: + IF (tcsymbolISUB((kcfirstISUB(k)) )) = curr call.symbol + THEN found:= TRUE; + IF (tcarityISUB((kcfirstISUB(k)) )) = curr call.arity + THEN insert clause in candidates + FI + ELIF found + THEN LEAVE get candidates + FI; + k:= (kcrestISUB(k)) . + + more knowledge: k <> nil. + + insert clause in candidates: + kl:= candidates; + new kp (candidates); + replace(kcfirst,candidates,kcfirstISUBk); + replace(kcrest, candidates, kl). + + son: + { If rules has n sons, then this refinement will return TRUE the first + n times, it is called and FALSE forever after. + IF son then curr frame has become a frame for the next son. + So this refinement helps to construct the prooftree. + } + + IF candidates = nil + THEN FALSE + ELSE create next son + FI. + + create next son: + initialize son; + REP try to unify curr call with candidates + UNTIL candidates exhausted PER; + { not unified } + forget son. + + initialize son: + last ep:= ep; + new (fp, res frame); + fc(res frame).environment:= nil. + + try to unify curr call with candidates: + k:= (kcfirstISUB(candidates)) ; + IF + unify (curr call, + curr frame, + TERM:(tcsymbolISUBk, tcargumentsISUBk, tcarityISUBk), + res frame) + THEN + IF tracing THEN trace unification results FI; + apply rule; + fill result frame + ELSE remove curr call from candidates + FI. + + candidates exhausted: candidates = nil. + + forget son: + fp DECR 1; FALSE. + + fill result frame: + ts:= (kcfirstISUB(candidates)) ; + fc(res frame):= FRAMECELL:(curr call, + curr frame, + tcrestISUBts, + fc(res frame).environment, + last ep, + (kcrestISUB(candidates)) , + cut level); + curr frame:= res frame; + LEAVE son WITH TRUE. + + remove curr call from candidates: + candidates:= (kcrestISUB(candidates)) ; + LEAVE try to unify curr call with candidates. + + apply rule: + SELECT curr call.symbol OF + CASE cons: {cons, to construct lists, see PROC unify} + CASE cut: fc(res frame):= FRAMECELL:(curr call, curr frame, nil, + fc(res frame).environment, last ep, nil, cut level); + curr frame:= res frame; + FOR ts FROM fp DOWNTO cut level + REP fc(ts).rest:= nil PER; + LEAVE son WITH TRUE + CASE bye: IF curr call.arity = 0 + THEN push (""13""); + finish:= TRUE + FI + CASE list: IF curr call.arity = 0 COR curr call.arity = 1 + THEN found:= TRUE; + IF curr call.arity = 0 + THEN pattern:= cut + ELSE value (argfirst, t, curr frame); + pattern:= t.symbol + FI; + write knowledgebase (knowledge base) + FI + CASE call: undo bindings (last ep); + new tp (ts); + replace(tcrest,ts, fc(curr frame).subgoals); + fc(curr frame).subgoals:= ts; + value (argfirst, t, curr frame); + t.arguments:= revers (t.arguments); + replace(tcsymbol,ts, t.symbol); + replace(tcarguments,ts, t.arguments); + replace(tcarity,ts, t.arity); + LEAVE son WITH TRUE + CASE xpar: {X parameter of call} + CASE writ: IF curr call.arity = 1 + THEN value (argfirst, t, curr frame); + quoting:= FALSE; + write term backward (t); write (" "); + quoting:= TRUE + FI + CASE wriq: IF curr call.arity = 1 + THEN value (argfirst, t, curr frame); + write term backward (t); write (" ") + FI + CASE read: IF curr call.arity <> 1 + THEN + ELIF argfirst.arity = var + THEN initiate read terms (ts, + name (symboltable,argfirst.symbol)); + read term (t); + nc(fc(curr frame).environment).first.substitute:= t + ELSE syntax error ("read parameter must be variable") + FI + CASE get0, get: + IF curr call.arity <> 1 + THEN + ELIF argfirst.arity = var + THEN getchar (command); + WHILE curr call.symbol = get + CAND code(command) < 32 + REP getchar (command) PER; + t.arity:= integer; + t.arguments:= nil; + t.symbol:= code (command); + nc(fc(curr frame).environment).first.substitute:= t + ELSE syntax error ("get parameter must be variable") + FI + CASE put0: value (argfirst, t, curr frame); + IF curr call.arity = 1 CAND t.arity = integer + THEN write (code (t.symbol)) + FI + CASE incr: IF curr call.arity = 1 + THEN + value(argfirst, t, curr frame); + t.symbol INCR 1; + IF t.arity = integer + CAND argfirst.arity = var + THEN k:= fc(curr frame).environment; + nc(k).first.substitute:= t; + ELSE syntax error ("integer variable expected") + FI FI + CASE ass: IF curr call.arity = 1 + THEN value (argfirst,t,currframe); + IF t.symbol = nil + CAND t.arguments > nil + THEN assertz (t.arguments); + IF free of errors + THEN reset tp:= tp; + reset kp:= kp; + reset symboltable:= symboltable + FI + ELSE syntax error ("parameter must be a list") + FI FI + CASE assa: IF curr call.arity = 1 + THEN value (argfirst,t,currframe); + IF t.symbol = nil + CAND t.arguments > nil + THEN asserta (t.arguments); + IF free of errors + THEN reset tp:= tp; + reset kp:= kp; + reset symboltable:= symboltable + FI + ELSE syntax error ("parameter must be a list") + FI FI + CASE retr: IF curr call.arity = 1 + THEN value (argfirst,t,currframe); + IF t.symbol = nil + CAND t.arguments > nil + THEN i:= rule count; + retract (t.arguments); + IF i <> rule count + THEN remove curr call from candidates + FI + ELSE syntax error ("parameter must be a list") + FI FI + CASE vari: IF curr call.arity = 1 + THEN value (argfirst, t, curr frame); + IF t.arity <> var + THEN remove curr call from candidates + FI + FI + CASE is: IF curr call.arity = 2 + THEN disable stop; + t.symbol:= arith (TERM:(tcsymbolISUBargrest, + tcargumentsISUBargrest, + tcarityISUBargrest), + curr frame); + IF is error THEN put error; clear error FI; + enable stop; + t.arity := integer; + t.arguments:= nil; + IF unify (argfirst, curr frame, t, curr frame) + THEN LEAVE apply rule + FI FI; + remove curr call from candidates + CASE ypar: {Y parameter of is} + CASE dif: IF curr call.arity = 2 CAND + unify (argfirst, + curr frame, + TERM:(tcsymbolISUBargrest, + tcargumentsISUBargrest, + tcarityISUBargrest), + curr frame) + THEN remove curr call from candidates + FI + CASE leq: IF curr call.arity = 2 + THEN get operands; + IF t.arity = integer + THEN IF t.symbol <= t2.symbol + THEN LEAVE apply rule + FI + ELIF name (symboltable, t.symbol) <= + name (symboltable, t2.symbol) + THEN LEAVE apply rule + FI FI; + remove curr call from candidates + CASE eq: IF curr call.arity = 2 + THEN get operands; + IF NOT ( t = t2 ) + THEN remove curr call from candidates + FI FI + CASE univ: IF curr call.arity = 2 + CAND np > fsc(fsp).last np + THEN + get operands; + IF t2.arity = var CAND t.arity >= 0 + THEN new tp (ts); + replace (tcsymbol,ts,t.symbol); + replace (tcarguments, ts, nil); + replace (tcarity,ts,0); + replace (tcrest,ts,revers(t.arguments)); + nc(np).first.substitute.arguments:= ts; + nc(np).first.substitute.symbol:= nil; + nc(np).first.substitute.arity:= t.arity + 1 + ELIF t.arity = var CAND t2.arity > 0 + CAND t2.symbol <= cons + THEN np DECR 1; + t2. arguments:= revers(t2.arguments); + nc(np).first.substitute.symbol:= + tcsymbol ISUB t2.arguments; + nc(np).first.substitute.arguments:= + tcrest ISUB t2.arguments; + nc(np).first.substitute.arity:= t2.arity - 1; + np INCR 1 + ELSE syntax error ("wrong parameter after =..") + FI FI + CASE clau: get operands; + IF curr call.arity = 2 + THEN + IF t.arity < 0 + THEN syntax error ("clause with wrong parameter") + ELSE find clause; + k:= tcrest ISUB (kcfirstISUBk); + t3.symbol:= nil; + t3.arguments:= k; + t3.arity:= no of terms (k); + IF NOT unify (t2, res frame, + t3, curr frame) + THEN remove curr call from candidates + FI + FI + FI + CASE claupar: { anonymous parameter of clause } + CASE nam: IF curr call.arity = 2 + THEN get operands; + IF t.arity = var + CAND t2.symbol = nil + THEN command:= ""; + k:= t2.arguments; + REP command:= code (tcsymbolISUBk) + command; + k:= tcrestISUBk + UNTIL k <= nil PER; + t.symbol:= link (symboltable, command); + IF t.symbol = 0 + THEN insert (symboltable, command, t.symbol); + FI; + t.arity:= 0; + t.arguments:= nil; + nc(fc(curr frame).environment).first.substitute:= t + ELIF t2.arity = var + CAND t.arity = 0 + THEN command:= name (symboltable, t.symbol); + ts:= nil; + FOR k FROM 1 UPTO length(command) + REP new tp (i); + IF ts = nil + THEN ts:= i + ELSE replace (tcrest, j, i) + FI; + j:= i; + replace (tcrest, i, nil); + replace (tcarity, i, integer); + replace (tcarguments, i, nil); + replace (tcsymbol, i, code (command SUB k)) + PER; + t3.arity:= length(command); + t3.arguments:= ts; + t3.symbol:= nil; + IF unify (t2, res frame, t3, curr frame) THEN FI + ELSE syntax error ("name insufficient parameters") + FI FI + CASE argi: get operands; + IF curr call.arity = 3 + THEN k:= argrest; + value (TERM:(tcsymbolISUB(tcrestISUB(k)), + tcargumentsISUB(tcrestISUB(k)), + tcarityISUB(tcrestISUB(k))), + t3, + curr frame); + IF t.arity <> integer COR t2.arity <= 0 + COR t.symbol <= 0 COR t.symbol > t2.arity + THEN syntax error ("arg with wrong parameter") + ELSE + FOR k FROM t2.arity DOWNTO ( t.symbol + 1) + REP IF t2.arguments <= nil + THEN syntax error ("out of range"); + LEAVE apply rule + FI; + t2.arguments:= tcrestISUB(t2.arguments) + PER; + IF t3.arity = var + THEN nc(fc(curr frame).environment).first.substitute + := TERM:(tcsymbolISUBt2.arguments, + tcargumentsISUBt2.arguments, + tcarityISUBt2.arguments) + ELIF NOT unify (TERM:(tcsymbolISUBt2.arguments, + tcargumentsISUBt2.arguments, + tcarityISUBt2.arguments), + curr frame, + t3, + curr frame) + THEN remove curr call from candidates + FI + FI + FI + CASE zpar: {z parameter of arg} + CASE func: IF curr call.arity = 3 + THEN + get operands; + k:= argrest; + value (TERM:(tcsymbolISUB(tcrestISUB(k)), + tcargumentsISUB(tcrestISUB(k)), + tcarityISUB(tcrestISUB(k))), + t3, + curr frame); + IF t2.arity = var + THEN IF t3.arity = var + THEN + t2.symbol:= argfirst.symbol; + t2.arity := 0; + nc(nc(fc(curr frame).environment).rest).first. + substitute:= t2; + k:= tcrestISUB(k); + t3.symbol:= argfirst.arity; + t3.arity := integer; + nc(fc(curr frame).environment).first. + substitute:= t3 + ELIF t3.arity = integer + CAND t.arity = t3.symbol + THEN t.arity:= 0; + t.arguments:= nil; + nc(fc(curr frame).environment).first. + substitute:= t + ELSE remove curr call from candidates + FI + ELIF ( t.arity = var) + CAND (t2.arity = 0) + CAND (t3.arity = integer) + THEN t2.arity:= t3.symbol; + FOR k FROM 1 UPTO t3.symbol + REP new tp (ts); + replace (tcarity, ts, var); + anonym value DECR 1; + replace (tcsymbol, ts, anonym value); + replace (tcarguments, ts, nil); + replace (tcrest, ts, t2.arguments); + t2.arguments:= ts + PER; + nc(fc(curr frame).environment).first. + substitute:= t2 + ELIF t2.arity <= 0 + THEN IF t.symbol = t2.symbol + THEN IF t.arity = t3.symbol + CAND t3.arity = integer + THEN + ELIF t3.arity = var + THEN t3.arity := integer; + t3.symbol:= t.arity; + nc(fc(curr frame).environment).first. + substitute:= t3 + ELSE remove curr call from candidates + FI + ELSE remove curr call from candidates + FI + ELSE syntax error ("wrong functor parameters") + FI FI + CASE elan: disable stop; + lernsequenz auf taste legen ("q","break"13""); + SELECT + pos("consult,reconsult,sysout,sysin,forget,trace,line,abolish," + ,name (symboltable, argfirst.symbol) + ",") OF + CASE 01: consult (arg1) + CASE 09: reconsult (arg1) + CASE 19: sysout (arg1) + CASE 26: sysin (arg1) + CASE 32: forget (arg1, quiet) + CASE 39: trace (arg1) + CASE 45: line + CASE 50: value (TERM:(tcsymbolISUBargrest, + tcargumentsISUBargrest, + tcarityISUBargrest), + t, + curr frame); + abolish (t.symbol) + OTHERWISE do (elan command) + ENDSELECT; + lernsequenz auf taste legen ("q","bye"13""); + IF is error THEN put error; clear error FI; + enable stop + END SELECT. + + get operands: + value (argfirst, t, curr frame); + value (TERM:(tcsymbolISUBargrest, + tcargumentsISUBargrest, + tcarityISUBargrest), + t2, + curr frame). + + argfirst:TERM:(tcsymbolISUBcurr call.arguments, + tcargumentsISUBcurr call.arguments, + tcarityISUBcurr call.arguments). + + argrest: tcrestISUBcurr call.arguments. + + arg1: value (TERM:(tcsymbolISUBargrest, + tcargumentsISUBargrest, + tcarityISUBargrest), + t, + curr frame); + name(symboltable, t.symbol). + +find clause: + k:= knowledgebase; + WHILE k <> nil + REP + ts:= kcfirstISUBk; + IF TERM:(tcsymbolISUBts,tcargumentsISUBts,tcarityISUBts) = t + THEN LEAVE find clause + FI; + k:= kcrestISUBk + PER; + remove curr call from candidates; + LEAVE apply rule. + + elan command: + command:= ""; + ts:= curr call.arguments; + WHILE ts <> nil + REP value (TERM:(tcsymbolISUBts, + tcargumentsISUBts, + tcarityISUBts), + t, + curr frame); + command CAT name (symboltable, t.symbol); + found:= ts = curr call.arguments; + ts:= tcrestISUB(ts); + IF found + THEN IF ts > nil THEN command CAT "(""" FI + ELIF ts = nil + THEN command CAT """)" + ELSE command CAT """,""" + FI + PER; + command. + + trace unification results: + inference level INCR 1; + write term (curr call); write ("="); + value (TERM:(tcsymbolISUB(kcfirstISUB(candidates)) , + tcargumentsISUB(kcfirstISUB(candidates)) , + tcarityISUB(kcfirstISUB(candidates)) ), t, res frame); + write term backward (t); + IF testing + THEN ts:= ep; + IF ts > last ep THEN write (" with ") FI; + list expressions + FI; + line. + + list expressions: + WHILE ts > last ep + REP k:= fc(ec(ts).index).environment; + WHILE nc(k).first.variable.symbol <> ec(ts).term.symbol + REP k:= nc(k).rest PER; + write term (ec(ts).term); write ("="); + write term (nc(k).first.substitute); write (" "); + ts DECR 1 + PER. + +ENDPROC prove; + +BOOL PROC unify (TERM CONST t1, FRAME CONST f1, + TERM CONST t2, FRAME CONST f2): + + { Unifies the expressions and , + If unification succeeds, both environments are updated. } + +{}{inference count INCR 1;} + IF f1 = f2 CAND t1 = t2 + THEN TRUE + ELIF t1.arity = var + THEN TERM VAR t; + FRAME VAR f; + IF bound (t1, f1, t, f) + THEN unify (t, f, t2, f2) + { ELIF occurs (t1, f1, t2, f2) THEN FALSE } + ELSE bind expression 1; + push expression 1; + TRUE + FI + ELIF t2.arity = var + THEN IF bound (t2, f2, t, f) + THEN unify (t, f, t1, f1) + { ELIF occurs (t2, f2, t1, f1) THEN FALSE } + ELSE bind expression 2; + push expression 2; + TRUE + FI + ELIF t1.symbol = t2.symbol + CAND t1.arity = t2.arity + THEN constant or compound term + ELIF t1.symbol = cons CAND t2.symbol = nil + CAND t1.arity = 2 CAND t2.arguments > nil + CAND unify (TERM:(tcsymbolISUBt1.arguments, + tcargumentsISUBt1.arguments, + tcarityISUBt1.arguments), + f1, + TERM:(tcsymbolISUBt2.arguments, + tcargumentsISUBt2.arguments, + tcarityISUBt2.arguments), + f2) + THEN construct list 1 + ELIF t2.symbol = cons CAND t1.symbol = nil + CAND t2.arity = 2 CAND t1.arguments > nil + CAND unify (TERM:(tcsymbolISUBt2.arguments, + tcargumentsISUBt2.arguments, + tcarityISUBt2.arguments), + f2, + TERM:(tcsymbolISUBt1.arguments, + tcargumentsISUBt1.arguments, + tcarityISUBt1.arguments), + f1) + THEN construct list 2 + ELSE FALSE + FI. + +constant or compound term: + { arguments of t1 and t2 are properly instantiated by the parser } + EXPRESSIONS VAR last ep:= ep; + TERMS VAR x:= t1.arguments, y:= t2.arguments; + WHILE x <> nil + REP IF unify (TERM:(tcsymbolISUBx, tcargumentsISUBx, tcarityISUBx), + f1, + TERM:(tcsymbolISUBy, tcargumentsISUBy, tcarityISUBy), + f2) + THEN x:= tcrestISUB(x); + y:= tcrestISUB(y) + ELSE undo bindings (last ep); + LEAVE unify WITH FALSE + FI + PER; + TRUE. + + construct list 1: + last ep:= ep; + IF t2.symbol = cons + THEN TERM VAR tail:= TERM:(tcsymbolISUB(tcrestISUB(t2.arguments)), + tcargumentsISUB(tcrestISUB(t2.arguments)), + tcarityISUB(tcrestISUB(t2.arguments))); + ELSE tail:= TERM: (nil, (tcrestISUB(t2.arguments)) , + no of terms (t2.arguments) - 1); + FI; + IF bound (TERM:(tcsymbolISUB(tcrestISUB(t1.arguments)) , + tcargumentsISUB(tcrestISUB(t1.arguments)) , + tcarityISUB(tcrestISUB(t1.arguments)) ), + f1, + t, + f) + THEN IF unify (t, f, tail, f2) + THEN TRUE + ELSE undo bindings (last ep); FALSE + FI + ELSE bind tail 1; + push tail 1; + TRUE + FI. + + construct list 2: + last ep:= ep; + IF t1.symbol = cons + THEN tail:= TERM:(tcsymbolISUB(tcrestISUB(t1.arguments)) , + tcargumentsISUB(tcrestISUB(t1.arguments)) , + tcarityISUB(tcrestISUB(t1.arguments)) ); + ELSE tail:= TERM: (nil, tcrestISUB(t1.arguments), + no of terms (t1.arguments) - 1); + FI; + IF bound (TERM:(tcsymbolISUB(tcrestISUB(t2.arguments)) , + tcargumentsISUB(tcrestISUB(t2.arguments)) , + tcarityISUB(tcrestISUB(t2.arguments)) ), + f2, + t, + f) + THEN IF unify (t, f, tail, f1) + THEN TRUE + ELSE undo bindings (last ep); FALSE + FI + ELSE bind tail 2; + push tail 2; + TRUE + FI. + + bind expression 1: + { bind the expression to in the environment } + new environment n; + nc(n).first:= SUBSTITUTION:(t1, t2, f2); + nc(n).rest :=fc(f1).environment; + fc(f1).environment:= n. + + bind expression 2: + new environment n; + nc(n).first:= SUBSTITUTION:(t2, t1, f1); + nc(n).rest :=fc(f2).environment; + fc(f2).environment:= n. + + bind tail 1: + new environment n; + nc(n).first:= SUBSTITUTION:( + TERM:(tcsymbolISUB(tcrestISUB(t1.arguments)), + tcargumentsISUB(tcrestISUB(t1.arguments)) , + tcarityISUB(tcrestISUB(t1.arguments)) ), + tail, + f2); + nc(n).rest :=fc(f1).environment; + fc(f1).environment:= n. + + bind tail 2: + new environment n; + nc(n).first:= SUBSTITUTION:( + TERM:(tcsymbolISUB(tcrestISUB(t2.arguments)) , + tcargumentsISUB(tcrestISUB(t2.arguments)) , + tcarityISUB(tcrestISUB(t2.arguments)) ), + tail, + f1); + nc(n).rest :=fc(f2).environment; + fc(f2).environment:= n. + + push expression 1: + ep INCR 1; + ec(ep):= EXPRESSION:(t1, f1). + + push expression 2: + ep INCR 1; + ec(ep):= EXPRESSION:(t2, f2). + + push tail 1: + ep INCR 1; + ec(ep):= EXPRESSION:(TERM:(tcsymbolISUB(tcrestISUB(t1.arguments)) , + tcargumentsISUB(tcrestISUB(t1.arguments)) , + tcarityISUB(tcrestISUB(t1.arguments)) ), + f1). + + push tail 2: + ep INCR 1; + ec(ep):= EXPRESSION:(TERM:(tcsymbolISUB(tcrestISUB(t2.arguments)) , + tcargumentsISUB(tcrestISUB(t2.arguments)) , + tcarityISUB(tcrestISUB(t2.arguments)) ), + f2). + + new environment n: + ENVIRONMENT VAR n; + IF np = limit THEN pegeloverflow ELSE np INCR 1; n:= np FI +ENDPROC unify; + +BOOL OP = (TERM CONST t1, t2): { INLINE; } + { Two terms are equal iff their printed representations are + indistinguishable. Don't confuse with equal expressions. } + + IF ( t1.symbol = t2.symbol ) + CAND ( t1.arity = t2.arity ) + THEN IF t1.arguments = 0 + THEN terms are variables or constants + ELSE terms are compound + FI + ELSE FALSE + FI. + + terms are variables or constants: TRUE. + + terms are compound: + TERMS VAR x:= t1.arguments, + y:= t2.arguments; + WHILE x <> nil + REP IF recursive equal (TERM:(tcsymbolISUBx, + tcargumentsISUBx, + tcarityISUBx), + TERM:(tcsymbolISUBy, + tcargumentsISUBy, + tcarityISUBy)) + THEN x:= tcrestISUB(x); + y:= tcrestISUB(y) + ELSE LEAVE = WITH FALSE + FI + PER; TRUE. +ENDOP =; + +BOOL PROC recursive equal (TERM CONST t1, t2): t1=t2 +ENDPROC recursive equal; + +PROC undo bindings (EXPRESSIONS CONST last ep): + { Remove the binding for each of the expressions } + WHILE ep > last ep + REP remove matching substitutions; + remove expression + PER. + + remove matching substitutions: + { with variable equal to term t from environment env } + TERM VAR t:= ec(ep).term; + ENVIRONMENT VAR n:= env, last:= nil; + WHILE n <> nil + REP IF nc(n).first.variable.symbol = t.symbol + THEN forget n + ELSE last:= n + FI; + n:= nc(n).rest + PER. + + forget n: + IF last = nil + THEN env := nc(n).rest + ELSE nc(last).rest:= nc(n).rest + FI; + IF n = np THEN np DECR 1 FI. + + env: fc(ec(ep).index).environment. + + remove expression: + { Removes the first expression from e recovering the space used } + ep DECR 1. + +END PROC undo bindings; + +PROC consult (TEXT CONST knowledge): + { asserts the clauses from the file into knowledge base } +{} enable stop; + IF NOT exists (knowledge) + THEN syntax error ("consulting file not existing"); LEAVE consult + FI; + last param (knowledge); + TERMS VAR clauses; + BOOL VAR single:= TRUE; + rule count:= 0; + initiate read terms (knowledge, clauses); + WHILE look ahead <> end of input + REP rule count INCR 1; + cout (rule count); + read clause; + assertz (clauses); + clauses:= nil + PER; + remove token; + IF anything noted + THEN modify (file); + note edit (file) + FI; + IF free of errors + THEN reset tp:= tp; + reset kp:= kp; + reset symboltable:= symboltable; + put (rule count) + ELSE put (0); from file:= FALSE + FI; + putline ("rules inserted."); + line . + + read clause: + TERM VAR term; + IF single + THEN read term (term); + IF term.arity = var + THEN syntax error ("clause starts with variable") + ELIF name (symboltable, term.symbol) = ":-" + THEN read terms (clauses); + call terms (clauses); + LEAVE consult + FI; + IF look ahead = colon + THEN remove token; + read terms (clauses) + FI + ELIF look ahead = semicolon + THEN remove token; + read terms (clauses) + FI; + IF look ahead = semicolon + THEN single:= FALSE + ELIF look ahead = period + THEN single:= TRUE; + remove token + ELSE syntax error ("period or semicolon expected") + FI; + insert term in clauses. + + insert term in clauses: + TERMS VAR tmp; + new tp (tmp); + replace(tcsymbol,tmp,term.symbol); + replace(tcarguments,tmp,term.arguments); + replace(tcarity,tmp,term.arity); + replace(tcrest,tmp, clauses); + clauses:= tmp. + + remove token: + look ahead empty:= TRUE. + +END PROC consult; + +PROC reconsult (TEXT CONST knowledge): + { asserts the clauses from the file into knowledge base } +{} enable stop; + IF NOT exists (knowledge) + THEN syntax error ("reconsulting file not existing"); LEAVE reconsult + FI; + last param (knowledge); + TERMS VAR clauses; + BOOL VAR single:= TRUE; + rule count:= 0; + initiate read terms (knowledge, clauses); + WHILE look ahead <> end of input + REP rule count INCR 1; + cout (rule count); + read clause; + abolish (tcsymbol ISUB clauses); + clauses:= nil + PER; + remove token; + consult (knowledge). + + read clause: + TERM VAR term; + IF single + THEN read term (term); + IF term.arity = var + THEN syntax error ("clause starts with variable") + ELIF name (symboltable, term.symbol) = ":-" + THEN read terms (clauses); + call terms (clauses); + LEAVE reconsult + FI; + IF look ahead = colon + THEN remove token; + read terms (clauses) + FI + ELIF look ahead = semicolon + THEN remove token; + read terms (clauses) + FI; + IF look ahead = semicolon + THEN single:= FALSE + ELIF look ahead = period + THEN single:= TRUE; + remove token + ELSE syntax error ("period or semicolon expected") + FI; + insert term in clauses. + + insert term in clauses: + TERMS VAR tmp; + new tp (tmp); + replace(tcsymbol,tmp,term.symbol); + replace(tcarguments,tmp,term.arguments); + replace(tcarity,tmp,term.arity); + replace(tcrest,tmp, clauses); + clauses:= tmp. + + remove token: + look ahead empty:= TRUE. + +END PROC reconsult; + +PROC assertz (TERMS CONST clause): + { Inserts the clause into the knowledge base before the first clause + beginning with the same functor. + Clauses beginning with the same functor are assumed to be listed + consecutively. + } + CLAUSES VAR c1, c2, c3; + IF free of errors + THEN IF freep > nil + THEN c3:= freec(freep); + freep DECR 1; + IF reset freep > freep THEN reset freep:= freep FI + ELSE new kp (c3) + FI; + replace(kcfirst,c3, clause); + IF knowledge base = nil + COR (tcsymbolISUB((kcfirstISUB(knowledgebase)) )) = + (tcsymbolISUB(clause)) + THEN insert on top + ELSE c1:= knowledge base; + REP find and insert clause PER + FI + FI. + + find and insert clause: + c2:= (kcrestISUB(c1)) ; + IF c2 = nil + THEN insert on top + ELIF (tcsymbolISUB((kcfirstISUB(c2)) )) = (tcsymbolISUB(clause)) + THEN insert before + FI; + c1:= c2. + + insert on top: + replace(kcrest,c3, knowledge base); + knowledge base:= c3; + LEAVE assertz. + + insert before: + replace(kcrest,c3, c2); + replace(kcrest,c1, c3); + LEAVE assertz. + +ENDPROC assertz; + +PROC asserta (TERMS CONST clause): + { Inserts the clause into the knowledge base after the last clause + beginning with the same functor. + Clauses beginning with the same functor are assumed to be listed + consecutively. + } + CLAUSES VAR c1, c2, c3; + IF free of errors + THEN IF freep > nil + THEN c3:= freec(freep); + freep DECR 1; + IF reset freep > freep THEN reset freep:= freep FI + ELSE new kp (c3) + FI; + replace(kcfirst,c3, clause); + IF knowledge base = nil + THEN replace(kcrest,c3, knowledge base); + knowledge base:= c3 + ELSE c1:= knowledge base; + REP find and insert clause PER + FI + FI. + + find and insert clause: + c2:= (kcrestISUB(c1)) ; + IF c2 = nil + THEN append after c1 + ELIF (tcsymbolISUB((kcfirstISUB(c2)) )) = (tcsymbolISUB(clause)) + THEN insert behind + FI; + c1:= c2. + + append after c1: + replace(kcrest,c1, clause); + LEAVE asserta. + + insert behind: + REP c1:= c2; + c2:= (kcrestISUB(c1)) ; + UNTIL (tcsymbolISUB((kcfirstISUB(c2)) )) <> (tcsymbolISUB(clause)) + PER; + replace(kcrest,c3, c2); + replace(kcrest,c1, c3); + LEAVE asserta. + +ENDPROC asserta; + +PROC retract (TERMS CONST clause): + { Retracts the clause from the knowledge base. } + CLAUSES VAR c1:= knowledge base, c2; + IF free of errors + THEN IF c1 = nil + THEN rule count DECR 1 + ELIF c1 > build ins CAND terms eq ((kcfirstISUB(c1)) , clause) + THEN retract top + ELSE REP find and retract clause PER + FI + FI. + + find and retract clause: + c2:= (kcrestISUB(c1)) ; + IF c2 = nil + THEN rule count DECR 1; + LEAVE retract + ELIF c2 > build ins CAND terms eq ((kcfirstISUB(c2)) , clause) + THEN retract c2 + FI; + c1:= c2. + + retract top: + freep INCR 1; + reset freep:= freep; + freec(freep):= knowledge base; + knowledge base:= (kcrestISUB(knowledge base)) ; + LEAVE retract. + + retract c2: + replace(kcrest,c1, (kcrestISUB(c2)) ); + freep INCR 1; + reset freep:= freep; + freec(freep):= c2; + LEAVE retract. + +ENDPROC retract; + +PROC abolish (SYMBOL CONST clause): + { Retracts all the clauses with this name from the knowledge base. } +{} enable stop; + CLAUSES VAR c1:= knowledge base, c2; + IF free of errors + THEN REP + IF c1 = nil + THEN rule count DECR 1; + LEAVE abolish + ELIF c1 = knowledgebase CAND c1 > build ins + CAND (tcsymbol ISUB(kcfirstISUBc1)) = clause + THEN retract top; + c1:= knowledgebase + ELSE find and retract clause + FI + PER + FI. + + find and retract clause: + c2:= kcrestISUBc1 ; + IF c2 = nil + THEN rule count DECR 1; + LEAVE abolish + ELIF c2 > build ins + CAND (tcsymbol ISUB(kcfirstISUBc2)) = clause + THEN retract c2 + ELSE c1:= c2 + FI. + + retract top: + freep INCR 1; + reset freep:= freep; + freec(freep):= knowledge base; + knowledge base:= (kcrestISUB(knowledge base)). + + retract c2: + replace(kcrest,c1, (kcrestISUB(c2)) ); + freep INCR 1; + reset freep:= freep; + freec(freep):= c2. + +ENDPROC abolish; + +BOOL PROC terms eq (TERMS CONST a, b): + IF a = b + THEN TRUE + ELIF a = 0 COR b = 0 + THEN FALSE + ELIF TERM:(tcsymbolISUBa, + tcargumentsISUBa, + tcarityISUBa) = + TERM:(tcsymbolISUBb, + tcargumentsISUBb, + tcarityISUBb) + THEN terms eq ((tcrestISUB(a)) , (tcrestISUB(b)) ) + ELSE FALSE + FI +ENDPROC terms eq; + +PROC value (TERM CONST t, TERM VAR r, FRAME CONST f): + { sets r to the value of t in f^.environment } +{} enable stop; + IF t.arguments = 0 + THEN IF t.arity = var + THEN variable term + ELSE constant term + FI + ELSE compound term + FI. + + constant term: r:= t. + + variable term: + TERM VAR t1, t2; + FRAME VAR f1; + IF bound (t, f, t1, f1) + THEN value (t1, r, f1) + ELSE r:= t + FI. + + compound term: + INT VAR step:= 3; + TERMS VAR ts:= t.arguments; + r.arguments:= nil; + WHILE ts <> nil + REP value (TERM:(tcsymbolISUBts, + tcargumentsISUBts, + tcarityISUBts), + t1, + f); + IF stepping + CAND step = 1 CAND t.symbol = cons CAND t1.symbol = nil + THEN step:= 0; + value (t1, t2, f); + ts:= t2.arguments + ELSE ts:= tcrestISUB(ts); + push term in arguments + FI; + PER; + IF step = 0 + THEN r.symbol:= nil + ELSE r.symbol:= t.symbol + FI; + r.arity:= no of terms (r.arguments). + + stepping: + IF step > 1 THEN step DECR 1; TRUE ELSE FALSE FI. + + push term in arguments: + TERMS VAR term; + new tp (term); + replace(tcsymbol,term, t1.symbol); + replace(tcarguments,term, t1.arguments); + replace(tcarity,term, t1.arity); + replace(tcrest,term, r.arguments); + r.arguments:= term. +ENDPROC value; + +BOOL PROC bound (TERM CONST t1, FRAME CONST f1, + TERM VAR t2, FRAME VAR f2): + { returns TRUE iff the expression is bound and + assigns the expression to which it is bound. } + ENVIRONMENT VAR n:= fc(f1).environment; + SUBSTITUTION VAR sub; + WHILE n <> nil + REP sub:= nc(n).first; + IF t1.symbol = sub.variable.symbol + THEN t2:= sub.substitute; + f2:= sub.others; + LEAVE bound WITH TRUE + ELSE n:= nc(n).rest + FI + PER; + FALSE +ENDPROC bound; + +PROC append term (TERM CONST appendix, TERMS VAR list): + TERMS VAR term, last term; + IF list = nil + THEN new tp (term); + list:= term + ELSE term:= list; + REP last term:= term; + term:= tcrestISUB(term) + UNTILterm = nil PER; + new tp (term); + replace(tcrest,last term, term); + FI; + replace(tcsymbol,term,appendix.symbol); + replace(tcarguments,term,appendix.arguments); + replace(tcarity,term,appendix.arity); + replace(tcrest,term, nil) +END PROC append term; + +TERMS PROC revers (TERMS CONST ts): + IF ts <= nil + THEN ts + ELSE TERMS VAR reverted:= revers ((tcrestISUB(ts)) ); + append term (TERM:(tcsymbolISUBts, + revers (tcargumentsISUBts), + tcarityISUBts), + reverted); + reverted + FI +ENDPROC revers; + +PROC call terms (TERMS VAR ts): + TEXT VAR old:= sysout; + forget ("$sysin$",quiet); + sysout ("$sysin$"); + WHILE ts > nil + REP write term (TERM:(tcsymbolISUBts, + tcargumentsISUBts, + tcarityISUBts)); + line; + ts:= tcrestISUB(ts) + PER; + write ("elan(sysin,())."); + sysout (old); + sysin ("$sysin$") +ENDPROC call terms; + +PROC write environment list (FRAME CONST frame): + write environment list (frame, fc(frame).environment); +ENDPROC write environment list; + +PROC write environment list (FRAME CONST frame, ENVIRONMENT CONST en): + IF en <> nil + THEN write environment list (frame, nc(en).rest); + write term (nc(en).first.variable); write (" = "); + value (nc(en).first.variable, t, frame); + write term backward (t); + IF en <> fc(frame).environment THEN write (", ") FI + FI +ENDPROC write environment list; + +PROC write knowledge base (CLAUSES CONST k): + TERMS VAR t:= (kcfirstISUB(k)) ; + IF t > nil CAND k <= reset kp CAND k > build ins + CAND (pattern = cut COR pattern = (tcsymbolISUB(t)) + ) + THEN found:= FALSE; + IF (kcrestISUB(k)) > nil + THEN write knowledge base ((kcrestISUB(k)) ) + FI; + write term (TERM:(tcsymbolISUBt, tcargumentsISUBt, tcarityISUBt)); + t:= (tcrestISUB(t)) ; + IF t > nil + THEN write (":- "); + write terms + FI; + write ("."); + line + ELIF (found COR k <= build ins) CAND (kcrestISUB(k)) > nil + THEN write knowledge base ((kcrestISUB(k)) ) + FI. + + write terms: + BOOL VAR once:= FALSE; + WHILE t <> nil + REP IF once THEN write (", ") ELSE once:= TRUE FI; + write term (TERM:(tcsymbolISUBt, tcargumentsISUBt, tcarityISUBt)); + t:= (tcrestISUB(t)) ; + PER. +ENDPROC write knowledge base; + +PROC write symbol (TERM CONST t): + TEXT VAR w1, w2:= name (symboltable, t.symbol); + IF quoting + THEN scan (w2); + next symbol (w1, i); INT VAR i; + IF w1 = w2 CAND i <> num + THEN write (w2) + ELSE write (""""); write (w2); write ("""") + FI + ELSE write (w2) + FI +ENDPROC write symbol; + +PROC write term backward (TERM CONST t): + IF t.arity = integer + THEN write (text (t.symbol)) + ELIF t.symbol <= cons + THEN IF t.symbol < 0 + THEN write ("_"+text(-t.symbol)) + ELSE write ("["); + write subterms backward (t, t.arguments); write ("]") + FI + ELSE + write symbol (t); + IF t.arguments <> nil + THEN compound term + FI + FI. + + compound term: + write ("("); write subterms backward (t, t.arguments); write (")"). + +ENDPROC write term backward; + +PROC write subterms backward (TERM CONST t, TERMS CONST ts): + IF ts = nil + THEN + ELSE write subterms backward (t, (tcrestISUB(ts)) ); + write term backward ( + TERM:(tcsymbolISUBts, tcargumentsISUBts, tcarityISUBts)); + IF ts <> t.arguments + THEN IF t.symbol = cons THEN write ("|") ELSE write (",") FI + FI + FI +ENDPROC write subterms backward; + +PROC write term (TERM CONST t): + IF t.arity = integer + THEN write (text (t.symbol)) + ELIF t.symbol <= cons + THEN IF t.symbol < 0 + THEN write ("_"+text(-t.symbol)) + ELSE write ("["); write terms; write ("]") + FI + ELSE + write symbol (t); + IF t.arguments <> nil + THEN compound term + FI + FI. + + compound term: + write ("("); write terms; write (")"). + + write terms: + TERMS VAR ts:= t.arguments; + WHILE ts <> nil + REP write term ( + TERM:(tcsymbolISUBts, tcargumentsISUBts, tcarityISUBts)); + ts:= tcrestISUB(ts); + IF ts <> nil + THEN IF t.symbol = cons THEN write ("|") ELSE write (",") FI + FI + PER. + +ENDPROC write term; + +PROC read consult list: + TERM VAR t; + TERMS CONST old tp:= tp; + WHILE filename read REP PER; + IF look ahead <> close bracket + THEN syntax error ("closing bracket expected") + FI; + remove token; + reset symboltable:= symboltable; + TERMS CONST ts:= tp; + tp:= old tp; + consult list (ts); + from file:= FALSE. + + filename read: + BOOL VAR was minus:= FALSE; + IF look ahead = minus + THEN remove token; + was minus:= TRUE + FI; + IF look ahead = identifier + THEN new tp (tp); + read term (t); + replace(tcsymbol,tp, t.symbol); + replace(tcarguments,tp, t.arguments); + replace(tcarity,tp, t.arity); + IF was minus THEN replace(tcarity,tp, var); + FI; + IF NOT exists (name (symboltable, (tcsymbolISUB(tp)) + )) + THEN syntax error ("file does not exist"); FALSE + ELIF look ahead = comma THEN remove token; TRUE + ELSE TRUE + FI + ELSE FALSE + FI . + + remove token: + look ahead empty:= TRUE. +ENDPROC read consult list; + +PROC consult list (TERMS CONST ts): + IF ts > tp + THEN TERM VAR term:= + TERM:(tcsymbolISUBts, tcargumentsISUBts, tcarityISUBts); + consult list (ts-1); + IF free of errors + THEN TEXT VAR fname:= name (symboltable, term.symbol); + IF term.arity = var + THEN put ("reconsulting"); putline (fname); reconsult (fname) + ELSE put ( "consulting"); putline (fname); consult (fname) + FI + FI + FI +ENDPROC consult list; + +PROC initiate read terms (TERMS VAR ts, TEXT CONST prompter): + enable stop; + look ahead empty:= TRUE; ahead empty:= TRUE; + from file:= FALSE; + TEXT VAR inputline; + IF prompter = "-" + THEN inputline:= "" + ELSE inputline:= ""13"" + FI; + REP + WHILE sysin = "" CAND is escape + REP write (""13""15"gib kommando: "); + get command; + IF inputline = "" + THEN write (""14""3""3"") + ELSE write (""14""13""10""); + IF prompter = "-" + THEN lernsequenz auf taste legen ("k", inputline); + FI; + disable stop; + lernsequenz auf taste legen ("q","break"13""); + do (inputline); + lernsequenz auf taste legen ("q","bye"13""); + IF is error + THEN put (errormessage); clear error + FI; + enable stop; + FI; + write (""13""10""5"?"); + write (prompter); + write (" ") + PER; + getline (inputline); + IF inputline <> "" + CAND (inputline SUB length (inputline)) <> "." + THEN inputline CAT "." + FI; + scan (inputline); + ts:= nil + UNTIL inputline <> "" PER; + IF prompter = "-" + THEN lernsequenz auf taste legen ("k", inputline) + FI. + + is escape: + REP IF inputline = ""13"" + THEN write (""13""10""5"?"); + write (prompter); + write (" ") + ELIF inputline = "?" + THEN putline ("?"); inform; push (""13"") + FI; + getchar (inputline) + UNTIL pos ("?"13"", inputline) = 0 + PER; + IF inputline = ""27"" + THEN getchar (inputline); + IF inputline = ""27"" + THEN TRUE + ELSE push (inputline); push (""27""); FALSE + FI + ELSE push (inputline); FALSE + FI. + + get command: + getchar (inputline); + IF inputline = ""27"" + THEN getchar (inputline); + IF inputline = ""27"" + THEN inputline:= ""; + line + ELSE push (inputline); + push (""27""); + getline (inputline) + FI + ELSE push (inputline); + getline (inputline) + FI. + +ENDPROC initiate read terms; + +PROC initiate read terms (TEXT CONST knowledge, TERMS VAR ts): + look ahead empty:= TRUE; ahead empty:= TRUE; + file:= sequential file (input, knowledge); + from file:= TRUE; + scan (file); + ts:= nil +ENDPROC initiate read terms; + +PROC read terms (TERMS VAR ts): + { the actual parameter for ts should be initiated < ts:=nil > + at top level of recursion + } + TERM VAR t; + WHILE look ahead <> close paren CAND look ahead <> close bracket + CAND look ahead <> period + REP read term (t); + append term (t, ts) + UNTIL end of list PER. + + end of list: + IF look ahead = comma + THEN remove comma; + FALSE + ELSE TRUE + FI. + + remove comma: look ahead empty:= TRUE. + +ENDPROC read terms; + +PROC read term (TERM VAR t): + IF look ahead = open paren + THEN remove token; + read term (t); + transform infix to prefix (t, 0); + IF look ahead = close paren + THEN remove token + ELSE syntax error ("closing parentheses missing") + FI + ELSE read prefix term (t); + transform infix to prefix (t, 0) + FI . + + remove token: look ahead empty:= TRUE . +ENDPROC read term; + +PROC transform infix to prefix (TERM VAR t, INT CONST last prio): + SELECT look ahead OF + CASE minus, plus, times, slash, less, equal, uneq, grt, eqeq, eqdotdot, + boldvar: + operator:= look ahead value; + IF last prio <= priority (operator) + THEN + remove token; + IF look ahead = open paren + THEN read term (t2); + ELSE read prefix term (t2); + FI; + IF last prio < priority (operator) + THEN transform infix to prefix (t2, priority (operator)); + FI; + form result; + transform infix to prefix (t, last prio) + FI + ENDSELECT. + + form result: + second operand; + first operand; + prefix. + +second operand: + TERMS VAR p2; + TERM VAR t2; + new tp (p2); + replace(tcsymbol, p2, t2.symbol); + replace(tcarguments, p2, t2.arguments); + replace(tcarity, p2, t2.arity); + replace(tcrest, p2, nil). + +first operand: + TERMS VAR p1; + new tp (p1); + replace(tcsymbol, p1, t.symbol); + replace(tcarguments, p1, t.arguments); + replace(tcarity, p1, t.arity); + replace(tcrest, p1, p2). + +prefix: + INT VAR operator; + t.symbol:= operator; + t.arguments:= p1; + t.arity:= 2. + + remove token: + look ahead empty:= TRUE. + +ENDPROC transform infix to prefix; + +INT PROC priority (INT CONST operator): + SELECT operator OF + CASE times, slash, mod: 7 + CASE minus, plus: 6 + CASE 9,10,11,12,13: 5 + OTHERWISE 2 + ENDSELECT +ENDPROC priority; + +PROC read prefix term (TERM VAR t): + SELECT look ahead OF + CASE exclamation: term is cut + CASE bold var: term is a variable + CASE underscore: term is anonym + CASE number: term is number + CASE identifier, + minus, plus, times, slash, less, equal, uneq, grt, eqeq, eqdotdot: + IF look ahead = minus + THEN remove token; + IF look ahead = number {monadic minus} + THEN look ahead value:= - look ahead value; + term is number; + LEAVE read prefix term + FI + ELSE remove token + FI; + term is identifier; + IF look ahead = open paren + THEN term is compound + { ELSE term is a constant } + FI + CASE open bracket: term is list + CASE colon: term is colon + OTHERWISE syntax error ("wrong expression"); + t:= TERM:(nil, nil, 0) + ENDSELECT. + + term is cut: + remove token; + t:= TERM:(cut, nil, 0). + + term is a variable: + remove token; + t:= TERM:(look ahead value, nil, var). + + term is anonym: + remove token; + anonym value DECR 1; + t:= TERM:(anonym value, nil, var). + + term is number: + remove token; + t:= TERM:(look ahead value, nil, integer). + + term is identifier: + t:= TERM:(look ahead value, nil, 0). + + term is list: + remove token; + t:= TERM:(nil, nil, 0); + IF look ahead = close bracket + THEN remove token + ELSE non empty list + FI. + + non empty list: + TERM VAR t1; + read term (t1); + append term (t1, t.arguments); + IF look ahead = close bracket + THEN remove token; + t.arity:= 1 + ELSE list with more than one element + FI. + + list with more than one element: + IF look ahead = stroke + THEN t.symbol:= cons + ELIF look ahead <> comma CAND look ahead <> colon + THEN syntax error ("comma missing") + FI; + term is compound list. + + term is compound list: + remove token; + read terms (t.arguments); + t.arity:= no of terms (t.arguments); + IF look ahead = close bracket + THEN remove token + ELSE syntax error ("closing bracket missing") + FI. + + term is compound: + remove token; + read terms (t.arguments); + t.arity:= no of terms (t.arguments); + IF look ahead = close paren + THEN remove token + ELSE syntax error ("closing parentheses missing") + FI. + + term is colon: + remove token; + INT VAR i:= link (symboltable, ":-"); + IF i = 0 + THEN insert (symboltable, ":-", i) + FI; + t:= TERM:(i, nil, 0). + + remove token: + look ahead empty:= TRUE. + +ENDPROC read prefix term; + +INT PROC no of terms (TERMS CONST ts): + INT VAR i:= 0, t:=ts; + WHILE t <> nil + REP t:= (tcrestISUB(t)) ; + i INCR 1 + PER; + i +ENDPROC no of terms; + +INT PROC arith (TERM CONST term, FRAME CONST curr frame): + TERM VAR t; + IF term.arity = var + THEN value (term, t, curr frame) + ELSE t:= term + FI; + IF t.arity = integer + THEN t.symbol + ELIF t.arity = var + THEN syntax error ("free variable in arith expression"); 0 + ELIF t.arity = 1 + THEN SELECT t.symbol OF + CASE plus: arith (t1, curr frame) + CASE minus: - arith (t1, curr frame) + OTHERWISE syntax error ("unknown arith operator"); 0 + ENDSELECT + ELIF t.arity = 2 + THEN SELECT t.symbol OF + CASE plus: arith (t1, curr frame) + arith (t2, curr frame) + CASE minus: arith (t1, curr frame) - arith (t2, curr frame) + CASE times: arith (t1, curr frame) * arith (t2, curr frame) + CASE slash: arith (t1, curr frame) DIV arith (t2, curr frame) + CASE mod: arith (t1, curr frame) MOD arith (t2, curr frame) + OTHERWISE syntax error ("unknown arith operator"); 0 + ENDSELECT + ELSE syntax error ("wrong arith expression"); 0 + FI. + + t1: TERM:(tcsymbolISUBt.arguments, + tcargumentsISUBt.arguments, + tcarityISUBt.arguments) . + + t2: TERM:(tcsymbolISUB(tcrestISUB(t.arguments)) , + tcargumentsISUB(tcrestISUB(t.arguments)) , + tcarityISUB(tcrestISUB(t.arguments)) ) . + +ENDPROC arith; + +TOKEN PROC look ahead : + { Returns the token in the look ahead. + If the look ahead is empty it calls the scanner + to get the next symbol, + which is then placed into the look ahead. + } + SYMBOLTYPE VAR symboltype; + IF look ahead empty + THEN look ahead empty:= FALSE; + get next symbol; + store the symbol + FI; + look ahead token. + + get next symbol: + IF ahead empty + THEN IF from file + THEN next symbol (file, look ahead symbol, symboltype) + ELSE next symbol (look ahead symbol, symboltype) + FI + ELSE ahead empty:= TRUE; + look ahead symbol:= ahead symbol; + symboltype:= ahead symboltype + FI. + + store the symbol: + SELECT symboltype OF + CASE tag,tex: look ahead token:= identifier; + IF look ahead symbol = "" + THEN look ahead value:= 0; + ELSE install + FI + CASE num: look ahead token:= number; + look ahead value:= int(look ahead symbol) + CASE bold: look ahead token:= bold var; + install + CASE operator: look ahead token:= + pos ("|!:-+*/_<=<>==..", look ahead symbol); + IF look ahead token = equal + THEN get next symbol; + IF symboltype = operator + CAND look ahead symbol = "=" + THEN look ahead token:= eqeq; + look ahead symbol:= "==" + ELIF look ahead symbol = "." + THEN get next symbol; + IF look ahead symbol = "." + THEN look ahead token:= eqdotdot; + look ahead symbol:= "=.." + ELSE syntax error ("second period missing") + FI + ELSE ahead symbol:= look ahead symbol; + ahead symboltype:= symboltype; + ahead empty:= FALSE; + look ahead symbol:= "="; + look ahead token := equal + FI + FI; + IF look ahead token > 3 + THEN install + FI + CASE delimiter: look ahead token:= + pos ("|!:-+*/_<=<>==..,;()[]", look ahead symbol); + SELECT look ahead token OF + CASE colon: minus must follow + CASE 0: syntax error ("wrong delimiter") + ENDSELECT + CASE endoffile: look ahead token:= end of input + CASE within com: look ahead token:= end of input; + syntax error ("within comment") + CASE within tex: look ahead token:= end of input; + syntax error ("within text") + ENDSELECT. + + minus must follow: + get next symbol; + IF look ahead symbol <> "-" + THEN syntax error ("minus after colon expected") FI. + + install: + look ahead value:= link (symboltable, look ahead symbol); + IF look ahead value = 0 + THEN insert(symboltable,look ahead symbol,look ahead value) + FI. +ENDPROC look ahead; + +PROC inform: + enable stop; + put (" "); + put (clock(0) - start time); put ("SEC"); + IF inference count > 0 CAND clock(0) > start time + THEN + put (inference count); put ("inferences"); + put (int (real (inference count) / (clock(0) - start time))); + put ("LIPS") + FI; + FOR k FROM 2 UPTO fsp + REP line; + FRAME CONST f:= fsc(k).frame; + INT CONST ind:= fc(f).level; + IF ind <= 40 + THEN write (ind*" ") + ELSE write (text(ind) + ": ") + FI; + value (fc(f).call, t, fc(f).father); + write term backward (t) + PER; + IF testing + THEN put(tp); put(kp); put(fp); put(fsp); put(np); put(ep) + FI; + line +ENDPROC inform; + +PROC syntax error (TEXT CONST message): + free of errors:= FALSE; + write ("!- "); + write note (message); + write note (" at '"); + write note (look ahead symbol); + write note ("' "); + IF from file + THEN write note ("in rule "); write note (rule count); + write note ("line "); write note (lineno(file) - 1) + FI; + look ahead empty:= TRUE; + line; note line +ENDPROC syntax error; + +PROC write note (TEXT CONST t): + write (t); + IF from file THEN note (t) FI +ENDPROC write note; + +PROC write note (INT CONST i): + put (i); + IF from file THEN note (i) FI +ENDPROC write note; + +PROC trace (TEXT CONST on): + testing:= test on; + tracing:= trace on. + trace on: pos (on, "on") > 0. + test on : pos (on, "test") > 0 +ENDPROC trace; + +PROC new kp (INT VAR pointer): + kp INCR 1; pointer:= kp; + IF length (kcfirst) < 2*kp + THEN IF kp > 15990 + THEN pegel overflow + ELSE kcfirst CAT "1234567890123456"; + kcrest CAT "1234567890123456"; + FI FI +ENDPROC new kp; + +PROC new tp (INT VAR pointer): + tp INCR 1; pointer:= tp; + IF length (tcsymbol) < 2*tp + THEN IF tp = 15990 + THEN pegel overflow + ELSE tcsymbol CAT "1234567890123456"; + tcarguments CAT "1234567890123456"; + tcarity CAT "1234567890123456"; + tcrest CAT "1234567890123456" + FI FI +ENDPROC new tp; + +PROC new (INT VAR pegel, pointer): + IF pegel = limit + THEN pegel overflow + ELSE pegel INCR 1; pointer:= pegel + FI +ENDPROC new; + +PROC pegeloverflow: line; write (" "); + put(tp); put(kp); put(fp); put(fsp); put(np); put(ep); + errorstop ("pegeloverflow") +ENDPROC pegeloverflow; + + +{ +Programmtransformation: + + PASCAL mit Pointer ==> ELAN + + +1. Rekursive Datentypen: + + type t = ^tcell; ==> LET T = INT; + + { schwache Datenabstraktion mit LET ist besser, + weil keine neuen Zugriffsprozeduren erforderlich. + + GLOBAL: + } + LET nil = 0, limit <= 500; + ROW limit TCELL VAR tc; { t cell } + INT VAR tp:= nil; { t pegel } + + +2. Deklaration: + + var x : t; ==> T VAR x; { Type checking selber machen ! } + + +3. Pointer-Initialisierung: + + x:= nil; ==> x:= nil; + + +4. Allokation: + + new (x); ==> new (tp,x); + + dispose (x); ==> kommt nicht vor + + +5. Applikation: + + x^.feld ==> TERMSCELL:(TERM:(tcsymbolISUBx, tcargumentsISUBx, tcarityISUBx), tcrestISUBx).feld + + WITH ==> Refinement verwenden + +{ Programmtransformation ROW limit TERMSCELL VAR tc => TEXT VAR } + T1; + "new (tp, " CA "new tp ("; + T1; + REP + col(1); + D "tc("; + IF at ("tc(tc(") + THEN D "tc("; + attest; + col(1); + D "tc(" + FI; + attest + UNTIL eof PER +. +attest: +IF at ("tc("+any**1+").first."+any**2+":="+any**3+";"+any**4) +THEN C ("replace(tc"+match(2)+","+match(1)+","+match(3)+");"+match(4)) +ELIF at ("tc("+any**1+").rest:="+any**3+";"+any**4) +THEN C ("replace(tcrest,"+match(1)+","+match(3)+");"+match(4)) +ELIF at ("tc("+any**1+").first:="+any**3+";"+any**4) +THEN C ("replace(tcsymbol,"+match(1)+","+match(3)+ + ".symbol); replace(tcarguments,"+match(1)+","+match(3)+ + ".arguments); replace(tcarity,"+match(1)+","+match(3)+ + ".arity);"+match(4)) +ELIF at ("tc("+any**1+").first."+any**2+" "+any**4) +THEN C ("(tc"+match(2)+"ISUB("+match(1)+")) "+match(4)) +ELIF at ("tc("+any**1+").rest"+any**4) +THEN C ("(tcrestISUB("+match(1)+")) "+match(4)) +ELIF at ("tc("+any**1+").first).first"+any**4) +THEN C ("TERM:(tcsymbolISUB"+match(1)+ + ").first, tcargumentsISUB"+match(1)+ + ").first, tcarityISUB"+match(1)+").first)"+match(4)) +ELIF at ("tc("+any**1+").first"+any**4) +THEN C ("TERM:(tcsymbolISUB"+match(1)+ + ", tcargumentsISUB"+match(1)+", tcarityISUB"+match(1)+")"+match(4)) +ELIF at ("tc("+any**1+"):= TERMSCELL:("+any**2+","+any**3+")"+any**4) +THEN C ("replace(tcsymbol,"+match(1)+","+match(2)+ + ".symbol); replace(tcarguments,"+match(1)+","+match(2)+ + ".arguments); replace(tcarity,"+match(1)+","+match(2)+ + ".arity); replace(tcrest,"+match(1)+","+match(3)+")"+match(4)) +ELIF at ("tc("+any**1+")"+any**4) +THEN C ("TERMSCELL:(TERM:(tcsymbolISUB"+match(1)+ + ", tcargumentsISUB"+match(1)+", tcarityISUB"+match(1) + +"), tcrestISUB"+match(1)+")" +match(4)) +ELIF NOT eof +THEN stop +FI; +col(col-1); D("*"); C "" +. + +} + +END PACKET prolog; + +{ TEST } +lernsequenz auf taste legen ("7",""124""); +lernsequenz auf taste legen ("ü",""91""); +lernsequenz auf taste legen ("+",""93""); + diff --git a/lang/prolog/1.8.7/src/prolog installation b/lang/prolog/1.8.7/src/prolog installation new file mode 100644 index 0000000..cc674fa --- /dev/null +++ b/lang/prolog/1.8.7/src/prolog installation @@ -0,0 +1,117 @@ +(*************************************************************************) +(*** Insertiert die für PROLOG benötigten Pakete und holt die ***) +(*** Beispiele vom Archiv. ***) +(*** ***) +(*** Autor : W. Metterhausen Stand : 03.12.87 ***) +(*************************************************************************) + +erste bildschirmmeldung; + + +IF yes("Prolog insertieren?") + + THEN + hole sourcen vom archiv; + insertiere alle pakete; + hole beispiele vom archiv; + forget ("prolog installation", quiet); + type("push(""bye""13""prolog again"");prolog(""standard"")"13""); +FI. + + +insertiere alle pakete : + insert and say ("thesaurus"); + insert and say ("prolog"). + +erste bildschirmmeldung : + page; + put center (" Generator für Prolog gestartet."); line; + put center ("--------------------------------------------------");line; + put center (" Prolog kann nur in einer Task aufgebaut werden, ");line; + put center (" die nicht bereits umfangreiche insertierte Pakete ");line; + put center (" enthält! Gegebenenfalls sollte Prolog in ");line; + put center (" einer Task direkt unter ""UR"" angelegt werden. ");line; + line (2). + +hole sourcen vom archiv : + TEXT VAR datei; + datei := "thesaurus"; hole wenn noetig; + datei := "prolog"; hole wenn noetig; + line. + +hole beispiele vom archiv : + datei := "standard"; hole wenn noetig; + datei := "sum"; hole wenn noetig; + datei := "permute"; hole wenn noetig; + datei := "family"; hole wenn noetig; + datei := "puzzle"; hole wenn noetig; + datei := "calc"; hole wenn noetig; + datei := "prieks"; hole wenn noetig; + datei := "topographie"; hole wenn noetig; + datei := "quicksort"; hole wenn noetig; + datei := "prolog dokumentation"; + hole wenn noetig; + release(archive); + line. + +hole wenn noetig : + IF NOT exists (datei) THEN + put line (""""+ datei + """ wird vom Archiv geholt"); + fetch (datei, archive) + FI. + +PROC insert and say (TEXT CONST datei) : + + INT VAR cx, cy; + put line ("Inserting """ + datei + """..."); + get cursor (cx, cy); + checkoff; + insert (datei); + checkon; + cl eop (cx, cy); line; + forget (datei, quiet). + +END PROC insert and say; + +TEXT PROC inverse (TEXT CONST t): + ""15"" + t + " " + ""14"" +END PROC inverse; + +PROC put center (TEXT CONST t): + put center (t, 80) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t): + put center (zeile, t, 80) +END PROC put center; + +PROC put center (TEXT CONST t, INT CONST gesamtbreite): + INT VAR cy; + get cursor (cy, cy); + put center (cy, t, gesamtbreite) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite): + cursor ((gesamtbreite - length (t)) DIV 2, zeile); + put (t). +END PROC put center; + +PROC cl eol: + out (""5"") +END PROC cl eol; + +PROC cl eop: + out (""4"") +END PROC cl eop; + +PROC cl eol (INT CONST cx, cy): + cursor (cx, cy); + cl eol +END PROC cl eol; + +PROC cl eop (INT CONST cx, cy): + cursor (cx, cy); + cl eop +END PROC cl eop; + + diff --git a/lang/prolog/1.8.7/src/puzzle b/lang/prolog/1.8.7/src/puzzle new file mode 100644 index 0000000..648beb6 --- /dev/null +++ b/lang/prolog/1.8.7/src/puzzle @@ -0,0 +1,24 @@ + {Solution: 9,5,6,7,0,8,2} +puzzle:- repeat, permute ((9,8,7,6,5,2,0), SENDMORY), + write (SENDMORY), + puzzle (SENDMORY, SEND, MORE, MONEY), + elan (line), + write (SEND), write (+), + write (MORE), write (=), + write (MONEY). + +puzzle([S,E,N,D,O,R,Y], SEND, MORE, MONEY):- + SEND IS ((S * 10 + E) * 10 + N) * 10 + D, + MORE IS ((10 + O) * 10 + R) * 10 + E, + MONEY IS (((10 + O) * 10 + N) * 10 + E) * 10 + Y, + MONEY IS SEND + MORE. + +permute ([], []). +permute ([E|X], Z):- permute (X, Y), insert (E, Y, Z). + +insert (E, X, [E|X]). +insert (E, [F|X], [F|Y]):- insert (E, X, Y). + +repeat. +repeat:- repeat. + diff --git a/lang/prolog/1.8.7/src/quicksort b/lang/prolog/1.8.7/src/quicksort new file mode 100644 index 0000000..79276c0 --- /dev/null +++ b/lang/prolog/1.8.7/src/quicksort @@ -0,0 +1,14 @@ +(* quicksort algorithm nach Clocksin-Mellish *) + +(* Example : quicksort ([1,3,2,4], [1,2,3,4], []) *) + +quicksort ([H|T], S, X) :- + split (H, T, A, B), + quicksort (A, S, [H|Y]), + quicksort (B, Y, X). +quicksort ([], X, X). + +split (H, [A|X], [A|Y], Z) :- A <= H, split (H, X, Y, Z). +split (H, [A|X], Y, [A|Z]) :- split (H, X, Y, Z). +split (_, [], [], []). + diff --git a/lang/prolog/1.8.7/src/standard b/lang/prolog/1.8.7/src/standard new file mode 100644 index 0000000..bc983ca --- /dev/null +++ b/lang/prolog/1.8.7/src/standard @@ -0,0 +1,35 @@ +abolish (X) :- elan (abolish, X). +append ([], X, X) :- !. +append ([X|Y], Z, [X|W]) :- append (Y, Z, W). +atom (X) :- functor (X, Y, 0). +atomic (X) :- atom (X); integer (X). +consult (X) :- elan (consult, X). +end :- bye. +fail :- []. +findall (X, Y, Z) :- tell ("$$"), write ("[ "), findall (X,Y); + write (" ]"), told, see ("$$"), read (Z), + seen, elan (forget, "$$"). +findall (X, Y) :- call (Y), writeq (X), write (","), []. +integer (X) :- functor (X, Y, -1). +listing (X). +member (X, [X|Z]). +member (X, [Y|Z]) :- member (X, Z). +nl :- elan (line). +non var (X) :- var (X), !, []; . +not (X) :- call (X), !, []; . +notrace :- elan (trace, off). +reconsult (X) :- elan (reconsult, X). +repeat. +repeat :- repeat. +see (X) :- elan (sysin, X). +seen :- elan (sysin, ""). +tab (X) :- tab(X,1). +tab (X,Y) :- Y<=X, !, put (32), incr(Y), tab(X,Y);. +tell (X) :- elan (sysout, X). +told :- elan (sysout, ""). +trace :- elan (trace, on). +true. +< (X, Y) :- <= (X, Y), <> (X, Y). +> (X, Y) :- <= (Y, X). +>= (X, Y) :- < (Y, X). + diff --git a/lang/prolog/1.8.7/src/sum b/lang/prolog/1.8.7/src/sum new file mode 100644 index 0000000..e1b6b13 --- /dev/null +++ b/lang/prolog/1.8.7/src/sum @@ -0,0 +1,13 @@ +suc (0, 1). suc (1, 2). suc (2, 3). suc (3, 4). suc (4, 5). +suc (5, 6). suc (6, 7). suc (7, 8). suc (8, 9). +sum (0, X, X). +sum (X, Y, Z):- suc (V, X), sum (V, Y, W), suc (W, Z). +plus (X, [0,0], X):- !. +plus (X, Y, Z):- plus one (V, Y), plus (X, V, W), !, plus one (W, Z). +plus one ([X, Y], [V, W]):- suc (Y, W), X = V, !; + Y = 9, suc (X, V), W = 0. +treereverse (X,Y):- rev (X,Y), !; rev (Y,X), !. +rev ([], []). +rev ([X|Y], Z):- X <> [H|T], rev (Y, W), !, append (W, [X], Z); + rev (X, V), rev (Y, W), !, append (W, [V], Z). + diff --git a/lang/prolog/1.8.7/src/thesaurus b/lang/prolog/1.8.7/src/thesaurus new file mode 100644 index 0000000..4694981 --- /dev/null +++ b/lang/prolog/1.8.7/src/thesaurus @@ -0,0 +1,360 @@ +(* ------------------- VERSION 2 19.01.87 ------------------- *) +PACKET thesaurus handling (* Autor: J.Liedtke *) + + DEFINES THESAURUS , + := , + empty thesaurus , + insert, (* fuegt ein Element ein *) + delete, (* loescht ein Element falls vorhanden *) + rename, (* aendert ein Element falls vorhanden *) + CONTAINS , (* stellt fest, ob enthalten *) + link , (* index in thesaurus *) + name , (* name of entry *) + decode invalid chars ,(* Steuerzeichen dekodieren *) + get , (* get next entry ("" is eof) *) + highest entry : (* highest valid index of thes *) + + +TYPE THESAURUS = TEXT ; + +LET nil = 0 , + niltext = "" , + max name length = 80 , + begin entry char = ""0"" , + end entry char = ""255"" , + nil entry = ""0""255"" , + nil name = "" , + quote = """" ; + +TEXT VAR entry , + dummy ; +INT VAR cache index := 0 , + cache pos ; + + +TEXT PROC decode (INT CONST number) : + + dummy := " " ; + replace (dummy, 1, number) ; + dummy . + +ENDPROC decode ; + +INT PROC decode (TEXT CONST string, INT CONST position) : + + subtext (string, position, position + 1) ISUB 1 . + +ENDPROC decode ; + +PROC access (THESAURUS CONST thesaurus, TEXT CONST name) : + + construct entry ; + IF NOT cache identifies entry + THEN search through thesaurus list + FI ; + IF entry found + THEN cache index := decode (list, cache pos - 2) + ELSE cache index := 0 + FI . + +construct entry : + entry := begin entry char ; + entry CAT name ; + decode invalid chars (entry, 2) ; + entry CAT end entry char . + +search through thesaurus list : + cache pos := pos (list, entry) . + +cache identifies entry : + cache pos <> 0 AND + pos (list, entry, cache pos, cache pos + LENGTH entry) = cache pos . + +entry found : cache pos > 0 . + +list : CONCR (thesaurus) . + +ENDPROC access ; + +PROC access (THESAURUS CONST thesaurus, INT CONST index) : + + IF cache identifies index + THEN cache index := index ; + construct entry + ELSE cache pos := pos (list, decode (index) + begin entry char) ; + IF entry found + THEN cache pos INCR 2 ; + cache index := index ; + construct entry + ELSE cache index := 0 ; + entry := niltext + FI + FI . + +construct entry : + entry := subtext (list, cache pos, pos (list, end entry char, cache pos)) . + +cache identifies index : + subtext (list, cache pos-2, cache pos) = decode (index) + begin entry char . + +entry found : cache pos > 0 . + +list : CONCR (thesaurus) . + +ENDPROC access ; + + + +THESAURUS PROC empty thesaurus : + + THESAURUS : (""1""0"") + +ENDPROC empty thesaurus ; + + +OP := (THESAURUS VAR dest, THESAURUS CONST source ) : + + CONCR (dest) := CONCR (source) . + +ENDOP := ; + +TEXT VAR insert name ; + +PROC insert (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR index) : + + insert name := name ; + decode invalid chars (insert name, 1) ; + insert name if possible . + +insert name if possible : + IF insert name = "" OR LENGTH insert name > max name length + THEN index := nil ; errorstop ("Name unzulaessig") + ELIF overflow + THEN index := nil + ELSE insert element + FI . + +overflow : + LENGTH CONCR (thesaurus) + LENGTH insert name + 4 > max text length . + +insert element : + search free entry ; + IF entry found + THEN insert into directory + ELSE add entry to directory if possible + FI . + +search free entry : + access (thesaurus, nil name) . + +insert into directory : + change (list, cache pos + 1, cache pos, insert name) ; + index := cache index . + +add entry to directory if possible : + INT CONST next free index := decode (list, LENGTH list - 1) ; + add entry to directory . + +add entry to directory : + list CAT begin entry char ; + cache pos := LENGTH list ; + cache index := next free index ; + list CAT insert name ; + list CAT end entry char + decode (next free index + 1) ; + index := cache index . + +entry found : cache index > 0 . + +list : CONCR (thesaurus) . + +ENDPROC insert ; + +PROC decode invalid chars (TEXT VAR name, INT CONST start pos) : + + INT VAR invalid char pos := pos (name, ""0"", ""31"", start pos) ; + WHILE invalid char pos > 0 REP + change (name, invalid char pos, invalid char pos, decoded char) ; + invalid char pos := pos (name, ""0"", ""31"", invalid char pos) + PER ; + change all (name, ""255"", quote + "255" + quote) . + +decoded char : quote + text(code(name SUB invalid char pos)) + quote. + +ENDPROC decode invalid chars ; + +PROC insert (THESAURUS VAR thesaurus, TEXT CONST name) : + + INT VAR index ; + insert (thesaurus, name, index) ; + IF index = nil AND NOT is error + THEN errorstop ("THESAURUS-Ueberlauf") + FI . + +ENDPROC insert ; + +PROC delete (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR index) : + + access (thesaurus, name) ; + index := cache index ; + delete (thesaurus, index) . + +ENDPROC delete ; + +PROC delete (THESAURUS VAR thesaurus, INT CONST index) : + + access (thesaurus, index) ; + IF entry found + THEN delete entry + FI . + +delete entry : + IF is last entry of thesaurus + THEN cut off as much as possible + ELSE set to nil entry + FI . + +set to nil entry : + change (list, cache pos, cache pos + LENGTH entry - 1, nil entry) . + +cut off as much as possible : + WHILE predecessor is also nil entry REP + set cache to this entry + PER ; + list := subtext (list, 1, cache pos - 1) ; + erase cache . + +predecessor is also nil entry : + subtext (list, cache pos - 4, cache pos - 3) = nil entry . + +set cache to this entry : + cache pos DECR 4 . + +erase cache : + cache pos := 0 ; + cache index := 0 . + +is last entry of thesaurus : + pos (list, end entry char, cache pos) = LENGTH list - 2 . + +list : CONCR (thesaurus) . + +entry found : cache index > nil . + +ENDPROC delete ; + + +BOOL OP CONTAINS (THESAURUS CONST thesaurus, TEXT CONST name ) : + + IF name = niltext OR LENGTH name > max name length + THEN FALSE + ELSE access (thesaurus, name) ; entry found + FI . + +entry found : cache index > nil . + +ENDOP CONTAINS ; + +PROC rename (THESAURUS VAR thesaurus, TEXT CONST old, new) : + + rename (thesaurus, link (thesaurus, old), new) + +ENDPROC rename ; + +PROC rename (THESAURUS VAR thesaurus, INT CONST index, TEXT CONST new) : + + insert name := new ; + decode invalid chars (insert name, 1) ; + IF overflow + THEN errorstop ("THESAURUS-Ueberlauf") + ELIF insert name = "" OR LENGTH insert name > max name length + THEN errorstop ("Name unzulaessig") + ELSE change to new name + FI . + +overflow : + LENGTH CONCR (thesaurus) + LENGTH insert name + 4 > max text length . + +change to new name : + access (thesaurus, index) ; + IF cache index <> 0 AND entry <> "" + THEN change (list, cache pos + 1, cache pos + LENGTH entry - 2, insert name) + FI . + +list : CONCR (thesaurus) . + +ENDPROC rename ; + +INT PROC link (THESAURUS CONST thesaurus, TEXT CONST name) : + + access (thesaurus, name) ; + cache index . + +ENDPROC link ; + +TEXT PROC name (THESAURUS CONST thesaurus, INT CONST index) : + + access (thesaurus, index) ; + subtext (entry, 2, LENGTH entry - 1) . + +ENDPROC name ; + +PROC get (THESAURUS CONST thesaurus, TEXT VAR name, INT VAR index) : + + identify index ; + REP + to next entry + UNTIL end of list COR valid entry found PER . + +identify index : + IF index = 0 + THEN cache index := 0 ; + cache pos := 1 + ELSE access (thesaurus, index) + FI . + +to next entry : + cache pos := pos (list, begin entry char, cache pos + 1) ; + IF cache pos > 0 + THEN correct cache pos ; + get entry + ELSE get nil entry + FI . + +correct cache pos : + IF (list SUB cache pos + 2) = begin entry char + THEN cache pos INCR 2 + ELIF (list SUB cache pos + 1) = begin entry char + THEN cache pos INCR 1 + FI . + +get entry : + cache index INCR 1 ; + index := cache index ; + name := subtext (list, cache pos + 1, end entry pos - 1) . + +get nil entry : + cache index := 0 ; + cache pos := 0 ; + index := 0 ; + name := "" . + +end entry pos : pos (list, end entry char, cache pos) . + +end of list : index = 0 . + +valid entry found : name <> "" . + +list : CONCR (thesaurus) . + +ENDPROC get ; + +INT PROC highest entry (THESAURUS CONST thesaurus) : (*840813*) + + decode (list, LENGTH list - 1) - 1 . + +list : CONCR (thesaurus) . + +ENDPROC highest entry ; + +ENDPACKET thesaurus handling ; + diff --git a/lang/prolog/1.8.7/src/topographie b/lang/prolog/1.8.7/src/topographie new file mode 100644 index 0000000..c0924cf --- /dev/null +++ b/lang/prolog/1.8.7/src/topographie @@ -0,0 +1,59 @@ +member(X,[X|_]). +member(X,[_|Y]):- + member(X,Y). + +append([],L,L). +append([X|A],B,[X|C]):- + append(A,B,C). + +efface(A,[A|L],L):- + !. +efface(A,[B|L],[B|M]):- + efface(A,L,M). +efface(_,[],[]). + + +nol(N):- + read(N). + +input(_,_,N,N,L,L). +input(X,Y,R,N,L,O):- + read(X), + read(Y), + append([[X,Y]],L,M), + C IS R+1, + input(_,_,C,N,M,O). + +enter(L):- + nol(N), + input(X,Y,0,N,[],L). + + +searchnext(X,Y,[H|T]):- + H=[X,Y]; + H=[Y,X]; + searchnext(X,Y,T). + +onemove(_,_,[],L):- + write(L). +onemove(X,Y,L,H):- + searchnext(X,Y,L), + efface([X,Y],L,N), + L<>N, + write(N),elan(line), + append(H,[Y],F), + onemove(Y,Z,N,F). +onemove(X,Y,L,H):- + searchnext(X,Y,L), + efface([Y,X],L,N), + L<>N, + write(N),elan(line), + append(H,[Y],F), + onemove(Y,Z,N,F). + + + +go:- + enter(L),!, + onemove(X,Y,L,[X]). + diff --git a/system/base/1.7.5/source-disk b/system/base/1.7.5/source-disk new file mode 100644 index 0000000..5708023 --- /dev/null +++ b/system/base/1.7.5/source-disk @@ -0,0 +1 @@ +175_src/source-code-1.7.5.img diff --git a/system/base/1.7.5/src/advertising b/system/base/1.7.5/src/advertising new file mode 100644 index 0000000..45f73ef --- /dev/null +++ b/system/base/1.7.5/src/advertising @@ -0,0 +1,35 @@ +(* ------------------- VERSION 1 06.03.86 ------------------- *) +PACKET advertising DEFINES (* Autor: J.Liedtke *) + + eumel must advertise : + + +LET myself id field = 9 ; + + +PROC eumel must advertise : + + IF online AND channel <= 15 + THEN out (""1""4"") ; + IF station is not zero + THEN out (""15"Station: ") ; + out (text (station number)) ; + out (" "14"") + FI ; + cursor (60,1) ; + out (""15"Terminal: ") ; + out (text (channel)) ; + out (" "14"") ; + cursor (22,5) ; + (* out ("E U M E L Pilot-Version /M"13""10""10""10"") *) + out ("E U M E L Version 1.7.5.10 /M+ "13""10""10""10"") + FI . + +station is not zero : pcb (myself id field) >= 256 . + +station number : pcb (myself id field) DIV 256 . + +ENDPROC eumel must advertise ; + +ENDPACKET advertising ; + diff --git a/system/base/1.7.5/src/basic transput b/system/base/1.7.5/src/basic transput new file mode 100644 index 0000000..5608bb1 --- /dev/null +++ b/system/base/1.7.5/src/basic transput @@ -0,0 +1,177 @@ + +PACKET basic transput DEFINES + out , + outsubtext , + outtext , + TIMESOUT , + cout , + display , + inchar , + incharety , + cat input , + pause , + cursor , + get cursor , + channel , + online , + control , + blockout , + blockin : + + + +LET channel field = 4 , + blank times 64 = + " " ; + +LET BLOCKIO = STRUCT (ALIGN page align, ROW 256 INT buffer) , + buffer page = 2 ; + +BOUND BLOCKIO VAR block io ; +DATASPACE VAR block io ds ; +INITFLAG VAR this packet := FALSE ; + + +PROC out (TEXT CONST text ) : + EXTERNAL 60 +ENDPROC out ; + +PROC outsubtext ( TEXT CONST source, INT CONST from ) : + EXTERNAL 62 +END PROC outsubtext; + +PROC outsubtext (TEXT CONST source, INT CONST from, to) : + EXTERNAL 63 +END PROC outsubtext; + +PROC outtext ( TEXT CONST source, INT CONST from, to ) : + out subtext (source, from, to) ; + INT VAR trailing ; + IF from <= LENGTH source + THEN trailing := to - LENGTH source + ELSE trailing := to + 1 - from + FI ; + IF trailing > 0 + THEN trailing TIMESOUT " " + FI +ENDPROC outtext ; + +OP TIMESOUT (INT CONST times, TEXT CONST text) : + + IF text = " " + THEN fast timesout blank + ELSE timesout + FI . + +fast timesout blank : + INT VAR i := 0 ; + WHILE i + 64 < times REP + out (blank times 64) ; + i INCR 64 + PER ; + outsubtext (blank times 64, 1, times - i) . + +timesout : + FOR i FROM 1 UPTO times REP + out(text) + ENDREP . + +ENDOP TIMESOUT ; + +PROC display (TEXT CONST text) : + IF online + THEN out (text) + FI +ENDPROC display ; + +PROC inchar (TEXT VAR character ) : + EXTERNAL 64 +ENDPROC inchar ; + +TEXT PROC incharety : + EXTERNAL 65 +END PROC incharety ; + +TEXT PROC incharety (INT CONST time limit) : + internal pause (time limit) ; + incharety +ENDPROC incharety ; + +PROC pause (INT CONST time limit) : + internal pause (time limit) ; + TEXT CONST dummy := incharety +ENDPROC pause ; + +PROC pause : + TEXT VAR dummy; inchar (dummy) +ENDPROC pause ; + +PROC internal pause (INT CONST time limit) : + EXTERNAL 66 +ENDPROC internal pause ; + +PROC cat input (TEXT VAR t, esc char) : + EXTERNAL 68 +ENDPROC cat input ; + + +PROC cursor (INT CONST x, y) : + out (""6"") ; + out (code(y-1)) ; + out (code(x-1)) ; +ENDPROC cursor ; + +PROC get cursor (INT VAR x, y) : + EXTERNAL 67 +ENDPROC get cursor ; + +PROC cout (INT CONST number) : + EXTERNAL 61 +ENDPROC cout ; + + +INT PROC channel : + pcb (channel field) +ENDPROC channel ; + +BOOL PROC online : + pcb (channel field) <> 0 +ENDPROC online ; + + +PROC control (INT CONST code1, code2, code3, INT VAR return code) : + EXTERNAL 84 +ENDPROC control ; + +PROC blockout (ROW 256 INT CONST block, INT CONST code1, code2, + INT VAR return code) : + + access block io ds ; + block io.buffer := block ; + blockout (block io ds, buffer page, code1, code2, return code) . + +access block io ds : + IF NOT initialized (this packet) + THEN block io ds := nilspace + FI ; + block io := block io ds . + +ENDPROC blockout ; + +PROC blockin (ROW 256 INT VAR block, INT CONST code1, code2, + INT VAR return code) : + + access block io ds ; + blockin (block io ds, buffer page, code1, code2, return code) ; + block := block io.buffer . + +access block io ds : + IF NOT initialized (this packet) + THEN block io ds := nilspace + FI ; + block io := block io ds . + +ENDPROC blockin ; + +ENDPACKET basic transput ; + diff --git a/system/base/1.7.5/src/bits b/system/base/1.7.5/src/bits new file mode 100644 index 0000000..e9e84e7 --- /dev/null +++ b/system/base/1.7.5/src/bits @@ -0,0 +1,78 @@ + +PACKET bits DEFINES + + AND , + OR , + XOR , + bit , + lowest reset , + lowest set , + reset bit , + rotate , + set bit : + +LET bits per int = 16 ; + +ROW bits per int INT VAR bit mask := ROW bits per int INT: + (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1) ; + +PROC rotate (INT VAR bits, INT CONST number of bits) : + EXTERNAL 83 +ENDPROC rotate ; + +INT OP AND (INT CONST left, right) : + EXTERNAL 124 +ENDOP AND ; + +INT OP OR (INT CONST left, right) : + EXTERNAL 125 +ENDOP OR ; + +INT OP XOR (INT CONST left, right) : + EXTERNAL 121 +ENDOP XOR ; + +BOOL PROC bit (INT CONST bits, bit no) : + + (bits AND bit mask (bit no+1)) <> 0 + +ENDPROC bit ; + +PROC set bit (INT VAR bits, INT CONST bit no) : + + bits := bits OR bit mask (bit no+1) + +ENDPROC set bit ; + +PROC reset bit (INT VAR bits,INT CONST bit no) : + + bits := bits XOR (bits AND bit mask (bit no+1)) + +ENDPROC reset bit ; + +INT PROC lowest set (INT CONST bits) : + + INT VAR mask index ; + FOR mask index FROM 1 UPTO 16 REP + IF (bits AND bit mask (mask index)) <> 0 + THEN LEAVE lowest set WITH mask index - 1 + FI + PER ; + -1 + +ENDPROC lowest set ; + +INT PROC lowest reset (INT CONST bits) : + + INT VAR mask index ; + FOR mask index FROM 1 UPTO bits per int REP + IF (bits AND bit mask (mask index)) = 0 + THEN LEAVE lowest reset WITH mask index - 1 + FI + PER ; + -1 + +ENDPROC lowest reset ; + +ENDPACKET bits ; + diff --git a/system/base/1.7.5/src/bool b/system/base/1.7.5/src/bool new file mode 100644 index 0000000..5bf1e65 --- /dev/null +++ b/system/base/1.7.5/src/bool @@ -0,0 +1,16 @@ + +PACKET bool DEFINES XOR, true, false : + +BOOL CONST true := TRUE , + false:= FALSE ; + +BOOL OP XOR (BOOL CONST left, right) : + + IF left THEN NOT right + ELSE right + FI + +ENDOP XOR ; + +ENDPACKET bool ; + diff --git a/system/base/1.7.5/src/command dialogue b/system/base/1.7.5/src/command dialogue new file mode 100644 index 0000000..3011187 --- /dev/null +++ b/system/base/1.7.5/src/command dialogue @@ -0,0 +1,123 @@ + +PACKET command dialogue DEFINES (* Autor: J.Liedtke *) + (* Stand: 25.11.83 *) + command dialogue , + say , + yes , + no , + param position , + last param , + std , + QUIET , + quiet : + + +LET up = ""3"" , + right = ""2"" , + cr lf = ""13""10"" , + param pre = " (""" , + param post = """)"13""10"" ; + + +TEXT VAR std param := "" ; + +BOOL VAR dialogue flag := TRUE ; + +INT VAR param x := 0 ; + + +TYPE QUIET = INT ; + +QUIET PROC quiet : + QUIET:(0) +ENDPROC quiet ; + + +BOOL PROC command dialogue : + dialogue flag +ENDPROC command dialogue ; + +PROC command dialogue (BOOL CONST status) : + dialogue flag := status +ENDPROC command dialogue ; + + +BOOL PROC yes (TEXT CONST question) : + + IF dialogue flag + THEN ask question + ELSE TRUE + FI . + +ask question : + out (question) ; + skip previous input chars ; + out (" (j/n) ? ") ; + get answer ; + IF correct answer + THEN out (answer) ; + out (cr lf) ; + positive answer + ELSE out (""7"") ; + LENGTH question + 9 TIMESOUT ""8"" ; + yes (question) + FI . + +get answer : + TEXT VAR answer ; + inchar (answer) . + +correct answer : + pos ("jnyJNY", answer) > 0 . + +positive answer : + pos ("jyJY", answer) > 0 . + +skip previous input chars : + REP UNTIL incharety = "" PER . + +ENDPROC yes ; + +BOOL PROC no (TEXT CONST question) : + + NOT yes (question) + +ENDPROC no ; + +PROC say (TEXT CONST message) : + + IF dialogue flag + THEN out (message) + FI + +ENDPROC say ; + +PROC param position (INT CONST x) : + + param x := x + +ENDPROC param position ; + +TEXT PROC last param : + + IF param x > 0 AND online + THEN out (up) ; + param x TIMESOUT right ; + out (param pre) ; + out (std param) ; + out (param post) + FI ; + std param . + +ENDPROC last param ; + +PROC last param (TEXT CONST new) : + std param := new +ENDPROC last param ; + +TEXT PROC std : + std param +ENDPROC std ; + +ENDPACKET command dialogue ; + diff --git a/system/base/1.7.5/src/command handler b/system/base/1.7.5/src/command handler new file mode 100644 index 0000000..756382b --- /dev/null +++ b/system/base/1.7.5/src/command handler @@ -0,0 +1,290 @@ +(* ------------------- VERSION 2 05.05.86 ------------------- *) +PACKET command handler DEFINES (* Autor: J.Liedtke *) + + get command , + analyze command , + do command , + command error , + cover tracks : + + +LET cr lf = ""4""13""10"" , + esc k = ""27"k" , + command pre = ""4""13" " , + command post = ""13""10" " , + + max command length = 2010 , + + tag type = 1 , + texttype = 4 , + eof type = 7 ; + + +TEXT VAR command handlers own command line := "" , + previous command line := "" , + symbol , + procedure , + pattern , + error note := "" ; + +INT VAR symbol type ; + + +PROC get command (TEXT CONST command text) : + + get command (command text, command handlers own command line) + +ENDPROC get command ; + +PROC get command (TEXT CONST command text, TEXT VAR command line) : + + set line nr (0) ; + error protocoll ; + get command from console . + +error protocoll : + IF is error + THEN put error ; + clear error + ELSE command line := "" ; + FI . + +get command from console : + normalize cursor ; + REP + out (command pre) ; + out (command text) ; + out (command post) ; + editget command + UNTIL command line <> "" PER ; + param position (LENGTH command line) ; + out (command post) . + +editget command : + TEXT VAR exit char ; + REP + get cursor (x, y) ; + editget (command line, max command length, x size - x, + "", "k", exit char) ; + ignore halt errors during editget ; + break quiet if command line is too long ; + IF exit char = esc k + THEN cursor to begin of command input ; + command line := previous command line + ELIF LENGTH command line > 1 + THEN previous command line := command line ; + LEAVE editget command + ELSE LEAVE editget command + FI + PER . + +normalize cursor : + INT VAR x, y; + out (crlf) ; + get cursor (x, y) ; + cursor (x, y) . + +ignore halt errors during editget : + IF is error + THEN clear error + FI . + +break quiet if command line is too long : + IF command line is too long + THEN command line := "break (quiet)" + FI . + +command line is too long : + LENGTH command line = max command length . + +cursor to begin of command input : + out (command pre) . + +ENDPROC get command ; + + +PROC analyze command ( TEXT CONST command list, + INT CONST permitted type, + INT VAR command index, number of params, + TEXT VAR param 1, param 2) : + + analyze command (command list, command handlers own command line, + permitted type, command index, + number of params, param 1, param 2) + +ENDPROC analyze command ; + +PROC analyze command ( TEXT CONST command list, command line, + INT CONST permitted type, + INT VAR command index, number of params, + TEXT VAR param 1, param 2) : + + error note := "" ; + scan (command line) ; + next symbol ; + IF symbol type <> tag type AND symbol <> "?" + THEN error ("Name ungueltig") ; + impossible command + ELIF pos (command list, symbol) > 0 + THEN procedure name ; + parameter list pack option ; + nothing else in command line ; + decode command + ELSE impossible command + FI . + +procedure name : + procedure := symbol ; + next symbol . + +parameter list pack option : + number of params := 0 ; + param 1 := "" ; + param 2 := "" ; + IF symbol = "(" + THEN next symbol ; + parameter list ; + IF symbol <> ")" AND error note = "" + THEN error (") fehlt") + FI + ELIF symbol type <> eof type + THEN error ("( fehlt") + FI . + +parameter list : + parameter (param 1, number of params, permitted type) ; + IF symbol = "," + THEN next symbol ; + parameter (param 2, number of params, permitted type) ; + FI . + +nothing else in command line : + next symbol ; + IF symbol <> "" + THEN error ("Kommando zu schwierig") + FI . + +decode command : + command index := index (command list, procedure, number of params) . + +impossible command : + command index := 0 . + +ENDPROC analyze command ; + +PROC parameter (TEXT VAR param, INT VAR number of params, + INT CONST permitted type) : + + IF symbol type = text type OR symbol type = permitted type + THEN param := symbol ; + number of params INCR 1 ; + next symbol + ELSE error ("Parameter ist kein TEXT ("" fehlt)") + FI + +ENDPROC parameter ; + +INT PROC index (TEXT CONST list, procedure, INT CONST params) : + + pattern := procedure ; + pattern CAT ":" ; + IF procedure name found + THEN get colon pos ; + get dot pos ; + get end pos ; + get command index ; + get param index ; + IF param index >= 0 + THEN command index + param index + ELSE - command index + FI + ELSE 0 + FI . + +procedure name found : + INT VAR index pos := pos (list, pattern) ; + WHILE index pos > 0 REP + IF index pos = 1 COR (list SUB index pos - 1) <= "9" + THEN LEAVE procedure name found WITH TRUE + FI ; + index pos := pos (list, pattern, index pos + 1) + PER ; + FALSE . + +get param index : + INT CONST param index := + pos (list, text (params), dot pos, end pos) - dot pos - 1 . + +get command index : + INT CONST command index := + int ( subtext (list, colon pos + 1, dot pos - 1) ) . + +get colon pos : + INT CONST colon pos := pos (list, ":", index pos) . + +get dot pos : + INT CONST dot pos := pos (list, ".", index pos) . + +get end pos : + INT CONST end pos := dot pos + 4 . + +ENDPROC index ; + +PROC do command : + + do (command handlers own command line) + +ENDPROC do command ; + +PROC error (TEXT CONST message) : + + error note := message ; + scan ("") ; + procedure := "-" + +ENDPROC error ; + +PROC command error : + + disable stop ; + IF error note <> "" + THEN errorstop (error note) ; + error note := "" + FI ; + enable stop + +ENDPROC command error ; + + +PROC next symbol : + + next symbol (symbol, symbol type) + +ENDPROC next symbol ; + + +PROC cover tracks : + + cover tracks (command handlers own command line) ; + cover tracks (previous command line) ; + erase buffers of compiler and do packet . + +erase buffers of compiler and do packet : + do (command handlers own command line) . + +ENDPROC cover tracks ; + +PROC cover tracks (TEXT VAR secret) : + + INT VAR i ; + FOR i FROM 1 UPTO LENGTH secret REP + replace (secret, i, " ") + PER ; + WHILE LENGTH secret < 13 REP + secret CAT " " + PER + +ENDPROC cover tracks ; + +ENDPACKET command handler ; + diff --git a/system/base/1.7.5/src/dataspace b/system/base/1.7.5/src/dataspace new file mode 100644 index 0000000..3045a53 --- /dev/null +++ b/system/base/1.7.5/src/dataspace @@ -0,0 +1,74 @@ +(* ------------------- VERSION 3 22.04.86 ------------------- *) +PACKET dataspace DEFINES + + := , + nilspace , + forget , + type , + heap size , + storage , + ds pages , + next ds page , + blockout , + blockin , + ALIGN : + + +LET myself id field = 9 , + lowest ds number = 4 , + highest ds number = 255 ; + +TYPE ALIGN = ROW 252 INT ; + +OP := (DATASPACE VAR dest, DATASPACE CONST source ) : + EXTERNAL 70 +ENDOP := ; + +DATASPACE PROC nilspace : + EXTERNAL 69 +ENDPROC nilspace ; + +PROC forget (DATASPACE CONST dataspace ) : + EXTERNAL 71 +ENDPROC forget ; + +PROC type (DATASPACE CONST ds, INT CONST type) : + EXTERNAL 72 +ENDPROC type ; + +INT PROC type (DATASPACE CONST ds) : + EXTERNAL 73 +ENDPROC type ; + +INT PROC heap size (DATASPACE CONST ds) : + EXTERNAL 74 +ENDPROC heap size ; + +INT PROC storage (DATASPACE CONST ds) : + (ds pages (ds) + 1) DIV 2 +ENDPROC storage ; + +INT PROC ds pages (DATASPACE CONST ds) : + pages (ds, pcb (myself id field)) +ENDPROC ds pages ; + +INT PROC pages (DATASPACE CONST ds, INT CONST task nr) : + EXTERNAL 88 +ENDPROC pages ; + +INT PROC next ds page (DATASPACE CONST ds, INT CONST page nr) : + EXTERNAL 87 +ENDPROC next ds page ; + +PROC blockout (DATASPACE CONST ds, INT CONST page nr, code1, code2, + INT VAR return code) : + EXTERNAL 85 +ENDPROC blockout ; + +PROC blockin (DATASPACE VAR ds, INT CONST page nr, code1, code2, + INT VAR return code) : + EXTERNAL 86 +ENDPROC blockin ; + +ENDPACKET dataspace ; + diff --git a/system/base/1.7.5/src/date handling b/system/base/1.7.5/src/date handling new file mode 100644 index 0000000..66da110 --- /dev/null +++ b/system/base/1.7.5/src/date handling @@ -0,0 +1,303 @@ +PACKET date handling DEFINES date, time, (* Autor: H. Indenbirken *) + time of day, (* Stand: 02.06.1986 (wk)*) + month, day , year , + hour , + minute, + second : + +LET middle yearlength = 31557380.0, + weeklength = 604800.0, + daylength = 86400.0, + hours = 3600.0, + minutes = 60.0, + seconds = 1.0; + + +(* Tage bis zum Jahr 01.01.1900: 693970.25 5.995903e10 Sekunden *) +(* Dieser Tag ist ein Montag *) + +REAL VAR begin of today := 0.0 , end of today := 0.0 ; + +TEXT VAR today , result ; + + +ROW 12 REAL CONST previous days :: ROW 12 REAL : (0.0, 2678400.0, 5097600.0, + 7776000.0, 10368000.0, 13046400.0, + 15638400.0, 18316800.0, 20995200.0, + 23587200.0, 26265600.0, 28857600.0); + +REAL PROC day: day length END PROC day; +REAL PROC hour: hours END PROC hour; +REAL PROC minute: minutes END PROC minute; +REAL PROC second: seconds END PROC second; + +TEXT PROC date : + + IF clock (1) < begin of today OR end of today <= clock (1) + THEN begin of today := clock (1) ; + end of today := floor (begin of today/daylength)*daylength+daylength; + today := date (begin of today) + FI ; + today + +ENDPROC date ; + +TEXT PROC date (REAL CONST datum): + INT VAR year :: int (datum/middle yearlength), + day :: int (((datum - datum MOD daylength) MOD middle yearlength) / daylength) + 1; + +correct kalendary day; + + calculate month and correct day; + result := daytext; + result CAT monthtext; + result CAT yeartext; + change all (result, " ", "0") ; + result . + +correct kalendary day: + IF day >= 60 AND NOT leapyear + THEN day INCR 1 FI . + +leapyear: + IF year MOD 100 = 0 + THEN year MOD 400 = 0 + ELSE year MOD 4 = 0 + FI. + +calculate month and correct day: + INT VAR month; + IF day > 182 + THEN IF day > 274 + THEN IF day > 305 + THEN IF day > 335 + THEN month := 12; + day DECR 335 + ELSE month := 11; + day DECR 305 + FI + ELSE month := 10; + day DECR 274 + FI + ELSE IF day > 213 + THEN IF day > 244 + THEN month := 9; + day DECR 244 + ELSE month := 8; + day DECR 213 + FI + ELSE month := 7; + day DECR 182 + FI + FI + ELSE IF day > 91 + THEN IF day > 121 + THEN IF day > 152 + THEN month := 6; + day DECR 152 + ELSE month := 5; + day DECR 121 + FI + ELSE month := 4; + day DECR 91 + FI + ELSE IF day > 31 + THEN IF day > 60 + THEN month := 3; + day DECR 60 + ELSE month := 2; + day DECR 31 + FI + ELSE month := 1 FI + FI + FI . + +daytext : + text (day, 2) + "." . + +monthtext : + text (month,2) + "." . + +yeartext: + IF 1900 <= year AND year < 2000 + THEN text (year - 1900, 2) + ELSE text (year, 4) + FI . + +END PROC date; + +TEXT PROC day (REAL CONST datum): + SELECT int ((datum MOD weeklength)/daylength) OF + CASE 1: "Donnerstag" + CASE 2: "Freitag" + CASE 3: "Samstag" + CASE 4: "Sonntag" + CASE 5: "Montag" + CASE 6: "Dienstag" + OTHERWISE "Mittwoch" ENDSELECT . +END PROC day; + +TEXT PROC month (REAL CONST datum): + SELECT int (subtext (date (datum), 4, 5)) OF + CASE 1: "Januar" + CASE 2: "Februar" + CASE 3: "März" + CASE 4: "April" + CASE 5: "Mai" + CASE 6: "Juni" + CASE 7: "Juli" + CASE 8: "August" + CASE 9: "September" + CASE 10: "Oktober" + CASE 11: "November" + OTHERWISE "Dezember" ENDSELECT . + +END PROC month; + +TEXT PROC year (REAL CONST datum) : + + TEXT VAR buffer := subtext (date (datum), 7) ; + IF LENGTH buffer = 2 + THEN "19" + buffer + ELSE buffer + FI . + +ENDPROC year ; + +TEXT PROC time of day : + time of day (clock (1)) +ENDPROC time of day ; + +TEXT PROC time of day (REAL CONST value) : + subtext (time (value MOD daylength), 1, 5) +ENDPROC time of day ; + +TEXT PROC time (REAL CONST value) : + time (value,10) +ENDPROC time ; + +TEXT PROC time (REAL CONST value, INT CONST length) : + result := "" ; + IF length > 7 + THEN result CAT hour ; + result CAT ":" + FI ; + result CAT minute ; + result CAT ":" ; + result CAT rest ; + change all (result, " ", "0") ; + result . + +hour : + text (int (value/hours), length-8) . + +minute : + text (int (value/minutes MOD 60.0), 2) . + +rest : + text (value MOD minutes, 4, 1) . + +END PROC time ; + +REAL PROC date (TEXT CONST datum) : + split and check datum; + real (day no)*daylength + + previous days [month no] + calendary day + + floor (real (year no)*middleyearlength / daylength)*daylength . + +split and check datum: + INT CONST day no :: first no; + IF NOT last conversion ok + THEN errorstop ("inkorrekte Datumsangabe (Tag) : " + datum) FI; + + INT CONST month no :: second no; + IF NOT last conversion ok OR month no < 1 OR month no > 12 + THEN errorstop ("inkorrekte Datumsangabe (Monat) : " + datum) FI; + + INT CONST year no :: third no + century; + IF NOT last conversion ok + THEN errorstop ("inkorrekte Datumsangabe (Jahr) : " + datum) FI; + + IF day no < 1 OR day no > size of month + THEN errorstop ("inkorrekte Datumsangabe (Tag) : " + datum) FI . + +century: + IF (length (datum) - second pos) <= 2 + THEN 1900 + ELSE 0 FI . + +size of month: + SELECT month no OF + CASE 1, 3, 5, 7, 8, 10, 12: 31 + CASE 4, 6, 9, 11: 30 + OTHERWISE february size ENDSELECT . + +february size: + IF leapyear + THEN 29 + ELSE 28 FI . + +calendary day: + IF month no > 2 AND leapyear + THEN daylength + ELSE 0.0 FI . + +leapyear: + year no MOD 4 = 0 AND year no MOD 400 <> 0 . + +first no: + INT CONST first pos :: pos (datum, "."); + int (subtext (datum, 1, first pos-1)) . + +second no: + INT CONST second pos :: pos (datum, ".", first pos+1); + int (subtext (datum, first pos + 1, second pos-1)) . + +third no: + int (subtext (datum, second pos + 1)) . + +END PROC date; + +REAL PROC time (TEXT CONST time) : + split and check time; + hour + min + sec . + +split and check time: + REAL CONST hour :: hour no * hours; + IF NOT last conversion ok + THEN errorstop ("inkorrekte Datumsangabe (Stunde) : " + time) FI; + + REAL CONST min :: min no * minutes; + IF NOT last conversion ok + THEN errorstop ("inkorrekte Datumsangabe (Minute) : " + time) FI; + + REAL CONST sec :: sec no; + IF NOT last conversion ok + THEN errorstop ("inkorrekte Datumsangabe (Sekunde) : " + time) FI; + + set conversion (hour ok AND min ok AND sec ok) . + +hour no: + INT CONST hour pos :: pos (time, ":"); + real (subtext (time, 1, hour pos-1)) . + +min no: + INT VAR min pos :: pos (time, ":", hour pos+1); + IF min pos = 0 + THEN real (subtext (time, hour pos + 1, LENGTH time)) + ELSE real (subtext (time, hour pos + 1, min pos-1)) + FI . + +sec no: + IF min pos = 0 + THEN 0.0 + ELSE real (subtext (time, min pos + 1)) + FI . + +hour ok: 0.0 <= hour AND hour < daylength . +min ok: 0.0 <= min AND min < hours . +sec ok: 0.0 <= sec AND sec < minutes . +END PROC time; + +END PACKET datehandling + diff --git a/system/base/1.7.5/src/editor b/system/base/1.7.5/src/editor new file mode 100644 index 0000000..62af2db --- /dev/null +++ b/system/base/1.7.5/src/editor @@ -0,0 +1,2959 @@ +PACKET editor paket DEFINES (* EDITOR 121 *) + (**********) (* 19.07.85 -bk- *) + (* 10.09.85 -ws- *) + (* 25.04.86 -sh- *) + edit, editget, (* 06.06.86 -wk- *) + quit, quit last, (* 04.06.86 -jl- *) + push, type, + word wrap, margin, + write permission, + set busy indicator, + two bytes, + is kanji esc, + within kanji, + rubin mode, + is editget, + getchar, nichts neu, + getcharety, satznr neu, + is incharety, ueberschrift neu, + get window, zeile neu, + get editcursor, abschnitt neu, + get editline, bildabschnitt neu, + put editline, bild neu, + aktueller editor, alles neu, + groesster editor, satznr zeigen, + open editor, ueberschrift zeigen, + editfile, bild zeigen: + + +LET hop = ""1"", right = ""2"", + up char = ""3"", clear eop = ""4"", + clear eol = ""5"", cursor pos = ""6"", + piep = ""7"", left = ""8"", + down char = ""10"", rubin = ""11"", + rubout = ""12"", cr = ""13"", + mark key = ""16"", abscr = ""17"", + inscr = ""18"", dezimal = ""19"", + backcr = ""20"", esc = ""27"", + dach = ""94"", blank = " "; + + +LET no output = 0, out zeichen = 1, + out feldrest = 2, out feld = 3, + clear feldrest = 4; + +LET FELDSTATUS = STRUCT (INT stelle, alte stelle, rand, limit, + anfang, marke, laenge, verschoben, + BOOL einfuegen, fliesstext, write access, + TEXT tabulator); +FELDSTATUS VAR feldstatus; + +TEXT VAR begin mark := ""15"", + end mark := ""14""; + +TEXT VAR separator := "", kommando := "", audit := "", zeichen := "", + satzrest := "", merksatz := "", alter editsatz := ""; + +INT VAR kommando zeiger := 1, umbruchstelle, umbruch verschoben, + zeile, spalte, output mode := no output, postblanks := 0, + min schreibpos, max schreibpos, cpos, absatz ausgleich; + +BOOL VAR lernmodus := FALSE, separator eingestellt := FALSE, + invertierte darstellung := FALSE, absatzmarke steht, + cursor diff := FALSE, editget modus := FALSE, + two byte mode := FALSE, std fliesstext := TRUE;. + +schirmbreite : x size - 1 . +schirmhoehe : y size . +maxbreite : schirmbreite - 2 . +maxlaenge : schirmhoehe - 1 . +marklength : mark size .; + +initialisiere editor; + +.initialisiere editor : + anfang := 1; zeile := 0; verschoben := 0; tabulator := ""; + einfuegen := FALSE; fliesstext := TRUE; zeileneinfuegen := FALSE; + marke := 0; bildmarke := 0; feldmarke := 0.; + +(******************************** editget ********************************) + +PROC editget (TEXT VAR editsatz, INT CONST editlimit, editlaenge, + TEXT CONST sep, res, TEXT VAR exit char) : + IF editlaenge < 1 THEN errorstop ("Fenster zu klein") FI; + separator := ""13""; separator CAT sep; + separator eingestellt := TRUE; + TEXT VAR reservierte editget tasten := ""11""12"" ; + reservierte editget tasten CAT res ; + disable stop; + absatz ausgleich := 0; exit char := ""; get cursor; + FELDSTATUS CONST alter feldstatus := feldstatus; + feldstatus := FELDSTATUS : (1, 1, spalte - 1, editlimit, + 1, 0, editlaenge, 0, + FALSE, FALSE, TRUE, ""); + konstanten neu berechnen; + output mode := out feld; + feld editieren; + zeile verlassen; + feldstatus := alter feldstatus; + konstanten neu berechnen; + separator := ""; + separator eingestellt := FALSE . + +feld editieren : + REP + feldeditor (editsatz, reservierte editget tasten); + IF is error + THEN kommando zeiger := 1; kommando := ""; LEAVE feld editieren + FI ; + TEXT VAR t, zeichen; getchar (zeichen); + IF zeichen ist separator + THEN exit char := zeichen; LEAVE feld editieren + ELIF zeichen = hop + THEN feldout (editsatz, stelle); getchar (zeichen) + ELIF zeichen = mark key + THEN output mode := out feld + ELIF zeichen = abscr + THEN exit char := cr; LEAVE feld editieren + ELIF zeichen = esc + THEN getchar (zeichen); auf exit pruefen; + IF zeichen = rubout (*sh*) + THEN IF marke > 0 + THEN merksatz := subtext (editsatz, marke, stelle - 1); + change (editsatz, marke, stelle - 1, ""); + stelle := marke; marke := 0; konstanten neu berechnen + FI + ELIF zeichen = rubin + THEN t := subtext (editsatz, 1, stelle - 1); + t CAT merksatz; + satzrest := subtext (editsatz, stelle); + t CAT satzrest; + stelle INCR LENGTH merksatz; + merksatz := ""; editsatz := t + ELIF zeichen ist kein esc kommando (*wk*) + AND + kommando auf taste (zeichen) <> "" + THEN editget kommando ausfuehren + FI ; + output mode := out feld + FI + PER . + +zeichen ist kein esc kommando : (*wk*) + pos (hop + left + right, zeichen) = 0 . + +zeile verlassen : + IF marke > 0 OR verschoben <> 0 + THEN stelle DECR verschoben; verschoben := 0; feldout (editsatz, 0) + ELSE cursor (rand + 1 + min (LENGTH editsatz, editlaenge), zeile) + FI . + +zeichen ist separator : pos (separator, zeichen) > 0 . + +auf exit pruefen : + IF pos (res, zeichen) > 0 + THEN exit char := esc + zeichen; LEAVE feld editieren + FI . + +editget kommando ausfuehren : + editget zustaende sichern ; + do (kommando auf taste (zeichen)) ; + alte editget zustaende wieder herstellen ; + IF stelle < marke THEN stelle := marke FI; + konstanten neu berechnen . + +editget zustaende sichern : (*wk*) + BOOL VAR alter editget modus := editget modus; + FELDSTATUS VAR feldstatus vor do kommando := feldstatus ; + INT VAR zeile vor do kommando := zeile ; + TEXT VAR separator vor do kommando := separator ; + BOOL VAR separator eingestellt vor do kommando := separator eingestellt ; + editget modus := TRUE ; + alter editsatz := editsatz . + +alte editget zustaende wieder herstellen : + editget modus := alter editget modus ; + editsatz := alter editsatz; + feldstatus := feldstatus vor do kommando ; + zeile := zeile vor do kommando ; + separator := separator vor do kommando ; + separator eingestellt := separator eingestellt vor do kommando . + +END PROC editget; + +PROC editget (TEXT VAR editsatz, INT CONST editlimit, TEXT VAR exit char) : + editget (editsatz, editlimit, x size - x cursor, "", "", exit char) +END PROC editget; (* 05.07.84 -bk- *) + +PROC editget (TEXT VAR editsatz, TEXT CONST sep, res, TEXT VAR exit char) : + editget (editsatz, max text length, x size - x cursor, sep, res, exit char) +END PROC editget; (* 05.07.84 -bk- *) + +PROC editget (TEXT VAR editsatz) : + TEXT VAR exit char; (* 05.07.84 -bk- *) + editget (editsatz, max text length, x size - x cursor, "", "", exit char) +END PROC editget; + +PROC editget (TEXT VAR editsatz, INT CONST editlimit, editlaenge) : + TEXT VAR exit char; + editget (editsatz, editlimit, editlaenge, "", "", exit char) +ENDPROC editget; + +(******************************* feldeditor ******************************) + +TEXT VAR reservierte feldeditor tasten ; (*jl*) + +PROC feldeditor (TEXT VAR satz, TEXT CONST res) : + enable stop; + reservierte feldeditor tasten := ""1""2""8"" ; + reservierte feldeditor tasten CAT res; + absatzmarke steht := (satz SUB LENGTH satz) = blank; + alte stelle merken; + cursor diff bestimmen und ggf ausgleichen; + feld editieren; + absatzmarke updaten . + +alte stelle merken : alte stelle := stelle . + +cursor diff bestimmen und ggf ausgleichen : + IF cursor diff + THEN stelle INCR 1; cursor diff := FALSE + FI ; + IF stelle auf zweitem halbzeichen + THEN stelle DECR 1; cursor diff := TRUE + FI . + +feld editieren : + REP + feld optisch aufbereiten; + kommando annehmen und ausfuehren + PER . + +absatzmarke updaten : + IF absatzmarke soll stehen + THEN IF NOT absatzmarke steht THEN absatzmarke schreiben (TRUE) FI + ELSE IF absatzmarke steht THEN absatzmarke schreiben (FALSE) FI + FI . + +absatzmarke soll stehen : (satz SUB LENGTH satz) = blank . + +feld optisch aufbereiten : + stelle korrigieren; + verschieben wenn erforderlich; + randausgleich fuer doppelzeichen; + output mode behandeln; + ausgabe verhindern . + +randausgleich fuer doppelzeichen : + IF stelle = max schreibpos CAND stelle auf erstem halbzeichen + THEN verschiebe (1) + FI . + +stelle korrigieren : + IF stelle auf zweitem halbzeichen THEN stelle DECR 1 FI . + +stelle auf erstem halbzeichen : within kanji (satz, stelle + 1) . + +stelle auf zweitem halbzeichen : within kanji (satz, stelle) . + +output mode behandeln : + SELECT output mode OF + CASE no output : im markiermode markierung anpassen + CASE out zeichen : zeichen ausgeben; LEAVE output mode behandeln + CASE out feldrest : feldrest neu schreiben + CASE out feld : feldout (satz, stelle) + CASE clear feldrest : feldrest loeschen + END SELECT; + schreibmarke positionieren (stelle) . + +ausgabe verhindern : output mode := no output . + +im markiermode markierung anpassen : + IF markiert THEN markierung anpassen FI . + +markierung anpassen : + IF stelle > alte stelle + THEN markierung verlaengern + ELIF stelle < alte stelle + THEN markierung verkuerzen + FI . + +markierung verlaengern : + invers out (satz, alte stelle, stelle, "", end mark) . + +markierung verkuerzen : + invers out (satz, stelle, alte stelle, end mark, "") . + +zeichen ausgeben : + IF NOT markiert + THEN out (zeichen) + ELIF mark refresh line mode + THEN feldout (satz, stelle); schreibmarke positionieren (stelle) + ELSE out (begin mark); markleft; out (zeichen); out (end mark); markleft + FI . + +markleft : + marklength TIMESOUT left . + +feldrest neu schreiben : + IF NOT markiert + THEN feldrest unmarkiert neu schreiben + ELSE feldrest markiert neu schreiben + FI ; + WHILE postblanks > 0 CAND x cursor <= rand + laenge REP + out (blank); postblanks DECR 1 + PER ; postblanks := 0 . + +feldrest unmarkiert neu schreiben : + schreibmarke positionieren (alte stelle); + out subtext mit randbehandlung (satz, alte stelle, stelle am ende) . + +feldrest markiert neu schreiben : + markierung verlaengern; out subtext mit randbehandlung + (satz, stelle, stelle am ende - 2 * marklength) . + +kommando annehmen und ausfuehren : + kommando annehmen; kommando ausfuehren . + +kommando annehmen : + getchar (zeichen); kommando zurueckweisen falls noetig . + +kommando zurueckweisen falls noetig : + IF NOT write access CAND zeichen ist druckbar + THEN benutzer warnen; kommando ignorieren + FI . + +benutzer warnen : out (piep) . + +kommando ignorieren : + zeichen := ""; LEAVE kommando annehmen und ausfuehren . + +kommando ausfuehren : + neue satzlaenge bestimmen; + alte stelle merken; + IF zeichen ist separator + THEN feldeditor verlassen + ELIF zeichen ist druckbar + THEN fortschreiben + ELSE funktionstasten behandeln + FI . + +neue satzlaenge bestimmen : INT VAR satzlaenge := LENGTH satz . + +feldeditor verlassen : + IF NOT absatzmarke steht THEN blanks abschneiden FI; (*sh*) + push (zeichen); LEAVE feld editieren . + +blanks abschneiden : + INT VAR letzte non blank pos := satzlaenge; + WHILE letzte non blank pos > 0 CAND (satz SUB letzte non blank pos) = blank REP + letzte non blank pos DECR 1 + PER; satz := subtext (satz, 1, letzte non blank pos) . + +zeichen ist druckbar : zeichen >= blank . + +zeichen ist separator : + separator eingestellt CAND pos (separator, zeichen) > 0 . + +fortschreiben : + zeichen in satz eintragen; + IF is kanji esc (zeichen) THEN kanji zeichen schreiben FI; + bei erreichen von limit ueberlauf behandeln . + +zeichen in satz eintragen : + IF hinter dem satz + THEN satz mit leerzeichen auffuellen und zeichen anfuegen + ELIF einfuegen + THEN zeichen vor aktueller position einfuegen + ELSE altes zeichen ersetzen + FI . + +hinter dem satz : stelle > satzlaenge . + +satz mit leerzeichen auffuellen und zeichen anfuegen : + satz AUFFUELLENMIT blank; + zeichen anfuegen; + output mode := out zeichen . + +zeichen anfuegen : satz CAT zeichen; neue satzlaenge bestimmen . +zeichen ignorieren : benutzer warnen; LEAVE kommando ausfuehren . + +zeichen vor aktueller position einfuegen : + insert char (satz, zeichen, stelle); + neue satzlaenge bestimmen; + output mode := out feldrest . + +altes zeichen ersetzen : + replace (satz, stelle, zeichen); + IF stelle auf erstem halbzeichen + THEN output mode := out feldrest; replace (satz, stelle + 1, blank) + ELSE output mode := out zeichen + FI . + +kanji zeichen schreiben : + alte stelle merken; + stelle INCR 1; getchar (zeichen); + IF zeichen < ""64"" THEN zeichen := ""64"" FI; + IF hinter dem satz + THEN zeichen anfuegen + ELIF einfuegen + THEN zeichen vor aktueller position einfuegen + ELSE replace (satz, stelle, zeichen) + FI ; + output mode := out feldrest . + +bei erreichen von limit ueberlauf behandeln : (*sh*) + IF satzlaenge kritisch + THEN in naechste zeile falls moeglich + ELSE stelle INCR 1 + FI . + +satzlaenge kritisch : + IF stelle >= satzlaenge + THEN satzlaenge = limit + ELSE satzlaenge = limit + 1 + FI . + +in naechste zeile falls moeglich : + IF fliesstext AND umbruch moeglich OR NOT fliesstext AND stelle >= satzlaenge + THEN in naechste zeile + ELSE stelle INCR 1 + FI . + +umbruch moeglich : + INT CONST st := stelle; stelle := limit; + INT CONST ltzt wortanf := letzter wortanfang (satz); + stelle := st; einrueckposition (satz) < ltzt wortanf . + +in naechste zeile : + IF fliesstext + THEN ueberlauf und oder umbruch + ELSE ueberlauf ohne umbruch + FI . + +ueberlauf und oder umbruch : + INT VAR umbruchpos := 1; + umbruchposition bestimmen; + loeschposition bestimmen; + IF stelle = satzlaenge + THEN ueberlauf mit oder ohne umbruch + ELSE umbruch mit oder ohne ueberlauf + FI . + +umbruchposition bestimmen : + umbruchstelle := stelle; + stelle := satzlaenge; + umbruchpos := max (umbruchpos, letzter wortanfang (satz)); + stelle := umbruchstelle . + +loeschposition bestimmen : + INT VAR loeschpos := umbruchpos; + WHILE davor noch blank REP loeschpos DECR 1 PER . + +davor noch blank : + loeschpos > ganz links CAND (satz SUB (loeschpos - 1)) = blank . + +ganz links : max (1, marke) . + +ueberlauf mit oder ohne umbruch : + IF zeichen = blank OR loeschpos = ganz links + THEN stelle := 1; ueberlauf ohne umbruch + ELSE ueberlauf mit umbruch + FI . + +ueberlauf ohne umbruch : push (cr) . + +ueberlauf mit umbruch : + ausgabe verhindern; + umbruchkommando aufbereiten; + auf loeschposition positionieren . + +umbruchkommando aufbereiten : + zeichen := hop + rubout + inscr; + satzrest := subtext (satz, umbruchpos); + zeichen CAT satzrest; + IF stelle ist im umgebrochenen teil + THEN insert char (zeichen, backcr, max (stelle - umbruchpos + 1, 0) + 4); + zeichen CAT backcr + FI ; + push (zeichen) . + +stelle ist im umgebrochenen teil : stelle >= loeschpos . + +auf loeschposition positionieren : stelle := loeschpos . + +umbruch mit oder ohne ueberlauf : + umbruchposition anpassen; + IF stelle ist im umgebrochenen teil + THEN umbruch mit ueberlauf + ELSE umbruch ohne ueberlauf + FI . + +umbruchposition anpassen : + IF zeichen = blank + THEN umbruchpos := stelle + 1; + umbruchposition bestimmen; + neue loeschposition bestimmen + FI . + +neue loeschposition bestimmen : + loeschpos := umbruchpos; + WHILE davor noch blank AND stelle noch nicht erreicht REP loeschpos DECR 1 PER . + +stelle noch nicht erreicht : loeschpos > stelle + 1 . + +umbruch mit ueberlauf : ueberlauf mit umbruch . + +umbruch ohne ueberlauf : + zeichen := inscr; + satzrest := subtext (satz, umbruchpos); + zeichen CAT satzrest; + zeichen CAT up char + backcr; + umbruchstelle INCR 1; umbruch verschoben := verschoben; + satz := subtext (satz, 1, loeschpos - 1); + schreibmarke positionieren (loeschpos); feldrest loeschen; + output mode := out feldrest; + push (zeichen) . + +funktionstasten behandeln : + SELECT pos (kommandos, zeichen) OF + CASE c hop : hop kommandos behandeln + CASE c esc : esc kommandos behandeln + CASE c right : nach rechts oder ueberlauf + CASE c left : wenn moeglich ein schritt nach links + CASE c tab : zur naechsten tabulator position + CASE c dezimal : dezimalen schreiben + CASE c rubin : einfuegen umschalten + CASE c rubout : ein zeichen loeschen + CASE c abscr, c inscr, c down : feldeditor verlassen + CASE c up : eine zeile nach oben (*sh*) + CASE c cr : ggf absatz erzeugen + CASE c mark : markieren umschalten + CASE c backcr : zurueck zur umbruchstelle + OTHERWISE : sondertaste behandeln + END SELECT . + +kommandos : + LET c hop = 1, c right = 2, + c up = 3, c left = 4, + c tab = 5, c down = 6, + c rubin = 7, c rubout = 8, + c cr = 9, c mark = 10, + c abscr = 11, c inscr = 12, + c dezimal = 13, c esc = 14, + c backcr = 15; + + ""1""2""3""8""9""10""11""12""13""16""17""18""19""27""20"" . + +dezimalen schreiben : IF write access THEN dezimaleditor (satz) FI . + +zurueck zur umbruchstelle: + IF umbruch stelle > 0 THEN stelle := umbruch stelle FI; + IF verschoben <> umbruch verschoben + THEN verschoben := umbruch verschoben; output mode := out feld + FI . + +hop kommandos behandeln : + TEXT VAR zweites zeichen; getchar (zweites zeichen); + zeichen CAT zweites zeichen; + SELECT pos (hop kommandos, zweites zeichen) OF + CASE h hop : nach links oben + CASE h right : nach rechts blaettern + CASE h left : nach links blaettern + CASE h tab : tab position definieren oder loeschen + CASE h rubin : zeile splitten + CASE h rubout : loeschen oder rekombinieren + CASE h cr, h up, h down : feldeditor verlassen + OTHERWISE : zeichen ignorieren + END SELECT . + +hop kommandos : + LET h hop = 1, h right = 2, + h up = 3, h left = 4, + h tab = 5, h down = 6, + h rubin = 7, h rubout = 8, + h cr = 9; + + ""1""2""3""8""9""10""11""12""13"" . + +nach links oben : + stelle := max (marke, anfang) + verschoben; feldeditor verlassen . + +nach rechts blaettern : + INT CONST rechter rand := stelle am ende - markierausgleich; + IF stelle ist am rechten rand + THEN stelle INCR laenge - 2 * markierausgleich + ausgleich fuer doppelzeichen + ELSE stelle := rechter rand + FI ; + IF satzlaenge <= limit THEN stelle := min (stelle, limit) FI; + alte einrueckposition mitziehen . + +stelle ist am rechten rand : + stelle auf erstem halbzeichen CAND stelle = rechter rand - 1 + COR stelle = rechter rand . + +ausgleich fuer doppelzeichen : stelle - rechter rand . + +nach links blaettern : + INT CONST linker rand := stelle am anfang; + IF stelle = linker rand + THEN stelle DECR laenge - 2 * markierausgleich + ELSE stelle := linker rand + FI ; + stelle := max (ganz links, stelle); + alte einrueckposition mitziehen . + +tab position definieren oder loeschen : + IF stelle > LENGTH tabulator + THEN tabulator AUFFUELLENMIT right; tabulator CAT dach + ELSE replace (tabulator, stelle, neues tab zeichen) + FI ; + feldeditor verlassen . + +neues tab zeichen : + IF (tabulator SUB stelle) = right THEN dach ELSE right FI . + +zeile splitten : + IF write access THEN feldeditor verlassen ELSE zeichen ignorieren FI . + +loeschen oder rekombinieren : + IF NOT write access + THEN zeichen ignorieren + ELIF hinter dem satz + THEN zeilen rekombinieren + ELIF auf erstem zeichen + THEN ganze zeile loeschen + ELSE zeilenrest loeschen + FI . + +zeilen rekombinieren : feldeditor verlassen . +auf erstem zeichen : stelle = 1 . +ganze zeile loeschen : satz := ""; feldeditor verlassen . + +zeilenrest loeschen : + change (satz, stelle, satzlaenge, ""); + output mode := clear feldrest . + +esc kommandos behandeln : + getchar (zweites zeichen); + zeichen CAT zweites zeichen; + auf exit pruefen; + SELECT pos (esc kommandos, zweites zeichen) OF + CASE e hop : lernmodus umschalten + CASE e right : zum naechsten wort + CASE e left : zum vorigen wort + OTHERWISE : belegte taste ausfuehren + END SELECT . + +auf exit pruefen : + IF pos (res, zweites zeichen) > 0 THEN feldeditor verlassen FI . + +esc kommandos : + LET e hop = 1, + e right = 2, + e left = 3; + + ""1""2""8"" . + +lernmodus umschalten : + IF lernmodus THEN lernmodus ausschalten ELSE lernmodus einschalten FI; + feldeditor verlassen . + +lernmodus ausschalten : + lernmodus := FALSE; + belegbare taste erfragen; + audit := subtext (audit, 1, LENGTH audit - 2); + IF taste = hop + THEN (* lernsequenz nicht auf taste legen *) (* 16.08.85 -ws- *) + ELSE lernsequenz auf taste legen (taste, audit) + FI ; + audit := "" . + +belegbare taste erfragen : + TEXT VAR taste; getchar (taste); + WHILE taste ist reserviert REP + benutzer warnen; getchar (taste) + PER . + +taste ist reserviert : (* 16.08.85 -ws- *) + taste <> hop CAND pos (reservierte feldeditor tasten, taste) > 0 . + +lernmodus einschalten : audit := ""; lernmodus := TRUE . + +zum vorigen wort : + IF stelle > 1 + THEN stelle DECR 1; stelle := letzter wortanfang (satz); + alte einrueckposition mitziehen; + IF (satz SUB stelle) <> blank THEN LEAVE zum vorigen wort FI + FI ; + feldeditor verlassen . + +zum naechsten wort : + IF kein naechstes wort THEN feldeditor verlassen FI . + +kein naechstes wort : + BOOL VAR im alten wort := TRUE; + INT VAR i; + FOR i FROM stelle UPTO satzlaenge REP + IF im alten wort + THEN im alten wort := (satz SUB i) <> blank + ELIF (satz SUB i) <> blank + THEN stelle := i; LEAVE kein naechstes wort WITH FALSE + FI + PER; + TRUE . + +belegte taste ausfuehren : + IF ist kommando taste + THEN feldeditor verlassen + ELSE gelerntes ausfuehren + FI . + +ist kommando taste : taste enthaelt kommando (zweites zeichen) . + +gelerntes ausfuehren : + push (lernsequenz auf taste (zweites zeichen)) . (*sh*) + +nach rechts oder ueberlauf : + IF fliesstext COR stelle < limit OR satzlaenge > limit + THEN nach rechts + ELSE auf anfang der naechsten zeile + FI . + +nach rechts : + IF stelle auf erstem halbzeichen THEN stelle INCR 2 ELSE stelle INCR 1 FI; + alte einrueckposition mitziehen . + +auf anfang der naechsten zeile : push (abscr) . + +nach links : stelle DECR 1; alte einrueckposition mitziehen . + +alte einrueckposition mitziehen : + IF satz ist leerzeile + THEN alte einrueckposition := stelle + ELSE alte einrueckposition := min (stelle, einrueckposition (satz)) + FI . + +satz ist leerzeile : + satz = "" OR satz = blank . + +wenn moeglich ein schritt nach links : + IF stelle = ganz links + THEN zeichen ignorieren + ELSE nach links + FI . + +zur naechsten tabulator position : + bestimme naechste explizite tabulator position; + IF tabulator gefunden + THEN explizit tabulieren + ELIF stelle <= satzlaenge + THEN implizit tabulieren + ELSE auf anfang der naechsten zeile + FI . + +bestimme naechste explizite tabulator position : + INT VAR tab position := pos (tabulator, dach, stelle + 1); + IF tab position > limit AND satzlaenge <= limit + THEN tab position := 0 + FI . + +tabulator gefunden : tab position <> 0 . + +explizit tabulieren : stelle := tab position; push (dezimal) . + +implizit tabulieren : + tab position := einrueckposition (satz); + IF stelle < tab position + THEN stelle := tab position + ELSE stelle := satzlaenge + 1 + FI . + +einfuegen umschalten : + IF NOT write access THEN zeichen ignorieren FI; (*sh*) + einfuegen := NOT einfuegen; + IF einfuegen THEN einfuegen optisch anzeigen FI; + feldeditor verlassen . + +einfuegen optisch anzeigen : + IF markiert + THEN out (begin mark); markleft; out (dach left); warten; + out (end mark); markleft + ELSE out (dach left); warten; + IF stelle auf erstem halbzeichen + THEN out text (satz, stelle, stelle + 1) + ELSE out text (satz, stelle, stelle) + FI + FI . + +markiert : marke > 0 . +dach left : ""94""8"" . + +warten : + TEXT VAR t := incharety (2); + kommando CAT t; IF lernmodus THEN audit CAT t FI . + +ein zeichen loeschen : + IF NOT write access THEN zeichen ignorieren FI; (*sh*) + IF zeichen davor soll geloescht werden + THEN nach links oder ignorieren + FI ; + IF NOT hinter dem satz THEN aktuelles zeichen loeschen FI . + +zeichen davor soll geloescht werden : + hinter dem satz COR markiert . + +nach links oder ignorieren : + IF stelle > ganz links + THEN nach links (*sh*) + ELSE zeichen ignorieren + FI . + +aktuelles zeichen loeschen : + stelle korrigieren; alte stelle merken; + IF stelle auf erstem halbzeichen + THEN delete char (satz, stelle); + postblanks INCR 1 + FI ; + delete char (satz, stelle); + postblanks INCR 1; + neue satzlaenge bestimmen; + output mode := out feldrest . + +eine zeile nach oben : (*sh*) + IF NOT absatzmarke steht CAND NOT ist teil eines umbruchkommandos + THEN blanks abschneiden + FI ; + push (zeichen); LEAVE feld editieren . + +ist teil eines umbruchkommandos : (kommando SUB kommandozeiger) = backcr . + +ggf absatz erzeugen : (*sh*) + IF write access + THEN IF NOT absatzmarke steht THEN blanks abschneiden FI; + IF stelle > LENGTH satz AND fliesstext AND NOT absatzmarke steht + THEN satz CAT blank + FI + FI ; push (zeichen); LEAVE feld editieren . + +markieren umschalten : + IF markiert + THEN marke := 0; maxschreibpos INCR marklength; cpos DECR marklength + ELSE marke := stelle; maxschreibpos DECR marklength; cpos INCR marklength; + verschieben wenn erforderlich + FI ; + feldeditor verlassen . + +sondertaste behandeln : push (esc + zeichen) . +END PROC feldeditor; + +PROC dezimaleditor (TEXT VAR satz) : + INT VAR dezimalanfang := stelle; + zeichen einlesen; + IF dezimalstartzeichen CAND ueberschreibbar THEN dezimalen schreiben FI; + push (zeichen) . + +zeichen einlesen : TEXT VAR zeichen; getchar (zeichen) . +dezimalzeichen : pos (dezimalen, zeichen) > 0 AND nicht separator . +dezimalstartzeichen : pos (startdezimalen, zeichen) > 0 AND nicht separator . +dezimalen : "0123456789" . +startdezimalen : "+-0123456789" . +nicht separator : pos (separator, zeichen) = 0 . + +ueberschreibbar : + dezimalanfang > LENGTH satz OR + pos (ueberschreibbare zeichen, satz SUB dezimalanfang) > 0 . + +ueberschreibbare zeichen : " ,.+-0123456789" . + +dezimalen schreiben : + REP + dezimale in satz eintragen; + dezimalen zeigen; + zeichen einlesen; + dezimalanfang DECR 1 + UNTIL dezimaleditor beendet PER; + stelle INCR 1 . + +dezimale in satz eintragen : + IF dezimalanfang > LENGTH satz + THEN satz AUFFUELLENMIT blank; satz CAT zeichen + ELSE delete char (satz, dezimalanfang); insert char (satz, zeichen, stelle) + FI . + +dezimalen zeigen : + INT VAR min dezimalschreibpos := max (min schreibpos, dezimalanfang); + IF markiert THEN markiert zeigen ELSE unmarkiert zeigen FI; + schreibmarke positionieren (stelle) . + +markiert : marke > 0 . + +markiert zeigen : + invers out (satz, min dezimalschreibpos, stelle, "", end mark); + out (zeichen) . + +unmarkiert zeigen : + schreibmarke positionieren (min dezimalschreibpos); + out subtext (satz, min dezimalschreibpos, stelle) . + +dezimaleditor beendet : + NOT dezimalzeichen OR + dezimalanfang < max (min schreibpos, marke) OR + NOT ueberschreibbar . +END PROC dezimaleditor; + +BOOL PROC is editget : + editget modus +END PROC is editget ; + +PROC get editline (TEXT VAR editline, INT VAR editpos, editmarke) : + IF editget modus + THEN editline := alter editsatz; + editpos := stelle + FI ; + editmarke := marke +END PROC get editline; + +PROC put editline (TEXT CONST editline, INT CONST editpos, editmarke) : + IF editget modus + THEN alter editsatz := editline; + stelle := max (editpos, 1); + marke := max (editmarke, 0) + FI +END PROC put editline; + +BOOL PROC within kanji (TEXT CONST satz, INT CONST stelle) : + count directly prefixing kanji esc bytes; + number of kanji esc bytes is odd . + +count directly prefixing kanji esc bytes : + INT VAR pos := stelle - 1, kanji esc bytes := 0; + WHILE pos > 0 CAND is kanji esc (satz SUB pos) REP + kanji esc bytes INCR 1; pos DECR 1 + PER . + +number of kanji esc bytes is odd : + (kanji esc bytes AND 1) <> 0 . +END PROC within kanji; + +BOOL PROC is kanji esc (TEXT CONST char) : (*sh*) + two byte mode CAND + (char >= ""129"" AND char <= ""159"" OR char >= ""224"" AND char <= ""239"") +END PROC is kanji esc; + +BOOL PROC two bytes : two byte mode END PROC two bytes; + +PROC two bytes (BOOL CONST new mode) : + two byte mode := new mode +END PROC two bytes; + +PROC outtext (TEXT CONST source, INT CONST from, to) : + out subtext mit randbehandlung (source, from, to); + INT VAR trailing; + IF from <= LENGTH source + THEN trailing := to - LENGTH source + ELSE trailing := to - from + 1 + FI ; trailing TIMESOUT blank +END PROC outtext; + +PROC out subtext mit randbehandlung (TEXT CONST satz, INT CONST von, bis) : + IF von > bis + THEN + ELIF bis >= LENGTH satz COR NOT within kanji (satz, bis + 1) + THEN out subtext mit anfangsbehandlung (satz, von, bis) + ELSE out subtext mit anfangsbehandlung (satz, von, bis - 1); out (blank) + FI +END PROC out subtext mit randbehandlung; + +PROC out subtext mit anfangsbehandlung (TEXT CONST satz, INT CONST von, bis) : + IF von > bis + THEN + ELIF von = 1 COR NOT within kanji (satz, von) + THEN out subtext (satz, von, bis) + ELSE out (blank); out subtext (satz, von + 1, bis) + FI +END PROC out subtext mit anfangsbehandlung; + +PROC get cursor : get cursor (spalte, zeile) END PROC get cursor; + +INT PROC x cursor : get cursor; spalte END PROC x cursor; + +BOOL PROC write permission : write access END PROC write permission; + +PROC push (TEXT CONST ausfuehrkommando) : + IF ausfuehrkommando = "" (*sh*) + THEN + ELIF kommando = "" + THEN kommando := ausfuehrkommando + ELIF (kommando SUB kommando zeiger - 1) = ausfuehrkommando + THEN kommando zeiger DECR 1 + ELIF replace moeglich + THEN kommando zeiger DECR laenge des ausfuehrkommandos; + replace (kommando, kommando zeiger, ausfuehrkommando) + ELSE insert char (kommando, ausfuehrkommando, kommando zeiger) + FI . + +replace moeglich : + INT CONST laenge des ausfuehrkommandos := LENGTH ausfuehrkommando; + kommando zeiger > laenge des ausfuehrkommandos . +END PROC push; + +PROC type (TEXT CONST ausfuehrkommando) : + kommando CAT ausfuehrkommando +END PROC type; + +INT PROC stelle am anfang : anfang + verschoben END PROC stelle am anfang; + +INT PROC stelle am ende : stelle am anfang+laenge-1 END PROC stelle am ende; + +INT PROC markierausgleich : SIGN marke * marklength END PROC markierausgleich; + +PROC verschieben wenn erforderlich : + IF stelle > max schreibpos + THEN verschiebe (stelle - max schreibpos) + ELIF stelle < min schreibpos + THEN verschiebe (stelle - min schreibpos) + FI +END PROC verschieben wenn erforderlich; + +PROC verschiebe (INT CONST i) : + verschoben INCR i; + min schreibpos INCR i; + max schreibpos INCR i; + cpos DECR i; + output mode := out feld; + schreibmarke positionieren (stelle) (* 11.05.85 -ws- *) +END PROC verschiebe; + +PROC konstanten neu berechnen : + min schreibpos := anfang + verschoben; + IF min schreibpos < 0 (* 17.05.85 -ws- *) + THEN min schreibpos DECR verschoben; verschoben := 0 + FI ; + max schreibpos := min schreibpos + laenge - 1 - markierausgleich; + cpos := rand + laenge - max schreibpos +END PROC konstanten neu berechnen; + +PROC schreibmarke positionieren (INT CONST sstelle) : + cursor (cpos + sstelle, zeile) +END PROC schreibmarke positionieren; + +PROC simple feldout (TEXT CONST satz, INT CONST dummy) : + (* PRECONDITION : NOT markiert AND verschoben = 0 *) + (* AND feldrest schon geloescht *) + schreibmarke an feldanfang positionieren; + out subtext mit randbehandlung (satz, anfang, anfang + laenge - 1); + IF (satz SUB LENGTH satz) = blank THEN absatzmarke schreiben (TRUE) FI . + +schreibmarke an feldanfang positionieren : cursor (rand + 1, zeile) . +END PROC simple feldout; + +PROC feldout (TEXT CONST satz, INT CONST sstelle) : + schreibmarke an feldanfang positionieren; + feld ausgeben; + feldrest loeschen; + IF (satz SUB LENGTH satz) = blank THEN absatzmarke schreiben (TRUE) FI . + +schreibmarke an feldanfang positionieren : cursor (rand + 1, zeile) . + +feld ausgeben : + INT VAR von := anfang + verschoben, bis := von + laenge - 1; + IF nicht markiert + THEN unmarkiert ausgeben + ELIF markiertes nicht sichtbar + THEN unmarkiert ausgeben + ELSE markiert ausgeben + FI . + +nicht markiert : marke <= 0 . + +markiertes nicht sichtbar : + bis DECR marklength * (1 + SIGN sstelle); marke > bis + 1 . + +unmarkiert ausgeben : + out subtext mit randbehandlung (satz, von, bis) . + +markiert ausgeben : + INT VAR smarke := max (von, marke); + out text (satz, von, smarke - 1); out (begin mark); + verschiedene feldout modes behandeln . + +verschiedene feldout modes behandeln : + IF sstelle = 0 + THEN out subtext mit randbehandlung (satz, smarke, bis); out (end mark) + ELSE out text (satz, smarke, zeilenrand); out (end mark); (*sh*) + out subtext mit randbehandlung (satz, sstelle, bis) + FI . + +zeilenrand : min (bis, sstelle - 1) . +END PROC feldout; + +PROC absatzmarke schreiben (BOOL CONST schreiben) : + IF fliesstext AND nicht markiert + THEN cursor (rand + 1 + laenge, zeile); + out (absatzmarke) ; + absatzmarke steht := TRUE + FI . + +nicht markiert : marke <= 0 . + +absatzmarke : + IF NOT schreiben + THEN " " + ELIF marklength > 0 + THEN ""15""14"" + ELSE ""15" "14" " + FI . +END PROC absatzmarke schreiben; + +PROC invers out (TEXT CONST satz, INT CONST von, bis, TEXT CONST pre, post) : + IF mark refresh line mode + THEN feldout (satz, stelle) + ELSE schreibmarke positionieren (von); + out (begin mark); markleft; out (pre); + out text (satz, von, bis - 1); out (post) + FI . + +markleft : + marklength TIMESOUT left . + +END PROC invers out; + +PROC feldrest loeschen : + IF rand + laenge < maxbreite COR invertierte darstellung + THEN INT VAR x; get cursor (x, zeile); + (rand + laenge - x + 1 + absatz ausgleich) TIMESOUT blank; (*sh*) + cursor (x, zeile) + ELSE out (clear eol); absatzmarke steht := FALSE + FI +END PROC feldrest loeschen; + +OP AUFFUELLENMIT (TEXT VAR satz, TEXT CONST fuellzeichen) : + INT VAR i; + FOR i FROM stelle - LENGTH satz DOWNTO 2 REP + satz CAT fuellzeichen + PER +END OP AUFFUELLENMIT; + +INT PROC einrueckposition (TEXT CONST satz) : (*sh*) + IF fliesstext AND satz = blank + THEN anfang + ELSE max (pos (satz, ""33"", ""254"", 1), 1) + FI +END PROC einrueckposition; + +INT PROC letzter wortanfang (TEXT CONST satz) : (*sh*) + INT CONST ganz links := max (1, marke); + BOOL VAR noch nicht im neuen wort := TRUE; + INT VAR i; + FOR i FROM stelle DOWNTO ganz links REP + IF noch nicht im neuen wort + THEN noch nicht im neuen wort := char = blank + ELIF is kanji esc (char) + THEN LEAVE letzter wortanfang WITH i + ELIF nicht mehr im neuen wort + THEN LEAVE letzter wortanfang WITH i + 1 + FI + PER ; + ganz links . + +char : satz SUB i . + +nicht mehr im neuen wort : char = blank COR within kanji (satz, i) . +END PROC letzter wortanfang; + +PROC getchar (TEXT VAR zeichen) : + IF kommando = "" + THEN inchar (zeichen); IF lernmodus THEN audit CAT zeichen FI + ELSE zeichen := kommando SUB kommando zeiger; + kommando zeiger INCR 1; + IF kommando zeiger > LENGTH kommando + THEN kommando zeiger := 1; kommando := "" + FI ; + IF LENGTH kommando - kommando zeiger < 3 + THEN kommando CAT inchety + FI + FI . +END PROC getchar; + +TEXT PROC inchety : + IF lernmodus + THEN TEXT VAR t := incharety; audit CAT t; t + ELSE incharety + FI +END PROC inchety; + +BOOL PROC is incharety (TEXT CONST muster) : + IF kommando = "" + THEN TEXT CONST t := inchety; + IF t = muster THEN TRUE ELSE kommando := t; FALSE FI + ELIF (kommando SUB kommando zeiger) = muster + THEN kommando zeiger INCR 1; + IF kommando zeiger > LENGTH kommando + THEN kommando zeiger := 1; kommando := "" + FI ; + TRUE + ELSE FALSE + FI +END PROC is incharety; + +TEXT PROC getcharety : + IF kommando = "" + THEN inchety + ELSE TEXT CONST t := kommando SUB kommando zeiger; + kommando zeiger INCR 1; + IF kommando zeiger > LENGTH kommando + THEN kommando zeiger := 1; kommando := "" + FI ; t + FI +END PROC getcharety; + +PROC get editcursor (INT VAR x, y) : (*sh*) + IF actual editor > 0 THEN aktualisiere bildparameter FI; + x := rand - (anfang + verschoben - 1 - markierausgleich) + stelle; + y := zeile . + + aktualisiere bildparameter : + INT VAR old x, old y; get cursor (old x, old y); + dateizustand holen; bildausgabe steuern; satznr zeigen; + fenster zeigen; zeile := bildrand + zeilennr; cursor (old x, old y) . +END PROC get editcursor; + +(************************* Zugriff auf Feldstatus *************************). + +stelle : feldstatus.stelle . +alte stelle : feldstatus.alte stelle . +rand : feldstatus.rand . +limit : feldstatus.limit . +anfang : feldstatus.anfang . +marke : feldstatus.marke . +laenge : feldstatus.laenge . +verschoben : feldstatus.verschoben . +einfuegen : feldstatus.einfuegen . +fliesstext : feldstatus.fliesstext . +write access : feldstatus.write access . +tabulator : feldstatus.tabulator . + +(***************************************************************************) + +LET undefinierter bereich = 0, nix = 1, + bildzeile = 2, akt satznr = 2, + abschnitt = 3, ueberschrift = 3, + bild = 4, fehlermeldung = 4; + +LET BILDSTATUS = STRUCT (INT feldlaenge, kurze feldlaenge, + bildrand, bildlaenge, kurze bildlaenge, + ueberschriftbereich, bildbereich, + erster neusatz, letzter neusatz, + old zeilennr, old lineno, old mark lineno, + BOOL zeileneinfuegen, old line update, + TEXT satznr pre, ueberschrift pre, + ueberschrift text, ueberschrift post, old satz, + FRANGE old range, + FILE file), + EDITSTATUS = STRUCT (FELDSTATUS feldstatus, BILDSTATUS bildstatus), + max editor = 10, + EDITSTACK = ROW max editor EDITSTATUS; + +BILDSTATUS VAR bildstatus ; +EDITSTACK VAR editstack; + +ROW max editor INT VAR einrueckstack; + +BOOL VAR markiert; +TEXT VAR filename, tab, bildsatz, bildzeichen, fehlertext, + akt bildsatz ; +INT VAR zeilennr, satznr, bildanfang, bildmarke, feldmarke, + actual editor := 0, max used editor := 0, + letzer editor auf dieser datei, + alte einrueckposition := 1; + +INT PROC aktueller editor : actual editor END PROC aktueller editor; + +INT PROC groesster editor : max used editor END PROC groesster editor; + +(****************************** bildeditor *******************************) + +PROC bildeditor (TEXT CONST res, PROC (TEXT CONST) kommando interpreter) : + evtl fehler behandeln; + enable stop; + TEXT VAR reservierte tasten := ""11""12""27"bf" ; + reservierte tasten CAT res ; + INT CONST my highest editor := max used editor; + laenge := feldlaenge; + konstanten neu berechnen; + REP + markierung justieren; + altes feld nachbereiten; + feldlaenge einstellen; + ueberschrift zeigen; + fenster zeigen ; + zeile bereitstellen; + zeile editieren; + kommando ausfuehren + PER . + +evtl fehler behandeln : + IF is error + THEN fehlertext := errormessage; + IF fehlertext <> "" THEN neu (fehlermeldung, nix) FI; + clear error + ELSE fehlertext := "" + FI . + +markierung justieren : + IF bildmarke > 0 + THEN IF satznr <= bildmarke + THEN bildmarke := satznr; + stelle := max (stelle, feldmarke); + marke := feldmarke + ELSE marke := 1 + FI + FI . + +zeile bereitstellen : IF hinter letztem satz THEN insert record (file) FI . +hinter letztem satz : lineno (file) > lines (file) . + +altes feld nachbereiten : + IF old line update AND lineno (file) <> old lineno + THEN IF verschoben <> 0 + THEN verschoben := 0; konstanten neu berechnen; + FI ; + INT CONST alte zeilennr := old lineno - bildanfang + 1; + IF alte zeilennr > 0 AND alte zeilennr <= aktuelle bildlaenge + THEN INT CONST m := marke; + IF lineno (file) < old lineno + THEN marke := 0 + ELIF old lineno = bildmarke + THEN marke := min (feldmarke, LENGTH old satz + 1) + ELSE marke := min (marke, LENGTH old satz + 1) + FI ; + zeile := bildrand + alte zeilennr; + feldout (old satz, 0); marke := m + FI + FI ; + old line update := FALSE; old satz := "" . + +feldlaenge einstellen : + INT CONST alte laenge := laenge; + IF zeilennr > kurze bildlaenge + THEN laenge := kurze feldlaenge + ELSE laenge := feldlaenge + FI ; + IF laenge <> alte laenge + THEN konstanten neu berechnen + FI . + +zeile editieren : + zeile := bildrand + zeilennr; + exec (PROC (TEXT VAR, TEXT CONST) feldeditor, file, reservierte tasten); + old lineno := satznr; + IF markiert oder verschoben + THEN old line update := TRUE; read record (file, old satz) + FI . + +markiert oder verschoben : markiert COR verschoben <> 0 . + +kommando ausfuehren : + getchar (bildzeichen); + SELECT pos (kommandos, bildzeichen) OF + CASE x hop : hop kommando verarbeiten + CASE x esc : esc kommando verarbeiten + CASE x up : zum vorigen satz + CASE x down : zum folgenden satz + CASE x rubin : zeicheneinfuegen umschalten + CASE x mark : markierung umschalten + CASE x cr : eingerueckt mit cr (* 08.06.85 -ws- *) + CASE x inscr : eingerueckt zum folgenden satz + CASE x abscr : zum anfang des folgenden satzes + END SELECT . + +kommandos : + LET x hop = 1, x up = 2, + x down = 3, x rubin = 4, + x cr = 5, x mark = 6, + x abscr = 7, x inscr = 8, + x esc = 9; + + ""1""3""10""11""13""16""17""18""27"" . + +zeicheneinfuegen umschalten : + rubin segment in ueberschrift eintragen; + neu (ueberschrift, nix) . + +rubin segment in ueberschrift eintragen : + replace (ueberschrift text, 9, rubin segment) . + +rubin segment : + IF einfuegen THEN "RUBIN" ELSE "....." FI . + +hop kommando verarbeiten : + getchar (bildzeichen); + read record (file, bildsatz); + SELECT pos (hop kommandos, bildzeichen) OF + CASE y hop : nach oben + CASE y cr : neue seite + CASE y up : zurueckblaettern + CASE y down : weiterblaettern + CASE y tab : put tabs (file, tabulator); neu (ueberschrift, nix) + CASE y rubout : zeile loeschen + CASE y rubin : zeileneinfuegen umschalten + END SELECT . + +hop kommandos : + LET y hop = 1, y up = 2, + y tab = 3, y down = 4, + y rubin = 5, y rubout = 6, + y cr = 7; + + ""1""3""9""10""11""12""13"" . + +zeileneinfuegen umschalten : + zeileneinfuegen := NOT zeileneinfuegen; + IF zeileneinfuegen + THEN zeile aufspalten; logisches eof setzen + ELSE leere zeile am ende loeschen; logisches eof loeschen + FI ; restbild zeigen . + +zeile aufspalten : + IF stelle <= LENGTH bildsatz OR stelle = 1 + THEN loesche ggf trennende blanks und spalte zeile + FI . + +loesche ggf trennende blanks und spalte zeile: (* 26.06.84 -bk- *) + INT VAR first non blank pos := stelle; + WHILE first non blank pos <= length (bildsatz) CAND + (bildsatz SUB first non blank pos) = blank REP + first non blank pos INCR 1 + PER ; + split line and indentation; (*sh*) + first non blank pos := stelle - 1; + WHILE first non blank pos >= 1 CAND + (bildsatz SUB first non blank pos) = blank REP + first non blank pos DECR 1 + PER; + bildsatz := subtext (bildsatz, 1, first non blank pos); + write record (file, bildsatz) . + +split line and indentation : + split line (file, first non blank pos, TRUE) . + +logisches eof setzen : + down (file); col (file, 1); + set range (file, 1, 1, old range); up (file) . + +leere zeile am ende loeschen : + to line (file, lines (file)); + IF len (file) = 0 THEN delete record (file) FI; + to line (file, satznr) . + +logisches eof loeschen : + col (file, stelle); set range (file, old range) . + +restbild zeigen : + erster neusatz := satznr; + letzter neusatz := bildanfang + bildlaenge - 1; + rest segment in ueberschrift eintragen; + neu (ueberschrift, abschnitt) . + +rest segment in ueberschrift eintragen : + replace (ueberschrift text, feldlaenge - 25, rest segment) . + +rest segment : + IF zeileneinfuegen THEN "REST" ELSE "...." FI . + +esc kommando verarbeiten : + getchar (bildzeichen); + eventuell zeichen zurueckweisen; (* 04.05.85 -ws- *) + IF taste ist reserviert + THEN belegte taste ausfuehren + ELSE fest vordefinierte esc funktion + FI ; ende nach quit . + +eventuell zeichen zurueckweisen : (* 04.05.85 -ws- *) + IF NOT write access CAND NOT erlaubte taste + THEN benutzer warnen; LEAVE kommando ausfuehren + FI . + +erlaubte taste : pos (zulaessige zeichen, bildzeichen) > 0 . +zulaessige zeichen : res + ""1""2""8""27"bfq" . +benutzer warnen : out (piep) . + +ende nach quit : + IF max used editor < my highest editor THEN LEAVE bildeditor FI . + +taste ist reserviert : pos (res, bildzeichen) > 0 . + +fest vordefinierte esc funktion : + read record (file, bildsatz); + SELECT pos (esc kommandos, bildzeichen) OF + CASE z hop : lernmodus umschalten + CASE z esc : kommandodialog versuchen + CASE z left : zum vorigen wort + CASE z right : zum naechsten wort + CASE z b : bild an aktuelle zeile angleichen + CASE z f : belegte taste ausfuehren + CASE z rubout : markiertes vorsichtig loeschen + CASE z rubin : vorsichtig geloeschtes einfuegen + OTHERWISE : belegte taste ausfuehren + END SELECT . + +esc kommandos : + LET z hop = 1, z right = 2, + z left = 3, z rubin = 4, + z rubout = 5, z esc = 6, + z b = 7, z f = 8; + + ""1""2""8""11""12""27"bf" . + +zum vorigen wort : + IF vorgaenger erlaubt + THEN vorgaenger; read record (file, bildsatz); + stelle := LENGTH bildsatz + 1; push (esc + left) + FI . + +vorgaenger erlaubt : + satznr > max (1, bildmarke) . + +zum naechsten wort : + IF nicht auf letztem satz THEN weitersuchen wenn nicht gefunden FI . + +nicht auf letztem satz : line no (file) < lines (file) . + +weitersuchen wenn nicht gefunden : + nachfolgenden satz holen; + IF (nachfolgender satz SUB anfang) = blank + THEN push (abscr + esc + right) + ELSE push (abscr) + FI . + +nachfolgenden satz holen : + down (file); read record (file, nachfolgender satz); up (file) . + +bild an aktuelle zeile angleichen : + anfang INCR verschoben; verschoben := 0; + margin segment in ueberschrift eintragen; + neu (ueberschrift, bild) . + +margin segment in ueberschrift eintragen : + replace (ueberschrift text, 2, margin segment) . + +margin segment : + IF anfang <= 1 + THEN "......" + ELSE TEXT VAR margin text := "M" + text (anfang); + (6 - LENGTH margin text) * "." + margin text + FI . + +belegte taste ausfuehren : + kommando analysieren (bildzeichen, PROC(TEXT CONST) kommando interpreter) . + +kommandodialog versuchen: + IF fenster ist zu schmal fuer dialog + THEN kommandodialog ablehnen + ELSE kommandodialog fuehren + FI . + +fenster ist zu schmal fuer dialog : laenge < 20 . + +kommandodialog ablehnen : + fehlertext := "zu schmal fuer ESC ESC"; neu (fehlermeldung, nix) . + +kommandodialog fuehren: + INT VAR x0, x1, x2, x3, y; + get cursor (x0, y); + cursor (rand + 1, bildrand + zeilennr); + get cursor (x1, y); + out (begin mark); out (monitor meldung); + get cursor (x2, y); + (laenge - LENGTH monitor meldung - marklength) TIMESOUT blank; + get cursor (x3, y); + out (end mark); out (blank); + kommandozeile editieren; + ueberschrift zeigen; + absatz ausgleich := 2; (*sh*) + IF kommandotext = "" THEN LEAVE kommandodialog fuehren FI; + kommando auf taste legen ("f", kommandotext); + kommando analysieren ("f", PROC(TEXT CONST) kommando interpreter); + IF fehlertext <> "" + THEN push (esc + esc + esc + "k") + ELIF markiert + THEN zeile neu + FI . + +kommandozeile editieren : + TEXT VAR kommandotext := ""; + cursor (x1, y); out (begin mark); + disable stop; + darstellung invertieren; + editget schleife; + darstellung invertieren; + enable stop; + cursor (x3, y); out (end mark); + exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle); + cursor (x0, y) . + +darstellung invertieren : + TEXT VAR dummy := begin mark; begin mark := end mark; end mark := dummy; + invertierte darstellung := NOT invertierte darstellung . + +editget schleife : + TEXT VAR exit char; + REP + cursor (x2, y); + editget (kommandotext, max textlength, rand + laenge - x cursor, + "", "k?!", exit char); + neu (ueberschrift, nix); + IF exit char = ""27"k" + THEN kommando text := kommando auf taste ("f") + ELIF exit char = ""27"?" + THEN TEXT VAR taste; getchar (taste); + kommando text := kommando auf taste (taste) + ELIF exit char = ""27"!" + THEN getchar (taste); + IF ist reservierte taste + THEN set busy indicator; (*sh*) + out ("FEHLER: """ + taste + """ ist reserviert"7"") + ELSE kommando auf taste legen (taste, kommandotext); + kommandotext := ""; LEAVE editget schleife + FI + ELSE LEAVE editget schleife + FI + PER . + +ist reservierte taste : pos (res, taste) > 0 . +monitor meldung : "gib kommando : " . + +neue seite : bildanfang := satznr; zeilennr := 1; neu (akt satznr, bild) . + +weiterblaettern : + INT CONST akt bildlaenge := aktuelle bildlaenge; + IF nicht auf letztem satz + THEN erster neusatz := satznr; + IF zeilennr >= akt bildlaenge + THEN bildanfang INCR akt bildlaenge; neu (akt satznr, bild) + FI ; + satznr := min (lines (file), bildanfang + akt bildlaenge - 1); + letzter neusatz := satznr; + toline (file, satznr); + stelle DECR verschoben; + neu (akt satznr, nix); + zeilennr := satznr - bildanfang + 1; + IF markiert THEN neu (nix, abschnitt) FI; + einrueckposition bestimmen + FI . + +zurueckblaettern : + IF vorgaenger erlaubt + THEN IF zeilennr <= 1 + THEN bildanfang := max (1, bildanfang - aktuelle bildlaenge); + neu (akt satznr, bild) + FI ; + nach oben; einrueckposition bestimmen + FI . + +zeile loeschen : + IF stelle = 1 + THEN delete record (file); + erster neusatz := satznr; + letzter neusatz := bildanfang + bildlaenge - 1; + neu (nix, abschnitt) + ELSE zeilen rekombinieren + FI . + +zeilen rekombinieren : + IF nicht auf letztem satz + THEN aktuellen satz mit blanks auffuellen; + delete record (file); + nachfolgenden satz lesen; + bildsatz CAT nachfolgender satz ohne fuehrende blanks; + write record (file, bildsatz); + erster neusatz := satznr; + letzter neusatz := bildanfang + bildlaenge - 1; + neu (nix, abschnitt) + FI . + +aktuellen satz mit blanks auffuellen : + bildsatz AUFFUELLENMIT blank . + +nachfolgenden satz lesen : + TEXT VAR nachfolgender satz; + read record (file, nachfolgender satz) . + +nachfolgender satz ohne fuehrende blanks : + satzrest := subtext (nachfolgender satz, + einrueckposition (nachfolgender satz)); satzrest . + +zeile aufsplitten : + nachfolgender satz := ""; + INT VAR i; + FOR i FROM 2 UPTO min (stelle, einrueckposition (bildsatz)) REP + nachfolgender satz CAT blank + PER; + satzrest := subtext (bildsatz, naechste non blank position); + nachfolgender satz CAT satzrest; + bildsatz := subtext (bildsatz, 1, stelle - 1); + write record (file, bildsatz); + down (file); insert record (file); + write record (file, nachfolgender satz); up (file) . + +naechste non blank position : + INT VAR non blank pos := stelle; + WHILE (bildsatz SUB non blank pos) = blank REP + non blank pos INCR 1 + PER; non blank pos . + +zum vorigen satz : + IF vorgaenger erlaubt THEN vorgaenger; einrueckposition bestimmen FI . + +zum folgenden satz : (* 12.09.85 -ws- *) + IF nachfolger erlaubt THEN nachfolger; einrueckposition bestimmen + ELSE col (file, len (file) + 1); neu (nix, nix) + FI . + +einrueckposition bestimmen : (* 27.08.85 -ws- *) + read record (file, akt bildsatz); + INT VAR neue einrueckposition := einrueckposition (akt bildsatz); + IF akt bildsatz ist leerzeile + THEN alte einrueckposition := max (stelle, neue einrueckposition) + ELSE alte einrueckposition := min (stelle, neue einrueckposition) + FI . + +akt bildsatz ist leerzeile : + akt bildsatz = "" OR akt bildsatz = blank . + +zum anfang des folgenden satzes : + IF nachfolger erlaubt THEN nachfolger; stelle := anfang FI . + +nachfolger erlaubt : + write access COR nicht auf letztem satz . + +eingerueckt mit cr : + IF NOT nachfolger erlaubt THEN LEAVE eingerueckt mit cr FI; (*sh*) + read record (file, bildsatz); + INT VAR epos := einrueckposition (bildsatz); + nachfolger; col (file, 1); + IF eof (file) + THEN IF LENGTH bildsatz <= epos + THEN stelle := alte einrueckposition + ELSE stelle := epos + FI + ELSE read record (file, bildsatz); + stelle := einrueckposition (bildsatz); + IF bildsatz ist leerzeile (* 29.08.85 -ws- *) + THEN stelle := alte einrueckposition; + aktuellen satz mit blanks auffuellen + FI + FI ; + alte einrueckposition := stelle . + +bildsatz ist leerzeile : + bildsatz = "" OR bildsatz = blank . + +eingerueckt zum folgenden satz : (*sh*) + IF NOT nachfolger erlaubt OR NOT write access + THEN LEAVE eingerueckt zum folgenden satz + FI; + alte einrueckposition merken; + naechsten satz holen; + neue einrueckposition bestimmen; + alte einrueckposition := stelle . + +alte einrueckposition merken : + read record (file, bildsatz); + epos := einrueckposition (bildsatz); + auf aufzaehlung pruefen; + IF epos > LENGTH bildsatz THEN epos := anfang FI. + +auf aufzaehlung pruefen : + BOOL CONST aufzaehlung gefunden := + ist aufzaehlung CAND vorher absatzzeile CAND wort folgt; + IF aufzaehlung gefunden THEN epos := anfang des naechsten wortes FI . + +ist aufzaehlung : + INT CONST wortende := pos (bildsatz, blank, epos, epos + 20) - 1; + SELECT pos ("-*).:" , bildsatz SUB wortende) OF + CASE 1,2 : wortende = epos + CASE 3,4 : wortende <= epos + 7 + CASE 5 : TRUE + OTHERWISE: FALSE + ENDSELECT . + +vorher absatzzeile : + IF satznr = 1 + THEN TRUE + ELSE up (file); + INT CONST vorige satzlaenge := len (file); + BOOL CONST vorher war absatzzeile := + subtext (file, vorige satzlaenge, vorige satzlaenge) = blank; + down (file); vorher war absatzzeile + FI . + +wort folgt : + INT CONST anfang des naechsten wortes := + pos (bildsatz, ""33"", ""254"", wortende + 1); + anfang des naechsten wortes > wortende . + +naechsten satz holen : + nachfolger; col (file, 1); + IF eof (file) + THEN bildsatz := "" + ELSE IF neue zeile einfuegen erforderlich + THEN insert record (file); bildsatz := ""; + letzter neusatz := bildanfang + bildlaenge - 1 + ELSE read record (file, bildsatz); + letzter neusatz := satznr; + ggf trennungen zurueckwandeln und umbruch indikator einfuegen + FI ; + erster neusatz := satznr; + neu (nix, abschnitt) + FI . + +neue zeile einfuegen erforderlich : + BOOL CONST war absatz := war absatzzeile; + war absatz COR neuer satz ist zu lang . + +war absatzzeile : + INT VAR wl := pos (kommando, up backcr, kommando zeiger); + wl = 0 COR (kommando SUB (wl - 1)) = blank . + +neuer satz ist zu lang : laenge des neuen satzes >= limit . + +laenge des neuen satzes : + IF len (file) > 0 + THEN len (file) + wl + ELSE wl + epos + FI . + +up backcr : ""3""20"" . + +ggf trennungen zurueckwandeln und umbruch indikator einfuegen : + LET trenn k = ""220"", + trenn strich = ""221""; + TEXT VAR umbruch indikator; + IF letztes zeichen ist trenn strich + THEN entferne trenn strich; + IF letztes zeichen = trenn k + THEN wandle trenn k um + FI ; + umbruch indikator := up backcr + ELIF letztes umgebrochenes zeichen ist kanji + THEN umbruch indikator := up backcr + ELSE umbruch indikator := blank + up backcr + FI ; + change (kommando, wl, wl+1, umbruch indikator) . + +letztes umgebrochenes zeichen ist kanji : within kanji (kommando, wl-1) . + +letztes zeichen ist trenn strich : + TEXT CONST last char := letztes zeichen; + last char = trenn strich COR + last char = "-" CAND wl > 2 CAND (kommando SUB (wl-2)) <> blank . + +letztes zeichen : kommando SUB (wl-1) . +entferne trenn strich : delete char (kommando, wl-1); wl DECR 1 . +wandle trenn k um : replace (kommando, wl-1, "c") . +loesche indikator : delete char (kommando, wl) . + +neue einrueckposition bestimmen : + IF aufzaehlung gefunden CAND bildsatz ist leerzeile + THEN stelle := epos + ELIF NOT bildsatz ist leerzeile + THEN stelle := einrueckposition (bildsatz) + ELIF war absatz COR auf letztem satz + THEN stelle := epos + ELSE down (file); read record (file, nachfolgender satz); + up (file); stelle := einrueckposition (nachfolgender satz) + FI ; + IF ist einfuegender aber nicht induzierter umbruch + THEN loesche indikator; + umbruchstelle := stelle + wl - kommando zeiger - anzahl der stz; + umbruchverschoben := 0 + FI . + +auf letztem satz : NOT nicht auf letztem satz . + +ist einfuegender aber nicht induzierter umbruch : + wl := pos (kommando, backcr, kommando zeiger); + wl > 0 CAND (kommando SUB (wl - 1)) <> up char . + +anzahl der stz : + TEXT CONST umgebrochener anfang := subtext (kommando, kommando zeiger, wl-1); + INT VAR anz := 0, anf := pos (umgebrochener anfang, ""1"", ""31"", 1); + WHILE anf > 0 REP + anz INCR 1; anf := pos (umgebrochener anfang, ""1"", ""31"", anf + 1) + PER; anz . + +markiertes vorsichtig loeschen : + IF write access CAND markiert + THEN clear removed (file); + IF nur im satz markiert + THEN behandle einen satz + ELSE behandle mehrere saetze + FI + FI . + +nur im satz markiert : line no (file) = bildmarke . + +behandle einen satz : + insert record (file); + satzrest := subtext (bildsatz, marke, stelle - 1); + write record (file, satzrest); + remove (file, 1); + change (bildsatz, marke, stelle - 1, ""); + stelle := marke; + marke := 0; bildmarke := 0; feldmarke := 0; + markiert := FALSE; mark (file, 0, 0); + konstanten neu berechnen; + IF bildsatz = "" + THEN delete record (file); + erster neusatz := satznr; + letzter neusatz := bildanfang + bildlaenge - 1; + neu (nix, abschnitt) + ELSE write record (file, bildsatz); + neu (nix, bildzeile) + FI . + +behandle mehrere saetze : + erster neusatz := bildmarke; + letzter neusatz := bildanfang + bildlaenge - 1; + zeile an aktueller stelle auftrennen; + ersten markierten satz an markieranfang aufspalten; + markierten bereich entfernen; + bild anpassen . + +zeile an aktueller stelle auftrennen : + INT VAR markierte saetze := line no (file) - bildmarke + 1; + IF nicht am ende der zeile + THEN IF nicht am anfang der zeile + THEN zeile aufsplitten + ELSE up (file); markierte saetze DECR 1 + FI + FI . + +nicht am anfang der zeile : stelle > 1 . +nicht am ende der zeile : stelle <= LENGTH bildsatz . + +ersten markierten satz an markieranfang aufspalten : + to line (file, line no (file) - (markierte saetze - 1)); + read record (file, bildsatz); + stelle := feldmarke; + IF nicht am anfang der zeile + THEN IF nicht am ende der zeile + THEN zeile aufsplitten + ELSE markierte saetze DECR 1 + FI ; + to line (file, line no (file) + markierte saetze) + ELSE to line (file, line no (file) + markierte saetze - 1) + FI ; + read record (file, bildsatz) . + +markierten bereich entfernen : + zeilen nr := line no (file) - markierte saetze - bildanfang + 2; + remove (file, markierte saetze); + marke := 0; bildmarke := 0; feldmarke := 0; + markiert := FALSE; mark (file, 0, 0); + konstanten neu berechnen; + stelle := 1 . + +bild anpassen : + satz nr := line no (file); + IF zeilen nr <= 1 + THEN bildanfang := line no (file); zeilen nr := 1; + neu (akt satznr, bild) + ELSE neu (akt satznr, abschnitt) + FI . + +vorsichtig geloeschtes einfuegen : + IF NOT write access OR removed lines (file) = 0 + THEN LEAVE vorsichtig geloeschtes einfuegen + FI ; + IF nur ein satz + THEN in aktuellen satz einfuegen + ELSE aktuellen satz aufbrechen und einfuegen + FI . + +nur ein satz : removed lines (file) = 1 . + +in aktuellen satz einfuegen : + reinsert (file); + read record (file, nachfolgender satz); + delete record (file); + TEXT VAR t := bildsatz; + bildsatz := subtext (t, 1, stelle - 1); + aktuellen satz mit blanks auffuellen; (*sh*) + bildsatz CAT nachfolgender satz; + satzrest := subtext (t, stelle); + bildsatz CAT satzrest; + write record (file, bildsatz); + stelle INCR LENGTH nachfolgender satz; + neu (nix, bildzeile) . + +aktuellen satz aufbrechen und einfuegen : + INT CONST alter bildanfang := bildanfang; + old lineno := satznr; + IF stelle = 1 + THEN reinsert (file); + read record (file, bildsatz) + ELIF stelle > LENGTH bildsatz + THEN down (file); + reinsert (file); + read record (file, bildsatz) + ELSE INT VAR von := stelle; + WHILE (bildsatz SUB von) = blank REP von INCR 1 PER; + satzrest := subtext (bildsatz, von, LENGTH bildsatz); + INT VAR bis := stelle - 1; + WHILE (bildsatz SUB bis) = blank REP bis DECR 1 PER; + bildsatz := subtext (bildsatz, 1, bis); + write record (file, bildsatz); + down (file); + reinsert (file); + read record (file, bildsatz); + nachfolgender satz := einrueckposition (bildsatz) * blank; + nachfolgender satz CAT satzrest; + down (file); insert record (file); + write record (file, nachfolgender satz); up (file) + FI ; + stelle := max (1, LENGTH bildsatz); (* 22.06.84 -bk- *) + satz nr := line no (file); + zeilennr INCR satznr - old lineno; + zeilennr := min (zeilennr, aktuelle bildlaenge); + bildanfang := satznr - zeilennr + 1; + IF bildanfang veraendert + THEN abschnitt neu (bildanfang, 9999) + ELSE abschnitt neu (old lineno, 9999) + FI ; + neu (akt satznr, nix). + +bildanfang veraendert : bildanfang <> alter bildanfang . + +lernmodus umschalten : + learn segment in ueberschrift eintragen; neu (ueberschrift, nix) . + +learn segment in ueberschrift eintragen : + replace (ueberschrift text, feldlaenge - 19, learn segment) . + +learn segment : + IF lernmodus THEN "LEARN" ELSE "....." FI . + +markierung umschalten : + IF markiert THEN markierung ausschalten ELSE markierung einschalten FI . + +markierung einschalten : + bildmarke := satznr; feldmarke := marke; markiert := TRUE; + mark (file, bildmarke, feldmarke); + neu (nix, bildzeile) . + +markierung ausschalten : + erster neusatz := max (bildmarke, bildanfang); + letzter neusatz := satznr; + bildmarke := 0; feldmarke := 0; markiert := FALSE; + mark (file, 0, 0); + IF erster neusatz = letzter neusatz + THEN neu (nix, bildzeile) + ELSE neu (nix, abschnitt) + FI . +END PROC bildeditor; + +PROC neu (INT CONST ue bereich, b bereich) : + ueberschriftbereich := max (ueberschriftbereich, ue bereich); + bildbereich := max (bildbereich, b bereich) +END PROC neu; + + +PROC nach oben : + letzter neusatz := satznr; + satznr := max (bildanfang, bildmarke); + toline (file, satznr); + stelle DECR verschoben; + zeilennr := satznr - bildanfang + 1; + erster neusatz := satznr; + IF markiert + THEN neu (akt satznr, abschnitt) + ELSE neu (akt satznr, nix) + FI +END PROC nach oben; + +INT PROC aktuelle bildlaenge : + IF stelle - stelle am anfang < kurze feldlaenge + AND feldlaenge > 0 + THEN bildlaenge (*wk*) + ELSE kurze bildlaenge + FI +END PROC aktuelle bildlaenge; + +PROC vorgaenger : + up (file); satznr DECR 1; + marke := 0; stelle DECR verschoben; + IF zeilennr = 1 + THEN bildanfang DECR 1; neu (ueberschrift, bild) + ELSE zeilennr DECR 1; neu (akt satznr, nix); (*sh*) + IF markiert THEN neu (nix, bildzeile) FI + FI +END PROC vorgaenger; + +PROC nachfolger : + down (file); satznr INCR 1; + stelle DECR verschoben; + IF zeilennr = aktuelle bildlaenge + THEN bildanfang INCR 1; + IF rollup erlaubt + THEN rollup + ELSE neu (ueberschrift, bild) + FI + ELSE neu (akt satznr, nix); zeilennr INCR 1 (*sh*) + FI ; + IF markiert THEN neu (nix, bildzeile) FI . + +rollup erlaubt : + kurze bildlaenge = maxlaenge AND kurze feldlaenge = maxbreite . + +rollup : + out (down char); + IF bildzeichen = inscr + THEN neu (ueberschrift, nix) + ELIF is cr or down CAND (write access COR nicht auf letztem satz) (*sh*) + THEN neu (nix, bildzeile) + ELSE neu (ueberschrift, bildzeile) + FI . + +is cr or down : + IF kommando = "" THEN kommando := inchety FI; + kommando char = down char COR kommando char = cr . + +kommando char : kommando SUB kommando zeiger . + +nicht auf letztem satz : line no (file) < lines (file) . +END PROC nachfolger; + +BOOL PROC next incharety is (TEXT CONST muster) : + INT CONST klen := LENGTH kommando - kommando zeiger + 1, + mlen := LENGTH muster; + INT VAR i; FOR i FROM 1 UPTO mlen - klen REP kommando CAT inchety PER; + subtext (kommando, kommando zeiger, kommando zeiger + mlen - 1) = muster +END PROC next incharety is; + +PROC quit last: (* 22.06.84 -bk- *) + IF actual editor > 0 AND actual editor < max used editor + THEN verlasse alle groesseren editoren + FI . + +verlasse alle groesseren editoren : + open editor (actual editor + 1); quit . +END PROC quit last; + +PROC quit : + IF actual editor > 0 THEN verlasse aktuellen editor FI . + +verlasse aktuellen editor : + disable stop; + INT CONST aktueller editor := actual editor; + in innersten editor gehen; + REP + IF zeileneinfuegen THEN hop rubin simulieren FI; + ggf bildschirmdarstellung korrigieren; + innersten editor schliessen + UNTIL aktueller editor > max used editor PER; + actual editor := max used editor . + +in innersten editor gehen : open editor (max used editor) . + +hop rubin simulieren : + zeileneinfuegen := FALSE; + leere zeilen am dateiende loeschen; (*sh*) + ggf bildschirmdarstellung korrigieren; + logisches eof loeschen . + +innersten editor schliessen : + max used editor DECR 1; + IF max used editor > 0 + THEN open editor (max used editor); + bildeinschraenkung aufheben + FI . + +logisches eof loeschen : + col (file, stelle); set range (file, old range) . + +leere zeilen am dateiende loeschen : (* 15.08.85 -ws- *) + satz nr := line no (file) ; + to line (file, lines (file)) ; + WHILE lines (file) > 1 AND bildsatz ist leerzeile REP + delete record (file); + to line (file, lines (file)) + PER; + toline (file, satznr) . + +bildsatz ist leerzeile : + TEXT VAR bildsatz; + read record (file, bildsatz); + ist leerzeile . + +ist leerzeile : + bildsatz = "" OR bildsatz = blank . + +ggf bildschirmdarstellung korrigieren : + satz nr DECR 1; (* für Bildschirmkorrektur *) + IF satznr > lines (file) + THEN zeilen nr DECR satz nr - lines (file); + satz nr := lines (file); + dateizustand retten + FI . + +bildeinschraenkung aufheben : + laenge := feldlaenge; + kurze feldlaenge := feldlaenge; + kurze bildlaenge := bildlaenge; + neu (nix, bild) . +END PROC quit; + +PROC nichts neu : neu (nix, nix) END PROC nichts neu; + +PROC satznr neu : neu (akt satznr, nix) END PROC satznr neu; + +PROC ueberschrift neu : neu (ueberschrift, nix) END PROC ueberschrift neu; + +PROC zeile neu : + INT CONST zeile := line no (file); + abschnitt neu (zeile, zeile) +END PROC zeile neu; + +PROC abschnitt neu (INT CONST von satznr, bis satznr) : + IF von satznr <= bis satznr + THEN erster neusatz := min (erster neusatz, von satznr); + letzter neusatz := max (letzter neusatz, bis satznr); + neu (nix, abschnitt) + ELSE abschnitt neu (bis satznr, von satznr) + FI +END PROC abschnitt neu; + +PROC bildabschnitt neu (INT CONST von zeile, bis zeile) : (*sh*) + IF von zeile <= bis zeile + THEN erster neusatz := max (1, von zeile + bildanfang - 1); + letzter neusatz := min (bildlaenge, bis zeile + bildanfang - 1); + IF von zeile < 1 + THEN neu (ueberschrift, abschnitt) + ELSE neu (nix , abschnitt) + FI + ELSE bildabschnitt neu (bis zeile, von zeile) + FI +END PROC bildabschnitt neu; + +PROC bild neu : neu (nix, bild) END PROC bild neu; (*sh*) + +PROC bild neu (FILE VAR f) : + INT CONST editor no := abs (editinfo (f)) DIV 256; + IF editor no > 0 AND editor no <= max used editor + THEN IF editor no = actual editor + THEN bild neu + ELSE editstack (editor no).bildstatus.bildbereich := bild + FI + FI +END PROC bild neu; + +PROC alles neu : + neu (ueberschrift, bild); + INT VAR i; + FOR i FROM 1 UPTO max used editor REP + editstack (i).bildstatus.bildbereich := bild; + editstack (i).bildstatus.ueberschriftbereich := ueberschrift + PER +END PROC alles neu; + +PROC satznr zeigen : + out (satznr pre); out (text (text (lineno (file)), 4)) +END PROC satznr zeigen; + +PROC ueberschrift zeigen : + SELECT ueberschriftbereich OF + CASE akt satznr : satznr zeigen; + ueberschriftbereich := nix + CASE ueberschrift : ueberschrift schreiben; + ueberschriftbereich := nix + CASE fehlermeldung : fehlermeldung schreiben; + ueberschriftbereich := ueberschrift + END SELECT +END PROC ueberschrift zeigen; + +PROC fenster zeigen : + SELECT bildbereich OF + CASE bildzeile : + zeile := bildrand + zeilennr; + IF line no (file) > lines (file) + THEN feldout ("", stelle) + ELSE exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle) + FI + CASE abschnitt : + bild ausgeben + CASE bild : + erster neusatz := 1; + letzter neusatz := 9999; + bild ausgeben + OTHERWISE : + LEAVE fenster zeigen + END SELECT; + erster neusatz := 9999; + letzter neusatz := 0; + bildbereich := nix +END PROC fenster zeigen ; + +PROC bild ausgeben : + BOOL CONST schreiben ist ganz einfach := NOT markiert AND verschoben = 0; + INT CONST save marke := marke, + save verschoben := verschoben, + save laenge := laenge, + act lineno := lineno (file), + von := max (1, erster neusatz - bildanfang + 1); + INT VAR bis := min (letzter neusatz - bildanfang + 1, bildlaenge); + IF kurze feldlaenge <= 0 THEN bis := min (bis, kurze bildlaenge) FI; + IF von > bis THEN LEAVE bild ausgeben FI; + verschoben := 0; + IF markiert + THEN IF mark lineno (file) < bildanfang + von - 1 + THEN marke := anfang + ELSE marke := 0 + FI + FI ; + abschnitt loeschen und neuschreiben; + to line (file, act lineno); + laenge := save laenge; + verschoben := save verschoben; + marke := save marke . + +markiert : mark lineno (file) > 0 . + +abschnitt loeschen und neuschreiben : + abschnitt loeschen; + INT VAR line number := bildanfang + von - 1; + to line (file, line number); + abschnitt schreiben . + +abschnitt loeschen : + cursor (rand + 1, bildrand + von); + IF bildrest darf komplett geloescht werden + THEN out (clear eop) + ELSE zeilenweise loeschen + FI . + +bildrest darf komplett geloescht werden : + bis = maxlaenge AND kurze bildlaenge = maxlaenge + AND kurze feldlaenge = maxbreite . + +zeilenweise loeschen : + INT VAR i; + FOR i FROM von UPTO bis REP + check for interrupt; + feldlaenge einstellen; + feldrest loeschen; + IF i < bis THEN out (down char) FI + PER . + +feldlaenge einstellen : + IF ganze zeile sichtbar + THEN laenge := feldlaenge + ELSE laenge := kurze feldlaenge + FI . + +ganze zeile sichtbar : i <= kurze bildlaenge . + +abschnitt schreiben : + INT CONST last line := lines (file); + FOR i FROM von UPTO bis + WHILE line number <= last line REP + check for interrupt; + feldlaenge einstellen; + zeile schreiben; + down (file); + line number INCR 1 + PER . + +check for interrupt : + kommando CAT inchety; + IF kommando <> "" + THEN IF zeilen nr = 1 CAND up command CAND vorgaenger erlaubt + THEN LEAVE abschnitt loeschen und neuschreiben + ELIF zeilen nr = bildlaenge CAND down command CAND nicht letzter satz + THEN LEAVE abschnitt loeschen und neuschreiben + FI + FI . + +vorgaenger erlaubt : + satznr > max (1, bildmarke) . + +up command : next incharety is (""3"") COR next incharety is (""1""3"") . + +down command : + next incharety is (""10"") CAND bildlaenge < maxlaenge + COR next incharety is (""1""10"") . + +nicht letzter satz : act lineno < lines (file) . + +zeile schreiben : + zeile := bildrand + i; + IF schreiben ist ganz einfach + THEN exec (PROC (TEXT CONST, INT CONST) simple feldout, file, 0) + ELSE zeile kompliziert schreiben + FI ; + IF line number = old lineno THEN old line update := FALSE FI . + +zeile kompliziert schreiben : + IF line number = mark lineno (file) THEN marke := mark col (file) FI; + IF line number = act lineno + THEN verschoben := save verschoben; + exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle); + verschoben := 0; marke := 0 + ELSE exec (PROC (TEXT CONST, INT CONST) feldout, file, 0); + IF line number = mark lineno (file) THEN marke := anfang FI + FI . +END PROC bild ausgeben; + +PROC bild zeigen : (* wk *) + + dateizustand holen ; + ueberschrift zeigen ; + bildausgabe steuern ; + bild neu ; + fenster zeigen ; + oldline no := satznr ; + old line update := FALSE ; + old satz := "" ; + old zeilennr := satznr - bildanfang + 1 ; + dateizustand retten . + +ENDPROC bild zeigen ; + +PROC ueberschrift initialisieren : (*sh*) + satznr pre := + cursor pos + code (bildrand - 1) + code (rand + feldlaenge - 6); + ueberschrift pre := + cursor pos + code (bildrand - 1) + code (rand) + mark anf; + ueberschrift text := ""; INT VAR i; + FOR i FROM 16 UPTO feldlaenge REP ueberschrift text CAT "." PER; + ueberschrift post := blank + mark end + "Zeile " + mark anf; + ueberschrift post CAT blank + mark end + " "; + filename := headline (file); + filename := subtext (filename, 1, feldlaenge - 24); + insert char (filename, blank, 1); filename CAT blank; + replace (ueberschrift text, filenamepos, filename); + rubin segment in ueberschrift eintragen; + margin segment in ueberschrift eintragen; + rest segment in ueberschrift eintragen; + learn segment in ueberschrift eintragen . + +filenamepos : (LENGTH ueberschrift text - LENGTH filename + 3) DIV 2 . +mark anf : begin mark + mark ausgleich. +mark end : end mark + mark ausgleich. +mark ausgleich : (1 - sign (max (mark size, 0))) * blank . + +rubin segment in ueberschrift eintragen : + replace (ueberschrift text, 9, rubin segment) . + +rubin segment : + IF einfuegen THEN "RUBIN" ELSE "....." FI . + +margin segment in ueberschrift eintragen : + replace (ueberschrift text, 2, margin segment) . + +margin segment : + IF anfang <= 1 + THEN "......" + ELSE TEXT VAR margin text := "M" + text (anfang); + (6 - LENGTH margin text) * "." + margin text + FI . + +rest segment in ueberschrift eintragen : + replace (ueberschrift text, feldlaenge - 25, rest segment) . + +rest segment : + IF zeileneinfuegen THEN "REST" ELSE "...." FI . + +learn segment in ueberschrift eintragen : + replace (ueberschrift text, feldlaenge - 19, learn segment) . + +learn segment : + IF lernmodus THEN "LEARN" ELSE "....." FI . + +END PROC ueberschrift initialisieren; + +PROC ueberschrift schreiben : + replace (ueberschrift post, satznr pos, text (text (lineno (file)), 4)); + out (ueberschrift pre); out (ueberschrift text); out (ueberschrift post); + get tabs (file, tab); + IF pos (tab, dach) > 0 + THEN out (ueberschrift pre); + out subtext (tab, anfang + 1, anfang + feldlaenge - 1); + cursor (rand + 1 + feldlaenge, bildrand); out (end mark) + FI . + + satznr pos : IF mark size > 0 THEN 9 ELSE 10 FI . (*sh*) +END PROC ueberschrift schreiben; + +PROC fehlermeldung schreiben : + ueberschrift schreiben; + out (ueberschrift pre); + out ("FEHLER: "); + out subtext (fehlertext, 1, feldlaenge - 21); + out (blank); + out (piep); + cursor (rand + 1 + feldlaenge, bildrand); out (end mark) +END PROC fehlermeldung schreiben; + +PROC set busy indicator : + cursor (rand + 2, bildrand) +END PROC set busy indicator; + +PROC kommando analysieren (TEXT CONST taste, + PROC (TEXT CONST) kommando interpreter) : + disable stop; + bildausgabe normieren; + zustand in datei sichern; + editfile modus setzen; + kommando interpreter (taste); + editfile modus zuruecksetzen; + IF actual editor <= 0 THEN LEAVE kommando analysieren FI; + absatz ausgleich := 2; (*sh*) + konstanten neu berechnen; + neues bild bei undefinierter benutzeraktion; + evtl fehler behandeln; + zustand aus datei holen; + bildausgabe steuern . + +editfile modus setzen : + BOOL VAR alter editget modus := editget modus ; + editget modus := FALSE . + +editfile modus zuruecksetzen : + editget modus := alter editget modus . + +evtl fehler behandeln : + IF is error + THEN fehlertext := errormessage; + IF fehlertext <> "" THEN neu (fehlermeldung, nix) FI; + clear error + ELSE fehlertext := "" + FI . + +zustand in datei sichern : + old zeilennr := zeilennr; + old mark lineno := bildmarke; + dateizustand retten . + +zustand aus datei holen : + dateizustand holen; + IF letzer editor auf dieser datei <> actual editor + THEN zurueck auf alte position; neu (ueberschrift, bild) + FI . + +zurueck auf alte position : + to line (file, old lineno); + col (file, alte stelle); + IF fliesstext + THEN editinfo (file, old zeilennr) + ELSE editinfo (file, - old zeilennr) + FI ; dateizustand holen . + +bildausgabe normieren : + bildbereich := undefinierter bereich; + erster neusatz := 9999; + letzter neusatz := 0 . + +neues bild bei undefinierter benutzeraktion : + IF bildbereich = undefinierter bereich THEN alles neu FI . +END PROC kommando analysieren; + +PROC bildausgabe steuern : + IF markiert + THEN IF old mark lineno = 0 + THEN abschnitt neu (bildmarke, satznr); + konstanten neu berechnen + ELIF stelle veraendert (*sh*) + THEN zeile neu + FI + ELIF old mark lineno > 0 + THEN abschnitt neu (old mark lineno, (max (satznr, old lineno))); + konstanten neu berechnen + FI ; + IF satznr <> old lineno + THEN neu (akt satznr, nix); + neuen bildaufbau bestimmen + ELSE zeilennr := old zeilennr + FI ; + zeilennr := min (min (zeilennr, satznr), aktuelle bildlaenge); + bildanfang := satznr - zeilennr + 1 . + +stelle veraendert : stelle <> alte stelle . + +neuen bildaufbau bestimmen : + zeilennr := old zeilennr + satznr - old lineno; + IF 1 <= zeilennr AND zeilennr <= aktuelle bildlaenge + THEN im fenster springen + ELSE bild neu aufbauen + FI . + +im fenster springen : + IF markiert THEN abschnitt neu (old lineno, satznr) FI . + +bild neu aufbauen : + neu (nix, bild); zeilennr := max (1, aktuelle bildlaenge DIV 2) . +END PROC bildausgabe steuern; + +PROC word wrap (BOOL CONST b) : + IF actual editor = 0 + THEN std fliesstext := b + ELSE fliesstext in datei setzen + FI . + +fliesstext in datei setzen : + fliesstext := b; + IF fliesstext veraendert THEN editinfo (file, - editinfo (file)) FI; + neu (ueberschrift, bild) . + +fliesstext veraendert : + fliesstext AND editinfo (file) < 0 OR + NOT fliesstext AND editinfo (file) > 0 . +END PROC word wrap; + +BOOL PROC word wrap : (*sh*) + IF actual editor = 0 + THEN std fliesstext + ELSE fliesstext + FI +END PROC word wrap; + +INT PROC margin : anfang END PROC margin; + +PROC margin (INT CONST i) : (*sh*) + IF anfang <> i CAND i > 0 AND i < 16001 + THEN anfang := i; neu (ueberschrift, bild); + margin segment in ueberschrift eintragen + ELSE IF i >= 16001 OR i < 0 + THEN errorstop ("ungueltige Anfangsposition (1 - 16000)") + FI + FI . + +margin segment in ueberschrift eintragen : + replace (ueberschrift text, 2, margin segment) . + +margin segment : + IF anfang <= 1 + THEN "......" + ELSE TEXT VAR margin text := "M" + text (anfang); + (6 - LENGTH margin text) * "." + margin text + FI . + +END PROC margin; + +BOOL PROC rubin mode : rubin mode (actual editor) END PROC rubin mode; + +BOOL PROC rubin mode (INT CONST editor nr) : (*sh*) + IF editor nr < 1 OR editor nr > max used editor + THEN errorstop ("Editor nicht eroeffnet") + FI ; + IF editor nr = actual editor + THEN einfuegen + ELSE editstack (editor nr).feldstatus.einfuegen + FI +END PROC rubin mode; + +PROC edit (INT CONST i, TEXT CONST res, + PROC (TEXT CONST) kommando interpreter) : + edit (i, i, i, res, PROC (TEXT CONST) kommando interpreter) +END PROC edit; + +PROC edit (INT CONST von, bis, start, TEXT CONST res, + PROC (TEXT CONST) kommando interpreter) : + disable stop; + IF von < bis + THEN edit (von+1, bis, start, res, PROC (TEXT CONST) kommando interpreter); + IF max used editor < von THEN LEAVE edit FI; + open editor (von) + ELSE open editor (start) + FI ; + absatz ausgleich := 2; + bildeditor (res, PROC (TEXT CONST) kommando interpreter); + cursor (1, schirmhoehe); + IF is error + THEN kommando zeiger := 1; kommando := ""; quit + FI ; + IF lernmodus CAND actual editor = 0 THEN warnung ausgeben FI . (*sh*) + + warnung ausgeben : + out (clear eop); out ("WARNUNG: Lernmodus nicht ausgeschaltet"13""10"") . +END PROC edit; + +PROC dateizustand holen : + modify (file); + get tabs (file, tabulator); + zeilennr und fliesstext und letzter editor aus editinfo decodieren; + limit := max line length (file); + stelle := col (file); + markiert := mark (file); + IF markiert + THEN markierung holen + ELSE keine markierung + FI ; + satz nr := lineno (file); + IF zeilennr > aktuelle bildlaenge (*sh*) + THEN zeilennr := min (satznr, aktuelle bildlaenge); bild neu + ELIF zeilennr > satznr + THEN zeilennr := min (satznr, aktuelle bildlaenge) + FI ; zeilennr := max (zeilennr, 1); + bildanfang := satz nr - zeilennr + 1 . + +zeilennr und fliesstext und letzter editor aus editinfo decodieren : + zeilennr := edit info (file); + IF zeilennr = 0 + THEN zeilennr := 1; + fliesstext := std fliesstext + ELIF zeilennr > 0 + THEN fliesstext := TRUE + ELSE zeilennr := - zeilennr; + fliesstext := FALSE + FI ; + letzer editor auf dieser datei := zeilennr DIV 256; + zeilennr := zeilennr MOD 256 . + +markierung holen : + bildmarke := mark lineno (file); + feldmarke := mark col (file); + IF line no (file) <= bildmarke + THEN to line (file, bildmarke); + marke := feldmarke; + stelle := max (stelle, feldmarke) + ELSE marke := 1 + FI . + +keine markierung : + bildmarke := 0; + feldmarke := 0; + marke := 0 . +END PROC dateizustand holen; + +PROC dateizustand retten : + put tabs (file, tabulator); + IF fliesstext + THEN editinfo (file, zeilennr + actual editor * 256) + ELSE editinfo (file, - (zeilennr + actual editor * 256)) + FI ; + max line length (file, limit); + col (file, stelle); + IF markiert + THEN mark (file, bildmarke, feldmarke) + ELSE mark (file, 0, 0) + FI +END PROC dateizustand retten; + +PROC open editor (FILE CONST new file, BOOL CONST access) : + disable stop; quit last; + neue bildparameter bestimmen; + open editor (actual editor + 1, new file, access, x, y, x len, y len). + +neue bildparameter bestimmen : + INT VAR x, y, x len, y len; + IF actual editor > 0 + THEN teilbild des aktuellen editors + ELSE volles bild + FI . + +teilbild des aktuellen editors : + get editcursor (x, y); bildgroesse bestimmen; + IF fenster zu schmal (*sh*) + THEN enable stop; errorstop ("Fenster zu klein") + ELIF fenster zu kurz + THEN verkuerztes altes bild nehmen + FI . + +bildgroesse bestimmen : + x len := rand + feldlaenge - x + 3; + y len := bildrand + bildlaenge - y + 1 . + +fenster zu schmal : x > schirmbreite - 17 . +fenster zu kurz : y > schirmhoehe - 1 . + +verkuerztes altes bild nehmen : + x := rand + 1; y := bildrand + 1; + IF fenster zu kurz THEN enable stop; errorstop ("Fenster zu klein") FI; + x len := feldlaenge + 2; + y len := bildlaenge; + kurze feldlaenge := 0; + kurze bildlaenge := 1 . + +volles bild : + x := 1; y := 1; x len := schirmbreite; y len := schirmhoehe . +END PROC open editor; + +PROC open editor (INT CONST editor nr, + FILE CONST new file, BOOL CONST access, + INT CONST x start, y, x len start, y len) : + INT VAR x := x start, + x len := x len start; + IF editor nr > max editor + THEN errorstop ("zu viele Editor-Fenster") + ELIF editor nr > max used editor + 1 OR editor nr < 1 + THEN errorstop ("Editor nicht eroeffnet") + ELIF fenster ungueltig + THEN errorstop ("Fenster ungueltig") + ELSE neuen editor stacken + FI . + +fenster ungueltig : + x < 1 COR x > schirmbreite COR y < 1 COR y > schirmhoehe COR + x len - 2 <= 15 COR y len - 1 < 1 COR + x + x len - 1 > schirmbreite COR y + y len - 1 > schirmhoehe . + +neuen editor stacken : + disable stop; + IF actual editor > 0 AND ist einschraenkung des alten bildes + THEN dateizustand holen; + aktuelles editorbild einschraenken; + arbeitspunkt in das restbild positionieren; + abgrenzung beruecksichtigen + FI ; + aktuellen zustand retten; + neuen zustand setzen; + neues editorbild zeigen; + actual editor := editor nr; + IF actual editor > max used editor + THEN max used editor := actual editor + FI . + +ist einschraenkung des alten bildes : + x > rand CAND x + x len = rand + feldlaenge + 3 CAND + y > bildrand CAND y + y len = bildrand + bildlaenge + 1 . + +aktuelles editorbild einschraenken : + kurze feldlaenge := x - rand - 3; + kurze bildlaenge := y - bildrand - 1 . + +arbeitspunkt in das restbild positionieren : + IF stelle > 3 + THEN stelle DECR 3; alte stelle := stelle + ELSE WHILE zeilennr > 1 AND zeilennr > kurze bildlaenge REP + vorgaenger + PER; old lineno := satznr + FI . + +abgrenzung beruecksichtigen : + IF x - rand > 1 + THEN balken malen; + x INCR 2; + x len DECR 2 + FI . + +balken malen : + INT VAR i; + FOR i FROM 0 UPTO y len-1 REP + cursor (x, y+i); out (kloetzchen) (*sh*) + PER . + +kloetzchen : IF mark size > 0 THEN ""15""14"" ELSE ""15" "14" " FI . + +aktuellen zustand retten : + IF actual editor > 0 + THEN dateizustand retten; + editstack (actual editor).feldstatus := feldstatus; + editstack (actual editor).bildstatus := bildstatus; + einrueckstack (actual editor) := alte einrueckposition + FI . + +neuen zustand setzen : + FRANGE VAR frange; + feldstatus := FELDSTATUS : + (1, 1, x-1, 0, 1, 0, x len-2, 0, FALSE, TRUE, access, ""); + bildstatus := BILDSTATUS : + (x len-2, x len-2, y, y len-1, y len-1, ueberschrift, bild, + 0, 0, 1, 0, 0, FALSE, FALSE, "", "", "", "", "", frange, new file); + alte einrueckposition := 1; + dateizustand holen; + ueberschrift initialisieren . + +neues editorbild zeigen : + ueberschrift zeigen; fenster zeigen +END PROC open editor; + +PROC open editor (INT CONST i) : + IF i < 1 OR i > max used editor + THEN errorstop ("Editor nicht eroeffnet") + ELIF actual editor <> i + THEN switch editor + FI . + +switch editor : + aktuellen zustand retten; + actual editor := i; + neuen zustand setzen; + IF kein platz mehr fuer restfenster + THEN eingeschachtelte editoren vergessen; + bildeinschraenkung aufheben + ELSE neu (nix, nix) + FI . + +aktuellen zustand retten : + IF actual editor > 0 + THEN editstack (actual editor).feldstatus := feldstatus; + editstack (actual editor).bildstatus := bildstatus; + einrueckstack (actual editor) := alte einrueckposition; + dateizustand retten + FI . + +neuen zustand setzen : + feldstatus := editstack (i).feldstatus; + bildstatus := editstack (i).bildstatus; + alte einrueckposition := einrueckstack (i); + dateizustand holen . + +kein platz mehr fuer restfenster : + kurze feldlaenge < 1 AND kurze bildlaenge < 1 . + +eingeschachtelte editoren vergessen : + IF actual editor < max used editor + THEN open editor (actual editor + 1) ; + quit + FI ; + open editor (i) . + +bildeinschraenkung aufheben : + laenge := feldlaenge; + kurze feldlaenge := feldlaenge; + kurze bildlaenge := bildlaenge; + neu (ueberschrift, bild) . +END PROC open editor; + +FILE PROC editfile : + IF actual editor = 0 OR editget modus + THEN errorstop ("Editor nicht eroeffnet") + FI ; file +END PROC editfile; + +PROC get window (INT VAR x, y, x size, y size) : + x := rand + 1; + y := bildrand; + x size := feldlaenge + 2; + y size := bildlaenge + 1 +ENDPROC get window; + +(************************* Zugriff auf Bildstatus *************************). + +feldlaenge : bildstatus.feldlaenge . +kurze feldlaenge : bildstatus.kurze feldlaenge . +bildrand : bildstatus.bildrand . +bildlaenge : bildstatus.bildlaenge . +kurze bildlaenge : bildstatus.kurze bildlaenge . +ueberschriftbereich : bildstatus.ueberschriftbereich . +bildbereich : bildstatus.bildbereich . +erster neusatz : bildstatus.erster neusatz . +letzter neusatz : bildstatus.letzter neusatz . +old zeilennr : bildstatus.old zeilennr . +old lineno : bildstatus.old lineno . +old mark lineno : bildstatus.old mark lineno . +zeileneinfuegen : bildstatus.zeileneinfuegen . +old line update : bildstatus.old line update . +satznr pre : bildstatus.satznr pre . +ueberschrift pre : bildstatus.ueberschrift pre . +ueberschrift text : bildstatus.ueberschrift text . +ueberschrift post : bildstatus.ueberschrift post . +old satz : bildstatus.old satz . +old range : bildstatus.old range . +file : bildstatus.file . + +END PACKET editor paket; + diff --git a/system/base/1.7.5/src/elan do interface b/system/base/1.7.5/src/elan do interface new file mode 100644 index 0000000..72026a7 --- /dev/null +++ b/system/base/1.7.5/src/elan do interface @@ -0,0 +1,57 @@ + +PACKET elan do interface DEFINES (*Autor: J.Liedtke *) + (*Stand: 08.11.85 *) + do , + no do again : + + +LET no ins = FALSE , + no lst = FALSE , + no check = FALSE , + no sermon = FALSE , + compile line mode = 2 , + do again mode = 4 , + max command length = 2000 ; + + +INT VAR do again mod nr := 0 ; +TEXT VAR previous command := "" ; + +DATASPACE VAR ds ; + + +PROC do (TEXT CONST command) : + + enable stop ; + IF LENGTH command > max command length + THEN errorstop ("Kommando zu lang") + ELIF do again mod nr <> 0 AND command = previous command + THEN do again + ELSE previous command := command ; + compile and execute + FI . + +do again : + elan (do again mode, ds, "", do again mod nr, + no ins, no lst, no check, no sermon) . + +compile and execute : + elan (compile line mode, ds, command, do again mod nr, + no ins, no lst, no check, no sermon) . + +ENDPROC do ; + +PROC no do again : + + do again mod nr := 0 + +ENDPROC no do again ; + +PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, + INT VAR start module number, + BOOL CONST ins, lst, rt check, ser) : + EXTERNAL 256 +ENDPROC elan ; + +ENDPACKET elan do interface ; + diff --git a/system/base/1.7.5/src/error handling b/system/base/1.7.5/src/error handling new file mode 100644 index 0000000..34db65d --- /dev/null +++ b/system/base/1.7.5/src/error handling @@ -0,0 +1,142 @@ + +PACKET error handling DEFINES + + enable stop , + disable stop , + is error , + clear error , + errormessage , + error code , + error line , + put error , + errorstop , + stop : + + +LET cr lf = ""13""10"" , + line nr field = 1 , + error line field = 2 , + error code field = 3 , + syntax error code= 100 , + + error pre = ""7""13""10""5"FEHLER : " ; + + +TEXT VAR errortext := "" ; + + +PROC enable stop : + EXTERNAL 75 +ENDPROC enable stop ; + +PROC disable stop : + EXTERNAL 76 +ENDPROC disable stop ; + +PROC set error stop (INT CONST code) : + EXTERNAL 77 +ENDPROC set error stop ; + +BOOL PROC is error : + EXTERNAL 78 +ENDPROC is error ; + +PROC clear error : + EXTERNAL 79 +ENDPROC clear error ; + +PROC select error message : + + SELECT error code OF + CASE 1 : error text := "'halt' vom Terminal" + CASE 2 : error text := "Stack-Ueberlauf" + CASE 3 : error text := "Heap-Ueberlauf" + CASE 4 : error text := "INT-Ueberlauf" + CASE 5 : error text := "DIV durch 0" + CASE 6 : error text := "REAL-Ueberlauf" + CASE 7 : error text := "TEXT-Ueberlauf" + CASE 8 : error text := "zu viele DATASPACEs" + CASE 9 : error text := "Ueberlauf bei Subskription" + CASE 10: error text := "Unterlauf bei Subskription" + CASE 11: error text := "falscher DATASPACE-Zugriff" + CASE 12: error text := "INT nicht initialisiert" + CASE 13: error text := "REAL nicht initialisiert" + CASE 14: error text := "TEXT nicht initialisiert" + CASE 15: error text := "nicht implementiert" + CASE 16: error text := "Block unlesbar" + CASE 17: error text := "Codefehler" + END SELECT + +ENDPROC select error message ; + +TEXT PROC error message : + + select error message ; + error text + +ENDPROC error message ; + +INT PROC error code : + + pcb (error code field) + +ENDPROC error code ; + +INT PROC error line : + + IF is error + THEN pcb (error line field) + ELSE 0 + FI + +ENDPROC error line ; + +PROC syntax error (TEXT CONST message) : + + INTERNAL 259 ; + errorstop (syntax error code, message) . + +ENDPROC syntax error ; + +PROC errorstop (TEXT CONST message) : + + errorstop (0, message) ; + +ENDPROC errorstop ; + +PROC errorstop (INT CONST code, TEXT CONST message) : + + IF NOT is error + THEN error text := message ; + set error stop (code) + FI + +ENDPROC errorstop ; + +PROC put error : + + IF is error + THEN select error message ; + IF error text <> "" + THEN put error message + FI + FI . + +put error message : + out (error pre) ; + out (error text) ; + IF error line > 0 + THEN out (" bei Zeile "); out (text (error line)) ; + FI ; + out (cr lf) . + +ENDPROC put error ; + +PROC stop : + + errorstop ("stop") + +ENDPROC stop ; + +ENDPACKET error handling ; + diff --git a/system/base/1.7.5/src/eumel coder part 1 b/system/base/1.7.5/src/eumel coder part 1 new file mode 100644 index 0000000..83974f7 --- /dev/null +++ b/system/base/1.7.5/src/eumel coder part 1 @@ -0,0 +1,866 @@ +PACKET eumel coder part 1 (* Autor: U. Bartling *) + DEFINES run, run again, + insert, + prot, prot off, + check, check on, check off, + warnings, warnings on, warnings off, + + help, bulletin, packets + : + +(**************************************************************************) +(* *) +(* E U M E L - C O D E R *) +(* *) +(* *) +(* Zur Beschreibung des Coders siehe *) +(* U.Bartling, J. Liedtke: EUMEL-Coder-Interface *) +(* *) +(* Stand der Dokumentation : 13.02.1986 *) +(* Stand der Implementation : 16.04.1986 *) +(* *) +(* *) +(**************************************************************************) + + + (***** Globale Variable *****) + +TEXT VAR object name; + +FILE VAR bulletin file; + +INT VAR hash table pointer, nt link, permanent pointer, param link, + index, mode, word; + +BOOL VAR found, end of params; + +#page# +(**************************************************************************) +(* *) +(* 1. Interface zum ELAN-Compiler 10.04.1986 *) +(* 1.7.5.4 *) +(* *) +(* Beschreibung der Tabellen (-groessen), *) +(* internen Vercodung von Typen *) +(* und Kennungen . *) +(* Initialisieren und Beenden des Compilers, *) +(* Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle *) +(* *) +(**************************************************************************) + + +LET begin of hash table = 0 , + end of hash table = 1023 , + + begin of permanent table = 22784 , + before first pt entry = 22784 , + first permanent entry = 22785 , + end of permanent table = 32767 , + + wordlength = 1 , (* compile u n d run time *) + two word length = 2 , + three word length = 3 , + + permanent param const = 10000 , + permanent param var = 20000 , + permanent proc op = 30000 , + permanent type = 30000 , + permanent row = 10 , + permanent struct = 11 , + permanent param proc = 12 , +(* permanent param proc end marker = 0 , *) + permanent type field = 0 , + + ptt limit = 10000 , + begin of pt minus ptt limit = 12784 , + + void = 0 , + int = 1 , + real = 2 , + string = 3 , + bool = 5 , + bool result = 6 , + dataspace = 7 , + row = 10 , + struct = 11 , + + const = 1 , + var = 2 , +(* proc = 3 , *) +(* denoter = 5 , *) + bold = 2 , + + ins = TRUE , + no ins = FALSE , + no lst = FALSE , + sermon = TRUE , + no sermon = FALSE , + + run again mode = 0 , + compile file mode = 1 , + + warning message = 2 , + error message = 4 , + + point line = "..............." ; + +INT CONST permanent packet := -2 , + permanent end := -3 ; + + +INT VAR run again mod nr := 0 ; + + + (***** Start/Ende *****) + +PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, + INT VAR start module number, BOOL CONST ins, lst, rtc, ser) : + EXTERNAL 256 +ENDPROC elan ; + + (***** Hash/Namenstabelle *****) +. +next hash entry : + hash table pointer INCR wordlength . + +end of hash table reached : + hash table pointer > end of hash table . + +yet another nt entry : + nt link := cdb int (nt link) ; + nt link <> 0 . ; + +PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : + EXTERNAL 10031 +ENDPROC declare object ; + +PROC to object (TEXT CONST searched object) : + hash ; + search nt entry . + +hash : + hash code := 0 ; + FOR index FROM 1 UPTO LENGTH searched object REP + addmult cyclic + ENDREP . + +addmult cyclic : + hash code INCR hash code ; + IF hash code > end of hash table THEN wrap around FI ; + hash code := (hash code + code (searched object SUB index)) MOD 1024 . + +wrap around : + hash code DECR end of hash table . + +hash code : nt link . + +search nt entry : + found := FALSE ; + WHILE yet another nt entry REP + read current entry ; + IF object name = searched object + THEN found := TRUE ; + LEAVE to object + FI + PER . + +read current entry : + permanent pointer := cdb int (nt link + wordlength) ; + object name := cdb text (nt link + two word length) +ENDPROC to object ; + + + (***** Permanent Tabelle *****) +. +next procedure : + permanent pointer := cdb int (permanent pointer) . ; + +PROC next pt param : + mode := cdb int (param link) MOD ptt limit ; + param link INCR wordlength ; + IF mode = permanent row THEN skip over permanent row + ELIF mode = permanent struct THEN skip over permanent struct + FI ; + set end marker if end of list . + +skip over permanent row : + param link INCR wordlength ; + next pt param . + +skip over permanent struct : + REP + next pt param ; + mode := cdb int (param link) + UNTIL mode = permanent type field PER ; + param link INCR wordlength +ENDPROC next pt param ; + +PROC set end marker if end of list : + mode := cdb int (param link) ; + end of params := mode >= permanent proc op OR mode <= 0 +ENDPROC set end marker if end of list ; + +PROC get type and mode (INT VAR type) : + mode := cdb int (param link) ; + IF mode = permanent param proc THEN type of param proc + ELSE type of object + FI . + +type of param proc : + param link INCR wordlength ; + get type and mode (type) ; + mode := permanent param proc . + +type of object : + IF mode < 0 THEN type := 2769 + (32767 + mode) ; + mode := 0 + ELSE type := mode MOD ptt limit ; + mode DECR type ; + translate type if necessary ; + translate mode if necessary + FI . + +translate type if necessary : + IF permanent row or struct THEN translate type FI . + +translate type : + type := param link - begin of pt minus ptt limit . + +translate mode if necessary : + IF mode = permanent param const THEN mode := const + ELIF mode = permanent param var THEN mode := var + FI . + +permanent row or struct : + type = permanent row OR type = permanent struct +ENDPROC get type and mode ; + + + (***** Allgemeine Zugriffsprozeduren *****) + +INT PROC cdb int (INT CONST index) : + EXTERNAL 116 +ENDPROC cdb int ; + +TEXT PROC cdb text (INT CONST index) : + EXTERNAL 117 +ENDPROC cdb text ; + +#page# +(**************************************************************************) +(* *) +(* 10. Inspector 16.04.1986 *) +(* *) +(**************************************************************************) + + + +INT VAR line number, pattern length, packet link, + begin of packet, last packet entry, indentation; + +TEXT VAR bulletin name, type and mode, pattern, buffer; + +DATASPACE VAR bulletin ds :: nilspace ; + +.packet name : + cdb text (cdb int(packet link + wordlength) + two word length) . + +.within editor : + aktueller editor > 0 . ; + +PROC name of type (INT CONST type) : + SELECT type OF + CASE void : + CASE int : type and mode CAT "INT" + CASE real : type and mode CAT "REAL" + CASE string : type and mode CAT "TEXT" + CASE bool, bool result : type and mode CAT "BOOL" + CASE dataspace : type and mode CAT "DATASPACE" + CASE row : type and mode CAT "ROW " + CASE struct : type and mode CAT "STRUCT" + OTHERWISE : complex type + ENDSELECT . + +complex type : + IF type > ptt limit THEN perhaps permanent struct or row + ELSE get complex type + FI . + +perhaps permanent struct or row : + index := type + begin of pt minus ptt limit ; + mode := cdb int (index) MOD ptt limit ; + IF mode = permanent row THEN get permanent row + ELIF mode = permanent struct THEN get permanent struct + ELSE type and mode CAT "-" + FI . + +get complex type : + index := type + begin of permanent table ; + IF is complex type THEN get name + ELSE type and mode CAT "-" + FI . + +is complex type : + permanent type definition mode = permanent type . + +get name : + type and mode CAT cdb text (link to type name + two word length) . + +link to type name : + cdb int (index + three word length) . + +permanent type definition mode : + cdb int (index + wordlength) . + +get permanent row : + INT VAR t; + type and mode CAT "ROW " ; + type and mode CAT text (cdb int (index + wordlength)) ; + type and mode CAT " " ; + param link := index + two wordlength ; + get type and mode (t) ; + name of type (t) . + +get permanent struct : + type and mode CAT "STRUCT ( ... )" +ENDPROC name of type ; + +PROC help (TEXT CONST proc name) : + prep bulletin ; + prep help ; + scan (object name) ; + next symbol (pattern) ; + packet link := end of permanent table ; + IF function = 0 THEN standard help + ELSE asterisk help + FI . + +prep help : + object name := compress (proc name) ; + INT VAR function :: 0 ; + INT CONST l :: LENGTH object name ; + IF l > 1 AND object name <> "**" + THEN IF (object name SUB l) = "*" + THEN function INCR 2 ; + delete char (object name, l) + FI ; + IF (object name SUB 1) = "*" + THEN function INCR 1 ; + delete char (object name, 1) + FI ; + IF another asterisk THEN wrong function FI + FI. + +another asterisk : + pos (object name, "*") <> 0 . + +wrong function : + errorstop ("unzulaessige Sternfunktion") . + +standard help : + to object (pattern) ; + IF found THEN display + ELSE error stop ("unbekannt: " + proc name) + FI . + +display : + WHILE permanent pointer <> 0 REP + put name of packet if necessary ; + put specifications (pattern) ; + next procedure + ENDREP ; + show bulletin file . + +put name of packet if necessary : + IF new packet THEN packet link := permanent pointer ; + find begin of packet ; + writeline (2) ; + write packet name + FI . + +find begin of packet : + REP + packet link DECR wordlength + UNTIL begin of packet found PER . + +begin of packet found : + cdb int (packet link) = permanent packet . + +new packet : + permanent pointer < packet link . + +asterisk help : + hash table pointer := begin of hash table ; + pattern length := LENGTH pattern - 1 ; + REP + list all objects in current hash table chain ; + next hash entry + UNTIL end of hash table reached ENDREP ; + show bulletin file . + +list all objects in current hash table chain : + nt link := hash table pointer ; + WHILE yet another nt entry REP + permanent pointer := cdb int (nt link + wordlength) ; + object name := cdb text (nt link + two word length) ; + IF matching THEN into bulletin FI + PER . + +matching : + INT CONST p :: pos (object name, pattern) ; + SELECT function OF + CASE 1 : p <> 0 AND p = LENGTH object name - pattern length + CASE 2 : p = 1 + CASE 3 : p <> 0 + OTHERWISE FALSE + ENDSELECT . + +into bulletin : + object names into bulletin (BOOL PROC not end of chain) +ENDPROC help ; + +BOOL PROC not end of chain : + permanent pointer <> 0 +ENDPROC not end of chain ; + +PROC write packet name : + indentation := 0 ; + write line ; + write bulletin line ("PACKET ") ; + indentation := 7 ; + object name := packet name ; + write bulletin line (object name) ; + write bulletin line (":") ; + writeline (2) +ENDPROC write packet name ; + +PROC put specifications (TEXT CONST proc name) : + put obj name (proc name) ; + to first param ; + IF NOT end of params THEN put param list FI ; + put result ; + writeline . + +to first param : + param link := permanent pointer + word length ; + set end marker if end of list . + +put result : + INT VAR type; + get type and mode (type) ; + IF type <> void THEN type and mode := " --> " ; + name of type (type) ; + write bulletin line (type and mode) + FI +ENDPROC put specifications ; + +PROC put param list : + write bulletin line (" (") ; + REP + INT VAR type, param mode; + get type and mode (type) ; + param mode := mode ; + put type and mode ; + maybe param proc ; + next pt param ; + IF end of params THEN write bulletin line (")") ; + LEAVE put param list + FI ; + write bulletin line (", ") ; + PER . + +put type and mode : + type and mode := "" ; + name of type (type) ; + type and mode CAT name of mode ; + write bulletin line (type and mode) . + +name of mode : + IF param mode = const THEN " CONST" + ELIF param mode = var THEN " VAR" + ELSE " PROC" + FI . + +maybe param proc : + IF mode = permanent param proc THEN put virtual params FI . + +put virtual params : + skip over result type if complex type ; + IF NOT end of virtual params THEN put param list FI. + +skip over result type if complex type : + next pt param . + +end of virtual params : + end of params +ENDPROC put param list ; + +PROC next packet : + REP + packet link INCR wordlength ; + word := cdb int (packet link) ; + IF word = permanent packet THEN true return + ELIF end of permanents THEN false return + FI ; + ENDREP . + +true return : + found := TRUE ; + LEAVE next packet . + +false return : + found := FALSE ; + LEAVE next packet . + +end of permanents : + word = permanent end OR packet link > end of permanent table +ENDPROC next packet ; + +PROC prep bulletin : + forget (bulletin ds) ; + bulletin ds := nilspace ; + bulletin file := sequential file (output, bulletin ds) ; + line number := 0 ; + buffer := "" +ENDPROC prep bulletin ; + +PROC show bulletin file : + IF within editor THEN ueberschrift neu FI ; + DATASPACE VAR local ds :: bulletin ds ; + FILE VAR local file :: sequential file (modify, local ds) ; + show (local file) ; + forget (local ds) +ENDPROC show bulletin file ; + +PROC write bulletin line (TEXT CONST line) : + IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ; + buffer CAT line +ENDPROC write bulletin line ; + +PROC writeline : + write (bulletin file, buffer) ; + line (bulletin file) ; + line number INCR 1 ; + cout (line number) ; + buffer := indentation * " " +ENDPROC writeline ; + +PROC writeline (INT CONST times) : + IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ; + writeline + ELSE index := times + FI ; + line (bulletin file, index) ; + line number INCR index; + indentation := 0 ; + cout (line number) +ENDPROC writeline ; + +PROC bulletin (TEXT CONST packet name) : + prep bulletin ; + scan (packet name) ; + next symbol (pattern) ; + to packet ; + IF found THEN list packet ; + show bulletin file + ELSE error stop (packet name + " ist kein Paketname") + FI . + +to packet : + last packet entry := 0 ; + get nametab link of packet name ; + packet link := before first pt entry ; + REP + packet link INCR wordlength ; + word := cdb int (packet link) ; + IF word < 0 THEN IF word = permanent packet THEN packet found + ELIF word = permanent end THEN return + FI + FI + ENDREP . + +get nametab link of packet name : + to object (pattern) ; + IF NOT found THEN error stop ("unbekanntes Paket :" + packet name) ; + LEAVE to packet + FI . + +packet found : + IF cdb int (packet link + wordlength) = nt link + THEN last packet entry := packet link FI . + +return : + IF last packet entry <> 0 THEN found := TRUE ; + packet link := last packet entry + ELSE found := FALSE + FI ; + LEAVE to packet +ENDPROC bulletin ; + +PROC list packet : + begin of packet := packet link + word length ; + write packet name ; + find end of packet ; + run through nametab and list all packet objects . + +find end of packet : + last packet entry := begin of packet ; + REP + last packet entry INCR wordlength ; + word := cdb int (last packet entry) ; + UNTIL end of packet entries PER . + +end of packet entries : + word = permanent packet OR word = permanent end . + +run through nametab and list all packet objects : + hashtable pointer := begin of hashtable ; + REP + nt link := hashtable pointer ; + list objects of current packet in this chain ; + next hash entry + UNTIL end of hashtable reached ENDREP . + +list objects of current packet in this chain : + WHILE yet another nt entry REP + permanent pointer := cdb int (nt link + wordlength) ; + put objects of this name + PER . + +put objects of this name : + IF there is at least one object of this name in the current packet + THEN into bulletin FI . + +there is at least one object of this name in the current packet : + REP + IF permanent pointer >= begin of packet AND + permanent pointer < last packet entry + THEN LEAVE there is at least one object of this name + in the current packet WITH TRUE FI ; + next procedure + UNTIL permanent pointer = 0 PER ; + FALSE . + +into bulletin : + object name := cdb text (nt link + two word length) ; + object names into bulletin (BOOL PROC within packet) +ENDPROC list packet ; + +BOOL PROC within packet : + permanent pointer >= begin of packet AND + permanent pointer < last packet entry +ENDPROC within packet ; + +PROC object names into bulletin (BOOL PROC link ok) : + scan (object name) ; + next symbol (object name, mode) ; + IF type definition THEN put type definition + ELSE put object definitions + FI . + +type definition : + mode = bold AND no params . + +no params : + cdb int (permanent pointer + word length) >= permanent type . + +put type definition : + put obj name (object name) ; + write bulletin line ("TYPE ") ; + writeline (1) . + +put object definitions : + WHILE link ok REP + put specifications (object name) ; + next procedure + ENDREP +ENDPROC object names into bulletin ; + +PROC bulletin : + prep bulletin ; + packet link := first permanent entry ; + REP + list packet ; + write line (4) ; + next packet + UNTIL NOT found PER ; + show bulletin file +ENDPROC bulletin ; + +PROC put obj name (TEXT CONST name) : + buffer := " " ; + bulletin name := point line ; + change (bulletin name, 1, end of line or name, name) ; + buffer CAT bulletin name ; + indentation := LENGTH buffer + 1 . + +end of line or name : + min (LENGTH name, LENGTH bulletin name) +ENDPROC put obj name ; + +PROC packets : + prep bulletin ; + packet link := first permanent entry ; + REP + object name := packet name ; + put obj name (object name) ; + write line ; + next packet + UNTIL NOT found PER ; + show bulletin file +ENDPROC packets ; + +#page# +(**************************************************************************) +(* *) +(* 11. ELAN Run-Interface 09.01.1986 *) +(* *) +(* Uebersetzen von ELAN-Programmen *) +(* Bereitstellen der Ausgabeprozeduren fuer den ELAN-Compiler *) +(* *) +(**************************************************************************) + + + +BOOL VAR list option := FALSE , + check option := TRUE , + warning option := FALSE , + listing enabled := FALSE ; + +FILE VAR listing file ; + +TEXT VAR listing file name := "" ; + + +PROC run (TEXT CONST file name) : + enable stop ; + IF NOT exists (file name) + THEN errorstop ("""" + file name + """ gibt es nicht") + FI ; + last param (file name) ; + run elan (file name, no ins) +END PROC run; + +PROC run : + run (last param) +ENDPROC run ; + +PROC run again : + IF run again mod nr <> 0 + THEN elan (run again mode, bulletin file, "", run again mod nr, + no ins, no lst, check option, no sermon) + ELSE errorstop ("'run again' nicht moeglich") + FI +ENDPROC run again ; + +PROC insert (TEXT CONST file name) : + enable stop ; + IF NOT exists (file name) + THEN errorstop ("""" + file name + """ gibt es nicht") + FI ; + last param (file name) ; + run elan (file name, ins) +ENDPROC insert ; + +PROC insert : + insert (last param) +ENDPROC insert ; + +PROC run elan (TEXT CONST file name, BOOL CONST insert option) : + FILE VAR source := sequential file (modify, file name) ; + IF listing enabled + THEN open listing file + FI ; + + disable stop ; + no do again ; + elan (compile file mode, source, "" , run again mod nr, + insert option, list option, check option, sermon) ; + + IF anything noted AND command dialogue + THEN ignore halt during compiling ; + note edit (source) ; + last param (file name) ; + errorstop ("") + FI . + +ignore halt during compiling : + IF is error + THEN put error ; + clear error ; + pause (5) + FI . + +open listing file : + listing file := sequential file (output, listing file name) ; + max line length (listing file, 130) + +ENDPROC run elan ; + +PROC out text (TEXT CONST text, INT CONST out type) : + INTERNAL 257 ; + IF online + THEN out (text) + FI ; + IF out type = error message OR (warning option AND out type = warning message) + THEN note (text) ; + FI ; + IF listing enabled + THEN write (listing file, text) + FI +ENDPROC out text ; + +PROC out line (INT CONST out type) : + INTERNAL 258 ; + IF online + THEN out (""13""10"") + FI ; + IF out type = error message + OR (warning option AND out type = warning message) + THEN note line + ELIF listing enabled + THEN line (listing file) + FI +ENDPROC out line ; + +PROC prot (TEXT CONST file name) : + list option := TRUE ; + listing file name := file name ; + listing enabled := TRUE +ENDPROC prot ; + +PROC prot off : + list option := FALSE ; + listing enabled := FALSE +ENDPROC prot off ; + +BOOL PROC prot : + list option +ENDPROC prot ; + +PROC check on : + check option := TRUE +ENDPROC check on ; + +PROC check off : + check option := FALSE +ENDPROC check off ; + +BOOL PROC check : + check option +ENDPROC check ; + +PROC warnings on : + warning option := TRUE +ENDPROC warnings on ; + +PROC warnings off : + warning option := FALSE +ENDPROC warnings off ; + +BOOL PROC warnings : + warning option +ENDPROC warnings ; + +ENDPACKET eumel coder part 1 ; + diff --git a/system/base/1.7.5/src/file b/system/base/1.7.5/src/file new file mode 100644 index 0000000..530dcb3 --- /dev/null +++ b/system/base/1.7.5/src/file @@ -0,0 +1,2122 @@ +(* ------------------- VERSION 35 02.06.86 ------------------- *) +PACKET file handling DEFINES (* Autoren: J.Liedtke, D.Martinek *) + (***********) + + FILE, + :=, + sequential file, + reorganize, + input, + output, + modify, + close, + putline, + getline, + put, + get, + write , + line, + reset, + down, + up, + downety, + uppety, + pattern found, + to first record, + to line, + to eof, + insert record, + delete record, + read record, + write record, + is first record, + eof, + line no, + FRANGE, + set range, + reset range , + remove, + clear removed, + reinsert, + max line length, + edit info, + line type , + copy attributes , + headline, + put tabs, + get tabs, + col, + word, + at, + removed lines, + exec, + pos , + len , + subtext , + change , + lines , + segments , + mark , + mark line no , + mark col , + set marked range , + split line , + concatenate line , + prefix , + sort , + lexsort : + + +(**********************************************************************) +(* *) +(* Terminologie: *) +(* *) +(* *) +(* ATOMROW Menge aller Atome eines FILEs. *) +(* Die einzelnen Atome haben zwar eine Position *) +(* im Row, aber in dieser Betrachtung keine *) +(* logische Reihenfolge. *) +(* *) +(* ATOM Basiselement, kann eine Zeile der Datei und die *) +(* zugehoerige Verwaltungsinformation aufnehmen *) +(* *) +(* CHAIN Zyklisch geschlossene Kette von Segmenten. *) +(* *) +(* SEGMENT Teilbereich des Atomrows, enthaelt 1 oder mehr *) +(* zusammenhaengende Atoms. *) +(* Jedes Segment hat ein Vorgaenger- und ein *) +(* Nachfolgersegment. *) +(* Jedes Segment enthaelt einen logisch zumsammen- *) +(* haengenden Teile einer Sequence. *) +(* *) +(* SEQUENCE Logische Folge von Lines. *) +(* Jede Sequence ist Teil einer Chain oder besteht *) +(* vollstaendig daraus: *) +(* *) +(* SEG1--SEG2--SEG3--SEG4--SEG5 *) +(* :----sequence----: *) +(* *) +(* Die 'Reihenfolge' ebenso wie die 'Anzahl' der *) +(* Lines ist eine wesentliche Eigenschaft einer *) +(* Sequence. *) +(* *) +(* LINE Ein Atom als Element ein Sequence betrachtet. *) +(* *) +(* *) +(**********************************************************************) +(* *) +(* Eigenschaften: *) +(* *) +(* Folgende Mengen bilden eine Zerlegung (im math. Sinn) einer *) +(* gesamten Datei: *) +(* used segment chain *) +(* scratch segment chain *) +(* free segment chain *) +(* unused tail *) +(* *) +(* Fuer jedes X aus (used, scratch, free) gelten: *) +(* *) +(* 'X sequence' ist echte Teilmenge von 'X segment chain'. *) +(* *) +(* (Daraus folgt, es gibt keine leere 'chain'.) *) +(* *) +(* 'X segment chain' ist zyklisch gekettet. *) +(* *) +(* Alle Atome von 'X segment chain' haben definierten Inhalt. *) +(* *) +(**********************************************************************) + + +LET file size = 4075 , + nil = 0 , + + free root = 1 , + scratch root = 2 , + used root = 3 , + first unused = 4 ; + + +LET SEQUENCE = STRUCT (INT index, segment begin, segment end, + INT line no, lines), + SEGMENT = STRUCT (INT succ, pred, end), + ATOM = STRUCT (SEGMENT seg, INT type, TEXT line), + ATOMROW = ROW filesize ATOM, + + LIST = STRUCT (SEQUENCE used, INT prefix lines, postfix lines, + SEQUENCE scratch, free, INT unused tail, + INT mode, col, limit, edit info, mark line, mark col, + ATOMROW atoms); + +TYPE FILE = BOUND LIST ; + +TYPE FRANGE = STRUCT (INT pre, post, BOOL pre was split, post was split); + + +OP := (FRANGE VAR left, FRANGE CONST right): + CONCR (left) := CONCR (right) +ENDOP := ; + + +OP := (FILE VAR left, FILE CONST right): + EXTERNAL 260 +END OP :=; + + +PROC becomes (INT VAR a, b) : + INTERNAL 260 ; + a := b +END PROC becomes; + + +PROC initialize (FILE VAR f) : + + f.used := SEQUENCE : (used root, used root, used root, 1, 0); + f.prefix lines := 0; + f.postfix lines := 0; + f.free := SEQUENCE : (free root, free root, free root, 1, 0); + f.scratch := SEQUENCE : (scratch root, scratch root, scratch root, 1, 0); + f.unused tail := first unused; + + f.limit := 77; + f.edit info := 0; + f.col := 1 ; + f.mark line := 0 ; + f.mark col := 0 ; + + INT VAR i; + FOR i FROM 1 UPTO 3 REP + root (i).seg := SEGMENT : (i, i, i); + root (i).line := "" + PER; + put tabs (f, "") . + +root : f.atoms . + +END PROC initialize; + + +(**********************************************************************) +(* *) +(* Segment Handler (SEGMENTs & CHAINs) *) +(* *) +(**********************************************************************) + +INT PROC segs (SEQUENCE CONST s, ATOMROW CONST atom) : + + INT VAR number of segments := 0 , + actual segment := s.segment begin ; + REP + number of segments INCR 1 ; + actual segment := atom (actual segment).seg.succ + UNTIL actual segment = s.segment begin PER ; + number of segments . + +ENDPROC segs ; + + +PROC next segment (SEQUENCE VAR s, ATOMROW CONST atom) : + + disable stop; + s.line no INCR (s.segment end - s.index + 1); + INT CONST new segment index := actual segment.succ; + s.segment begin := new segment index; + s.segment end := new segment.end; + s.index := new segment index . + +actual segment : atom (s.segment begin).seg . +new segment : atom (new segment index).seg . + +END PROC next segment; + + +PROC previous segment (SEQUENCE VAR s, ATOMROW CONST atom) : + + disable stop; + s.line no DECR (s.index - s.segment begin + 1); + INT CONST new segment index := actual segment.pred; + s.segment begin := new segment index; + s.segment end := new segment.end; + s.index := s.segment end . + +actual segment : atom (s.segment begin).seg . +new segment : atom (new segment index).seg . + +END PROC previous segment; + + +PROC split segment (SEQUENCE VAR s, ATOMROW VAR atom) : + + disable stop; + IF not at segment top + THEN split segment at actual position + FI . + +split segment at actual position : + INT CONST pred index := s.segment begin, + actual index := s.index, + succ index := pred.succ; + + actual.pred := pred index; + actual.succ := succ index; + actual.end := s.segment end; + + pred.succ := actual index; + pred.end := actual index - 1; + + succ.pred := actual index; + + s.segment begin := actual index . + +not at segment top : s.index > s.segment begin . + +pred : atom (pred index).seg . + +actual : atom (actual index).seg . + +succ : atom (succ index).seg . + +END PROC split segment; + + +PROC join segments (ATOMROW VAR atom, + INT CONST first index, INT VAR second index) : + + disable stop; + IF first seg.end + 1 = second index + THEN attach second to first segment + ELSE link first to second segment + FI . + +attach second to first segment : + first seg.end := second seg.end; + INT VAR successor of second := second seg.succ; + IF successor of second = second index + THEN first seg.succ := first index + ELSE join segments (atom, first index, successor of second) + FI; + second index := first index . + +link first to second segment : + first seg.succ := second index; + second seg.pred := first index . + +first seg : atom (first index).seg . +second seg : atom (second index).seg . + +END PROC join segments; + + +PROC delete segments (SEQUENCE VAR from, ATOMROW VAR atom, + INT CONST first index, last index, lines) : + + determine surrounding segments and new atom index; + join surrounding segments; + update sequence descriptor . + +determine surrounding segments and new atom index : + INT VAR pred index := first seg.pred, + actual index := last seg.succ; + from.index := actual index . + +join surrounding segments : + join segments (atom, pred index, actual index) . + +update sequence descriptor : + from.segment begin := actual index; + from.segment end := actual seg.end; + from.lines DECR lines . + +actual seg : atom (actual index).seg . +first seg : atom (first index).seg . +last seg : atom (last index).seg . + +END PROC delete segments; + + +PROC insert segments (SEQUENCE VAR into, ATOMROW VAR atom, + INT CONST first index, last index, lines) : + + join into sequence and new segments; + update sequence descriptor . + +join into sequence and new segments : + INT VAR actual index := into.index, + pred index := actual seg.pred; + join segments (atom, last index, actual index); + actual index := first index; + join segments (atom, pred index, actual index) . + +update sequence descriptor : + into.index := first index; + into.segment begin := actual index; + into.segment end := actual seg.end; + into.lines INCR lines . + +actual seg : atom (actual index).seg . + +END PROC insert segments; + + +PROC next atom (SEQUENCE VAR s, ATOMROW CONST atom) : + + IF s.line no <= s.lines + THEN to next atom + ELSE errorstop ("'down' nach Dateiende") + FI . + +to next atom : + disable stop; + IF s.index = s.segment end + THEN next segment (s, atom) + ELSE s.index INCR 1; + s.line no INCR 1 + FI + +END PROC next atom; + + +PROC next atoms (SEQUENCE VAR s, ATOMROW CONST atom, INT CONST times) : + + INT CONST destination line := min (s.line no + times, s.lines + 1); + jump upto destination segment; + position within destination segment . + +jump upto destination segment : + WHILE s.line no + length of actual segments tail < destination line REP + next segment (s, atom); + PER . + +position within destination segment : + disable stop; + s.index INCR (destination line - s.line no); + s.line no := destination line . + +length of actual segments tail : s.segment end - s.index . + +END PROC next atoms; + + +PROC previous atom (SEQUENCE VAR s, ATOMROW CONST atom) : + + IF s.line no > 1 + THEN to previous atom + ELSE errorstop ("'up' am Dateianfang") + FI . + +to previous atom : + disable stop; + IF s.index = s.segment begin + THEN previous segment (s, atom) + ELSE s.index DECR 1; + s.line no DECR 1 + FI + +END PROC previous atom; + + +PROC previous atoms (SEQUENCE VAR s, ATOMROW CONST atom, INT CONST times) : + + INT CONST destination line := max (1, s.line no - times); + jump back to destination segment; + position within destination segment . + +jump back to destination segment : + WHILE s.line no - length of actual segments head > destination line REP + previous segment (s, atom); + PER . + +position within destination segment : + disable stop; + s.index DECR (s.line no - destination line); + s.line no := destination line . + +length of actual segments head : s.index - s.segment begin . + +END PROC previous atoms; + + +TEXT VAR pre, pat, pattern0; +INT VAR last search line ; + +PROC search down (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern, + INT CONST max lines, INT VAR column) : + + INT CONST start col := column , + start line := s.lineno ; + last search line := min (s.lines, s.lineno + max lines) ; + pre:= somefix (pattern) ; + pattern0 := pattern ** 0 ; + down in atoms (s, atom, pre, column); + IF NOT (last search succeeded CAND like pattern) + THEN try again + FI; + last search succeeded := TRUE ; + column := matchpos (0) . + +try again: + WHILE s.line no < last search line + REP next atom (s, atom) ; + column := 1 ; + down in atoms (s, atom, pre, column); + IF last search succeeded CAND like pattern + THEN LEAVE try again + FI + PER; + column := 1 + LENGTH record; + last search succeeded := FALSE ; + LEAVE search down. + +like pattern : + correct position ; + pat := any (column-1) ; + pat CAT any ; + pat CAT pattern0 ; + pat CAT any ; + record LIKE pat . + +correct position : + IF s.lineno = start line + THEN column := start col + ELSE column := 1 + FI . + +record : atom (s.index).line . + +ENDPROC search down ; + +PROC down in atoms (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern, + INT VAR column) : + + last search succeeded := FALSE ; + search forwards in actual line ; + IF NOT found AND s.line no < last search line + THEN search in following lines + FI ; + IF found + THEN last search succeeded := TRUE + ELSE set column behind last char + FI . + +set column behind last char : + column := LENGTH atom (s.index).line + 1 . + +search forwards in actual line : + IF pattern <> "" + THEN column := pos (atom (s.index).line, pattern, column) + ELIF column > LENGTH atom (s.index).line + THEN column := 0 + FI . + +search in following lines : + next atom (s, atom) ; + IF pattern = "" + THEN column := 1 ; + LEAVE search in following lines + FI ; + REP + search forwards through segment ; + update file position forwards ; + IF found OR s.line no = last search line + THEN LEAVE search in following lines + ELSE next segment (s, atom) + FI + PER . + +search forwards through segment : + INT VAR search index := s.index , + last index := min (s.segment end, s.index+(last search line-s.line no)); + REP + column := pos (atom (search index).line, pattern) ; + IF found OR search index = last index + THEN LEAVE search forwards through segment + FI ; + search index INCR 1 + PER . + +update file position forwards : + disable stop ; + s.line no INCR (search index - s.index) ; + s.index := search index ; + enable stop . + +found : column > 0 . + +ENDPROC down in atoms ; + +TEXT PROC prefix (TEXT CONST pattern) : + + INT VAR invalid char pos := pos (pattern, ""0"", ""31"", 1) ; + SELECT invalid char pos OF + CASE 0 : pattern + CASE 1 : "" + OTHERWISE : subtext (pattern, 1, invalid char pos - 1) + ENDSELECT . + +ENDPROC prefix ; + +PROC search up (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern, + INT CONST max lines, INT VAR column) : + + last search line := max (1, s.lineno - max lines) ; + pre:= prefix (pattern); + pattern0 := pattern ** 0; + remember start point ; + up in atoms (s, atom, pre, column); + IF NOT (last search succeeded CAND last pattern in line found) + THEN try again + FI; + last search succeeded := TRUE ; + column := matchpos (0) . + + try again: + WHILE s.lineno > last search line OR column > 1 + REP previous atom (s, atom); + column := LENGTH record ; + up in atoms (s, atom, pre, column); + IF last search succeeded CAND last pattern in line found + THEN LEAVE try again + FI + PER; + column := 1; + last search succeeded := FALSE ; + LEAVE search up. + + remember start point : + INT VAR c:= column, r:= s.lineno;. + + last pattern in line found : + column := 2 ; + WHILE like pattern CAND right of start REP + column := matchpos (0) +1 + PER ; + column DECR 1 ; + like pattern CAND right of start . + + like pattern : + pat := any (column-1) ; + pat CAT any ; + pat CAT pattern0 ; + pat CAT any ; + record LIKE pat . + + right of start : (r > s.lineno COR c >= matchpos(0)) . + record : atom (s.index).line . + +ENDPROC search up ; + +PROC up in atoms (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern, + INT VAR column) : + + last search succeeded := FALSE ; + search backwards in actual line ; + IF NOT found AND s.line no > last search line + THEN search in preceeding lines + FI ; + IF found + THEN last search succeeded := TRUE + ELSE column := 1 + FI . + +search backwards in actual line : + IF pattern = "" + THEN LEAVE search backwards in actual line + FI ; + INT VAR last pos , new pos := 0 ; + REP + last pos := new pos ; + new pos := pos (atom (s.index).line, pattern, last pos+1) ; + UNTIL new pos = 0 OR new pos > column PER ; + column := last pos . + +search in preceeding lines : + previous atom (s, atom) ; + IF pattern = "" + THEN column := LENGTH atom (s.index).line + 1 ; + last search succeeded := TRUE ; + LEAVE search in preceeding lines + FI ; + REP + search backwards through segment ; + update file position backwards ; + IF found OR s.line no = last search line + THEN LEAVE search in preceeding lines + ELSE previous segment (s, atom) + FI + PER . + +search backwards through segment : + INT VAR search index := s.index , + last index := max (s.segment begin, s.index-(s.line no-last search line)); + REP + new pos := 0 ; + REP + column := new pos ; + new pos := pos (atom (search index).line, pattern, column+1) ; + UNTIL new pos = 0 PER ; + IF found OR search index = last index + THEN LEAVE search backwards through segment + FI ; + search index DECR 1 + PER . + +update file position backwards : + disable stop ; + s.line no DECR (s.index - search index) ; + s.index := search index ; + enable stop . + +found : column > 0 . + +ENDPROC up in atoms ; + +BOOL VAR last search succeeded ; + +BOOL PROC pattern found : + last search succeeded +ENDPROC pattern found ; + + + +PROC delete atom (SEQUENCE VAR used, free, ATOMROW VAR atom) : + + disable stop; + IF used.line no <= used.lines + THEN delete actual atom + ELSE errorstop ("'delete' am Dateiende") + FI . + +delete actual atom : + position behind actual free segment; + split segment (used, atom); + INT VAR actual index := used.index; + cut off tail of actual used segment; + delete segments (used, atom, actual index, actual index, 1); + insert segments (free, atom, actual index, actual index, 1) . + +position behind actual free segment : + IF free.line no <= free.lines + THEN next segment (free, atom) + FI . + +cut off tail of actual used segment : + IF actual index <> used.segment end + THEN used.index INCR 1; + split segment (used, atom); + used.index DECR 1 + FI . + +END PROC delete atom; + + +PROC insert atom (SEQUENCE VAR used, free,INT VAR unused, ATOMROW VAR atom) : + + disable stop; + split segment (used, atom); + IF free.lines > 0 + THEN insert new atom from free sequence + ELIF unused <= file size + THEN insert new atom from unused tail + ELSE errorstop ("FILE-Ueberlauf") + FI . + +insert new atom from free sequence : + get a free segments head; + make this atom to actual segment; + transfer from free to used chain . + +get a free segments head : + IF actual free segment is root segment + THEN previous segment (free, atom) + FI; + position to actual segments head . + +position to actual segments head : + INT VAR actual index := free.segment begin; + free.line no DECR (free.index - actual index); + free.index := actual index . + +make this atom to actual segment : + IF free.segment end > actual index + THEN free.index INCR 1; + split segment (free, atom); + free.index DECR 1 + FI . + +transfer from free to used chain : + delete segments (free, atom, actual index, actual index, 1); + insert segments (used, atom, actual index, actual index, 1); + atom (actual index).line := "" . + +insert new atom from unused tail : + actual index := unused; + atom (actual index).seg := + SEGMENT:(actual index, actual index, actual index); + atom (actual index).line := ""; + insert segments (used, atom, actual index, actual index, 1); + unused INCR 1 . + +actual free segment is root segment : free.segment begin = free root . + +END PROC insert atom; + + +PROC insert next (SEQUENCE VAR used, free, INT VAR unused, ATOMROW VAR atom, + TEXT CONST record) : + + IF used.line no > used.lines + THEN insert atom (used, free, unused, atom) + ELIF actual position before unused nonempty atomrow part + THEN forward and insert atom by simple extension of used atomrow part + ELSE next atom (used, atom); + insert atom (used, free, unused, atom) + FI; + atom (used.index).line := record . + +forward and insert atom by simple extension of used atomrow part : + used.line no INCR 1; + used.lines INCR 1; + used.index INCR 1; + used.segment end INCR 1; + atom (used.segment begin).seg.end INCR 1; + unused INCR 1 . + +actual position before unused nonempty atomrow part : + used.index = unused - 1 AND unused part not empty . + +unused part not empty : unused <= file size . + +END PROC insert next; + + +PROC transfer subsequence (SEQUENCE VAR source, dest, + ATOMROW VAR atom, INT CONST size) : + + IF size > 0 + THEN INT VAR subsequence size := min (size, source.line no); + mark begin of source part; + mark end of source part; + split destination sequence; + transfer part + FI . + +mark begin of source part : + previous atoms (source, atom, subsequence size - 1); + split segment (source, atom); + INT CONST first := source.segment begin . + +mark end of source part : + next atoms (source, atom, subsequence size - 1); + INT CONST last := source.segment begin; + next atom (source, atom); + split segment (source, atom) . + +split destination sequence : + split segment (dest, atom) . + +transfer part : + disable stop; + delete segments (source, atom, first, last, subsequence size); + source.line no DECR subsequence size; + insert segments (dest, atom, first, last, subsequence size); + next atoms (dest, atom, subsequence size - 1) . + +END PROC transfer subsequence; + + + +(********************************************************************) +(***** *****) +(***** FILE handler *****) +(***** *****) +(********************************************************************) + + + +LET file type = 1003 , + file type 16 = 1002 , + + closed = 0, + inp = 1, + outp = 2, + mod = 3, + end = 4, + + max limit = 16000, + super limit = 16001; + + +TYPE TRANSPUTDIRECTION = INT; + + +TRANSPUTDIRECTION PROC input : + TRANSPUTDIRECTION : (inp) +END PROC input; + + +TRANSPUTDIRECTION PROC output : + TRANSPUTDIRECTION : (outp) +END PROC output; + + +TRANSPUTDIRECTION PROC modify : + TRANSPUTDIRECTION : (mod) +END PROC modify; + + +FILE VAR result file; + + +FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, + DATASPACE CONST ds) : + IF type (ds) = file type + THEN result := ds + ELIF type (ds) < 0 + THEN result := ds; type (ds, file type); initialize (result file) + ELSE enable stop; errorstop ("Datenraum hat falschen Typ") + FI; + reset (result file, mode); + result file . + +result : CONCR (result file) . + +END PROC sequential file; + + +FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, TEXT CONST name) : + + IF exists (name) + THEN get dataspace if file + ELIF CONCR (mode) <> inp + THEN get new file space + ELSE errorstop (""""+name+""" gibt es nicht") ; enable stop + FI; + update status if necessary; + reset (result file, mode); + result file . + +get dataspace if file : + IF type (old (name)) = file type 16 + THEN reorganize (name) + FI ; + result := old (name, file type) ; + IF is 170 file + THEN result.col := 1 ; + result.mark line := 0 ; + result.mark col := 0 + FI . + +is 170 file : result.mark col < 0 . + +get new file space : + result := new (name); + IF NOT is error + THEN type (old (name), file type); initialize (result file) + FI . + +update status if necessary : + IF CONCR (mode) <> inp + THEN status (name, ""); headline (result file, name) + FI . + +result : CONCR (result file) . + +END PROC sequential file; + + +PROC reset (FILE VAR f) : + + IF f.mode = end + THEN reset (f, input) + ELSE reset (f, TRANSPUTDIRECTION:(f.mode)) + FI . + +ENDPROC reset ; + +PROC reset (FILE VAR f, TRANSPUTDIRECTION CONST mode) : + + IF f.mode <> mod OR new mode <> mod + THEN f.mode := new mode ; + initialize file index + FI . + +initialize file index : + IF new mode = outp + THEN to line without check (f, f.used.lines); + col := super limit + ELSE to line without check (f, 1); + col := 1 ; + IF new mode = inp AND file is empty + THEN f.mode := end + FI + FI . + +file is empty : f.used.lines = 0 . + +new mode : CONCR (mode) . + +col : CONCR (CONCR (f)).col . + +END PROC reset; + + +PROC input (FILE VAR f) : + + reset (f, input) . + +END PROC input; + + +PROC output (FILE VAR f) : + + reset (f, output) + +END PROC output; + + +PROC modify (FILE VAR f) : + + reset (f, modify) + +END PROC modify; + + +PROC close (FILE VAR f) : + + f.mode := closed . + +END PROC close; + + +PROC check mode (FILE CONST f, INT CONST mode) : + + IF f.mode = mode + THEN LEAVE check mode + ELIF f.mode = closed + THEN errorstop ("Datei zu!") + ELIF f.mode = mod + THEN errorstop ("unzulaessiger Zugriff auf modify-FILE") + ELIF mode = mod + THEN errorstop ("Zugriff nur auf modify-FILE zulaessig") + ELIF f.mode = end + THEN errorstop ("Leseversuch nach Dateiende") + ELIF mode = inp + THEN errorstop ("Leseversuch auf output-FILE") + ELIF mode = outp + THEN errorstop ("Schreibversuch auf input-FILE") + FI . + +END PROC check mode; + + +PROC to line without check (FILE VAR f, INT CONST destination line) : + + INT CONST distance := destination line - f.used.line no; + IF distance > 0 + THEN next atoms (f.used, f.atoms, distance) + ELIF distance < 0 + THEN previous atoms (f.used, f.atoms, - distance) + FI . + +END PROC to line without check; + + +PROC to line (FILE VAR f, INT CONST destination line) : + + check mode (f, mod); + to line without check (f, destination line) + +END PROC to line; + + +PROC to first record (FILE VAR f) : + + to line (f, 1) + +END PROC to first record; + + +PROC to eof (FILE VAR f) : + + to line (f, f.used.lines + 1) . + +END PROC to eof; + + +PROC putline (FILE VAR f, TEXT CONST word) : + + write (f, word); + col := super limit . + +col : CONCR (CONCR (f)).col . + +END PROC putline; + + +PROC delete record (FILE VAR f) : + + check mode (f, mod); + delete atom (f.used, f.free, f.atoms) . + +END PROC delete record; + + +PROC insert record (FILE VAR f) : + + check mode (f, mod); + insert atom (f.used, f.free, f.unused tail, f.atoms) . + +END PROC insert record; + + +PROC down (FILE VAR f) : + + check mode (f, mod); + next atom (f.used, f.atoms) . + +END PROC down ; + +PROC up (FILE VAR f) : + + check mode (f, mod); + previous atom (f.used, f.atoms) . + +END PROC up ; + +PROC down (FILE VAR f, INT CONST n) : + + to line (f, lineno (f) + n) + +ENDPROC down ; + +PROC up (FILE VAR f, INT CONST n) : + + to line (f, lineno (f) - n) + +ENDPROC up ; + + +PROC write record (FILE VAR f, TEXT CONST record) : + + check mode (f, mod); + IF not at eof + THEN f.atoms (f.used.index).line := record + ELSE errorstop ("'write' nach Dateiende") + FI . + +not at eof : f.used.line no <= f.used.lines . + +END PROC write record; + + +PROC read record (FILE CONST f, TEXT VAR record) : + + check mode (f, mod); + record := f.atoms (f.used.index).line . + +END PROC read record; + + +PROC line (FILE VAR f) : + + IF mode = end + THEN errorstop ("Leseversuch nach Dateiende") + ELIF mode = inp + THEN next atom (f.used, f.atoms); col := 1; check eof + ELIF mode = outp + THEN IF col <= max limit + THEN col := super limit + ELSE append empty line + FI + FI . + +append empty line : + insert next (f.used, f.free, f.unused tail, f.atoms, "") . + +col : CONCR (CONCR (f)).col . + +mode : CONCR (CONCR (f)).mode . + +check eof : + IF eof (f) THEN mode := end FI . + +END PROC line; + + +PROC line (FILE VAR f, INT CONST lines) : + + INT VAR i; FOR i FROM 1 UPTO lines REP line (f) PER + +END PROC line; + + +PROC getline (FILE VAR f, TEXT VAR text) : + + check mode (f, inp); + text := subtext (record, f.col); + IF f.used.line no >= f.used.lines + THEN f.mode := end ; + set end of file + ELSE to next line ; + f.col := 1 + FI . + +to next line : + next atom (f.used, f.atoms) . + +set end of file : + f.col := LENGTH record + 1 . + +record : f.atoms (f.used.index).line . + +END PROC getline; + + +BOOL PROC is first record (FILE CONST f) : + + check mode (f, mod); + f.used.line no = 1 . + +END PROC is first record; + + +BOOL PROC eof (FILE CONST f) : + + IF line no < lines THEN FALSE + ELIF line no = lines THEN col > LENGTH record + ELSE TRUE + FI . + +line no : f.used.line no . +lines : f.used.lines . +col : f.col . +record : f.atoms (f.used.index).line . + +END PROC eof; + + +INT PROC line no (FILE CONST f) : + + f.used.line no . + +END PROC line no; + + +PROC line type (FILE VAR f, INT CONST t) : + + f.atoms (f.used.index).type := t . + +ENDPROC line type ; + +INT PROC line type (FILE CONST f) : + + f.atoms (f.used.index).type . + +ENDPROC line type ; + + +PROC put (FILE VAR f, TEXT CONST word) : + + check mode (f, outp); + IF col + LENGTH word > f.limit + THEN append new line + ELSE record CAT word + FI; + record CAT " "; + col := LENGTH record + 1 . + +append new line : + insert next (f.used, f.free, f.unused tail, f.atoms, word) . + +record : f.atoms (f.used.index).line . +col : f.col . + +END PROC put; + + +PROC put (FILE VAR f, INT CONST value) : + + put (f, text (value)) + +END PROC put; + + +PROC put (FILE VAR f, REAL CONST real) : + + put (f, text (real)) + +END PROC put; + + +PROC write (FILE VAR f, TEXT CONST word) : + + check mode (f, outp); + IF col + LENGTH word - 1 > f.limit + THEN append new line + ELSE record CAT word + FI; + col := LENGTH record + 1 . + +append new line : + insert next (f.used, f.free, f.unused tail, f.atoms, word) . + +record : f.atoms (f.used.index).line . +col : f.col . + +END PROC write; + + +PROC get (FILE VAR f, TEXT VAR word, TEXT CONST separator) : + + check mode (f, inp); + skip separators; + IF word found + THEN get word + ELSE try to find word in next line + FI . + +skip separators : + INT CONST separator length := LENGTH separator; + WHILE is separator REP col INCR separator length PER . + +is separator : + subtext (record, col, col + separator length - 1) = separator . + +word found : col <= LENGTH record . + +get word : + INT VAR end of word := pos (record, separator, col) - 1; + IF separator found + THEN get text upto separator + ELSE get rest of record + FI . + +separator found : end of word >= 0 . + +get text upto separator : + word := subtext (record, col, end of word); + col := end of word + separator length + 1; + IF col > LENGTH record THEN line (f) FI . + +get rest of record : + word := subtext (record, col); line (f) . + +record : f.atoms (f.used.index).line . +col : f.col . + +try to find word in next line : + line (f); IF eof (f) THEN word := "" ELSE get (f, word, separator) FI . + +END PROC get; + + +PROC get (FILE VAR f, TEXT VAR word, INT CONST max length) : + + check mode (f, inp); + IF word is only a part of record + THEN get text of certain length + ELSE get rest of record + FI . + +word is only a part of record : + col <= LENGTH record - max length . + +get text of certain length : + word := text (record, max length, col); + col INCR max length . + +get rest of record : + word := subtext (record, col); line (f) . + +record : f.atoms (f.used.index).line . +col : f.col . + +END PROC get; + + +PROC get (FILE VAR f, TEXT VAR word) : + + get (f, word, " ") + +END PROC get; + + +TEXT VAR number word; + + +PROC get (FILE VAR f, INT VAR number) : + + get (f, number word); + number := int (number word) + +END PROC get; + + +PROC get (FILE VAR f, REAL VAR number) : + + get (f, number word); + number := real (number word) + +END PROC get; + + +TEXT VAR split record ; +INT VAR indentation ; + +PROC split line (FILE VAR f, INT CONST split col) : + + split line (f, split col, TRUE) + +ENDPROC split line ; + +PROC split line (FILE VAR f, INT CONST split col, BOOL CONST note indentation ) : + + IF note indentation + THEN get indentation + ELSE indentation := 0 + FI ; + get split record ; + insert split record and indentation ; + cut off old record . + +get indentation : + indentation := pos (actual record,""33"",""254"",1) - 1 ; + IF indentation < 0 OR indentation >= split col + THEN indentation := split col - 1 + FI . + +get split record : + split record := subtext (actual record, split col, max limit) . + +insert split record and indentation : + down (f) ; + insert record (f) ; + INT VAR i ; + FOR i FROM 1 UPTO indentation REP + actual record CAT " " + PER ; + actual record CAT split record ; + up (f) . + +cut off old record : + actual record := subtext (actual record, 1, split col-1) . + +actual record : f.atoms (f.used.index).line . + +ENDPROC split line ; + +PROC concatenate line (FILE VAR f, BOOL CONST delete blanks) : + + down (f) ; + split record := actual record ; + IF delete blanks + THEN delete leading blanks + FI ; + delete record (f) ; + up (f) ; + actual record CAT split record . + +delete leading blanks : + INT CONST non blank col := pos (split record, ""33"", ""254"", 1) ; + IF non blank col > 0 + THEN split record := subtext (split record, non blank col) + FI . + +actual record : f.atoms (f.used.index).line . + +ENDPROC concatenate line ; + +PROC concatenate line (FILE VAR f) : + concatenate line (f, TRUE) +ENDPROC concatenate line ; + +PROC reorganize : + + reorganize (last param) + +END PROC reorganize; + + +TEXT VAR file record ; + +PROC reorganize (TEXT CONST file name) : + + enable stop ; + FILE VAR input file, output file; + DATASPACE VAR scratch space; + INT CONST type of dataspace := type (old (file name)) ; + INT VAR counter; + + last param (file name); + IF type of dataspace = file type + THEN reorganize new to new + ELIF type of dataspace = file type 16 + THEN reorganize old to new + ELSE errorstop ("Datenraum hat falschen Typ") + FI; + replace file space by scratch space . + +reorganize new to new : + input file := sequential file (input, file name); + disable stop ; + scratch space := nilspace ; + output file := sequential file (output, scratch space); + copy attributes (input file, output file) ; + + FOR counter FROM 1 UPTO 9999 + WHILE NOT eof (input file) REP + cout (counter); + getline (input file, file record); + putline (output file, file record); + check for interrupt + PER . + +reorganize old to new : + LET OLDRECORD = STRUCT (INT succ, pred, x, y, TEXT record); + LET OLDFILE = BOUND ROW 4075 OLDRECORD; + LET dateianker = 2, freianker = 1; + INT VAR index := dateianker; + + OLDFILE VAR old file := old (file name); + disable stop; + scratch space := nilspace; + output file := sequential file (output, scratch space); + get old attributes ; + + say ("Datei wird in 1.7-Format gewandelt: ") ; + + FOR counter FROM 1 UPTO 9999 + WHILE NOT end of old file REP + cout (counter); + index := next record; + file record := record of old file ; + IF pos (file record, ""128"", ""250"", 1) > 0 + THEN change special chars + FI ; + putline (output file, file record); + check for interrupt + PER . + +get old attributes : + get old headline ; + get old limit and tabs . + +get old headline : + headline (output file, old file (dateianker).record) . + +get old limit and tabs : + file record := old file (freianker).record ; + max line length (output file, int (subtext (file record, 11, 15))) ; + put tabs (output file, subtext (file record, 16)) . + +change special chars : + change all (file record, ""193"", ""214"") (* Ae *) ; + change all (file record, ""207"", ""215"") (* Oe *) ; + change all (file record, ""213"", ""216"") (* Ue *) ; + change all (file record, ""225"", ""217"") (* ae *) ; + change all (file record, ""239"", ""218"") (* oe *) ; + change all (file record, ""245"", ""219"") (* ue *) ; + change all (file record, ""235"", ""220"") (* k *) ; + change all (file record, ""173"", ""221"") (* - *) ; + change all (file record, ""163"", ""222"") (* fis *) ; + change all (file record, ""160"", ""223"") (* blank *) ; + change all (file record, ""194"", ""251"") (* eszet *) . + +end of old file : next record = dateianker . + +next record : old file (index).succ . + +record of old file : old file (index).record . + +check for interrupt : + INT VAR size, used ; + storage (size, used) ; + IF used > size + THEN errorstop ("Speicherengpass") + FI ; + IF is error + THEN forget (scratch space) ; LEAVE reorganize + FI . + +replace file space by scratch space : + headline (output file, file name); + forget (file name, quiet) ; + type (scratch space, file type); + copy (scratch space, file name); + forget (scratch space) . + +END PROC reorganize; + + +PROC set range (FILE VAR f, INT CONST start line, start col, + FRANGE VAR old range) : + + check mode (f, mod); + IF valid restriction parameters + THEN prepare last line ; + prepare first line ; + save old range ; + set new range + ELSE errorstop ("FRANGE ungueltig") + FI . + +valid restriction parameters : + start line > 0 AND start col > 0 AND start before or at actual point . + +start before or at actual point : + start line < line no (f) OR + start line = line no (f) AND start col <= col (f) . + +prepare last line : + INT VAR last line ; + IF col (f) > 1 + THEN split line (f, col(f), FALSE) + FI . + +prepare first line : + IF start col > 1 + THEN split start line ; + FI . + +split start line : + INT VAR old line no := line no (f) ; + to line (f, start line) ; + split line (f, start col, FALSE) ; + to line (f, old line no + 1) . + +save old range : + old range.pre := f.prefix lines ; + old range.post:= f.postfix lines . + +set new range : + get pre lines ; + get post lines ; + disable stop ; + f.prefix lines INCR pre lines ; + f.postfix lines INCR post lines ; + f.used.lines DECR (post lines + pre lines) ; + f.used.line no DECR pre lines . + +get pre lines : + INT VAR pre lines ; + IF start col = 1 + THEN old range.pre was split := FALSE ; + pre lines := start line - 1 + ELSE old range.pre was split := TRUE ; + pre lines := start line + FI . + +get post lines : + INT VAR post lines ; + IF col (f) = 1 + THEN old range.post was split := FALSE ; + post lines := lines (f) - line no (f) + 1 + ELSE old range.post was split := TRUE ; + post lines := lines (f) - line no (f) + FI . + +END PROC set range; + + +PROC set range (FILE VAR f, FRANGE VAR new range) : + + check mode (f, mod); + INT CONST pre add := prefix - new range.pre, + post add := postfix - new range.post; + IF pre add < 0 OR post add < 0 + THEN errorstop ("FRANGE ungueltig") + ELSE set new range; + undo splitting if necessary ; + make range var invalid + FI . + +set new range : + disable stop; + prefix DECR pre add; + postfix DECR post add; + used.line no INCR pre add; + used.lines INCR (pre add + post add) . + +undo splitting if necessary : + IF new range.pre was split + THEN concatenate first line + FI ; + IF new range.post was split + THEN concatenate last line + FI . + +concatenate first line : + INT VAR old line := line no (f) ; + to line (f, pre add) ; + concatenate line (f, FALSE) ; + to line (f, old line - 1) . + +concatenate last line : + old line := line no (f) ; + to line (f, lines (f) - post add) ; + concatenate line (f, FALSE) ; + to line (f, old line) . + +make range var invalid : + new range.pre := maxint . + +used : f.used . +prefix : f.prefix lines . +postfix : f.postfix lines . + +END PROC set range; + +PROC reset range (FILE VAR f) : + + FRANGE VAR complete ; + complete.pre := 0 ; + complete.post:= 0 ; + complete.pre was split := FALSE ; + complete.post was split:= FALSE ; + set range (f, complete) + +ENDPROC reset range ; + +PROC remove (FILE VAR f, INT CONST size) : + + check mode (f, mod); + transfer subsequence (f.used, f.scratch, f.atoms, size) . + +END PROC remove; + + +PROC clear removed (FILE VAR f) : + + check mode (f, mod); + transfer subsequence (f.scratch, f.free, f.atoms, f.scratch.lines) . + +END PROC clear removed; + + +PROC reinsert (FILE VAR f) : + + check mode (f, mod); + transfer subsequence (f.scratch, f.used, f.atoms, f.scratch.lines) . + +END PROC reinsert; + + +PROC copy attributes (FILE CONST source file, FILE VAR dest file) : + + dest.limit := source.limit ; + dest.atoms (free root).line := source.atoms (free root).line ; + dest.atoms (scratch root).line := source.atoms (scratch root).line ; + dest.edit info := source.edit info . + +dest : CONCR (CONCR (dest file)) . +source : CONCR (CONCR (source file)) . + +ENDPROC copy attributes ; + + +INT PROC max line length (FILE CONST f) : + + f.limit . + +END PROC max line length; + + +PROC max line length (FILE VAR f, INT CONST new limit) : + + IF new limit > 0 AND new limit <= max limit + THEN f.limit := new limit + FI . + +END PROC max line length; + + +TEXT PROC headline (FILE CONST f) : + + f.atoms (free root).line . + +END PROC headline; + + +PROC headline (FILE VAR f, TEXT CONST head) : + + f.atoms (free root).line := head . + +END PROC headline; + + +PROC get tabs (FILE CONST f, TEXT VAR tabs) : + + tabs := f.atoms (scratch root).line . + +END PROC get tabs; + + +PROC put tabs (FILE VAR f, TEXT CONST tabs) : + + f.atoms (scratch root).line := tabs . + +END PROC put tabs; + + +INT PROC edit info (FILE CONST f) : + + f.edit info . + +END PROC edit info; + + +PROC edit info (FILE VAR f, INT CONST info) : + + f.edit info := info . + +END PROC edit info; + + +INT PROC lines (FILE CONST f) : + + f.used.lines . + +END PROC lines; + + +INT PROC removed lines (FILE CONST f) : + + f.scratch.lines . + +END PROC removed lines; + + +INT PROC segments (FILE CONST f) : + + segs(f.used,f.atoms) + segs(f.scratch,f.atoms) + segs(f.free,f.atoms) - 2 . + +ENDPROC segments ; + + +INT PROC col (FILE CONST f) : + + f.col + +ENDPROC col ; + +PROC col (FILE VAR f, INT CONST new column) : + + IF new column > 0 + THEN f.col := new column + FI + +ENDPROC col ; + +TEXT PROC word (FILE CONST f) : + + word (f, " ") + +ENDPROC word ; + +TEXT PROC word (FILE CONST f, TEXT CONST delimiter) : + + INT VAR del pos := pos (f, delimiter, col (f)) ; + IF del pos = 0 + THEN del pos := len (f) + 1 + FI ; + subtext (f, col (f), del pos - 1) + +ENDPROC word ; + +TEXT PROC word (FILE CONST f, INT CONST max length) : + + subtext (f, col (f), col (f) + max length - 1) + +ENDPROC word ; + +BOOL PROC at (FILE CONST f, TEXT CONST word) : + + pat := any (column-1) ; + pat CAT word ; + pat CAT any ; + record LIKE pat . + +column : f.col . +record : f.atoms (f.used.index).line . + +ENDPROC at ; + + +PROC exec (PROC (TEXT VAR, TEXT CONST) proc, FILE VAR f, TEXT CONST t) : + + proc (record, t) . + +record : f.atoms (f.used.index).line . + +END PROC exec; + + +PROC exec (PROC (TEXT VAR, INT CONST) proc, FILE VAR f, INT CONST i) : + + proc (record, i) . + +record : f.atoms (f.used.index).line . + +END PROC exec; + +INT PROC pos (FILE CONST f, TEXT CONST pattern, INT CONST i) : + + pos (record, pattern, i) . + +record : f.atoms (f.used.index).line . + +END PROC pos ; + +PROC down (FILE VAR f, TEXT CONST pattern) : + + down (f, pattern, file size) + +ENDPROC down ; + +PROC down (FILE VAR f, TEXT CONST pattern, INT CONST max line) : + + check mode (f,mod) ; + INT VAR pattern pos := f.col + 1 ; + search down (f.used, f.atoms, pattern, max line, pattern pos) ; + f.col := pattern pos + +ENDPROC down ; + +PROC downety (FILE VAR f, TEXT CONST pattern) : + + downety (f, pattern, file size) + +ENDPROC downety ; + +PROC downety (FILE VAR f, TEXT CONST pattern, INT CONST max line) : + + check mode (f,mod) ; + INT VAR pattern pos := f.col ; + search down (f.used, f.atoms, pattern, max line, pattern pos) ; + f.col := pattern pos + +ENDPROC downety ; + +PROC up (FILE VAR f, TEXT CONST pattern) : + + up (f, pattern, file size) + +ENDPROC up ; + +PROC up (FILE VAR f, TEXT CONST pattern, INT CONST max line) : + + check mode (f,mod) ; + INT VAR pattern pos := f.col - 1 ; + search up (f.used, f.atoms, pattern, max line, pattern pos) ; + f.col := pattern pos + +ENDPROC up ; + +PROC uppety (FILE VAR f, TEXT CONST pattern) : + + uppety (f, pattern, file size) + +ENDPROC uppety ; + +PROC uppety (FILE VAR f, TEXT CONST pattern, INT CONST max line) : + + check mode (f,mod) ; + INT VAR pattern pos := f.col ; + search up (f.used, f.atoms, pattern, max line, pattern pos) ; + f.col := pattern pos + +ENDPROC uppety ; + + +INT PROC len (FILE CONST f) : + + length (record) . + +record : f.atoms (f.used.index).line . + +ENDPROC len ; + +TEXT PROC subtext (FILE CONST f, INT CONST from, to) : + + subtext (record, from, to) . + +record : f.atoms (f.used.index).line . + +ENDPROC subtext ; + +PROC change (FILE VAR f, INT CONST from, to, TEXT CONST new) : + + check mode (f, mod) ; + change (record, from, to, new) . + +record : f.atoms (f.used.index).line . + +ENDPROC change ; + + +BOOL PROC mark (FILE CONST f) : + + f.mark line > 0 + +ENDPROC mark ; + +PROC mark (FILE VAR f, INT CONST line no, col) : + + IF line no > 0 + THEN f.mark line := line no + f.prefix lines ; + f.mark col := col + ELSE f.mark line := 0 ; + f.mark col := 0 + FI + +ENDPROC mark ; + +INT PROC mark line no (FILE CONST f) : + + IF f.mark line = 0 + THEN 0 + ELSE max (1, f.mark line - f.prefix lines) + FI + +ENDPROC mark line no ; + +INT PROC mark col (FILE CONST f) : + + IF f.mark line = 0 + THEN 0 + ELIF f.mark line <= f.prefix lines + THEN 1 + ELSE f.mark col + FI + +ENDPROC mark col ; + +PROC set marked range (FILE VAR f, FRANGE VAR old range) : + + IF mark (f) + THEN set range (f, mark line no (f), mark col (f), old range) + ELSE old range := previous range of file + FI . + +previous range of file : + FRANGE : (f.prefix lines, f.postfix lines, FALSE, FALSE) . + +ENDPROC set marked range ; + + +(*****************************************************************) + + (* Autor: P.Heyderhoff *) + (* Stand: 11.10.83 *) + +BOUND LIST VAR datei; +INT VAR sortierstelle, sortanker; +BOOL VAR ascii sort; +TEXT VAR median, tausch , links, rechts; + +PROC sort (TEXT CONST dateiname) : + sort (dateiname, 1) +END PROC sort; + +PROC sort (TEXT CONST dateiname, INT CONST sortieranfang) : + ascii sort := TRUE ; + sortierstelle := sortieranfang; sortiere (dateiname) +END PROC sort; + +PROC lex sort (TEXT CONST dateiname) : + lex sort (dateiname, 1) +ENDPROC lex sort ; + +PROC lex sort (TEXT CONST dateiname, INT CONST sortieranfang) : + ascii sort := FALSE ; + sortierstelle := sortieranfang; sortiere (dateiname) +ENDPROC lex sort ; + +PROC sortiere (TEXT CONST dateiname) : + + reorganize file if necessary ; + sort file . + +reorganize file if necessary : + FILE VAR f := sequential file (modify, dateiname) ; + IF segments (f) > 1 + THEN reorganize (dateiname) + FI . + +sort file : + f := sequential file (modify, dateiname) ; + INT CONST sortende := lines (f) + 3 ; + sortanker := 1 + 3 ; + datei := old (dateiname) ; + quicksort(sortanker, sortende) . + +END PROC sortiere; + +PROC quicksort ( INT CONST anfang, ende ) : + IF anfang < ende + THEN INT VAR p,q; + spalte (anfang, ende, p, q); + quicksort (anfang, q); + quicksort (p, ende) FI +END PROC quicksort; + +PROC spalte (INT CONST anfang, ende, INT VAR p, q): + fange an der seite an und waehle den median; + ruecke p und q so dicht wie moeglich zusammen; + hole ggf median in die mitte . + + fange an der seite an und waehle den median : + p := anfang; q := ende ; + INT CONST m :: (p + q) DIV 2 ; + median := subtext(datei m, sortierstelle) . + + ruecke p und q so dicht wie moeglich zusammen : + REP schiebe p und q so weit wie moeglich auf bzw ab; + IF p < q THEN vertausche die beiden FI + UNTIL p > q END REP . + + vertausche die beiden : + tausch := datei p; datei p := datei q; datei q := tausch; + p INCR 1; q DECR 1 . + + schiebe p und q so weit wie moeglich auf bzw ab : + WHILE p kann groesser werden REP p INCR 1 END REP; + WHILE q kann kleiner werden REP q DECR 1 END REP . + + p kann groesser werden : + IF p <= ende + THEN links := subtext (datei p, sortierstelle) ; + IF ascii sort + THEN median >= links + ELSE median LEXGREATEREQUAL links + FI + ELSE FALSE + FI . + + q kann kleiner werden : + IF q >= anfang + THEN rechts := subtext(datei q, sortierstelle) ; + IF ascii sort + THEN rechts >= median + ELSE rechts LEXGREATEREQUAL median + FI + ELSE FALSE + FI . + + hole ggf median in die mitte : + IF m < q THEN vertausche m und q + ELIF m > p THEN vertausche m und p FI . + + vertausche m und q : + tausch := datei m; datei m := datei q; datei q := tausch; q DECR 1 . + + vertausche m und p : + tausch := datei m; datei m := datei p; datei p := tausch; p INCR 1 . + + datei m : datei.atoms (m).line . + datei p : datei.atoms (p).line . + datei q : datei.atoms (q).line . + +END PROC spalte; + +END PACKET file handling; + diff --git a/system/base/1.7.5/src/functions b/system/base/1.7.5/src/functions new file mode 100644 index 0000000..9f338ff --- /dev/null +++ b/system/base/1.7.5/src/functions @@ -0,0 +1,760 @@ +PACKET editor functions DEFINES (* FUNCTIONS - 052 *) + (**************) (* 17.07.85 -bk- *) + (* 10.09.85 -ws- *) + edit, (* 25.04.86 -sh- *) + show, (* 27.05.86 -wk- *) + U, + D, + T, + up, + down, + downety, + uppety, + to line, + PUT, + GET, + P, + G, + limit, + len, + eof, + C, + change to, + CA, + change all, + lines, + line no, + col, + mark, + at, + word, + std kommando interpreter, + note, + note line, + note edit, + anything noted, + note file: + + +LET marker = "^", + ersatzmarker = "'", + schritt = 50, + file size = 4072, + write acc = TRUE, + read acc = FALSE; + +LET bold = 2, + integer = 3, + string = 4, + end of file = 7; + +LET std res = "eqvw19dpgn"9""; + +FILE VAR edfile; +BOOL VAR from scratchfile :: FALSE; +TEXT VAR kommandotext, tabulator, zeile; + + +PROC std kommando interpreter (TEXT CONST taste) : + enable stop ; + edfile := editfile; + set busy indicator; + SELECT pos (std res, taste) OF + CASE 1 (*e*) : edit + CASE 2 (*q*) : quit + CASE 3 (*v*) : quit last + CASE 4 (*w*) : open editor (next editor) + CASE 5 (*1*) : toline (1); col (1) + CASE 6 (*9*) : toline (lines); col (len+1) + CASE 7 (*d*) : d case + CASE 8 (*p*) : p case + CASE 9 (*g*) : g case + CASE 10(*n*) : note edit + CASE 11(*tab*): change tabs + OTHERWISE : echtes kommando analysieren + END SELECT . + +d case : + IF mark + THEN PUT ""; mark (FALSE); from scratchfile := TRUE + ELSE textzeile auf taste legen + FI . + +p case : + IF mark (*sh*) + THEN IF write permission + THEN PUT ""; push(""27""12""); from scratchfile := TRUE + ELSE out (""7"") + FI + ELSE textzeile auf taste legen + FI . + +g case : + IF write permission (*sh*) + THEN IF from scratchfile + THEN GET "" + ELSE IF is editget + THEN push (lernsequenz auf taste ("g")); nichts neu + FI + FI + ELSE out (""7"") + FI . + +textzeile auf taste legen : + read record (edfile, zeile); + zeile := subtext (zeile, col); + lernsequenz auf taste legen ("g", zeile); + from scratchfile := FALSE; zeile neu . + +next editor : + (aktueller editor MOD groesster editor) + 1 . + +change tabs : + get tabs (edfile, tabulator) ; + IF pos (tabulator, marker) <> 0 + THEN change all (tabulator, marker, ersatzmarker) + ELSE change all (tabulator, ersatzmarker, marker) + FI ; + put tabs (edfile, tabulator) ; + ueberschrift neu . + +echtes kommando analysieren : + kommandotext := kommando auf taste (taste); + IF kommandotext = "" + THEN nichts neu; LEAVE std kommando interpreter + FI ; + scan (kommandotext); + TEXT VAR s1; INT VAR t1; next symbol (s1, t1); + TEXT VAR s2; INT VAR t2; next symbol (s2, t2); + IF t1 = integer AND t2 = end of file THEN toline (int (s1)) + ELIF t1 = string AND t2 = end of file THEN down (s1) + ELIF perhaps simple up or down THEN + ELIF perhaps simple changeto THEN + ELSE do (kommandotext) + FI . + +perhaps simple up or down : + IF t1 = bold + THEN TEXT VAR s3; INT VAR t3; next symbol (s3, t3); + IF t3 <> end of file THEN FALSE + ELIF s1 = "U" THEN perhaps simple up + ELIF s1 = "D" THEN perhaps simple down + ELSE FALSE + FI + ELSE FALSE + FI . + +perhaps simple up : + IF t2 = string THEN up (s2); TRUE + ELIF t2 = integer THEN up (int (s2)); TRUE + ELSE FALSE + FI . + +perhaps simple down : + IF t2 = string THEN down (s2); TRUE + ELIF t2 = integer THEN down (int (s2)); TRUE + ELSE FALSE + FI . + +perhaps simple changeto : + IF t1 = string AND s2 = "C" AND t3 is string AND t4 is eof + THEN s1 C s3; TRUE + ELSE FALSE + FI . + +t3 is string : + next symbol (s3, t3); + t3 = string . + +t4 is eof : + TEXT VAR s4; INT VAR t4; + next symbol (s4, t4); + t4 = end of file . +END PROC std kommando interpreter; + + +PROC edit (FILE VAR f) : + enable stop; + IF aktueller editor > 0 (*wk*) + THEN ueberschrift neu + FI ; + open editor (f, write acc); + edit (groesster editor, std res, PROC(TEXT CONST) std kommando interpreter) +END PROC edit; + + +PROC edit (FILE VAR f, INT CONST x, y, x size, y size) : + enable stop; + open editor (groesster editor + 1, f, write acc, x, y, x size, y size); + edit (groesster editor, std res, PROC(TEXT CONST) std kommando interpreter) +END PROC edit; + + +PROC edit (FILE VAR f, TEXT CONST res, PROC (TEXT CONST) kdo interpreter) : + enable stop; + open editor (f, write acc); + edit (groesster editor, res, PROC(TEXT CONST) kdo interpreter) +END PROC edit; + + +PROC edit : + IF aktueller editor > 0 + THEN dateiname einlesen; + edit (dateiname) + ELSE edit (last param) + FI . + +dateiname einlesen : + INT VAR x, y; get editcursor (x, y); + IF x < x size - 17 (*sh*) + THEN cursor (x, y); + out (""15"Dateiname:"14""); + (x size-14-x) TIMESOUT " "; + (x size-14-x) TIMESOUT ""8""; + TEXT VAR dateiname := std; + editget (dateiname); + trailing blanks entfernen; + quotes entfernen + ELSE errorstop ("Fenster zu klein") + FI . + +trailing blanks entfernen: + INT VAR i := LENGTH dateiname; + WHILE (dateiname SUB i) = " " REP i DECR 1 PER; + dateiname := subtext (dateiname, 1, i) . + +quotes entfernen : + IF (dateiname SUB 1) = """" AND (dateiname SUB LENGTH dateiname) = """" + THEN dateiname := subtext (dateiname, 2, LENGTH dateiname - 1) + FI . +END PROC edit; + + +PROC edit (TEXT CONST filename) : + IF filename <> "" + THEN edit named file + ELSE errorstop ("Name ungueltig") + FI . + +edit named file : + last param (filename); + IF exists (filename) COR yes ("""" + filename + """ neu einrichten") + THEN IF aktueller editor > 0 THEN ueberschrift neu FI; (*sh*) + FILE VAR f := sequential file (modify, filename); + headline (f, filename); edit (f); last param (filename) + ELSE errorstop ("") + FI . +END PROC edit; + + +PROC edit (TEXT CONST filename, INT CONST x, y, x size, y size) : + last param (filename); + IF exists (filename) COR yes ("""" + filename + """ neu einrichten") + THEN FILE VAR f := sequential file (modify, filename); + headline (f, filename); edit (f, x, y, x size, y size); + last param (filename) + ELSE errorstop ("") + FI +END PROC edit; + + +PROC edit (INT CONST i) : + edit (i, std res, PROC (TEXT CONST) std kommando interpreter) +END PROC edit; + + +PROC show (FILE VAR f) : + enable stop; + open editor (f, read acc); + edit(groesster editor, std res, PROC(TEXT CONST) std kommando interpreter); +END PROC show; + + +PROC show (TEXT CONST filename) : (*sh*) + last param (filename); + IF exists (filename) + THEN FILE VAR f := sequential file (modify, filename); + show (f); last param (filename) + ELSE errorstop ("""" + filename + """ gibt es nicht") + FI +END PROC show; + + +PROC show : + show (last param) +END PROC show; + + +DATASPACE VAR local space; +INT VAR zeilenoffset; +TEXT VAR kopierzeile; + + +OP PUT (TEXT CONST filename) : + nichts neu; + IF mark + THEN markierten bereich in datei schreiben + FI . + +markierten bereich in datei schreiben : + disable stop; + zieldatei vorbereiten; + quelldatei oeffnen; + IF noch genuegend platz in der zieldatei (*sh*) + THEN zeilenweise kopieren + ELSE errorstop ("FILE-Ueberlauf") + FI ; + quelldatei schliessen; + zieldatei schliessen; + set busy indicator . + +zieldatei vorbereiten : + FRANGE VAR ganze zieldatei; + IF exists (filename) THEN forget (filename); ueberschrift neu FI; + FILE VAR destination; + IF filename = "" + THEN forget (local space); local space := nilspace; + destination := sequential file (output, local space) + ELSE destination := sequential file (modify, filename) ; + INT CONST groesse der zieldatei := lines (destination); (*sh*) + set marked range (destination, ganze zieldatei) ; + output (destination) + FI . + +quelldatei oeffnen : + zeilenoffset := mark line no (edfile) - 1; + INT CONST old line := line no, old col := col; + FRANGE VAR ganze datei; + set range (edfile, mark lineno (edfile), mark col (edfile), ganze datei); + input (edfile) . + +noch genuegend platz in der zieldatei : + lines + groesse der zieldatei < file size . + +zeilenweise kopieren : + enable stop; + satznr neu; + INT VAR zeile; + FOR zeile FROM 1 UPTO lines (edfile) REP + getline (edfile, kopierzeile); + putline (destination, kopierzeile); + satznr zeigen + PER . + +quelldatei schliessen : + modify (edfile); + set range (edfile, ganze datei); + to line (old line); + col (old col) . + +zieldatei schliessen : + IF filename <> "" + THEN INT CONST last line written := line no (destination) ; + modify (destination) ; + to line (destination, last line written) ; + col (destination, len (destination) + 1) ; + bild neu (destination) ; + set range (destination, ganze zieldatei) + FI . +END OP PUT; + + +OP P (TEXT CONST filename) : + PUT filename +END OP P ; + + +OP GET (TEXT CONST filename) : (*sh*) + IF NOT write permission + THEN errorstop ("Schreibversuch auf 'show'-Datei") + FI ; + quelldatei oeffnen; + IF nicht mehr genuegend platz im editfile + THEN quelldatei schliessen; errorstop ("FILE-Ueberlauf") + FI ; + disable stop; + zieldatei oeffnen; + zeilenweise kopieren ; + zieldatei schliessen; + quelldatei schliessen; + set busy indicator . + +quelldatei oeffnen : + FILE VAR source; + FRANGE VAR ganze quelldatei; + IF filename = "" + THEN source := sequential file (input, local space) + ELSE IF NOT exists (filename) + THEN errorstop ("""" + filename + """ gibt es nicht") + FI ; + source := sequential file (modify, filename); + INT CONST old line := line no (source), + old col := col (source); + set marked range (source, ganze quelldatei); + input (source) + FI . + +nicht mehr genuegend platz im editfile : + lines (source) + lines >= file size . + +zeilenweise kopieren : + enable stop; + satznr neu; + INT VAR zeile; + FOR zeile FROM 1 UPTO lines (source) REP + getline (source, kopierzeile); + putline (edfile, kopierzeile); + satznr zeigen + PER . + +zieldatei oeffnen : + zeilenoffset := line no - 1; + leere datei in editfile einschachteln; + output (edfile) . + +leere datei in editfile einschachteln : + INT CONST range start col := col; + FRANGE VAR ganze datei; + set range (edfile, line no, col, ganze datei); + IF lines = 1 THEN delete record (edfile) FI . + +quelldatei schliessen : + IF filename <> "" + THEN modify (source); + set range (source, ganze quelldatei); + to line (source, old line); + col (source, old col) + FI . + +zieldatei schliessen : + modify (edfile); + to line (lines); + col (range start col); + set range (edfile, ganze datei); + abschnitt neu (zeilenoffset + 1, lines) . +END OP GET; + + +OP G (TEXT CONST filename) : + GET filename +END OP G; + + +INT PROC len : + len (edfile) +END PROC len; + + +PROC col (INT CONST stelle) : + nichts neu; col (edfile, stelle) +END PROC col; + + +INT PROC col : + col (edfile) +END PROC col; + + +PROC limit (INT CONST limit) : + nichts neu; max line length (edfile, limit) +END PROC limit; + + +INT PROC limit : + max line length (edfile) +END PROC limit; + + +INT PROC lines : + lines (edfile) +END PROC lines; + + +INT PROC line no : + line no (edfile) +END PROC line no; + + +PROC to line (INT CONST satz nr) : + satznr neu; + edfile := editfile; + IF satz nr > lines + THEN toline (edfile, lines); col (len + 1) + ELSE to line (edfile, satz nr) + FI +END PROC to line; + + +OP T (INT CONST satz nr) : + to line (satz nr) +END OP T; + + +PROC down (INT CONST anz) : + nichts neu; down (edfile, anz) +END PROC down; + + +OP D (INT CONST anz) : + down (anz) +END OP D; + + +PROC up (INT CONST anz) : + nichts neu; up (edfile, anz) +END PROC up; + + +OP U (INT CONST anz) : + up (anz) +END OP U; + + +PROC down (TEXT CONST muster) : + nichts neu; + REP + down (muster, schritt - line no MOD schritt); + IF pattern found + THEN LEAVE down + ELSE satznr zeigen + FI + UNTIL eof PER +END PROC down; + + +OP D (TEXT CONST muster) : + down (muster) +END OP D; + + +PROC down (TEXT CONST muster, INT CONST anz) : + nichts neu; down (edfile, muster, anz) +END PROC down; + + +PROC up (TEXT CONST muster) : + nichts neu; + REP + up (muster, (line no - 1) MOD schritt + 1); + IF pattern found + THEN LEAVE up + ELSE satznr zeigen + FI + UNTIL line no = 1 PER +END PROC up; + + +OP U (TEXT CONST muster) : + up (muster) +END OP U; + + +PROC up (TEXT CONST muster, INT CONST anz) : + nichts neu; up (edfile, muster, anz) +END PROC up; + + +PROC downety (TEXT CONST muster) : + nichts neu; + IF NOT at (muster) + THEN down (muster) + FI +END PROC downety; + + +PROC downety (TEXT CONST muster, INT CONST anz) : + nichts neu; downety (edfile, muster, anz) +END PROC downety; + + +PROC uppety (TEXT CONST muster) : + nichts neu; + IF NOT at (muster) + THEN up (muster) + FI +END PROC uppety; + + +PROC uppety (TEXT CONST muster, INT CONST anz) : + nichts neu; uppety (edfile, muster, anz) +END PROC uppety; + + +OP C (TEXT CONST old, new) : + change to (old, new) +END OP C; + +OP C (TEXT CONST replacement) : + IF NOT write permission (*sh*) + THEN errorstop ("Schreibversuch auf 'show'-Datei") + FI ; + IF at (edfile, match(0)) + THEN zeile neu; change (edfile, matchpos(0), matchend(0), replacement) + FI +END OP C; + +PROC change to (TEXT CONST old, new) : + IF NOT write permission (*sh*) + THEN errorstop ("Schreibversuch auf 'show'-Datei") + FI ; + nichts neu; + REP + downety (old, schritt - line no MOD schritt); + IF pattern found + THEN change (edfile, matchpos(0), matchend(0), new); + col (col + LENGTH new); zeile neu; + LEAVE changeto + ELSE satznr zeigen + FI + UNTIL eof PER +END PROC change to; + + +OP CA (TEXT CONST old, new) : + change all (old, new) +END OP CA; + + +PROC change all (TEXT CONST old, new) : + WHILE NOT eof REP old C new PER +END PROC change all; + + +BOOL PROC eof : + eof (edfile) +END PROC eof; + + +BOOL PROC mark : + mark (edfile) +END PROC mark; + + +PROC mark (BOOL CONST mark on) : + nichts neu; + IF mark on + THEN mark (edfile, line no, col) + ELSE mark (edfile, 0, 0) + FI +END PROC mark; + + +BOOL PROC at (TEXT CONST pattern) : + at (edfile, pattern) +END PROC at; + +TEXT PROC word : + word (edfile) +END PROC word; + + +TEXT PROC word (TEXT CONST sep) : + word (edfile, sep) +END PROC word; + + +TEXT PROC word (INT CONST len) : + word (edfile, len) +END PROC word; + + +LET no access = 0, + edit access = 1, + output access = 2; + +INT VAR last note file mode; +FILE VAR notebook; +INITFLAG VAR this packet := FALSE; +DATASPACE VAR note ds; + + +PROC note (TEXT CONST text) : + access note file (output access); + write (notebook, text) +END PROC note; + + +PROC note (INT CONST number) : + access note file (output access); + put (notebook, number) +END PROC note; + + +PROC note line : + access note file (output access); + line (notebook) +END PROC note line; + + +BOOL PROC anything noted : + access note file (no access); + last note file mode = output access +END PROC anything noted; + + +FILE PROC note file : + access note file (output access); + notebook +END PROC note file; + + +PROC note edit (FILE VAR context) : (*sh*) + access note file (edit access); + make notebook erasable; + IF aktueller editor = 0 + THEN open editor (1, context, write acc, 1, 1, x size - 1, y size) + FI ; + get window size; + IF window large enough + THEN include note editor; + edit (aktueller editor-1, aktueller editor, aktueller editor-1, + std res, PROC (TEXT CONST) std kommando interpreter) + FI . + +get window size : + INT VAR x, y, windows x size, windows y size; + get window (x, y, windows x size, windows y size) . + +window large enough : + windows y size > 4 . + +include note editor : + open editor (aktueller editor + 1, notebook, write acc, + x, y + (windows y size + 1) DIV 2, + windows x size, windows y size DIV 2) . + +make notebook erasable : + last note file mode := edit access . +END PROC note edit; + + +PROC note edit : + access note file (edit access); + make notebook erasable; + edit (notebook) . + +make notebook erasable : + last note file mode := edit access . +END PROC note edit; + + +PROC access note file (INT CONST new mode) : + disable stop; + initialize note ds if necessary; + IF last note file mode < new mode + THEN forget (note ds); + note ds := nilspace; + notebook := sequential file (output, note ds); + headline (notebook, "notebook"); + last note file mode := new mode + FI . + +initialize note ds if necessary : + IF NOT initialized (this packet) + THEN note ds := nilspace; + last note file mode := no access + FI . +END PROC access note file; + +END PACKET editor functions; + diff --git a/system/base/1.7.5/src/init b/system/base/1.7.5/src/init new file mode 100644 index 0000000..471a717 --- /dev/null +++ b/system/base/1.7.5/src/init @@ -0,0 +1,251 @@ + "run again impossible" + "recursive run" + " " + " Compiler Error : " +" " +" |" +" Fehler entdeckt " +"Keine Fehler gefunden, " +" " +" ******* ENDE DER UEBERSETZUNG *******" +"FEHLER bei >> " +" << " +"weiter bei " +"TEXTende (Anfuehrungszeichen) fehlt irgendwo" +"Kommentarende fehlt irgendwo" +"nach dem Hauptprogramm darf kein Paket folgen" +"ungueltiger Name fuer ein DEFINES-Objekt" +"':' fehlt" +"nach ENDPACKET folgt nicht der Paketname" +"ENDPACKET fehlt" +"CONST oder VAR fehlt" +"ungueltiger Name" +" ',' in Deklarationsliste fehlt" +"ist nicht der PROC Name" +"fehlerhaftes Ende des Hauptprogramms" +"ENDPROC fehlt" +"PROC/OP Schachtelung unzulaessig" +"OP darf kein Parameter sein" +"steht mehrfach im PACKET Interface" +" ist mehrfach deklariert" +"ist schon als Datenobjekt deklariert" +"ist schon als PROC/OP deklariert" +"')' nach Parameterliste erwartet" +"Standard-Schluesselwort kann nicht redefiniert werden" +"ungueltig als BOLD" +"'(' fehlt" +"CONST bzw VAR nicht bei Strukturfeldern" +"'=' fehlt" +"Schluesselwort wird im Paket schon andersartig verwandt" +"Datentyp fehlt" +"ungueltiger OP Name" +"OP muss monadisch oder dyadisch sein" +"ist nicht der OP Name" +"ENDOP fehlt" +"Name nach ENDPROC fehlt" +"Name nach ENDOP fehlt" +"';' fehlt" +"END END ist Unsinn" +"Dieses END... kenne ich nicht" +"ROW Groesse ist kein INT" +"ROW Groesse ist kein Denoter" +"Ein ROW muss mindestens ein Element haben" +"ROW Groesse fehlt" +"Parameter kann man nicht initialisieren" +"Konstanten muessen initialisiert werden" +"'::' verwenden" +"')' fehlt" +"Exponent fehlt" +"Undefinierter Typ" +"Rekursiv definierter Typ" +"Mehrfach definierter Selektor" +"Variable bzw. Abkuerzung in der Paket-Schnittstelle" +"undefinierte ROW Groesse" +"Typ Deklarationen nur im Paketrumpf" +"CONST bzw. VAR ohne Zusammenhang" +"ist nicht deklariert, steht aber in der Paket-Schnittstelle" +"ist nicht deklariert" +"unbekanntes Kommando" +"THIS IS NO CORRECT EXTERNAL NUMBER." +"Schluesselwort unzulaessig" +"Name erwartet" +"Denoter erwartet" +"ENDPROC ohne Zusammenhang" +"ENDOP ohne Zusammenhang" +"Refinement ohne Zusammenhang" +"Delimiter zwischen Paket-Refinement und Deklaration fehlt" +"unzulaessiges Selektor-Symbol (kein Name)" +"BOUND Schachtelungen unzulaessig" +"BOUND-Objekte unzulaessig als Parameter" +"Textende fehlt" +"TEXT-Denoter zu lang" + +"Denoter-Wert wird fuer diese Maschine zu gross" +"Compiler-Fehler, wenden Sie sich an Ihren Systemberater!" +"ist ein zusammenhangloses Schluesselwort" +"'::' nur fuer Initialisierungen, sonst ':='" +"welches Objekt soll verlassen werden?" +"du bist gar nicht innerhalb dieses Refinements" +"nur die eigene PROC / OP kann verlassen werden" +"THEN fehlt" +"FI fehlt" +"BOOL-Ausdruck erwartet" +"ELSE-Teil ist notwendig, da ein Wert geliefert wird" +"INT-Ausdruck erwartet" +"OF fehlt" +"Keine Typanpassung moeglich" +"CASE-Label fehlt" +"mindestens eine CASE-Anweisung geben" +"CASE-Label ist zu gross (skipped)" +"mehrfach definiertes CASE-Label" +"ungueltiges Zeichen nach CASE-Label" +"OTHERWISE-Teil fehlt" +"END SELECT fehlt" +"rekursiver Aufruf eines Refinements" +" wird nicht benutzt" +"';' oder Operator ('+','-',...) fehlt" +"undefinierter monadischer Operator" +"undefinierter dyadischer Operator" +"Auf die Feinstruktur des Typs kann man nicht mehr zugreifen" +"fuer diesen Typ nicht definierter Selektor" +"INT,REAL,BOOL,TEXT koennen nicht selektiert werden" +"bei ROWs nur Subscription" +"nicht selektierbar" +"unzulaessiger Index fuer Subscription" +"'[' ohne Zusammenhang" +"']' ohne Zusammenhang" +"']' nach Subscription fehlt" +"ungueltig zwischen Anweisungen" +"nur die letzte Anweisung eines Abschnitts darf einen Wert liefern" +"Der Paketrumpf kann keinen Wert liefern" +"anstelle des letzten Symbols wurde ein Operand erwartet" +"Der Schleifenrumpf darf keinen Wert liefern" +"die Laufvariable muss eine INT VAR sein" +"wird schon in einer aeusseren Schleife als Laufvariable benutzt" +"FROM erwartet" +"UPTO bzw DOWNTO fehlt" +"REPEAT fehlt" +"END REP fehlt" +"die Konstante darf nicht veraendert werden" +"in einer FOR-Schleife darf die Laufvariable nicht veraendert werden" +"falscher Typ des Resultats" +"ist CONST, es wird aber ein VAR Parameter verlangt" +"unbekannte Prozedur" +"Parameter-Prozedur liefert falsches Resultat" +"Anzahl bzw. Typen der Parameter sind falsch" +"unbekannte Parameter-Prozedur" +"aktuelle Parameter-Prozedur hat CONST-, formale hat VAR-Parameter" +"Kein Konstruktor moeglich, da die Feinstruktur hier unbekannt ist" +"zu wenig Felder angegeben" +"zu viele Felder angegeben" +"unzulaessiger Trenner zwischen Feldern" +"Feld hat falschen Typ" +"falsche Element-Anzahl im ROW-Konstruktor" +"Dieser Typ kann nicht noch mehr konkretisiert werden" +"BOUND-Objekt zu gross" + +"Warnung in Zeile " +" Zeile " +"in Zeile " +" <----+---> " +" TYPE undefiniert " +" MODE undefiniert " +"Parameter spezifiziert: " +"Parameter Typ(en) sind: " +" B Code, " +" B Paketdaten generiert" +"Operand: " +"Operanden: " +", " +"erwartet " +"gefunden " +" " + +(* 001 *) END +(* 002 *) ENDPACKET +(* 003 *) ENDOP +(* 004 *) ENDOPERATOR +(* 005 *) ENDPROC +(* 006 *) ENDPROCEDURE +(* 007 *) PACKET +(* 008 *) OP +(* 009 *) OPERATOR +(* 010 *) PROC +(* 011 *) PROCEDURE +(* 012 *) FI +(* 013 *) ENDIF +(* 014 *) ENDREP +(* 015 *) ENDREPEAT +(* 016 *) PER +(* 017 *) ELIF +(* 018 *) ELSE +(* 019 *) UNTIL +(* 020 *) CASE +(* 021 *) OTHERWISE +(* 022 *) ENDSELECT +(* 023 *) INTERNAL +(* 024 *) DEFINES +(* 025 *) LET +(* 026 *) TYPE +(* 027 *) INT +(* 028 *) REAL +(* 029 *) DATASPACE +(* 030 *) TEXT +(* 031 *) BOOL +(* 032 *) BOUND +(* 033 *) ROW +(* 034 *) STRUCT +(* 035 *) CONST +(* 036 *) VAR +(* 037 INIT CONTROL *) INTERNAL +(* 038 *) CONCR +(* 039 *) REP +(* 040 *) REPEAT +(* 041 *) SELECT +(* 042 *) EXTERNAL +(* 043 *) IF +(* 044 *) THEN +(* 045 *) OF +(* 046 *) FOR +(* 047 *) FROM +(* 048 *) UPTO +(* 049 *) DOWNTO +(* 050 *) WHILE +(* 051 *) LEAVE +(* 052 *) WITH +(* 053 *) TRUE +(* 054 *) FALSE +(* 055 *) :: SBL := INCR DECR +(* 056 *) + - * / DIV MOD + ** + AND + CAND + OR + COR + NOT + = <> > >= < <= +(*040 *) MAIN +(*043*) ENDOFFILE + +PACKET a : + +PROC out (TEXT CONST t) : + EXTERNAL 60 +ENDPROC out ; + +PROC out text (TEXT CONST t, INT CONST typ) : + INTERNAL 257 ; + IF typ = typ + THEN out (t) + FI +ENDPROC out text ; + +PROC out line (INT CONST typ) : + INTERNAL 258 ; + IF typ = typ + THEN out (""13""10"") + FI +ENDPROC out line ; + +ENDPACKET a ; + diff --git a/system/base/1.7.5/src/integer b/system/base/1.7.5/src/integer new file mode 100644 index 0000000..aefb77f --- /dev/null +++ b/system/base/1.7.5/src/integer @@ -0,0 +1,265 @@ +(* ------------------- STAND : 23.10.85 --------------------*) +PACKET integer DEFINES text, int, MOD, + sign, SIGN, abs, ABS, **, min, max, minint, maxint, + random, initialize random , + last conversion ok, set conversion : + +INT PROC minint : -32767 - 1 ENDPROC minint ; + +INT PROC maxint : 32767 ENDPROC maxint ; + + +TEXT PROC text (INT CONST number) : + + IF number = minint THEN "-32768" + ELIF number < 0 THEN "-" + text(-number) + ELIF number <= 9 THEN code (number + 48) + ELSE text (number DIV 10) + digit + FI . + +digit : + code ( number MOD 10 + 48 ) . + +ENDPROC text ; + +TEXT PROC text (INT CONST number, length) : + + TEXT VAR result := text (number) ; + INT CONST number length := LENGTH result ; + IF number length < length + THEN (length - number length) * " " + result + ELIF number length > length + THEN length * "*" + ELSE result + FI + +ENDPROC text ; + +INT PROC int (TEXT CONST number) : + + skip blanks and sign ; + get value ; + result . + +skip blanks and sign : + BOOL VAR number is positive ; + INT VAR pos := 1 ; + skip blanks ; + IF (number SUB pos) = "-" + THEN number is positive := FALSE ; + pos INCR 1 + ELIF (number SUB pos) = "+" + THEN number is positive := TRUE ; + pos INCR 1 + ELSE number is positive := TRUE + FI . + +get value : + INT VAR value ; + get first digit ; + WHILE is digit REP + value := value * 10 + digit ; + pos INCR 1 + PER ; + set conversion ok result . + +get first digit : + IF is digit + THEN value := digit ; + pos INCR 1 + ELSE set conversion (FALSE) ; + LEAVE int WITH 0 + FI . + +is digit : 0 <= digit AND digit <= 9 . + +digit : code (number SUB pos) - 48 . + +result : + IF number is positive + THEN value + ELSE - value + FI . + +set conversion ok result : + skip blanks ; + conversion ok := (pos > LENGTH number) . + +skip blanks : + WHILE (number SUB pos) = " " REP + pos INCR 1 + PER . + +ENDPROC int ; + +INT OP MOD (INT CONST left, right) : + + EXTERNAL 43 + +ENDOP MOD ; + +INT PROC sign (INT CONST argument) : + + IF argument < 0 THEN -1 + ELIF argument > 0 THEN 1 + ELSE 0 + FI + +ENDPROC sign ; + +INT OP SIGN (INT CONST argument) : + sign (argument) +ENDOP SIGN ; + +INT PROC abs (INT CONST argument) : + + IF argument > 0 THEN argument + ELSE - argument + FI + +ENDPROC abs ; + +INT OP ABS (INT CONST argument) : + abs (argument) +ENDOP ABS ; + +INT OP ** (INT CONST arg, exp) : + + INT VAR x := arg , z := 1 , + counter := exp ; + + IF exp = 0 + THEN LEAVE ** WITH 1 + ELIF exp < 0 + THEN LEAVE ** WITH 1 DIV arg + FI ; + + WHILE counter >= 2 REP + calculate new x and z ; + counter := counter DIV 2 ; + ENDREP ; + z * x . + +calculate new x and z : + IF counter is not even + THEN z := z * x + FI ; + x := x * x . + +counter is not even : + counter MOD 2 = 1 . + +ENDOP ** ; + +INT PROC min (INT CONST first, second) : + + IF first < second THEN first ELSE second FI + +ENDPROC min ; + +INT PROC max (INT CONST first, second) : + + IF first > second THEN first ELSE second FI + +ENDPROC max ; + + + +BOOL VAR conversion ok := TRUE ; + +BOOL PROC last conversion ok : + conversion ok +ENDPROC last conversion ok ; + +PROC set conversion (BOOL CONST success) : + conversion ok := success +ENDPROC set conversion ; + + + +(*******************************************************************) +(* *) +(* Autor: A. Flammenkamp *) +(* RANDOM GENERATOR *) +(* *) +(* x := 4095 * x MOD (4095*4096+4093) *) +(* n+1 n *) +(* *) +(* Periode: 2**24-4 > 16.0e6 *) +(* *) +(* Beachte: x = 4096 * x1 + x0, 0 <= x0,x1 < 4096 *) +(* *) +(*******************************************************************) + + +INT VAR high := 1, low := 0 ; + +PROC initialize random (INT CONST start) : + + low := start MOD 4096 ; + IF start < 0 + THEN high := 256 + 16 + start DIV 4096 ; + IF low <> 0 THEN high DECR 1 FI + ELSE high := 256 + start DIV 4096 + FI + +ENDPROC initialize random ; + +INT PROC random (INT CONST lower bound, upper bound) : + + compute new random value ; + normalize high ; + normalize low ; + map into interval . + +compute new random value : + (* (high,low) := (low-high , 3*high-low) *) + high := low - high ; + low INCR low - 3 * high . + +normalize high : + IF high < 0 + THEN high INCR 4096 ; low DECR 3 + FI . + +normalize low : + (* high INCR low DIV 4096 ; + low := low MOD 4096 + *) + IF low >= 4096 THEN low overflow + ELIF low < 0 THEN low underflow + FI . + +low overflow : + IF low >= 8192 + THEN low DECR 8192 ; high INCR 2 + ELSE low DECR 4096 ; high INCR 1 ; post normalization + FI . + +post normalization : + (* IF (high,low) >= (4095,4093) + THEN (high,low) DECR (4095,4093) + FI + *) + IF high >= 4095 + THEN IF low >= 4093 THEN high DECR 4095 ; low DECR 4093 + ELIF high = 4096 THEN high := 0 ; low INCR 3 + FI + FI . + +low underflow : + low INCR 4096 ; high DECR 1 . + +map into interval : + INT VAR number := high MOD 16 - 8 ; + number INCR 4095 * number + low ; + IF lower bound <= upper bound + THEN lower bound + number MOD (upper bound - lower bound + 1) + ELSE upper bound + number MOD (lower bound - upper bound + 1) + FI . + +ENDPROC random ; + + +ENDPACKET integer ; + diff --git a/system/base/1.7.5/src/local manager b/system/base/1.7.5/src/local manager new file mode 100644 index 0000000..48d024b --- /dev/null +++ b/system/base/1.7.5/src/local manager @@ -0,0 +1,373 @@ +(* ------------------- VERSION 2 24.02.86 ------------------- *) +PACKET local manager (* Autor: J.Liedtke *) + + DEFINES + create, (* neue lokale Datei einrichten *) + new, (* 'create' und Datei liefern *) + old, (* bestehende Datei liefern *) + forget, (* lokale Datei loeschen *) + exists, (* existiert Datei (lokal) ? *) + status, (* setzt und liefert Status *) + rename, (* Umbenennung *) + copy , (* Datenraum in Datei kopieren *) + enter password,(* Passwort einfuehren *) + write password , + read password , + write permission , + read permission , + begin list , + get list entry , + all : + + + +LET size = 200 , + nil = 0 ; + +INT VAR index ; + +TEXT VAR system write password := "" , + system read password := "" , + actual password ; + +INITFLAG VAR this packet := FALSE ; + +DATASPACE VAR password space ; + +BOUND ROW size STRUCT (TEXT write, read) VAR passwords ; + + +THESAURUS VAR dir := empty thesaurus ; + +ROW size STRUCT (DATASPACE ds, + BOOL protected, + TEXT status) VAR crowd ; + + +PROC initialize if necessary : + + IF NOT initialized (this packet) + THEN system write password := "" ; + system read password := "" ; + dir := empty thesaurus ; + password space := nilspace ; + passwords := password space + FI + +ENDPROC initialize if necessary ; + + + +PROC create (TEXT CONST name) : + +IF exists (name ) + THEN error (name, "existiert bereits") ; + index := nil + ELSE insert and initialize entry +FI . + +insert and initialize entry : + disable stop ; + insert (dir, name, index) ; + IF index <> nil + THEN crowd (index).ds := nilspace ; + IF is error + THEN delete (dir, name, index) ; + LEAVE create + FI ; + status (name, "") ; + crowd (index).protected := FALSE + ELIF NOT is error + THEN errorstop ("zu viele Dateien") + FI . + +ENDPROC create ; + +DATASPACE PROC new (TEXT CONST name) : + + create (name) ; + IF index <> nil + THEN crowd (index).ds + ELSE nilspace + FI + +ENDPROC new ; + +DATASPACE PROC old (TEXT CONST name) : + + initialize if necessary ; + index := link (dir, name) ; + IF index = 0 + THEN error (name, "gibt es nicht") ; + nilspace + ELSE space + FI . + +space : crowd (index).ds . + +ENDPROC old ; + +DATASPACE PROC old (TEXT CONST name, INT CONST expected type) : + + initialize if necessary ; + index := link (dir, name) ; + IF index = 0 + THEN error (name, "gibt es nicht") ; + nilspace + ELIF type (space) <> expected type + THEN errorstop ("Datenraum hat falschen Typ") ; + nilspace + ELSE space + FI . + +space : crowd (index).ds . + +ENDPROC old ; + +BOOL PROC exists (TEXT CONST name) : + + initialize if necessary ; + dir CONTAINS name + +ENDPROC exists ; + +PROC forget (TEXT CONST name ) : + + initialize if necessary ; + say ("""") ; + say (name) ; + IF NOT exists (name) THEN say (""" existiert nicht") + ELIF yes (""" loeschen") THEN forget (name, quiet) + FI . + +ENDPROC forget ; + +PROC forget (TEXT CONST name, QUIET CONST q) : + + initialize if necessary ; + disable stop ; + delete (dir, name, index) ; + IF index <> nil + THEN forget ( crowd (index).ds ) ; + crowd (index).status := "" + FI . + +ENDPROC forget ; + +PROC forget : + + BOOL VAR status := command dialogue ; + command dialogue (TRUE) ; + forget (last param) ; + command dialogue (status) + +ENDPROC forget ; + +PROC status (TEXT CONST name, status text) : + + initialize if necessary ; + INT VAR index := link (dir, name) ; + IF index > 0 + THEN crowd (index).status := date + " " + text (status text, 4) + FI + +ENDPROC status ; + +TEXT PROC status (TEXT CONST name) : + + initialize if necessary ; + INT VAR index := link (dir, name) ; + IF index > 0 + THEN crowd (index).status + ELSE "" + FI + +ENDPROC status ; + +PROC status (INT CONST pos, TEXT CONST status pattern) : + + initialize if necessary ; + INT VAR index := 0 ; + WHILE index < highest entry (dir) REP + index INCR 1 ; + replace (actual status, pos , status pattern) + PER . + +actual status : crowd (index).status . + +ENDPROC status ; + +PROC copy (DATASPACE CONST source, TEXT CONST dest name) : + + IF exists (dest name) + THEN error (dest name, "existiert bereits") + ELSE copy file + FI . + +copy file : + disable stop ; + create ( dest name ) ; + INT VAR index := link (dir, dest name) ; + IF index > nil + THEN forget (crowd (index).ds) ; + crowd (index).ds := source + FI + +ENDPROC copy ; + +PROC copy (TEXT CONST source name, dest name) : + + copy (old (source name), dest name) + +ENDPROC copy ; + +PROC rename (TEXT CONST old name, new name) : + + IF exists (new name) + THEN error (new name, "existiert bereits") + ELIF exists (old name) + THEN rename (dir, old name, new name) ; + last param (new name) + ELSE error (old name, "gibt es nicht") + FI . + +ENDPROC rename ; + + +PROC begin list : + + initialize if necessary ; + index := 0 + +ENDPROC begin list ; + +PROC get list entry (TEXT VAR entry, status text) : + + get (dir, entry, index) ; + IF found + THEN status text := crowd (index).status ; + ELSE status text := "" ; + FI . + +found : index > 0 . + +ENDPROC get list entry ; + + +TEXT PROC write password : + + system write password + +ENDPROC write password ; + +TEXT PROC read password : + + system read password + +ENDPROC read password ; + + +PROC enter password (TEXT CONST password) : + + initialize if necessary ; + say (""3""5"") ; + INT CONST slash pos := pos (password, "/") ; + IF slash pos = 0 + THEN system write password := password ; + system read password := password + ELSE system write password := subtext (password, 1, slash pos-1) ; + system read password := subtext (password, slash pos+1) + FI . + +ENDPROC enter password ; + +PROC enter password (TEXT CONST file name, write pass, read pass) : + + INT CONST index := link (dir, file name) ; + IF index > 0 + THEN set protect password + FI . + +set protect password : + IF write pass = "" AND read pass = "" + THEN crowd (index).protected := FALSE + ELSE crowd (index).protected := TRUE ; + passwords (index).write := write pass ; + passwords (index).read := read pass + FI . + +ENDPROC enter password ; + +INT PROC password index (TEXT CONST file name) : + + initialize if necessary ; + INT CONST index := link (dir, file name) ; + IF index > 0 CAND crowd (index).protected + THEN index + ELSE 0 + FI + +ENDPROC password index ; + +BOOL PROC read permission (TEXT CONST name, supply password) : + + (****************************************************************) + (* for reasons of data security the password check algorithm *) + (* must not copy parts of the file password into variables *) + (* located in the standard dataspace! *) + (****************************************************************) + + access file password ; + file has no password COR (supply password <> "-" AND read password match) . + +read password match : + file password.read = supply password OR file password.read = "" . + +access file password : + INT CONST pw index := password index (name) . + +file password : passwords (pw index) . + +file has no password : pw index = 0 . + +ENDPROC read permission ; + +BOOL PROC write permission (TEXT CONST name, supply password) : + + (****************************************************************) + (* for reasons of data security the password check algorithm *) + (* must not copy parts of the file password into variables *) + (* located in the standard dataspace! *) + (****************************************************************) + + access file password ; + file has no password COR (supply password <> "-" AND write password match). + +write password match : + file password.write = supply password OR file password.write = "" . + +access file password : + INT CONST pw index := password index (name) . + +file password : passwords (pw index) . + +file has no password : pw index = 0 . + +ENDPROC write permission ; + +THESAURUS PROC all : + + initialize if necessary ; + THESAURUS VAR result := dir ; (*ueberfluessig ab naechstem Compiler *) + result + +ENDPROC all ; + +PROC error (TEXT CONST file name, error text) : + + errorstop ("""" + file name + """ " + error text) + +ENDPROC error ; + +ENDPACKET local manager ; + diff --git a/system/base/1.7.5/src/local manager 2 b/system/base/1.7.5/src/local manager 2 new file mode 100644 index 0000000..8f70301 --- /dev/null +++ b/system/base/1.7.5/src/local manager 2 @@ -0,0 +1,41 @@ + +PACKET local manager part 2 DEFINES (* Autor: J.Liedtke *) + (* Stand: 25.02.85 *) + list : + + +TEXT VAR file name, status text; + + +PROC list : + + disable stop ; + DATASPACE VAR ds := nilspace ; + FILE VAR list file := sequential file (output, ds) ; + headline (list file, "list") ; + list (list file) ; + show (list file) ; + forget (ds) . + +ENDPROC list ; + +PROC list (FILE VAR f) : + + enable stop ; + begin list ; + putline (f, "") ; + REP + get list entry (file name, status text) ; + IF file name = "" + THEN LEAVE list + FI ; + write (f, status text + " """ ) ; + write (f, file name) ; + write (f, """") ; + line (f) + PER . + +ENDPROC list ; + +ENDPACKET local manager part 2 ; + diff --git a/system/base/1.7.5/src/mathlib b/system/base/1.7.5/src/mathlib new file mode 100644 index 0000000..c726495 --- /dev/null +++ b/system/base/1.7.5/src/mathlib @@ -0,0 +1,268 @@ +(* ------------------- VERSION 2 06.03.86 ------------------- *) +PACKET mathlib DEFINES sqrt, **, exp, ln, log2, log10, e, pi, + sin, cos, tan, sind, cosd, tand, + arctan, arctand, random, initializerandom : + +LET pii = 3.141592653589793238462, + pi2 = 1.570796326794896619231, + pi3 = 1.047197551196597746154, + pi6 = 0.523598775598298873077, + pi4 = 1.273239544735162686151, + ln2 = 0.693147180559945309417, + lg2 = 0.301029995663981195213, + ln10 = 2.302585092994045684018, + lge = 0.434294481903251827651, + ei = 2.718281828459045235360, + pi180 = 57.295779513082320876798, + sqrt3 = 1.732050807568877293527, + sqr3 = 0.577350269189625764509, + sqr3p2= 3.732050807568877293527, + sqr3m2= 0.267949192431122706473, + sqr2 = 0.707106781186547524400; + +REAL VAR rdg::0.4711; + +REAL PROC pi: pii END PROC pi; +REAL PROC e : ei END PROC e; + +REAL PROC ln ( REAL CONST x ): + log2(x) * ln2 +END PROC ln; + +REAL PROC log10( REAL CONST x ): + log2(x) * lg2 +END PROC log10; + +REAL PROC log2 ( REAL CONST z ): + REAL VAR t, summe::0.0, x::z; + IF x=1.0 THEN 0.0 + ELIF x>0.0 THEN normal + ELSE errorstop("log2: " + text (x,20)); 0.0 FI. + +normal: + IF x >= 0.5 THEN normalise downwards + ELSE normalise upwards FI; + IF x < sqr2 THEN summe := summe - 0.75; t := trans8 + ELSE summe := summe - 0.25; t := trans2 FI; + summe + reihenentwicklung. + + normalise downwards: + WHILE x >= 8.0 REP x := 0.0625 * x; summe:=summe+4.0 PER; + WHILE x >= 1.0 REP x := 0.5 * x; summe:=summe+1.0 PER. + + normalise upwards: + WHILE x<=0.0625 REP x := 16.0 * x; summe:=summe-4.0 PER; + WHILE x<= 0.5 REP x := 2.0 * x; summe:=summe-1.0 PER. + + trans8: (x - 0.5946035575013605)/(x + 0.5946035575013605). + trans2: (x - 0.8408964152537145)/(x + 0.8408964152537145). + + reihenentwicklung: x := t * t; t * 0.06405572387119384648 * + ((((((3.465*x+4.095)*x+5.005)*x+6.435)*x+9.009)*x+15.015)*x+45.045) +END PROC log2; + +REAL PROC sqrt ( REAL CONST z ): + REAL VAR y0, y1, x::z; + INT VAR p :: decimal exponent(x) DIV 2; + IF p <= -64 THEN 0.0 + ELIF x < 0.0 THEN errorstop("sqrt: " + text (x,20)); 0.0 + ELSE nontrivial FI. + + nontrivial: + set exp (decimal exponent (x) -p-p, x); + IF x<10.0 THEN x := 5.3176703 - 40.760905/( 8.408065 + x ) + ELSE x := 16.81595 - 1288.973 /( 84.08065 + x ) FI; + y0 := x; + set exp (decimal exponent (x) + p, y0); + y1 := 0.5 * ( y0 + z/y0 ); + y0 := 0.5 * ( y1 + z/y1 ); + y1 := 0.5 * ( y0 + z/y0 ); + 0.5 * ( y1 + z/y1 ) +END PROC sqrt; + +REAL PROC exp ( REAL CONST z ): + REAL VAR x::z, a::1.0; BOOL VAR negativ :: x<0.0; + IF negativ THEN x := -x FI; + IF x>292.42830676 + THEN IF NOT negativ THEN errorstop ("REAL-Ueberlauf") FI ; 0.0 + ELIF x<=0.0001 + THEN ( 0.5*z + 1.0 ) * z + 1.0 + ELSE approx + FI. + + approx: + IF x > ln10 + THEN x := lge*x; + a := 1.0; + set exp (int(x), a); + x := frac(x)*ln10 + FI; + IF x >= 2.0 THEN a := 7.389056098930650227230*a; x := x-2.0 FI; + IF x >= 1.0 THEN a := 2.718281828459045235360*a; x := x-1.0 FI; + IF x >= 0.5 THEN a := 1.648721270700128146848*a; x := x-0.5 FI; + IF x >= 0.25 THEN a := 1.284025416687741484073*a; x := x-0.25 FI; + IF x >= 0.125 THEN a := 1.133148453066826316829*a; x := x-0.125 FI; + IF x >= 0.0625THEN a := 1.064494458917859429563*a; x := x-0.0625FI; + a:=a/50.4*(((((((0.01*x+0.07)*x+0.42)*x+2.1)*x+8.4)*x+25.2)*x+50.4)*x+50.4); + IF negativ THEN 1.0/a ELSE a FI . + +ENDPROC exp ; + +REAL PROC tan (REAL CONST x): + IF x < 0.0 THEN - tg( -x * pi4) + ELSE tg( x * pi4) FI +END PROC tan; + +REAL PROC tand (REAL CONST x): + IF x < 0.0 THEN - tg( -x / 45.0) + ELSE tg( x / 45.0) FI +END PROC tand; + +REAL PROC tg (REAL CONST x ): + REAL VAR q::floor(x), s::x-q; INT VAR n; + q := q - floor(0.25*q) * 4.0 ; + IF q < 2.0 + THEN IF q < 1.0 + THEN n:=0; + ELSE n:=1; s := 1.0 - s FI + ELSE IF q < 3.0 + THEN n:=2; + ELSE n:=3; s := 1.0 - s FI + FI; + q := s * s; + q := (((((((((-5.116186989653120e-11*q-5.608325022830701e-10)*q- + 9.526170109403018e-9)*q-1.517906721393745e-7)*q-2.430939946375515e-6)*q- + 3.901461426385464e-5)*q-6.324811612385572e-4)*q-1.076606829172646e-2)*q- + 0.2617993877991508)*q+pi4); + + SELECT n OF + CASE 0 : s/q + CASE 1 : q/s + CASE 2 : -q/s + OTHERWISE : -s/q ENDSELECT . + +END PROC tg; + +REAL PROC sin ( REAL CONST x ): + REAL VAR y, r, q; + IF x < 0.0 THEN y := -x; q := 4.0 ELSE y := x; q := 0.0 FI; + y := y * pi4; + r := floor(y); + sincos( q+r , y-r ) +END PROC sin; + +REAL PROC sind ( REAL CONST x ): + REAL VAR y, r, q; + IF x < 0.0 THEN y := -x; q := 4.0 ELSE y := x; q := 0.0 FI; + y := y / 45.0; + r := floor(y); + sincos( q+r , y-r ) +END PROC sind; + +REAL PROC cos ( REAL CONST x ): + REAL VAR y, q; + IF x < 0.0 THEN y := -x ELSE y := x FI; + y := y * pi4; + q := floor(y); + sincos( q+2.0, y-q ) +END PROC cos; + +REAL PROC cosd ( REAL CONST x ): + REAL VAR y, q; + IF x < 0.0 THEN y := -x ELSE y := x FI; + y := y / 45.0; + q := floor(y); + sincos( q+2.0, y-q ) +END PROC cosd; + +REAL PROC sincos ( REAL CONST q, y ): + REAL VAR r :: q - floor( 0.125*q + 0.1 ) * 8.0; + IF r >= 4.0 THEN IF r >= 6.0 THEN IF r >= 7.0 THEN - sin approx(1.0-y) + ELSE - cos approx(y) FI + ELSE IF r >= 5.0 THEN - cos approx(1.0-y) + ELSE - sin approx(y) FI FI + ELSE IF r >= 2.0 THEN IF r >= 3.0 THEN sin approx(1.0-y) + ELSE cos approx(y) FI + ELSE IF r >= 1.0 THEN cos approx(1.0-y) + ELSE sin approx(y) FI FI FI +END PROC sincos; + +REAL PROC sin approx ( REAL CONST x ): + REAL VAR z::x*x; + x*((((((0.6877101540593035e-11*z-0.1757149296873372e-8)*z+0.3133616216672568 + e-6)*z-0.3657620415845891e-4)*z+0.2490394570188737e-2)*z-0.807455121882e-1)* + z+0.7853981633974483) +END PROC sin approx; + +REAL PROC cos approx ( REAL CONST x ): + REAL VAR z::x*x; + ((((((-0.3857761864560276e-12*z+0.115004970178141e-9)*z-0.246113638267419e-7 + )*z+0.3590860445885748e-5)*z-0.3259918869266875e-3)*z+0.1585434424381541e-1) + *z-0.3084251375340425)*z+1.0 +END PROC cos approx; + +REAL PROC arctan ( REAL CONST y ): + REAL VAR f, z, x; BOOL VAR neg :: y < 0.0; + IF neg THEN x := -y ELSE x := y FI; + IF x>1.0 THEN f := a ELSE f := -b; neg := NOT neg FI; + z := x * x; + x := x/(((((((0.0107090276046822*z-0.01647757182108040)*z + +0.02177846332482151)*z-0.03019339673273880)*z+0.04656083561183398)*z + -0.0888888888888888)*z+0.3333333333333333)*z+1.0); + IF neg THEN x - f ELSE f - x FI. + + a:IF x>sqr3p2 THEN x := 1.0/x; pi2 ELSE x := 4.0/(sqrt3+x+x+x)-sqr3; pi3 FI. + b:IF x0 REP + m := n DIV 2 ; + IF m + m = n + THEN n := m ; + r := r*r + ELSE n DECR 1 ; + p := p*r + FI + END REP ; + IF b>0 + THEN p + ELSE 1.0 / p + FI + FI . + +END OP ** ; + +REAL PROC random: + rdg:=rdg+pii;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=frac(rdg);rdg +END PROC random; + +PROC initializerandom ( REAL CONST z ): + rdg := frac(z) +END PROC initializerandom; + +END PACKET mathlib; + diff --git a/system/base/1.7.5/src/pattern match b/system/base/1.7.5/src/pattern match new file mode 100644 index 0000000..f6190d8 --- /dev/null +++ b/system/base/1.7.5/src/pattern match @@ -0,0 +1,768 @@ +PACKET pattern match DEFINES (* Author: P.Heyderhoff *) + (* Date: 09.06.1986 *) + -, + OR, + **, + any, + notion, + bound, + match, + matchpos, + matchend, + somefix, + UNLIKE, + LIKE : + +(*------- Operation codes of the internal intermeadiate language: --------*) + +LET + z = ""0"", + stopz = ""1""0"", + closez = ""2""0"", + closor = ""2""0""3""0"", + or = ""3"", + oralpha = ""3""5"", + open2 = ""4""0""4""0"", + alpha = ""5"", + alphaz = ""5""0"", + lenz = ""6""0"", + nilz = ""6""0""0""0""7""0"", (* = any (0) *) + starz = ""7""0"", + star = ""8""0""2""7""0""1""0"", (* = any ** 1 *) + powerz = ""8""0"", + powerz0 = ""8""0""1"", + notionz = ""9""0"", + fullz = ""10""0"", + boundz = ""11""0""; +(*------------------------------------------------------------------------*) + +LET undefined = 0, (* fixleft value *) + forcer = 0, (* vaHue parameter *) + delimiter = " !""#$%&'()*+,-./:;<=>?§^_`­"; (* for 'PROC notion' *) + +TEXT OP - (TEXT CONST alphabet ): + p:= ""; + INT VAR j; + FOR j FROM 0 UPTO 255 + REP IF pos(alphabet,code(j)) = 0 + THEN p CAT code(j) + FI + PER; + p + ENDOP -; + +TEXT OP OR (TEXT CONST a, b): + open2 + notnil (a) + closor + notnil (b) + closez + ENDOP OR; + +TEXT OP ** (TEXT CONST p, INT CONST x): + powerz + code (1+x) + notnil (p) + stopz + ENDOP **; + +TEXT CONST any:= starz; + +TEXT PROC any (INT CONST n): + TEXT VAR t:= " "; + replace (t, 1, ABSn); + lenz + t + starz + ENDPROC any; + +TEXT PROC any (TEXT CONST a): alphaz + a + starz ENDPROC any; + +TEXT PROC any (INT CONST n, TEXT CONST a): + TEXT VAR t:= " "; + replace (t, 1, ABSn); + lenz + t + alphaz + a + starz + ENDPROC any; + +TEXT PROC notion (TEXT CONST t): notionz + notnil(t) + stopz ENDPROC notion; + +TEXT PROC notnil (TEXT CONST t): + IF t = "" + THEN nilz + ELSE t + FI + ENDPROC notnil; + +TEXT CONST bound := boundz; + +TEXT PROC full (TEXT CONST t): fullz + t + stopz ENDPROC full; + +TEXT PROC match (INT CONST x): + subtext (p, matchpos(x), matchend(x)) + ENDPROC match; + +INT PROC matchpos (INT CONST x): mapos (1 + x MOD 256) ENDPROC matchpos; + +INT PROC matchend (INT CONST x): maend (1 + x MOD 256) - 1 + ENDPROC matchend; + +(*----------------- GLOBAL VARIABLES: -----------------------------------*) + +ROW 256 INT VAR + (* Table of match registers. Each entry consists of two *) + (* pointers, which points to the TEXT object 't' *) + mapos, (* points to the beginning of the match *) + maend; (* points to the position after the end of match *) + +INT VAR ppos, tpos, (* workpositions in pattern 'p' and text 't' *) + floatpos, (* accumulation of all pending floatlengths *) + failpos, (* result of 'PROC in alpha' *) + plen, tlen, (* length of pattern 'p' and length of text 't' *) + skipcount, (* for track forward skipping *) + multi, vari; (* for handling of nonexclusive alternatives *) + +TEXT VAR p, (* the pattern to be find or some result *) + stack, (* stack of pending assignments *) + alphabet:=""; (* result of 'PROC find alpha', reset to nil *) + (* after its usage by 'find any' *) + +BOOL VAR fix, (* text position is fixed and not floating *) + no vari; (* not variing the order of alternatives *) + +TEXT PROC somefix (TEXT CONST pattern): + + (* delivers the first text occuring unconditionally in the pattern *) + + p:= pattern; + INT VAR j:= 1, n:= 0, k, len:= LENGTH p; + REP + SELECT text( subtext (p, j, j+1), 2) ISUB 1 OF + CASE 1,3,7,9,10,11: j INCR 2 + CASE 2: j INCR 2; n DECR 1 (* condition closed *) + CASE 4: j INCR 2; n INCR 1 (* condition opened *) + CASE 5: j := pos (p, starz, j+2) + 2 + CASE 6: j INCR 4 + CASE 8: j INCR 3 + OTHERWISE k:= pos(p, z, j+1) - 1; + IF k <= 0 THEN k:= 1+len FI; + IF star found + THEN change (p, starpos, starpos, star); + len:= LENGTH p; + k:= starpos + FI; + IF n = 0 CAND ( p SUB k ) <> or CAND k > j + THEN LEAVE somefix WITH subtext(p,j,k-1) + ELSE j:=k + FI + ENDSELECT + UNTIL j > len + PER; + "" . + + star found: + INT VAR starpos:= pos (p, "*", j); + starpos > 0 CAND starpos <= k . + + ENDPROC somefix; + +PROC skip (TEXT CONST p, BOOL CONST upto or): + + (* skips 'ppos' upto the end of the opened nest, n = nesting level *) + + INT VAR n:= 0; + REP + SELECT text (subtext (p, ppos, ppos+1), 2) ISUB 1 OF + CASE 1,2: IF n = 0 + THEN LEAVE skip + FI; + ppos INCR 2; + nDECR1 + CASE 3: IF n = 0 CAND upto or + THEN LEAVE skip + FI; + ppos INCR 2 + CASE 7: ppos INCR 2 + CASE 4,9,10,11: ppos INCR 2; + n INCR 1 + CASE 5: ppos:= pos (p, starz, ppos+2) + 2 + CASE 6: ppos INCR 4 + CASE 8: ppos INCR 3; + n INCR 1 + OTHERWISE ppos:= pos(p, z, ppos+1) - 1; + IF ppos < 0 + THEN ppos:= plen; + LEAVE skip + FI + ENDSELECT + PER + ENDPROC skip; + +BOOL OP UNLIKE (TEXT CONST t, p): NOT ( t LIKE p ) ENDOP UNLIKE; + +BOOL OP LIKE (TEXT CONST t, pattern): + init; + BOOL CONST found:= find (t,1,1, fixresult, floatresult); + save; + found. + + init: no vari:= TRUE; + vari:= 0; + tlen:= 1 + LENGTH t; + p:= full (pattern); + IF pos (p, bound) > 0 + THEN + IF subtext (p, 14, 15) = bound + THEN p:= subtext (p, 1, 8) + powerz0 + subtext (p, 16) + FI; + plen:= LENGTH p - 7; + IF subtext (p, plen, plen+1) = bound + THEN p:= subtext (p, 1, plen - 1) + stopz + stopz + FI; + FI; + plen:= LENGTH p + 1; + INT VAR fixresult, floatresult; + tpos:= 1; + floatpos:= 0; + stack:= ""; + alphabet:= ""; + fix:= TRUE; + skipcount:= 0; + multi:= 0. + + save: p:= t + + ENDOP LIKE; + +(*-------- Realisation of the pattern matching algorithms 'find' --------*) + +BOOL PROC find + (TEXT CONST t, INT CONST unit, from, INT VAR fixleft, floatlen): + + initialize; + BOOL CONST found:= pattern unit; + SELECT next command * unit OF + CASE 0,1,2: found + CASE 3: next; + find alternative + OTHERWISE find concatenation + ENDSELECT . + + find alternative: + IF found + THEN save left position; + backtrack; + IF find pattern CAND better + THEN note multiplicity + ELSE back to first one + FI + ELSE backtrack multi + FI. + + better: permutation XOR more left. + + permutation: vari MOD 2 = 1. + + save left position: j:= fixleft. + + more left: j > fixleft. + + backtrack multi: multi:= 2 * backmulti + 1; + vari:= backvari DIV 2; + find pattern. + + note multiplicity: multi:= 2 * multi + 1; + vari:= vari DIV 2; + TRUE. + + back to first one: backtrack; + IF find first subpattern + THEN skip (p, FALSE); + note multiplicity + ELSE errorstop ("pattern"); + FALSE + FI. + + find concatenation: + IF found + THEN IF ppos=plen COR find pattern COR track forward + COR ( multi > backmulti CAND vari = 0 CAND find variation ) + THEN TRUE + ELSE backtrack; FALSE + FI + ELSE skip (p, TRUE); FALSE + FI. + + track forward: (* must be performed before variation *) + j:=0; + last multi:= multi; + last vari:= vari; + WHILE skipcount = 0 + REP IF tlen = tpos + THEN LEAVE track forward WITH FALSE + FI; + backtrack; + j INCR 1; + skipcount:= j + UNTIL find first subpattern CAND find pattern + PER; + j:= skipcount; + skipcount:=0; + j=0. + + find variation: + multi:= last multi; + vari:= last vari; + FOR k FROM 1 UPTO (multi+1) DIV (backmulti+1) - 1 + REP backtrack with variation; + IF find first subpattern CAND find pattern + THEN vari:=0; + LEAVE find variation WITH TRUE + FI + PER; + FALSE. + + backtrack with variation: + backtrack; + vari:= k. + + find pattern: + find (t, 1, ppos+forcer, fixresult, floatresult) CAND keep result. + + find first subpattern: + find (t, 0, from, fixresult, floatresult) CAND keep result . + + initialize: + INT VAR j, + k, + fixresult, + floatresult, + last multi, + last vari; + BOOL CONST backfix:= fix; + TEXT CONST backstack:= stack; + floatlen:= 0; + INT CONST back:= tpos, + backfloat:= floatpos, + backskip:= skipcount, + backmulti:= multi, + backvari:= vari; + fixleft:= fixleft0. + + fixleft0: IF fix THEN back ELSE undefined FI. + + backtrack: + fix:= backfix; + tpos:= back; + fixleft:= fixleft0; + floatlen:= 0; + floatpos:= backfloat; + stack:= backstack; + skipcount:= backskip; + multi:= backmulti; + vari:= backvari. + + keep result: + IF fixleft = undefined + THEN IF fixresult = undefined + THEN floatlen INCR floatresult + ELSE fixleft := fixresult - floatlen; + floatpos DECR floatlen; + floatlen:= 0 + FI + FI; + TRUE. + + pattern unit: + init ppos; + SELECT command OF + CASE 1,2: find end + CASE 3: find nil + CASE 4: find choice + CASE 5: find alphabet + CASE 6: find fixlength any + CASE 7: find varlength any + CASE 8: find and store match + CASE 9: find notion + CASE 10: find full + CASE 11: next; find nil + OTHERWISE find plain text END SELECT. + + init ppos: ppos:= from + 2. + + command: text (subtext (p, from, from+1), 2) ISUB 1. + + next command: text (subtext (p, ppos, ppos+1), 2) ISUB 1. + + next: ppos INCR 2. + + find end: ppos DECR 2; + fixleft:= tpos; + LEAVE find WITH TRUE; + TRUE. + + find nil: ppos DECR 2; + fixleft:= tpos; + TRUE. + + find choice: IF find pattern + THEN next; TRUE + ELSE next; FALSE + FI. + + find plain text: find text upto next command; + IF fix THEN allow fix position only + ELIF text found THEN allow variable position + ELSE allow backtrack + FI. + + find text upto next command: + ppos:= pos (p, z, from + 1); + IF ppos = 0 + THEN ppos:= plen + ELSE ppos DECR 1 + FI; + IF star found + THEN change (p, starpos, starpos, star); + plen:= 1 + LENGTH p; + ppos:= starpos + FI; + tpos:= pos (t, subtext (p, from, ppos - 1), tpos). + + star found: + INT VAR starpos:= pos (p, "*", from); + starpos > 0 CAND starpos <= ppos . + + text found: + WHILE skipcount > 0 CAND tpos > 0 + REP skipcount DECR 1; + tpos:= pos (t, subtext(p,from,ppos-1), tpos+1) + PER; + tpos > 0 . + + allow fix position only: + IF tpos = back + THEN tpos INCR (ppos-from); TRUE + ELSE tpos:= back; + from = ppos + FI. + + allow variable position: + IF alphabet = "" COR in alpha (t, back, tpos) + THEN fix it; + tpos INCR (ppos-from); + TRUE + ELSE tpos:= back; + FALSE + FI. + + allow backtrack: + tpos:= back; + IF from = ppos + THEN fix it; + TRUE + ELSE FALSE + FI . + + find alphabet: + j:= pos (p, starz, ppos); + alphabet:= subtext (p, ppos, j-1); + ppos := j; + TRUE. + + find fixlength any: + get length value; + find alpha attribut; + IF alphabet = "" + THEN find any with fix length + ELSE find any in alphabet with fix length + FI. + + get length value: + floatlen:= subtext(p, ppos, ppos+1) ISUB 1; + ppos INCR 4. + + find alpha attribut: + IF (p SUB (ppos-2)) = alpha CAND find alphabet + THEN next + FI. + + find any with fix length: + tpos INCR floatlen; + IF tpos > tlen + THEN tpos:= back; + floatlen:=0; + FALSE + ELSE IF fix THEN floatlen:= 0 + ELIF floatlen = 0 + THEN fix it (* unlike niltext 6.6. *) + ELSE floatpos INCR floatlen + FI; + TRUE + FI. + + find any in alphabet with fix length: + IF first character in alpha + THEN IF NOT fix THEN fix it FI; + set fix found + ELSE set fix not found + FI. + + first character in alpha: + (fix COR advance) CAND in alpha (t, tpos, tpos+floatlen). + + advance: + FOR tpos FROM back UPTO tlen + REP IF pos (alphabet, t SUB tpos) > 0 + THEN LEAVE advance WITH TRUE + FI + PER; + FALSE. + + fix it: + fixleft:= back-floatpos; + make fix (back); + fixleft:= tpos. + + set fix found: + tpos INCR floatlen; + floatlen:= 0; + alphabet:= ""; + TRUE. + + set fix not found: tpos:= back; + alphabet:= ""; + floatlen:= 0; + FALSE. + + find varlength any: IF alphabet = "" + THEN really any + ELSE find varlength any in alphabet + FI. + + really any: IF fix + THEN fix:= FALSE; + fixleft:= tpos + ELIF floatpos = 0 + THEN fixleft:= tpos (* 6.6. *) + FI; + TRUE . + + find varlength any in alphabet: + IF fix THEN fixleft := tpos FI; + IF fix CAND pos (alphabet, t SUB tpos) > 0 + COR NOT fix CAND advance + THEN IF NOT fix THEN fix it FI; + set var found + ELSE set var not found + FI. + + set var found: tpos:= end of varlength any; + alphabet:= ""; + TRUE. + set var not found: tpos:= back; + alphabet:= ""; + FALSE. + end of varlength any: IF NOT in alpha(t,tpos,tlen) + THEN failpos + ELSE tlen + FI. + + find and store match: get register name; + IF find pattern + THEN next; + store; + TRUE + ELSE next; + FALSE + FI. + + store: IF fix + THEN mapos (reg):= fixleft; + maend (reg):= tpos + ELSE stack CAT code(floatlen) + + code(floatpos) + code(fixleft) + c + FI. + + get register name: TEXT CONST c:= p SUB (ppos); + INT VAR reg:= code (c); + ppos INCR 1. + + find notion: float notion; + exhaust notion . + + float notion: j:= back; + REP IF find pattern + THEN IF is notion (t, fixleft) + THEN LEAVE find notion WITH TRUE + ELIF backfix + THEN LEAVE float notion + ELSE go ahead FI + ELIF j=back + THEN next; + LEAVE find notion WITH FALSE + ELSE LEAVE float notion + FI + PER. + + go ahead: j INCR 1; + IF simple THEN j:= max (tpos, j) FI; + notion backtrack. + + simple: k:= from; + REP k := pos (p, z, k+2); + IF k > ppos-3 + THEN LEAVE simple WITH TRUE + ELIF pos (oralpha, p SUB k-1) > 0 + THEN LEAVE simple WITH FALSE + FI + PER; + FALSE. + + notion backtrack: tpos:= j; + fix:= backfix; + fixleft:= fixleft0; + floatlen:= 0; + floatpos:= backfloat + tpos - back; + stack:= backstack; + ppos:= from + 2 . + + exhaust notion: IF notion expansion + COR multi > backmulti + CAND no vari + CAND notion variation + THEN TRUE + ELSE backtrack; FALSE + FI. + + notion expansion: j:= 0; + multi:= last multi; + vari:= last vari; + WHILE skipcount = 0 + REP skip and try PER; + j:= skipcount; + skipcount:= 0; + j = 0. + + skip and try: backtrack; + j INCR 1; + skipcount:=j; + ppos:= from + 2; + IF find pattern + THEN IF is notion (t, fixleft) + THEN LEAVE find notion WITH TRUE + FI + ELSE next; LEAVE find notion WITH FALSE + FI . + + notion variation: no vari:= FALSE; + last multi:= multi; + last vari:= vari; + FOR k FROM 1 UPTO (multi+1) DIV (backmulti+1) - 1 + REP backtrack with variation; + IF find first subpattern + THEN no vari:= TRUE; + LEAVE find notion WITH TRUE + FI + PER; + no vari:= TRUE; + FALSE. + + find full: + find pattern CAND (end of line COR exhaust line). + + end of line: + next; + IF fix + THEN tpos = tlen + ELSE tpos:= tlen; + make fix (1); + TRUE + FI. + + exhaust line: + IF full expansion COR multi > 0 CAND no vari CAND full variation + THEN TRUE ELSE backtrack; + FALSE + FI. + + full expansion: + j:=0; + last multi:= multi; + last vari:= vari; + WHILE skipcount = 0 + REP IF tlen = tpos + THEN LEAVE full expansion WITH FALSE + FI; + backtrack; + j INCR 1; + skipcount:= j; + ppos:=from + 2 + UNTIL find pattern CAND tpos=tlen + PER; + j:= skipcount; + skipcount:=0; + j=0. + + full variation: + no vari:= FALSE; + multi:= last multi; + vari:= last vari; + FOR k FROM 1 UPTO multi + REP backtrack with variation; + IF find first subpattern + THEN no vari:= TRUE; + LEAVE find WITH TRUE + FI + PER; + no vari:= TRUE; + FALSE. + + ENDPROC find; + +BOOL PROC is notion (TEXT CONST t, INT CONST fixleft): + ppos INCR 2; + ( NOT fix + COR tpos = tlen + COR pos (delimiter, t SUB tpos) > 0 + COR pos (delimiter, t SUB tpos-1) > 0 + COR (t SUB tpos) <= "Z" + CAND (t SUB tpos-1) > "Z" ) + CAND ( fixleft <= 1 + COR pos (delimiter, t SUB fixleft-1) > 0 + COR pos (delimiter, t SUB fixleft) > 0 + COR (t SUB fixleft) > "Z" + CAND (t SUB fixleft-1) <= "Z" ) + + END PROC is notion; + +PROC make fix (INT CONST back): + WHILE stack not empty + REP INT VAR reg:= code (stack SUB top), + pos:= code (stack SUB top-1), + len:= code (stack SUB top-3), + dis:= code (stack SUB top-2) - floatpos; + maend(reg):= min (tpos + dis, tlen); (* 6.6. *) + mapos(reg):= pos or fix or float; + stack:= subtext (stack,1,top-4) + PER; + fix:= TRUE; + floatpos:= 0 . + + stack not empty: INT VAR top:= LENGTH stack; + top > 0. + + pos or fix or float: + IF pos = undefined + THEN IF len = 0 + THEN min (back + dis, tlen) + ELSE maend(reg) - len + FI + ELSE pos + FI. + + ENDPROC make fix; + +BOOL PROC in alpha (TEXT CONST t, INT CONST from, to): + FOR failpos FROM from UPTO to - 1 + REP IF pos (alphabet, t SUB failpos) = 0 + THEN LEAVE in alpha WITH FALSE + FI + PER; + TRUE + ENDPROC in alpha; + +TEXT PROC notion (TEXT CONST t, INT CONST r): notion (t) ** r ENDPROC notion; + +ENDPACKET pattern match; + diff --git a/system/base/1.7.5/src/pcb control b/system/base/1.7.5/src/pcb control new file mode 100644 index 0000000..9bf0e2d --- /dev/null +++ b/system/base/1.7.5/src/pcb control @@ -0,0 +1,79 @@ + +PACKET pcb and init control DEFINES (* Autor: J.Liedtke *) + (* Stand: 25.08.84 *) + session , + pcb , + set line nr , + clock , + INITFLAG , + := , + initialized , + storage , + id , + ke : + + +LET line number field = 1 , + myself id field = 9 ; + +TYPE INITFLAG = INT ; + + +INT PROC session : + EXTERNAL 126 +ENDPROC session ; + +INT PROC pcb (INT CONST field) : + EXTERNAL 80 +ENDPROC pcb ; + +PROC write pcb (INT CONST task nr, field, value) : + EXTERNAL 105 +ENDPROC write pcb ; + +PROC set line nr (INT CONST value) : + write pcb (pcb (myself id field), line number field, value) +ENDPROC set line nr ; + + +OP := (INITFLAG VAR flag, BOOL CONST flagtrue) : + + IF flagtrue + THEN CONCR (flag) := myself no + ELSE CONCR (flag) := 0 + FI . + +myself no : pcb (myself id field) AND 255 . + +ENDOP := ; + +BOOL PROC initialized (INITFLAG VAR flag) : + + IF CONCR (flag) = myself no + THEN TRUE + ELSE CONCR (flag) := myself no ; + FALSE + FI . + +myself no : pcb (myself id field) AND 255 . + +ENDPROC initialized ; + +REAL PROC clock (INT CONST nr) : + EXTERNAL 102 +ENDPROC clock ; + +PROC storage (INT VAR size, used) : + EXTERNAL 89 +ENDPROC storage ; + +INT PROC id (INT CONST no) : + EXTERNAL 129 +ENDPROC id ; + +PROC ke : + EXTERNAL 6 +ENDPROC ke ; + +ENDPACKET pcb and init control ; + diff --git a/system/base/1.7.5/src/real b/system/base/1.7.5/src/real new file mode 100644 index 0000000..3e3c651 --- /dev/null +++ b/system/base/1.7.5/src/real @@ -0,0 +1,442 @@ +(* ------------------- VERSION 6 05.05.86 ------------------- *) +PACKET real DEFINES (* Autor: J.Liedtke *) + + text , + int , + real , + round , + floor , + frac , + decimal exponent , + set exp , + INCR , + DECR , + abs , + ABS , + sign , + SIGN , + MOD , + min , + max , + max real , + small real : + +LET mantissa length = 13 , + digit zero index = 1 , + digit nine index = 10 ; +INT CONST + decimal point index := -1 ; + +TEXT VAR mantissa ; + +ROW 10 REAL VAR real digit ; + +INT VAR i ; REAL VAR d := 0.0 ; +FOR i FROM 1 UPTO 10 REP + real digit (i) := d ; + d := d + 1.0 +PER ; + +REAL PROC max real : 9.999999999999e126 ENDPROC max real ; + +REAL PROC small real : 1.0e-12 ENDPROC small real ; + +PROC sld (INT CONST in, REAL VAR real, INT VAR out) : + EXTERNAL 96 +ENDPROC sld ; + +INT PROC decimal exponent (REAL CONST mantissa) : + EXTERNAL 97 +ENDPROC decimal exponent ; + +PROC set exp (INT CONST exponent, REAL VAR number) : + EXTERNAL 98 +ENDPROC set exp ; + +REAL PROC tenpower (INT CONST exponent) : + REAL VAR result := 1.0 ; + set exp (exponent, result) ; + result +ENDPROC tenpower ; + +REAL PROC floor (REAL CONST real) : + EXTERNAL 99 +ENDPROC floor ; + +REAL PROC round (REAL CONST real, INT CONST digits) : + + REAL VAR result := real ; + IF (real <> 0.0) CAND (decimal exponent (real) + digits < mantissa length) + THEN round result ; + FI ; + result . + +round result : + set exp (decimal exponent (result) + digits, result) ; + IF result >= 0.0 + THEN result := floor (result + 0.5) + ELSE result := floor (result - 0.5) + FI ; + IF result <> 0.0 + THEN set exp (decimal exponent (result) - digits, result) + FI . + +ENDPROC round ; + +TEXT VAR result ; + +TEXT PROC text (REAL CONST real) : + + REAL VAR value := rounded to seven digits ; + IF value = 0.0 + THEN "0.0" + ELSE + process sign ; + get mantissa (value) ; + INT CONST exponent := decimal exponent (value) ; + get short mantissa ; + IF exponent > 7 OR exponent < LENGTH short mantissa - 7 + THEN scientific notation + ELSE short notation + FI + FI . + +rounded to seven digits : + round ( real * tenpower( -decimal exponent(real) ) , 6 ) + * tenpower ( decimal exponent(real) ) . + +process sign : + IF value < 0.0 + THEN result := "-" ; + value := - value + ELSE result := "" + FI . + +get short mantissa : + INT VAR i := 7 ; + WHILE (mantissa SUB i) = "0" REP + i DECR 1 + UNTIL i=1 END REP ; + TEXT CONST short mantissa := subtext (mantissa, 1, i) . + +scientific notation : + result CAT (mantissa SUB 1) ; + result CAT "." ; + result CAT subtext (mantissa, 2, 7) ; + result + "e" + text (exponent) . + +short notation : + IF exponent < 0 + THEN result + "0." + (-exponent - 1) * "0" + short mantissa + ELSE result CAT subtext (short mantissa, 1, exponent+1) ; + result CAT (exponent+1 - LENGTH short mantissa) * "0" ; + result CAT "." ; + result CAT subtext (short mantissa, exponent+2) ; + IF LENGTH short mantissa < exponent + 2 + THEN result + "0" + ELSE result + FI + FI . + +ENDPROC text ; + +PROC get mantissa (REAL CONST number) : + + REAL VAR real mantissa := number ; + mantissa := "" ; + INT VAR i , digit ; + FOR i FROM 1 UPTO mantissa length REP + sld (0, real mantissa, digit) ; + mantissa CAT code (digit + 48) + PER ; + +ENDPROC get mantissa ; + +TEXT PROC text (REAL CONST real, INT CONST length) : + + INT CONST mantissa length := min (length - 7, 13) ; + IF mantissa length > 0 + THEN construct scientific notation + ELSE result := length * "*" + FI ; + result . + +construct scientific notation : + REAL VAR value := rounded real ; + IF value = 0.0 + THEN result := subtext (" 0.0 ", 1, length) + ELSE process sign ; + process mantissa ; + process exponent + FI . + +rounded real : + round (real * tenpower ( -decimal exponent (real)) , mantissa length - 1) + * tenpower (decimal exponent (real)) . + +process sign : + IF value < 0.0 + THEN result := "-" + ELSE result := "+" + FI . + +process mantissa : + get mantissa (value) ; + result CAT (mantissa SUB 1) ; + result CAT "." ; + result CAT subtext (mantissa, 2, mantissa length) . + +process exponent : + IF decimal exponent (value) >= 0 + THEN result CAT "e+" + ELSE result CAT "e-" + FI ; + result CAT text (ABS decimal exponent (value), 3) ; + change all (result, " ", "0") . + +ENDPROC text ; + +TEXT PROC text (REAL CONST real, INT CONST length, fracs) : + + REAL VAR value := round (real, fracs) ; + INT VAR exponent := decimal exponent (value) ; + IF value = 0.0 THEN exponent := 0 FI ; + INT VAR floors := exponent + 1 , + floor length := length - fracs - 1 ; + IF value < 0.0 THEN floor length DECR 1 FI ; + + IF value too big + THEN length * "*" + ELSE transformed value + FI . + +transformed value : + process leading blanks and sign ; + get mantissa (value) ; + result CAT subtext (mantissa, 1, floors) ; + IF LENGTH mantissa < floors + THEN result CAT (floors - LENGTH mantissa) * "0" + FI ; + result CAT "." ; + IF exponent < 0 + THEN result CAT (-floors) * "0" ; + result CAT subtext (mantissa, 1, length - LENGTH result) + ELSE result CAT subtext (mantissa, floors+1, floors + fracs) + FI ; + IF LENGTH result < length + THEN result CAT (length - LENGTH result) * "0" + FI ; + result . + +process leading blanks and sign : + result := (floor length - max(floors,0)) * " " ; + IF value < 0.0 + THEN result CAT "-" ; + value := - value + FI . + +value too big : + floors > floor length . + +ENDPROC text ; + +REAL PROC real (TEXT CONST text) : + + skip leading blanks ; + sign ; + mantissa part ; + exponent ; + result . + +skip leading blanks : + INT VAR pos := 1 ; + skip blanks . + +skip blanks : + WHILE (text SUB pos) = " " REP + pos INCR 1 + PER . + +sign : + BOOL VAR negative ; + IF (text SUB pos) = "-" + THEN negative := TRUE ; + pos INCR 1 + ELIF (text SUB pos) = "+" + THEN negative := FALSE ; + pos INCR 1 + ELSE negative := FALSE + FI . + +mantissa part: + REAL VAR value ; + INT VAR exponent pos := 0 ; + get first digit ; + WHILE pos <= LENGTH text REP + digit := code (text SUB pos) - 47 ; + IF digit >= digit zero index AND digit <= digit nine index + THEN value := value * 10.0 + real digit (digit) ; + pos INCR 1 + ELIF digit = decimal point index AND exponent pos = 0 + THEN pos INCR 1 ; + exponent pos := pos + ELSE LEAVE mantissa part + FI + END REP . + +get first digit : + INT VAR digit := code (text SUB pos) - 47 ; + IF digit = decimal point index + THEN pos INCR 1 ; + exponent pos := pos ; + digit := code (text SUB pos) - 47 + FI ; + IF digit >= digit zero index AND digit <= digit nine index + THEN value := real digit (digit) ; + pos INCR 1 + ELSE set conversion (FALSE) ; + LEAVE real WITH 0.0 + FI . + +exponent : + INT VAR exp ; + IF exponent pos > 0 + THEN exp := exponent pos - pos + ELSE exp := 0 + FI ; + IF (text SUB pos) = "e" + THEN exp INCR int (subtext(text,pos+1)) + ELSE no more nonblank chars permitted + FI . + +no more nonblank chars permitted : + skip blanks ; + IF pos > LENGTH text + THEN set conversion (TRUE) + ELSE set conversion (FALSE) + FI . + +result : + value := value * tenpower (exp) ; + IF negative + THEN - value + ELSE value + FI . + +ENDPROC real ; + + +REAL PROC abs (REAL CONST value) : + + IF value >= 0.0 + THEN value + ELSE -value + FI + +ENDPROC abs ; + +REAL OP ABS (REAL CONST value) : + + abs (value) + +ENDOP ABS ; + +INT PROC sign (REAL CONST value) : + + IF value < 0.0 THEN -1 + ELIF value = 0.0 THEN 0 + ELSE 1 + FI + +ENDPROC sign ; + +INT OP SIGN (REAL CONST value) : + + sign (value) + +ENDOP SIGN ; + +REAL OP MOD (REAL CONST left, right) : + + REAL VAR result := left - floor (left/right) * right ; + IF result < 0.0 + THEN result + abs (right) + ELSE result + FI + +ENDOP MOD ; + +REAL PROC frac (REAL CONST value) : + + value - floor (value) + +ENDPROC frac ; + +REAL PROC max (REAL CONST a, b) : + + IF a > b THEN a ELSE b FI + +ENDPROC max ; + +REAL PROC min (REAL CONST a, b) : + + IF a < b THEN a ELSE b FI + +ENDPROC min ; + +OP INCR (REAL VAR dest, REAL CONST increment) : + + dest := dest + increment + +ENDOP INCR ; + +OP DECR (REAL VAR dest, REAL CONST decrement) : + + dest := dest - decrement + +ENDOP DECR ; + +INT PROC int (REAL CONST value) : + + IF value = minint value + THEN minint + ELSE compute int result ; + IF value < 0.0 + THEN - result + ELSE result + FI + FI . + +compute int result : + INT VAR result := 0, digit ,i ; + REAL VAR mantissa := value ; + + FOR i FROM 0 UPTO decimal exponent (value) REP + sld (0, mantissa, digit) ; + result := result * 10 + digit + PER . + +minint value : - 32768.0 . +minint : - 32767 - 1 . + +ENDPROC int ; + +REAL PROC real (INT CONST value) : + + IF value < 0 + THEN - real (-value) + ELIF value < 10 + THEN real digit (value+1) + ELSE split value into head and last digit ; + real (head) * 10.0 + real digit (last digit+1) + FI . + +split value into head and last digit : + INT CONST + head := value DIV 10 , + last digit := value - head * 10 . + +ENDPROC real ; + +ENDPACKET real ; + diff --git a/system/base/1.7.5/src/scanner b/system/base/1.7.5/src/scanner new file mode 100644 index 0000000..35a632c --- /dev/null +++ b/system/base/1.7.5/src/scanner @@ -0,0 +1,325 @@ +(* ------------------- VERSION 4 14.05.86 ------------------- *) +PACKET scanner DEFINES (* Autor: J.Liedtke *) + + scan , + continue scan , + next symbol : + + +LET tag = 1 , + bold = 2 , + number = 3 , + text = 4 , + operator= 5 , + delimiter = 6 , + end of file = 7 , + within comment = 8 , + within text = 9 ; + +LET digit 0 = 48 , + digit 9 = 57 , + upper case a = 65 , + upper case z = 90 , + lower case a = 97 , + lower case z = 122; + + +TEXT VAR line := "" , + char := "" , + chars:= "" ; + +INT VAR position := 0 , + comment depth ; +BOOL VAR continue text ; + + +PROC scan (TEXT CONST scan text) : + + comment depth := 0 ; + continue text := FALSE ; + continue scan (scan text) + +ENDPROC scan ; + +PROC continue scan (TEXT CONST scan text) : + + line := scan text ; + position := 0 ; + nextchar + +ENDPROC continue scan ; + +PROC next symbol (TEXT VAR symbol) : + + INT VAR type ; + next symbol (symbol, type) + +ENDPROC next symbol ; + +PROC next symbol (TEXT VAR symbol, INT VAR type) : + + skip blanks ; + IF is begin comment THEN process comment + ELIF comment depth > 0 THEN comment depth DECR 1 ; + process comment + ELIF is quote OR continue text THEN process text + ELIF is lower case letter THEN process tag + ELIF is upper case letter THEN process bold + ELIF is digit THEN process number + ELIF is delimiter THEN process delimiter + ELIF is niltext THEN eof + ELSE process operator + FI . + + +process comment : + read comment ; + IF comment depth = 0 + THEN next symbol (symbol, type) + ELSE type := within comment ; + symbol := "" + FI . + +process tag : + type := tag ; + assemble chars (lower case a, lower case z) ; + symbol := chars ; + REP + skip blanks ; + IF is lower case letter + THEN assemble chars (lower case a, lower case z) + ELIF is digit + THEN assemble chars (digit 0, digit 9) + ELSE LEAVE process tag + FI ; + symbol CAT chars + PER ; + nextchar . + +process bold : + type := bold ; + assemble chars (upper case a, upper case z) ; + symbol := chars . + +process number : + type := number ; + assemble chars (digit 0, digit 9) ; + symbol := chars ; + IF char = "." AND ahead char is digit + THEN process fraction ; + IF char = "e" + THEN process exponent + FI + FI . + +ahead char is digit : + digit 0 <= code (ahead char) AND code (ahead char) <= digit 9 . + +process fraction : + symbol CAT char ; + nextchar ; + assemble chars (digit 0, digit 9) ; + symbol CAT chars . + +process exponent : + symbol CAT char ; + nextchar ; + IF char = "+" OR char = "-" + THEN symbol CAT char ; + nextchar + FI ; + assemble chars (digit 0, digit 9) ; + symbol CAT chars . + +process text : + type := text ; + symbol := "" ; + IF continue text + THEN continue text := FALSE + ELSE next char + FI ; + WHILE not end of text REP + assemble chars (35, 254) ; + symbol CAT chars ; + IF NOT is quote + THEN symbol CAT char ; + nextchar + FI + ENDREP . + +not end of text : + IF is niltext + THEN continue text := TRUE ; type := within text ; FALSE + ELIF is quote + THEN end of text or exception + ELSE TRUE + FI . + +end of text or exception : + next char ; + IF is quote + THEN get quote ; TRUE + ELIF is digit + THEN get special char ; TRUE + ELSE FALSE + FI . + +get quote : + symbol CAT char ; + nextchar . + +get special char : + assemble chars (digit 0, digit 9) ; + symbol CAT code (int (chars) ) ; + nextchar . + +process delimiter : + type := delimiter ; + symbol := char ; + nextchar . + +process operator : + type := operator ; + symbol := char ; + nextchar ; + IF symbol = ":" + THEN IF char = "=" OR char = ":" + THEN symbol := ":=" ; + nextchar + ELSE type := delimiter + FI + ELIF is relational double char + THEN symbol CAT char ; + nextchar + ELIF symbol = "*" AND char = "*" + THEN symbol := "**" ; + next char + FI . + +eof : + type := end of file ; + symbol := "" . + +is lower case letter : + lower case a <= code (char) AND code (char) <= lower case z . + +is upper case letter : + upper case a <= code (char) AND code (char) <= upper case z . + +is digit : + digit 0 <= code (char) AND code (char) <= digit 9 . + +is delimiter : pos ( "()[].,;" , char ) > 0 . + +is relational double char : + TEXT VAR double := symbol + char ; + double = "<>" OR double = "<=" OR double = ">=" . + +is quote : char = """" . + +is niltext : char = "" . + +is begin comment : char = "{" OR char = "(" AND ahead char = "*" . + +ENDPROC next symbol ; + +PROC next char : + + position INCR 1 ; + char := line SUB position + +ENDPROC next char ; + +PROC skip blanks : + + position := pos (line, ""33"", ""254"", position) ; + IF position = 0 + THEN position := LENGTH line + 1 + FI ; + char := line SUB position . + +ENDPROC skip blanks ; + +TEXT PROC ahead char : + + line SUB position+1 + +ENDPROC ahead char ; + +PROC assemble chars (INT CONST low, high) : + + INT CONST begin := position ; + position behind valid text ; + chars := subtext (line, begin, position-1) ; + char := line SUB position . + +position behind valid text : + position := pos (line, ""32"", code (low-1), begin) ; + IF position = 0 + THEN position := LENGTH line + 1 + FI ; + INT CONST higher pos := pos (line, code (high+1), ""254"", begin) ; + IF higher pos <> 0 AND higher pos < position + THEN position := higher pos + FI . + +ENDPROC assemble chars ; + + +PROC read comment : + + TEXT VAR last char ; + comment depth INCR 1 ; + REP + last char := char ; + nextchar ; + IF is begin comment + THEN read comment + FI ; + IF char = "" + THEN LEAVE read comment + FI + UNTIL is end comment PER ; + comment depth DECR 1 ; + next char ; + skip blanks . + +is end comment : + char = "}" OR char = ")" AND last char = "*" . + +is begin comment : + char = "{" OR char = "(" AND ahead char = "*" . + +ENDPROC read comment ; + + +PROC scan (FILE VAR f) : + + getline (f, line) ; + scan (line) + +ENDPROC scan ; + +PROC next symbol (FILE VAR f, TEXT VAR symbol) : + + INT VAR type ; + next symbol (f, symbol, type) + +ENDPROC next symbol ; + +TEXT VAR scanned ; + +PROC next symbol (FILE VAR f, TEXT VAR symbol, INT VAR type) : + + next symbol (symbol, type) ; + WHILE type >= 7 AND NOT eof (f) REP + getline (f, line) ; + continue scan (line) ; + next symbol (scanned, type) ; + symbol CAT scanned + PER . + +ENDPROC next symbol ; + +ENDPACKET scanner ; + diff --git a/system/base/1.7.5/src/screen b/system/base/1.7.5/src/screen new file mode 100644 index 0000000..7e64961 --- /dev/null +++ b/system/base/1.7.5/src/screen @@ -0,0 +1,33 @@ + +PACKET screen description DEFINES + + xsize, ysize, marksize, mark refresh line mode : + + +INT VAR xs := 80, ys := 24, ms := 1; + +INT PROC xsize: xs END PROC xsize; + +INT PROC ysize: ys END PROC ysize; + +INT PROC marksize: ms END PROC marksize; + +PROC xsize (INT CONST i): xs := i END PROC xsize; + +PROC ysize (INT CONST i): ys := i END PROC ysize; + +PROC marksize (INT CONST i): ms := i END PROC marksize; + + +BOOL VAR line mode := FALSE; + +BOOL PROC mark refresh line mode: + line mode +END PROC mark refresh line mode; + +PROC mark refresh line mode (BOOL CONST b): + line mode := b +END PROC mark refresh line mode; + +END PACKET screen description ; + diff --git a/system/base/1.7.5/src/std transput b/system/base/1.7.5/src/std transput new file mode 100644 index 0000000..94c51db --- /dev/null +++ b/system/base/1.7.5/src/std transput @@ -0,0 +1,264 @@ +(* ------------------- VERSION 2 06.03.86 ------------------- *) +PACKET std transput DEFINES + + sysout , + sysin , + put , + putline , + line , + page , + write , + get , + getline , + get secret line : + + +LET cr = ""13"" , + cr lf = ""13""10"" , + home clear = ""1""4"" , + esc = ""27"" , + rubout = ""12"" , + bell = ""7"" , + back blank back = ""8" "8"" , + del line cr lf = ""5""13""10"" ; + +TEXT VAR number word , exit char ; + +BOOL VAR console output := TRUE, console input := TRUE ; + +FILE VAR outfile, infile ; +TEXT VAR outfile name := "", infile name := "" ; + + +PROC sysout (TEXT CONST file name) : + + outfile name := file name ; + IF file name = "" + THEN console output := TRUE + ELSE outfile := sequential file (output, file name) ; + console output := FALSE + FI + +ENDPROC sysout ; + +TEXT PROC sysout : + outfile name +ENDPROC sysout ; + +PROC sysin (TEXT CONST file name) : + + infile name := file name ; + IF file name = "" + THEN console input := TRUE + ELSE infile := sequential file (input, file name) ; + console input := FALSE + FI + +ENDPROC sysin ; + +TEXT PROC sysin : + infile name +ENDPROC sysin ; + + +PROC put (TEXT CONST word) : + + IF console output + THEN out (word) ; out (" ") + ELSE put (outfile, word) + FI + +ENDPROC put ; + +PROC put (INT CONST number) : + + put (text (number)) + +ENDPROC put ; + +PROC put (REAL CONST number) : + + put (text (number)) + +ENDPROC put ; + +PROC putline (TEXT CONST textline) : + + IF console output + THEN out (textline) ; out (cr lf) + ELSE putline (outfile, textline) + FI + +ENDPROC putline ; + +PROC line : + + IF console output + THEN out (cr lf) + ELSE line (outfile) + FI + +ENDPROC line ; + +PROC line (INT CONST times) : + + INT VAR i ; + FOR i FROM 1 UPTO times REP + line + PER + +ENDPROC line ; + +PROC page : + + IF console output + THEN out (home clear) + FI + +ENDPROC page ; + +PROC write (TEXT CONST word) : + + IF console output + THEN out (word) + ELSE write (outfile, word) + FI + +ENDPROC write ; + + +PROC get (TEXT VAR word) : + + IF console input + THEN get from console + ELSE get (infile, word) + FI . + +get from console : + REP + word := "" ; + editget (word, " ", "", exit char) ; + echoe exit char + UNTIL word <> "" AND word <> " " PER ; + delete leading blanks . + +delete leading blanks : + WHILE (word SUB 1) = " " REP + word := subtext (word,2) + PER . + +ENDPROC get ; + +PROC get (TEXT VAR word, TEXT CONST separator) : + + IF console input + THEN get from console + ELSE get (infile, word, separator) + FI . + +get from console : + word := "" ; + editget (word, separator, "", exit char) ; + echoe exit char . + +ENDPROC get ; + +PROC echoe exit char : + + IF exit char = ""13"" + THEN out (""13""10"") + ELSE out (exit char) + FI + +ENDPROC echoe exit char ; + +PROC get (INT VAR number) : + + get (number word) ; + number := int (number word) + +ENDPROC get ; + +PROC get (REAL VAR number) : + + get (number word) ; + number := real (number word) + +ENDPROC get ; + +PROC get (TEXT VAR word, INT CONST length) : + + IF console input + THEN get from console + ELSE get (infile, word, length) + FI . + +get from console : + word := "" ; + editget (word, length, exit char) ; + echoe exit char . + +ENDPROC get ; + +PROC getline (TEXT VAR textline) : + + IF console input + THEN get from console + ELSE getline (infile, textline) + FI . + +get from console : + textline := "" ; + editget (textline, "", "", exit char) ; + echoe exit char + +ENDPROC getline ; + +PROC get secret line (TEXT VAR textline) : + + TEXT VAR char ; + textline := "" ; + get start cursor position ; + get line very secret ; + IF char = esc + THEN get line little secret + FI ; + cursor to start position ; + out (del line cr lf) . + +get line very secret : + REP + inchar (char) ; + IF char = esc OR char = cr + THEN LEAVE get line very secret + ELIF char = rubout + THEN delete last char + ELIF char >= " " + THEN textline CAT char ; + out (".") + ELSE out (bell) + FI + PER . + +delete last char : + IF LENGTH textline = 0 + THEN out (bell) + ELSE out (back blank back) ; + delete char (textline, LENGTH textline) + FI . + +get line little secret : + cursor to start position ; + editget (textline, "", "", exit char) . + +get start cursor position : + INT VAR x, y; + get cursor (x, y) . + +cursor to start position : + cursor (x, y) . + +ENDPROC get secret line ; + +ENDPACKET std transput ; + diff --git a/system/base/1.7.5/src/tasten b/system/base/1.7.5/src/tasten new file mode 100644 index 0000000..752303b --- /dev/null +++ b/system/base/1.7.5/src/tasten @@ -0,0 +1,113 @@ + +PACKET tasten verwaltung DEFINES (* #009 *) + (***************) + + lernsequenz auf taste legen, + lernsequenz auf taste, + kommando auf taste legen, + kommando auf taste, + taste enthaelt kommando, + std tastenbelegung : + + + +LET kommandoidentifikation = ""0"" , + esc = ""27"" , + niltext = "" , + hop right left up down cr tab rubin rubout mark esc + = ""1""2""8""3""10""13""9""11""12""16""27"" ; + + +ROW 256 TEXT VAR belegung; +INT VAR i; FOR i FROM 1 UPTO 256 REP belegung (i) := "" PER; + +std tastenbelegung; + + +PROC lernsequenz auf taste legen (TEXT CONST taste, lernsequenz) : + + belege (belegung (code (taste) + 1), taste, lernsequenz) + +ENDPROC lernsequenz auf taste legen ; + +PROC belege (TEXT VAR tastenpuffer, TEXT CONST taste, lernsequenz) : + tastenpuffer := lernsequenz ; + verhindere rekursives lernen . + +verhindere rekursives lernen : + loesche alle folgen esc taste aber nicht esc esc taste ; + IF taste ist freies sonderzeichen + THEN change all (tastenpuffer, taste, niltext) + FI . + +loesche alle folgen esc taste aber nicht esc esc taste : + INT VAR i := pos (tastenpuffer, esc + taste) ; + WHILE i > 0 REP + IF ist esc esc taste + THEN i INCR 1 + ELSE change (tastenpuffer, i, i+1, niltext) + FI ; + i := pos (tastenpuffer, esc + taste, i) + PER . + +ist esc esc taste : + (tastenpuffer SUB i-1) = esc AND (tastenpuffer SUB i-2) <> esc . + +taste ist freies sonderzeichen : + taste < ""32"" AND + pos (hop right left up down cr tab rubin rubout mark esc, taste) = 0 . + +END PROC belege ; + + +TEXT PROC lernsequenz auf taste (TEXT CONST taste) : + IF taste enthaelt kommando (taste) + THEN "" + ELSE belegung (code (taste) + 1) + FI +END PROC lernsequenz auf taste; + + +PROC kommando auf taste legen (TEXT CONST taste, kommando) : + + belegung (code (taste) + 1) := kommandoidentifikation; + belegung (code (taste) + 1) CAT kommando + +END PROC kommando auf taste legen; + + +TEXT PROC kommando auf taste (TEXT CONST taste) : + IF taste enthaelt kommando (taste) + THEN subtext (belegung (code (taste) + 1), 2) + ELSE "" + FI +END PROC kommando auf taste; + + +BOOL PROC taste enthaelt kommando (TEXT CONST taste) : + (belegung (code (taste) + 1) SUB 1) = kommandoidentifikation +END PROC taste enthaelt kommando; + + +PROC std tastenbelegung: + lernsequenz auf taste legen ("(", ""91""); + lernsequenz auf taste legen (")", ""93""); + lernsequenz auf taste legen ("<", ""123""); + lernsequenz auf taste legen (">", ""125""); + lernsequenz auf taste legen ("A", ""214""); + lernsequenz auf taste legen ("O", ""215""); + lernsequenz auf taste legen ("U", ""216""); + lernsequenz auf taste legen ("a", ""217""); + lernsequenz auf taste legen ("o", ""218""); + lernsequenz auf taste legen ("u", ""219""); + lernsequenz auf taste legen ("k", ""220""); + lernsequenz auf taste legen ("-", ""221""); + lernsequenz auf taste legen ("#", ""222""); + ler�sequenz auf taste legen (" ", ""223""); + lernsequenz auf taste legen ("B", ""251""); + lernsequenz auf taste legen ("s", ""251""); +END PROC std tastenbelegung; + + +END PACKET tasten verwaltung; + diff --git a/system/base/1.7.5/src/text b/system/base/1.7.5/src/text new file mode 100644 index 0000000..4c659cf --- /dev/null +++ b/system/base/1.7.5/src/text @@ -0,0 +1,391 @@ +(* ------------------- VERSION 3 06.03.86 ------------------- *) +PACKET text DEFINES + + max text length , + SUB , + subtext , + text , + length , LENGTH , + CAT , + + , + * , + replace , + change , + change all , + compress , + pos , + code , + ISUB , + RSUB , + delete char , + insert char , + delete int , + insert int , + heap size , + collect heap garbage , + stranalyze , + LEXEQUAL , + LEXGREATER , + LEXGREATEREQUAL : + + + +TEXT VAR text buffer , tail buffer ; + +INT CONST max text length := 32000 ; + +TEXT OP SUB (TEXT CONST text, INT CONST pos ) : + EXTERNAL 48 +END OP SUB ; + +TEXT PROC subtext (TEXT CONST source, INT CONST from, to ): + EXTERNAL 49 +ENDPROC subtext ; + +TEXT PROC subtext (TEXT CONST source, INT CONST from ) : + EXTERNAL 50 +ENDPROC subtext ; + +INT PROC code (TEXT CONST text) : + EXTERNAL 46 +END PROC code ; + +TEXT PROC code (INT CONST code) : + EXTERNAL 47 +ENDPROC code ; + +INT OP ISUB (TEXT CONST text, INT CONST index) : + EXTERNAL 44 +ENDOP ISUB ; + +PROC replace (TEXT VAR text, INT CONST index, value) : + EXTERNAL 45 +ENDPROC replace ; + +REAL OP RSUB (TEXT CONST text, INT CONST index) : + EXTERNAL 100 +ENDOP RSUB ; + +PROC replace (TEXT VAR text, INT CONST index, REAL CONST code) : + EXTERNAL 101 +ENDPROC replace ; + + +PROC replace (TEXT VAR dest, INT CONST pos, TEXT CONST source) : + EXTERNAL 51 +ENDPROC replace ; + +TEXT PROC text (TEXT CONST source, INT CONST length ) : + + IF length < LENGTH source + THEN text buffer := subtext (source,1,length) + ELSE text buffer := source ; + mit blanks auffuellen + FI ; + text buffer . + +mit blanks auffuellen : + INT VAR i ; + FOR i FROM 1 UPTO length - LENGTH source REP + text buffer CAT " " + PER . + +ENDPROC text ; + +TEXT PROC text (TEXT CONST source, INT CONST length, from) : + text ( subtext (source, from) , length ) +ENDPROC text ; + +OP CAT (TEXT VAR right, TEXT CONST left ) : + EXTERNAL 52 +ENDOP CAT ; + +TEXT OP + (TEXT CONST left, right) : + text buffer := left ; + text buffer CAT right ; + text buffer +ENDOP + ; + +TEXT OP * (INT CONST times, TEXT CONST source ) : + + text buffer := "" ; + INT VAR i ; + FOR i FROM 1 UPTO times REP + text buffer CAT source + PER ; + text buffer + +ENDOP * ; + +INT PROC length (TEXT CONST text ) : + EXTERNAL 53 +ENDPROC length ; + +INT OP LENGTH (TEXT CONST text ) : + EXTERNAL 53 +ENDOP LENGTH ; + +INT PROC pos (TEXT CONST source, pattern) : + EXTERNAL 54 +ENDPROC pos ; + +INT PROC pos (TEXT CONST source, pattern, INT CONST from) : + EXTERNAL 55 +ENDPROC pos ; + +INT PROC pos (TEXT CONST source, pattern, INT CONST from, to) : + EXTERNAL 56 +ENDPROC pos ; + +INT PROC pos (TEXT CONST source, low, high, INT CONST from) : + EXTERNAL 58 +ENDPROC pos ; + +TEXT PROC compress (TEXT CONST text) : + + INT VAR begin, end ; + + search first non blank ; + search last non blank ; + text buffer := subtext (text, begin, end) ; + text buffer . + +search first non blank : + begin := 1 ; + WHILE (text SUB begin) = " " REP + begin INCR 1 + PER . + +search last non blank : + end := LENGTH text ; + WHILE (text SUB end) = " " REP + end DECR 1 + PER . + +ENDPROC compress ; + +PROC change (TEXT VAR destination, INT CONST from, to, TEXT CONST new) : + + IF LENGTH new = to - from + 1 AND to <= LENGTH destination + THEN replace (destination, from, new) + ELSE change via buffer + FI . + +change via buffer : + text buffer := subtext (destination, 1, from-1) ; + text buffer CAT new ; + tail buffer := subtext (destination, to + 1) ; + text buffer CAT tail buffer ; + destination := text buffer + +ENDPROC change ; + +PROC change (TEXT VAR destination, TEXT CONST old, new) : + + INT CONST position := pos (destination, old) ; + IF position > 0 + THEN change (destination, position, position + LENGTH old -1, new) + FI + +ENDPROC change ; + +PROC change all (TEXT VAR destination, TEXT CONST old, new) : + + INT VAR position := pos (destination, old) ; + IF LENGTH old = LENGTH new + THEN change by replace + ELSE change by change + FI . + +change by replace : + WHILE position > 0 REP + replace (destination, position, new) ; + position := pos (destination, old, position + LENGTH new) + PER . + +change by change : + WHILE position > 0 REP + change (destination, position, position + LENGTH old - 1 , new) ; + position := pos (destination, old, position + LENGTH new) + PER . + +ENDPROC change all ; + +PROC delete char (TEXT VAR string, INT CONST delete pos) : + + IF delete pos > 0 + THEN tail buffer := subtext (string, delete pos + 1) ; + string := subtext (string, 1, delete pos - 1) ; + string CAT tail buffer + FI + +END PROC delete char ; + +PROC insert char (TEXT VAR string, TEXT CONST char, + INT CONST insert pos) : + + IF insert pos > 0 AND insert pos <= LENGTH string + 1 + THEN tail buffer := subtext (string, insert pos) ; + string := subtext (string, 1, insert pos - 1) ; + string CAT char ; + string CAT tail buffer + FI + +END PROC insert char ; + +INT PROC heap size : + EXTERNAL 93 +ENDPROC heap size ; + +PROC collect heap garbage : + EXTERNAL 94 +ENDPROC collect heap garbage ; + +PROC stranalyze (ROW 256 INT CONST table, INT VAR sum, INT CONST max sum, + TEXT CONST string, INT VAR index, INT CONST to, + INT VAR exit code) : + EXTERNAL 57 +ENDPROC stranalyze ; + +(*******************************************************************) +(* lexikographische Vergleiche *) +(* Nach DIN 5007, Abschnitt 1 und Abschnitt 3.2 (Bindestrich) *) +(* Autor: Rainer Hahn, Jochen Liedtke *) +(* Stand: 1.7.4 (Jan. 1985) *) +(*******************************************************************) +LET first umlaut = ""214"" , + umlauts = ""214""215""216""217""218""219""251"" ; + + +TEXT VAR left letter, right letter; + +BOOL OP LEXEQUAL (TEXT CONST left, right) : + + compare (left, right) ; + left letter = right letter + +ENDOP LEXEQUAL ; + +BOOL OP LEXGREATER (TEXT CONST left, right) : + + compare (left, right) ; + left letter > right letter + +ENDOP LEXGREATER ; + +BOOL OP LEXGREATEREQUAL (TEXT CONST left, right) : + + compare (left, right) ; + left letter >= right letter + +ENDOP LEXGREATEREQUAL ; + +PROC compare (TEXT CONST left, right) : + + to begin of lex relevant text ; + REP + get left letter ; + get right letter + UNTIL NOT letter match OR both ended PER . + +to begin of lex relevant text : + INT VAR + left pos := pos (left, ""65"",""254"", 1) , + right pos := pos (right,""65"",""254"", 1) ; + IF left pos = 0 + THEN left pos := LENGTH left + 1 + FI ; + IF right pos = 0 + THEN right pos := LENGTH right + 1 + FI . + +get left letter : + left letter := left SUB left pos ; + left pos INCR 1 . + +get right letter : + right letter := right SUB right pos ; + right pos INCR 1 . + +letter match : + IF left letter = right letter + THEN TRUE + ELSE dine (left, left letter, left pos) ; + dine (right, right letter, right pos) ; + IF exactly one letter is double letter + THEN expand other letter + FI ; + left letter = right letter + FI . + +exactly one letter is double letter : + LENGTH left letter <> LENGTH right letter. + +expand other letter : + IF LENGTH left letter = 1 + THEN left letter CAT (left SUB left pos) ; + left pos INCR 1 + ELSE right letter CAT (right SUB right pos) ; + right pos INCR 1 + FI . + +both ended : left letter = "" . + +ENDPROC compare ; + +PROC dine (TEXT CONST string, TEXT VAR char, INT VAR string pos) : + + skip non letter chars ; + IF is capital letter + THEN translate to small letter + ELIF char >= first umlaut + THEN translate umlaut + FI . + +skip non letter chars : + WHILE NOT (is letter OR end of string) REP + char := string SUB string pos ; + string pos INCR 1 + PER . + +translate to small letter : + char := code (code (char) + 32) . + +translate umlaut : + SELECT pos (umlauts, char) OF + CASE 1,4 : char := "ae" + CASE 2,5 : char := "oe" + CASE 3,6 : char := "ue" + CASE 7 : char := "ss" + ENDSELECT . + +is capital letter : + INT VAR char code := code (char) ; + 65 <= char code AND char code <= 90 . + +is letter : + char code := code (char) OR 32 ; + (97 <= char code AND char code <= 122) OR char code >= 128 . + +end of string : char = "" . + +ENDPROC dine ; + +OP CAT (TEXT VAR result, INT CONST number) : + result CAT " "; + replace (result, LENGTH result DIV 2, number); +END OP CAT; + +PROC insert int (TEXT VAR result, INT CONST insert pos, number) : + INT VAR pos := insert pos * 2 - 1; + change (result, pos, pos - 1, " "); + replace (result, insert pos, number); +END PROC insert int; + +PROC delete int (TEXT VAR result, INT CONST delete pos) : + INT VAR pos := delete pos * 2; + change (result, pos - 1, pos, "") +END PROC delete int; + +ENDPACKET text ; + diff --git a/system/base/1.7.5/src/texter errors b/system/base/1.7.5/src/texter errors new file mode 100644 index 0000000..9c4383d --- /dev/null +++ b/system/base/1.7.5/src/texter errors @@ -0,0 +1,284 @@ +(* ------------------- VERSION 66 vom 06.03.86 -------------------- *) +PACKET texter errors and common DEFINES + only command line, + skip input, + char pos move, + begin of this char, + number chars, + display and pause, + report text processing error, + report text processing warning: + +(* Programm zur zentralen Haltung aller Fehlermeldungen der Textkosmetik + Autor: Rainer Hahn + Stand: 1.7.1 Febr. 1984 + 1.7.3 Juli " + 1.7.4 Febr. 1985 + *) + +LET escape = ""27""; + +TEXT VAR fehlerdummy; + +BOOL PROC only command line (TEXT CONST zeile): +INT VAR anfang, ende; +LET kommando zeichen = "#"; + IF pos (zeile, kommando zeichen) = 1 + THEN ende := pos (zeile, kommando zeichen, 2); + IF ende > 0 + THEN zaehle kommandos durch; + LEAVE only command line WITH richtiges kommandoende + FI + FI; + FALSE. + +zaehle kommandos durch: + WHILE ende + 1 = pos (zeile, kommando zeichen, ende +1) REP + anfang := pos (zeile, kommando zeichen, ende + 1); + ende := pos (zeile, kommando zeichen, anfang + 1) + END REP. + +richtiges kommandoende: + ende > 0 AND + (ende = length (zeile) OR (ende = length (zeile) - 1 AND absatzzeile)). + +absatzzeile: + (zeile SUB length (zeile)) = " ". +END PROC only command line; + +PROC skip input: + REP + TEXT CONST zeichen :: incharety; + IF zeichen = escape + THEN errorstop ("Abbruch durch ESC") + FI + UNTIL zeichen = "" END REP +END PROC skip input; + +PROC char pos move (TEXT CONST ein text, INT VAR zpos, INT CONST richtung): + zpos INCR richtung; + IF within kanji (ein text, zpos) + THEN zpos INCR richtung + FI +END PROC char pos move; + +PROC begin of this char (TEXT CONST ein text, INT VAR zpos): + IF zpos < 1 OR zpos > length (ein text) + THEN display and pause (7) + ELSE suche zeichenposition + FI. + +suche zeichenposition: + IF within kanji (ein text, zpos) + THEN zpos DECR 1 + FI. +END PROC begin of this char; + +INT PROC number chars (TEXT CONST ein text, INT CONST von pos, bis pos): + INT VAR index :: von pos, anz :: 0; + WHILE index <= bis pos REP + IF index > length (ein text) OR index > bis pos + THEN display and pause (5); LEAVE number chars WITH 0 + FI; + IF is kanji esc (ein text SUB index) + THEN index INCR 2 + ELSE index INCR 1 + FI; + anz INCR 1 + END REP; + anz +END PROC number chars; + +PROC display and pause (INT CONST nr): + line ; put ("LINER ERROR"); put (nr); pause +END PROC display and pause; + +PROC report text processing error (INT CONST error nr, + INT CONST line nr, + TEXT VAR message, + TEXT CONST addition): + + einfache meldung aufbauen; + meldung in fehlerdatei ausgeben. + +einfache meldung aufbauen: + message := "FEHLER Zeile "; + message CAT text (line nr); + message CAT ": "; + message CAT simple message; + message CAT " "; + message CAT addition. + +meldung in fehlerdatei ausgeben: + note (message); + note line; + fehlerdummy := " >>> "; + fehlerdummy CAT zusatz; + note (fehlerdummy); + note line. + +simple message: + SELECT error nr OF + CASE 1: "Unbekannter Schriftyp ignoriert:" + CASE 2: "#-Zeichen fehlt" + CASE 3: "foot in Fußnote (ignoriert)" + CASE 4: "cm-Angabe fehlt (REAL) (ignoriert):" + CASE 5: "INT-Parameter erwartet (ignoriert):" + CASE 6: "(versuchte) Trennung in Macro-Text" + CASE 7: "ie-Anweisung fehlt bei Seitenende" + CASE 8: "Unbekannte Anweisung (ignoriert):" + CASE 9: "Nicht kompilierbares Programm:" + CASE 10: "Einrückung (Leerzeichen am Zeilenanfang) zu groß" + CASE 11: "Anweisung hier nicht erlaubt (ignoriert):" + CASE 12: "Tabellen-Position liegt innerhalb eines b pos:" + CASE 13: "free-Wert > Textteil der Seite (ignoriert)" + CASE 14: "Mehr als 1 Zeichen in pagenr (ignoriert)" + CASE 15: "Macro innerhalb eines Macros definiert (ignoriert):" + CASE 16: "Mehr als drei Seitenzeichen" + CASE 17: "Mehr als zehn Zeilen im Index" + CASE 18: "Index Parameter inkorrekt (ignoriert): " + CASE 19: "Hinter Anweisung darf nichts mehr stehen (ignoriert):" + CASE 20: "Doppelter Index ignoriert:" + CASE 21: "ib(..) fehlt:" + CASE 22: "Inkorrekte Anweisung:" + CASE 23: "2 Byte Zeichen ohne zweites Zeichen am Zeilenende" + CASE 24: "free-Wert größer Seitenlänge (ignoriert):" + CASE 25: "Seitenende in head, bottom oder foot-Bereich plaziert" + CASE 26: "Anzahl columns < 2 ignoriert" + CASE 27: "INT-Parameter <= 0 ignoriert:" + CASE 28: "Kein Textzeichen vor oder hinter b" + CASE 29: "Nochmaliges columns ohne columns end (ignoriert)" + CASE 30: "set count-Parameter inkorrekt (ignoriert):" + CASE 31: "end ohne vorangehendes head, bottom oder foot" + CASE 32: "Max. Anzahl von Tabellen-Positionen überschritten" + CASE 33: "Macro-Aufruf oder -Definition in einem Macro (ignoriert):" + CASE 34: "counter nicht initialisiert (ignoriert):" + CASE 35: "store counter Kennung bereits vorhanden (ignoriert):" + CASE 36: "Spaltenbreite > limit" + CASE 37: "Zentimeter-Angabe in limit = 0 (ignoriert)" + CASE 38: "Zentimeter-Angabe inkorrekt (ignoriert):" + CASE 39: "Zentimeter-Angabe > als eingestelltes limit (ignoriert):" + CASE 40: "Makro-Definition (ignoriert):" + CASE 41: "Nochmaliges table ohne table end (ignoriert)" + CASE 42: "pos bereits hier gesetzt (ignoriert):" + CASE 43: "Druckposition (pos) nicht vorhanden:" + CASE 44: "Text breiter als Spalte bei:" + CASE 45: "rpos überschreibt vorherige Spalte bei:" + CASE 46: "cpos überschreibt vorherige Spalte bei:" + CASE 47: "dpos überschreibt vorherige Spalte bei:" + CASE 48: "Geblockter Text breiter als Spalte bei:" + CASE 49: "table end fehlt" + CASE 50: "Zentrierzeichen für dpos fehlt bei:" + CASE 51: "e-Anweisung ohne vorangehendes d oder u" + CASE 52: "fehlendes e auf dieser Zeile" + CASE 53: "Wort mit Exponent oder Index zu lang" + CASE 54: "Modifikation bereits angeschaltet bei on:" + CASE 55: "Modifikation nicht angeschaltet bei off:" + CASE 56: "Index bereits angeschaltet bei ib:" + CASE 57: "Index nicht angeschaltet bei ie:" + CASE 58: "Inkorrekte direkte Drucker-Anweisung (TEXT-Denoter):" + CASE 59: "tableend ohne vorangehendes table" + CASE 60: "put counter fehlt für:" + CASE 61: "store counter fehlt für:" + OTHERWISE "" + ENDSELECT. + +zusatz: + SELECT error nr OF + CASE 1: "type-Anweisung korrigieren" + CASE 2: "Bitte Einfügen" + CASE 3: "Geschachtelte Fußnoten sind nicht möglich" + CASE 4: "Beispiel: limit(16.0)" + CASE 5: "Beispiele: page(4), pagenr(""%"",4)" + CASE 6: "Trennung erscheint nicht im Ausdruck!" + CASE 7: "Index in Indexdatei ggf. vervollständigen" + CASE 10: "für Zeilenbreite (limit): Leerzeichen entfernen" + CASE 11: "(In head-, bottom- und foot-Bereichen)" + CASE 13: "Parameterwert verkleinern" + CASE 14: "Beispiel: pagenr(""$"",5)" + CASE 15: "Macros kontrollieren und ggf. neu laden" + CASE 16: "sind z.Z. nicht zugelassen" + CASE 17: "ie(..) vergessen?" + CASE 18: "1.Parameter gibt die Index-Nummer (1-10) an. Beispiel: ie(9)" + CASE 19: "Anweisung muß alleine oder am Zeilenende stehen" + CASE 24: "in einem head, bottom oder foot-Bereich" + CASE 25: "Vor oder hinter den Bereich plazieren" + CASE 26: "1.Parameter in columns korrigieren" + CASE 27: "Beispiel: page(20)" + CASE 29: "page und columnsend vorher einfügen" + CASE 30: "Beispiele: setcount(0); setcount(27)" + CASE 31: "end ggf. entfernen" + CASE 34: "Bitte set counter einfuegen" + CASE 37: "Muß positiv sein" + CASE 38: "Beispiel: limit(16.0)" + CASE 40: "pos-Anweisungen vor table plazieren" + CASE 41: "tableend vergessen?" + CASE 42: "Bitte pos-Anweisungen überprüfen" + CASE 43: "in clear pos-Anweisung" + CASE 48: "Ggf. lineform über die Spalte" + CASE 49: "Bitte vor Dateiende einfügen" + CASE 51, 52: "Bitte u und d-Anweisungen kontrollieren" + CASE 53: "e-Anweisung vergessen?" + CASE 54, 55, 56, 57: "Anweisung in angegebener Zeilennummer überprüfen" + CASE 60: "Bitte store counter Anweisungen überprüfen" + OTHERWISE "Bitte Korrigieren" + END SELECT. +END PROC report text processing error; + +PROC report text processing warning (INT CONST error nr, + INT CONST line nr, + TEXT VAR message, + TEXT CONST addition): + + einfache meldung aufbauen; + meldung in fehlerdatei ausgeben. + +einfache meldung aufbauen: + message := "WARNUNG Zeile "; + message CAT text (line nr); + message CAT ": "; + message CAT simple message; + message CAT " "; + message CAT addition. + +meldung in fehlerdatei ausgeben: + note (message); + note line; + fehlerdummy := " >>> "; + fehlerdummy CAT zusatz; + note (fehlerdummy); + note line. + +simple message: + SELECT error nr OF + CASE 1, 2: "" + CASE 3: "Nicht referenziert:" + CASE 4: "Ziel-Referenz fehlt:" + CASE 5: "Modifikation bei Dateiende nicht ausgeschaltet:" + CASE 6: "Index bei Dateiende nicht ausgeschaltet:" + CASE 7: "Nicht getrenntes Wort zu lang für Zeilenbreite:" + CASE 8: "Umschaltung auf gleichen Schrifttyp:" + CASE 9: "Kennzeichen schon vorhanden (Duplikat ignoriert):" + CASE 10: "Tabellenzeile breiter als limit" + CASE 11: "Mehr Spalten als Tabellen-Positionen bei:" + CASE 12: "Überschreibung nach" + CASE 13: "Leerzeichen vor:" + CASE 14: "Weniger Spalten als Tabellen-Positionen" + CASE 15: "counter mit dieser Kennung bereits initialisiert:" + OTHERWISE "" + ENDSELECT. + +zusatz: + SELECT error nr OF + CASE 3: "topage oder value fehlt" + CASE 4: "goalpage oder value fehlt" + CASE 7: "Bitte nachträglich trennen!" + CASE 8: "Schrifttyp wurde darum nicht verändert!" + CASE 9: "count und goalpage überprüfen" + CASE 12: "Bitte fehlende Leerzeichen einfügen" + CASE 13: "erzeugt ggf. zusätzliche Leerzeile" + OTHERWISE "Bitte überprüfen" + END SELECT. +END PROC report text processing warning; +END PACKET texter errors and common; + diff --git a/system/base/1.7.5/src/thesaurus b/system/base/1.7.5/src/thesaurus new file mode 100644 index 0000000..5ef7251 --- /dev/null +++ b/system/base/1.7.5/src/thesaurus @@ -0,0 +1,332 @@ +(* ------------------- VERSION 2 06.03.86 ------------------- *) +PACKET thesaurus handling (* Autor: J.Liedtke *) + + DEFINES THESAURUS , + := , + empty thesaurus , + insert, (* fuegt ein Element ein *) + delete, (* loescht ein Element falls vorhanden*) + rename, (* aendert ein Element falls vorhanden*) + CONTAINS , (* stellt fest, ob enthalten *) + link , (* index in thesaurus *) + name , (* name of entry *) + get , (* get next entry ("" is eof)*) + highest entry : (* highest valid index of thes*) + + +TYPE THESAURUS = TEXT ; + +LET thesaurus size = 200 , + nil = 0 , + niltext = "" , + max name length = 80 , + + begin entry char = ""0"" , + end entry char = ""1"" , + + nil entry = ""0""1"" , + nil name = "" , + + quote = """" ; + +TEXT VAR entry ; +INT VAR cache index := 0 , + cache pos ; + + +PROC access (THESAURUS CONST thesaurus, TEXT CONST name) : + + construct entry ; + IF NOT cache identifies entry + THEN search through thesaurus list + FI ; + IF entry found + THEN cache index := code (list SUB (cache pos - 1)) + ELSE cache index := 0 + FI . + +construct entry : + entry := begin entry char ; + entry CAT name ; + decode invalid chars (entry, 2) ; + entry CAT end entry char . + +search through thesaurus list : + cache pos := pos (list, entry) . + +cache identifies entry : + cache pos <> 0 AND + pos (list, entry, cache pos, cache pos + LENGTH entry) = cache pos . + +entry found : cache pos > 0 . + +list : CONCR (thesaurus) . + +ENDPROC access ; + +PROC access (THESAURUS CONST thesaurus, INT CONST index) : + + IF cache identifies index + THEN cache index := index ; + construct entry + ELSE cache pos := pos (list, code (index) + begin entry char) ; + IF entry found + THEN cache pos INCR 1 ; + cache index := index ; + construct entry + ELSE cache index := 0 ; + entry := niltext + FI + FI . + +construct entry : + entry := subtext (list, cache pos, pos (list, end entry char, cache pos)) . + +cache identifies index : + subtext (list, cache pos-1, cache pos) = code (index) + begin entry char . + +entry found : cache pos > 0 . + +list : CONCR (thesaurus) . + +ENDPROC access ; + + + +THESAURUS PROC empty thesaurus : + + THESAURUS : (""1"") + +ENDPROC empty thesaurus ; + + +OP := (THESAURUS VAR dest, THESAURUS CONST source ) : + + CONCR (dest) := CONCR (source) . + +ENDOP := ; + +TEXT VAR insert name ; + +PROC insert (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR index) : + + insert name := name ; + decode invalid chars (insert name, 1) ; + IF insert name = "" OR LENGTH insert name > max name length + THEN index := nil ; errorstop ("Name unzulaessig") + ELSE insert element + FI . + +insert element : + search free entry ; + IF entry found + THEN insert into directory + ELSE add entry to directory if possible + FI . + +search free entry : + access (thesaurus, nil name) . + +insert into directory : + change (list, cache pos + 1, cache pos, insert name) ; + index := cache index . + +add entry to directory if possible : + INT CONST next free index := code (list SUB LENGTH list) ; + IF next free index <= thesaurus size + THEN add entry to directory + ELSE directory overflow + FI . + +add entry to directory : + list CAT begin entry char ; + cache pos := LENGTH list ; + cache index := next free index ; + list CAT insert name ; + list CAT end entry char + code (next free index + 1) ; + index := cache index . + +directory overflow : + index := nil . + +entry found : cache index > 0 . + +list : CONCR (thesaurus) . + +ENDPROC insert ; + +PROC decode invalid chars (TEXT VAR name, INT CONST start pos) : + + INT VAR invalid char pos := pos (name, ""0"", ""31"", start pos) ; + WHILE invalid char pos > 0 REP + change (name, invalid char pos, invalid char pos, decoded char) ; + invalid char pos := pos (name, ""0"", ""31"", invalid char pos) + PER . + +decoded char : quote + text(code(name SUB invalid char pos)) + quote. + +ENDPROC decode invalid chars ; + +PROC insert (THESAURUS VAR thesaurus, TEXT CONST name) : + + INT VAR index ; + insert (thesaurus, name, index) ; + IF index = nil AND NOT is error + THEN errorstop ("THESAURUS-Ueberlauf") + FI . + +ENDPROC insert ; + +PROC delete (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR index) : + + access (thesaurus, name) ; + index := cache index ; + delete (thesaurus, index) . + +ENDPROC delete ; + +PROC delete (THESAURUS VAR thesaurus, INT CONST index) : + + access (thesaurus, index) ; + IF entry found + THEN delete entry + FI . + +delete entry : + IF is last entry of thesaurus + THEN cut off as much as possible + ELSE set to nil entry + FI . + +set to nil entry : + change (list, cache pos, cache pos + LENGTH entry - 1, nil entry) . + +cut off as much as possible : + WHILE predecessor is also nil entry REP + set cache to this entry + PER ; + list := subtext (list, 1, cache pos - 1) ; + erase cache . + +predecessor is also nil entry : + subtext (list, cache pos - 3, cache pos - 2) = nil entry . + +set cache to this entry : + cache pos DECR 3 . + +erase cache : + cache pos := 0 ; + cache index := 0 . + +is last entry of thesaurus : + pos (list, end entry char, cache pos) = LENGTH list - 1 . + +list : CONCR (thesaurus) . + +entry found : cache index > nil . + +ENDPROC delete ; + + +BOOL OP CONTAINS (THESAURUS CONST thesaurus, TEXT CONST name ) : + + IF name = niltext OR LENGTH name > max name length + THEN FALSE + ELSE access (thesaurus, name) ; entry found + FI . + +entry found : cache index > nil . + +ENDOP CONTAINS ; + +PROC rename (THESAURUS VAR thesaurus, TEXT CONST old, new) : + + rename (thesaurus, link (thesaurus, old), new) + +ENDPROC rename ; + +PROC rename (THESAURUS VAR thesaurus, INT CONST index, TEXT CONST new) : + + insert name := new ; + decode invalid chars (insert name, 1) ; + IF insert name = "" OR LENGTH insert name > max name length + THEN errorstop ("Name unzulaessig") + ELSE change to new name + FI . + +change to new name : + access (thesaurus, index) ; + IF cache index <> 0 AND entry <> "" + THEN change (list, cache pos + 1, cache pos + LENGTH entry - 2, insert name) + FI . + +list : CONCR (thesaurus) . + +ENDPROC rename ; + +INT PROC link (THESAURUS CONST thesaurus, TEXT CONST name) : + + access (thesaurus, name) ; + cache index . + +ENDPROC link ; + +TEXT PROC name (THESAURUS CONST thesaurus, INT CONST index) : + + access (thesaurus, index) ; + subtext (entry, 2, LENGTH entry - 1) . + +ENDPROC name ; + +PROC get (THESAURUS CONST thesaurus, TEXT VAR name, INT VAR index) : + + identify index ; + REP + to next entry + UNTIL end of list COR valid entry found PER . + +identify index : + IF index = 0 + THEN cache index := 0 ; + cache pos := 1 + ELSE access (thesaurus, index) + FI . + +to next entry : + cache pos := pos (list, begin entry char, cache pos + 1) ; + IF cache pos > 0 + THEN get entry + ELSE get nil entry + FI . + +get entry : + cache index INCR 1 ; + index := cache index ; + name := subtext (list, cache pos + 1, end entry pos - 1) . + +get nil entry : + cache index := 0 ; + cache pos := 0 ; + index := 0 ; + name := "" . + +end entry pos : pos (list, end entry char, cache pos) . + +end of list : index = 0 . + +valid entry found : name <> "" . + +list : CONCR (thesaurus) . + +ENDPROC get ; + +INT PROC highest entry (THESAURUS CONST thesaurus) : (*840813*) + + code (list SUB LENGTH list) - 1 . + +list : CONCR (thesaurus) . + +ENDPROC highest entry ; + +ENDPACKET thesaurus handling ; + diff --git a/system/dos/1.8.7/doc/dos-dat-handbuch b/system/dos/1.8.7/doc/dos-dat-handbuch new file mode 100644 index 0000000..a1e4fd4 --- /dev/null +++ b/system/dos/1.8.7/doc/dos-dat-handbuch @@ -0,0 +1,650 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#MS-DOS-DAT + + + + +#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.5)# + +#center#Lesen und Schreiben +#center#von +#center#MS-DOS Dateien + +#on ("b")##center#MS-DOS-DAT#off ("b")# +#free(1.5)# + + +#center#Version 2.0 + +#center#Stand 10.09.87 +#page# +#pagenr ("%",1)##setcount (1)##block##pageblock##count per page# +#headeven# +% #center#MS-DOS-DAT +#center#____________________________________________________________ + +#end# +#headodd# +#center#MS-DOS-DAT#right#% +#center#____________________________________________________________ + +#end# +#on("bold")# +#ib#1. Allgemeines#ie# +#off ("b")# + +Dieses Programm ermöglicht MS-DOS Dateien vom EUMEL aus von Disketten zu +lesen und auf Disketten zu schreiben. Die Benutzerschnittstelle ist ähnlich der des +EUMEL-Archivs organisiert. Der Benutzer kommuniziert mit einer Task des +EUMEL-Systems, nämlich mit der Task 'DOS'. Diese wickelt dann über das Archiv­ +laufwerk die Diskettenzugriffe ab. Der Benutzer meldet die MS-DOS Diskette mit +'reserve ("...", /"DOS")' an und kann dann mit 'list (/"DOS")', 'fetch ("...", /"DOS")', +'save ("...", /"DOS")' und weiteren Kommandos auf die MS-DOS Diskette zugreifen. +Für das Schreiben und Lesen (save, fetch) stehen insgesamt 7 verschiedene Be­ +triebsarten zur Verfügung. Man kann in eine Datei im ASCII Code mit und ohne +Anpassung der Umlaute, im IBM-ASCII Code, im Atari-ST Code oder ganz ohne +Codeumsetzung lesen bzw. schreiben. Die Betriebsart selbst wird beim Anmelden der +MS-DOS Diskette durch den Textparameter des 'reserve'-Kommandos bestimmt. + +Die gleiche Benutzerschnittstelle gilt für die Kommunikation mit der Task 'DOS HD'. +Diese Task liest und schreibt aber nicht auf der Diskette, sondern in der MS-DOS +Partition der Festplatte (falls vorhanden). + + +#on("bold")# +#ib#2. Benutzeranleitung #ie# +#off ("b")# +Im Normalfall will man als Benutzer eine EUMEL-Textdatei auf eine MS-DOS +Diskette schreiben oder eine mit z.B. Word-Star erstellte MS-DOS-Textdatei in +das EUMEL-System einlesen (implementierte Formate siehe Abschnitt 3). + +Lesen einer MS-DOS-Datei: + +#linefeed (1.25)# +#on ("b")# + reserve ("file ascii german", /"DOS"); + (* MS-DOS-Diskette ins Laufwerk einlegen *) + fetch (filename, /"DOS"); + release (/"DOS") +#off ("b")# + +Schreiben einer MS-DOS-Datei: + +#on ("b")# + reserve ("file ascii german", /"DOS"); + (* MS-DOS-Diskette ins Laufwerk einlegen *) + save (filename, /"DOS"); + release (/"DOS") +#off("b")# +#linefeed (1.0)# + + +Sollen statt der Umlaute []{|}\ verwendet werden, so ist statt "file ascii german" "file +ascii" einzustellen. Eine genaue Beschreibung aller 7 möglichen Betriebsarten wird in +Abschnitt 6 gegeben. Der Dateiname 'file name' unterliegt den im Abschnitt 4 be­ +schriebenen Einschränkungen. + + +#on("bold")# +#ib#3. Implementierte Formate#ie# +#off("b")# + +Diese Hardware ermöglicht das Bearbeiten von MS-DOS Disketten mit Hilfe der +Task /"DOS" und (falls es sich um einen MS-DOS fähigen Rechner mit MS-DOS Parti­ +tion auf der Festplatte handelt) das Bearbeiten von Daten in der MS-DOS Partition +der Platte. + +#on("bold")# +#ib#3.1 Arbeiten mit der Task /"DOS"#ie# +#off ("b")# + +Die Task /"DOS" verwendet das Archivlaufwerk als MS-DOS Datenträger. Es sind +alle mit dem IBM-Format der DOS Version 2 und 3 kompatiblen Formate für 5.25 +Zoll und 3.5 Zoll Disketten implementiert, sofern diese 512 Byte große Sektoren +verwenden und im ersten Sektor einen erweiterten BIOS-Parameterblock (BPB) +enthalten (hierzu gehören auch mit dem Atari ST bearbeitete Disketten). Weiterhin +sind die beiden von IBM verwendeten Formate der DOS Version 1 implementiert (5.25 +Zoll, ein- bzw. zweiseitig, 40 Spuren a 8 Sektoren). + +Die einzige Hardwarevoraussetzung besteht darin, daß der Hardwareanpassungs­ +modul (SHard) alle von DOS benutzten Sektoren lesen und schreiben können muß. + +#on("bold")# +#ib#3.2 Arbeiten mit der Task /"DOS HD"#ie# +#off ("b")# + +Die Task /"DOS HD" verwendet die MS-DOS Partition der Festplatte als Daten­ +träger (falls eine solche vorhanden ist und das SHard diese ansprechen kann). Hier +gibt es keine Beschränkungen bezüglich des Plattentyps. + + +#on("bold")# +#ib#4. Dateibenennung#ie# +#off ("b")# + +Die Namen für MS-DOS Dateien unterliegen bestimmten Regeln. Ein Dateiname +kann aus +- einem bis acht Zeichen oder +- einem bis acht Zeichen gefolgt von einem Punkt und einer Namenserweiterung + von einem bis drei Zeichen +bestehen. + +Gültige Zeichen sind +- die Buchstaben A bis Z +- die Ziffern 0 bis 9 +- die Sonder- und Satzzeichen $ \# & § ! ( ) { } + +Da weitere Sonderzeichen in verschiedenen MS-DOS Versionen in unterschiedlich­ +em Umfang erlaubt sind, ist ihre Verwendung beim Schreiben (save) vom EUMEL aus +nicht zugelassen. Beim Lesen und Löschen dagegen sind sie erlaubt. + +Außerdem sind die Buchstaben a - z erlaubt. Diese werden beim Zugriff auf das +MS-DOS Inhaltsverzeichnis (Directory) in große Buchstaben konvertiert. Durch das +Kommando 'fetch ("Test", /"DOS")' wird also die MS-DOS Datei mit dem Namen +'TEST' in die EUMEL Datei mit dem Namen 'Test' gelesen; 'save ("test", /"DOS")' +überschreibt dann die MS-DOS-Datei 'TEST' (natürlich nach Anfrage). + + +#on("bold")# +#ib#5. Beschreibung der Kommandos#ie# +#off ("b")# + +In diesem Abschnitt steht der Begriff Dostask beim Arbeiten mit der Floppy für die +Task /"DOS" und beim Arbeiten mit der MS-DOS Partition der Platte für die Task +/"DOS HD". Analog steht der Begriff Dosbereich beim Arbeiten mit der Floppy für die +Floppy und beim Arbeiten mit der MS-DOS Partition der Platte für diese Partition. + +#on("bold")# +THESAURUS OP ALL (TASK CONST task) +#off ("b")# + Wird der 'ALL'-Operator für die Dostask aufgerufen, so wird ein Thesaurus ge­ + liefert. In diesem Thesaurus sind alle im Dosbereich vorhandenen Dateien einge­ + tragen. Die vorhandenen Unterinhaltsverzeichnisse (Subdirectories) werden nicht + eingetragen. + + +#on("bold")# +PROC check (TEXT CONST filename, TASK CONST task) +#off ("b")# + Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' im Dosbe­ + reich prüfgelesen. Es werden nur die mit Daten belegten Blöcke prüfgelesen. Sollen + auch der Einträge im Inhaltsverzeichnis überprüft werden, so erreicht man dies + durch vorheriges neues Anmelden mit der Prozedur 'reserve'. + + +#on("bold")# +PROC clear (TASK CONST task) +#off ("b")# + Durch Aufruf dieser Prozedur für die Task /"DOS" wird die gesamte Diskette ge­ + löscht. Mit dieser Prozedur können #on ("u")#nur MS-DOS formatierte Disketten#off ("u")# behandelt + werden. Soll eine Diskette dagegen für den Gebrauch unter MS-DOS initialisiert + werden, so ist sie auf einem MS-DOS-Rechner zu formatieren. + + Der Aufruf dieser Prozedur für die Task /DOS HD" ist aus Sicherheitsgründen nicht + erlaubt. + + +#on("bold")# +PROC erase (TEXT CONST filename, TASK CONST task) +#off ("b")# + Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' im Dosbe­ + reich gelöscht. + + +#on("bold")# +BOOL PROC exists (TEXT CONST name, TASK CONST task) +#off ("b")# + Wird diese Prozedur für die Dostask aufgerufen, so liefert sie 'TRUE', falls eine + Datei mit dem Namen 'name' im Dosbereich existiert. Andernfalls liefert sie + 'FALSE'. + + +#on("bold")# +PROC fetch (TEXT CONST filename, TASK CONST task) +#off ("b")# + Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' aus dem + Dosbereich gelesen. Hierbei wird in der beim Anmelden (reserve ("...", dostask)) + bestimmten Betriebsart gelesen (siehe Abschnitt 6). + + +#on("bold")# +PROC list (TASK CONST task) +#off ("b")# + Wird diese Prozedur für die Dostask aufgerufen, so werden alle Dateien des In­ + haltsverzeichnisses und alle Unterverzeichnisse des Dosbereichs aufgelistet. + + +#on("bold")# +PROC release (TASK CONST task) +#off ("b")# + Der Aufruf dieser Prozedur für die Task Dostask hebt deren Reservierung auf. + Gleichzeitig wird auch der für block i/o benutzte Kanal freigegeben, so daß bei + Benutzung der Task /"DOS" der Archivkanal durch das EUMEL-Archiv wieder + benutzt werden kann. + + Um möglichst effizient arbeiten zu können, werden Inhaltsverzeichnis und Ket­ + tungsblock des Dosbereichs als Kopie im EUMEL gehalten. Der hierdurch belegte + Speicher wird beim 'release' wieder freigegeben. Dies ist bei kleinen Systemen + besonders wichtig. + + +#on("bold")# +PROC reserve (TEXT CONST mode, TASK CONST task) +#off ("b")# + Durch Aufruf für die Dostask werden Operationen mit dem Dosbereich angemel­ + det. Gleichzeitig koppelt sich die Dostask an den entsprechenden Kanal an. + (/"DOS" an Kanal 31 und /"DOS HD" an Kanal 29). Die Anmeldung wird abge­ + lehnt, wenn der für die MS-DOS Operationen benötigte Kanal belegt ist (z.B. bei + Kanal 31 durch eine Archiv­Operation). Ähnlich wie beim EUMEL-Archiv bleibt + diese Reservierung bis 5 Minuten nach dem letzten Zugriff gültig. + + Wird beim Arbeiten mit der Task /"DOS" die MS-DOS Diskette gewechselt, so + muß erneut 'reserve ("...", /"DOS")' aufgerufen werden. Nur so ist gewährleistet, + daß das Inhaltsverzeichnis der neuen Diskette geladen wird. + + Der Text 'mode' gibt die Betriebsart für das Schreiben und Lesen der Diskette + sowie den Pfad für das Bearbeiten von Subdirectories an und nicht wie beim + EUMEL-Archiv den Diskettennamen. Es gilt folgende Systax: + + modus :[\directory][\directory]...[\directory] + + Hierbei sind die Angaben in eckigen Klammern optional. Wird kein Pfad angege­ + ben, so wird mit dem Hauptdirektory der Diskette gearbeitet. Ansonsten wird mit + dem Directory gearbeitet, welches durch den hinter dem Doppelpunkt angegeben + Pfad bezeichnet wird. Als 'modus' können alle in Abschnitt 6 beschriebenen Be­ + triebsarten verwendet werden. + + +#on("bold")# +PROC save (TEXT CONST filename, TASK CONST task) +#off ("b")# + Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' in den + Dosbereich geschrieben. Hierbei wird in der beim Anmelden (reserve ("...", + dostask)) bestimmten Betriebsart geschrieben (siehe Abschnitt 6). + + +#on("bold")# +#ib#6. Die Betriebsarten von 'fetch' und 'save'#ie# + +#ib#6.1 Betriebsart: file ascii#ie# + +#on("bold")# +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei + werden von allen Zeichen nur die niederwertigen 7 Bit gemäß DIN 66 003, ASCII + Code, internationale Referenzversion interpretiert. Die Datei wird so aufbereitet, daß + ein Bearbeiten mit dem EUMEL-Editor möglich ist. Dies geschieht folgenderma­ + ßen: + - Alle im EUMEL darstellbaren Zeichen werden auf diese abgebildet. + - Die Zeichenfolgen CR LF, LF CR, LF, CR (CR = carriage return, LF = line­ + feed) beenden einen Satz in der MS-DOS-Datei. Dementsprechend wird + eumelseitig die aktuelle Zeile beendet. + - Das Zeichen FF (form feed) beendet eumelseitig die aktuelle Zeile. Außerdem + wird ein Satz mit dem Inhalt "\#page\#" eingefügt. + - TAB's (Code 9) werden mit Blanks zur nächsten 8ter-Position expandiert. + - 'Ctrl z' in der MS-DOS Datei wird als Dateiende interpretiert. Fehlt dieses, + so wird bis zum letzten Zeichen des letzten Sektors der Datei gelesen. + - Alle anderen Zeichen mit 0 <= code (zeichen) <=  31 (Steuerzeichen) + werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird + als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt). + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS + wird der ASCII Code, internationale Referenzversion gemäß DIN 66 003 verwendet. + Dies geschieht folgendermaßen: + - Die EUMEL-spezifischen Druckzeichen (Trenn -, Trenn k, Druck \#, ge­ + schütztes Blank) werden in -, k, \# und Blank umgesetzt. + - Alle in der internationalen Referenzversion des ASCII Codes vorhandenen + Eumel-Zeichen werden auf diese abgebildet. + - Alle in der internationalen Referenzversion des ASCII Codes nicht vorhande­ + nen Eumel-Zeichen werden durch eine Ersatzdarstellung dargestellt (der + Code des Zeichens wird als 3 stellige Dezimalzahl eingeschlossen von + \#-Zeichen dargestellt) + - Steht in einer Zeile nur das Kommando '\#page\#' so wird dieses in ein Sei­ + tenvorschubsteuerzeichen (""12"") umgewandelt. + - Eine dreistellige Dezimalzahl eingeschlossen von \# Zeichen wird als Ersatz­ + darstellung für das Zeichen mit dem durch die Dezimalzahl angegebenen + Code betrachte. Diese Ersatzdarstellung wird beim Schreiben aufgelöst (d.h. + durch das entsprechende Zeichen ersetzt). + - Nach jeder Zeile wird 'carriage return' und ' linefeed' angefügt + - Am Ende der Datei wird 'ctrl z' angehängt. + + +#on("bold")# +#ib#6.2 Betriebsart: file ascii german#ie# + +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei + werden von allen Zeichen nur die niederwertigen 7 Bit gemäß DIN 66 003, ASCII + Code, deutsche Referenzversion interpretiert. Die Datei wird so aufbereitet, daß ein + Bearbeiten mit dem EUMEL-Editor möglich ist. Dies geschieht wie in der Be­ + triebsart 'file ascii', jedoch stehen statt []{}|\ die Umlaute und ß zur Verfügung. + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS + wird der ASCII Code, deutsche Referenzversion gemäß DIN 66 003 verwendet. Dies + geschieht wie in der Betriebsart 'file ascii', jedoch stehen statt []{}|\ die Umlaute + zur Verfügung. + + +#on("bold")# +#ib#6.3 Betriebsart: file ibm#ie# + +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei + werden alle Zeichen wie in der von IBM verwendeten Version des ASCII Codes + interpretiert. Die Datei wird so aufbereitet, daß ein Bearbeiten mit dem EUMEL- + Editor möglich ist. Dies geschieht folgendermaßen: + - Alle im EUMEL darstellbaren Zeichen werden auf diese abgebildet. + - Die Zeichenfolgen CR LF, LF CR, LF, CR (CR = carriage return, LF = line­ + feed) beenden einen Satz in der MS-DOS-Datei. Dementsprechend wird + eumelseitig die aktuelle Zeile beendet. + - Das Zeichen FF (form feed) beendet eumelseitig die aktuelle Zeile. Außerdem + wird ein Satz mit dem Inhalt "\#page\#" eingefügt. + - TAB's (Code 9) werden mit Blanks zur nächsten 8ter-Position expandiert. + - Alle anderen Zeichen mit 0 <= code (zeichen) <=  31 (Steuerzeichen) + werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird + als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt). + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS + wird der ASCII Code in der von IBM verwendeten Version verwendet. Dies ge­ + schieht folgendermaßen: + - Die EUMEL-spezifischen Druckzeichen (Trenn -, Trenn k, Druck \#, ge­ + schütztes Blank) werden in -, k, \# und Blank umgesetzt. + - Alle in der IBM Version des ASCII Codes vorhandenen Eumel-Zeichen + werden auf diese abgebildet. + - Alle in der IBM Version des ASCII Codes nicht vorhandenen Eumel-Zeichen + werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird + als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt) + - Steht in einer Zeile nur das Kommando '\#page\#' so wird dieses in ein Sei­ + tenvorschubsteuerzeichen (""12"") umgewandelt. + - Eine dreistellige Dezimalzahl eingeschlossen von \# Zeichen wird als Ersatz­ + darstellung für das Zeichen mit dem durch die Dezimalzahl angegebenen + Code betrachte. Diese Ersatzdarstellung wird beim Schreiben aufgelöst (d.h. + durch das entsprechende Zeichen ersetzt). + - Nach jeder Zeile wird 'carriage return' und ' linefeed' angefügt + + +#on("bold")# +#ib#6.4 Betriebsart: file atari st#ie# + +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei + werden alle Zeichen wie in der vom Atari ST verwendeten Version des ASCII Codes + interpretiert. Die Datei wird so aufbereitet, daß ein Bearbeiten mit dem EUMEL- + Editor möglich ist. Dies geschieht folgendermaßen: + - Alle im EUMEL darstellbaren Zeichen werden auf diese abgebildet. + - Die Zeichenfolgen CR LF, LF CR, LF, CR (CR = carriage return, LF = line­ + feed) beenden einen Satz in der MS-DOS-Datei. Dementsprechend wird + eumelseitig die aktuelle Zeile beendet. + - Das Zeichen FF (form feed) beendet eumelseitig die aktuelle Zeile. Außerdem + wird ein Satz mit dem Inhalt "\#page\#" eingefügt. + - TAB's (Code 9) werden mit Blanks zur nächsten 8ter-Position expandiert. + - Alle anderen Zeichen mit 0 <= code (zeichen) <=  31 (Steuerzeichen) + werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird + als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt). + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS + wird der ASCII Code in der vom Atari ST verwendeten Version verwendet. Dies + geschieht folgendermaßen: + - Die EUMEL-spezifischen Druckzeichen (Trenn -, Trenn k, Druck \#, ge­ + schütztes Blank) werden in -, k, \# und Blank umgesetzt. + - Alle in der vom Atari ST verwendeten Version des ASCII Codes vorhandenen + Eumel-Zeichen werden auf diese abgebildet. + - Alle in der vom Atari ST verwendeten Version des ASCII Codes nicht + vorhandenen Eumel-Zeichen werden durch eine Ersatzdarstellung dargestellt + (der Code des Zeichens wird als 3 stellige Dezimalzahl eingeschlossen von + \#-Zeichen dargestellt) + - Steht in einer Zeile nur das Kommando '\#page\#' so wird dieses in ein Sei­ + tenvorschubsteuerzeichen (""12"") umgewandelt. + - Eine dreistellige Dezimalzahl eingeschlossen von \# Zeichen wird als Ersatz­ + darstellung für das Zeichen mit dem durch die Dezimalzahl angegebenen + Code betrachte. Diese Ersatzdarstellung wird beim Schreiben aufgelöst (d.h. + durch das entsprechende Zeichen ersetzt). + - Nach jeder Zeile wird 'carriage return' und ' linefeed' angefügt + + +#on("bold")# +#ib#6.5 Betriebsart: file transparent#ie# + +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei + werden von allen Zeichen alle 8 Bit interpretiert. Es werden keine Zeichen einge­ + fügt, gelöscht oder gewandelt. Somit stehen dann auch CR und LF Zeichen in der + EUMEL-Datei. + + Da eine solche Datei noch Steuerzeichen enthält, ist beim Bearbeiten mit dem + Editor Vorsicht geboten. + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Es werden keine + Codeumsetzungen durchgeführt. Insbesondere muß die EUMEL-Datei auch die CR + LF Sequenzen für das Zeilenende enthalten. + + +#on("bold")# +#ib#6.6 Betriebsart: row text#ie# +#off ("b")# + +Diese Betriebsart ist nur für Programmierer interessant. Sie ist für die Umsetzung +exotischer Codes in den EUMEL-Code mittels ELAN-Programmen gedacht. + +#on("bold")# +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird in einen Datenraum mit folgender Struktur + kopiert: + + STRUCT (INT benutzte texte, ROW 4000 TEXT datensatz) + + Dabei bekommt der Datenraum den Type 1000. Der Integer 'benutzte texte' gibt an, + wieviele Elemente des ROW 4000 TEXT benutzt sind. In jedem benutzten Element + des ROW 4000 TEXT steht der Inhalt einer logischen Gruppe der MS-DOS Disket­ + te. (Eine logische Gruppe umfaßt bei einer einseitig beschriebenen MS-DOS + Diskette 512 Byte und bei einer zweiseitig beschriebenen 1024 bzw. 2048 Byte). In + dieser Betriebsart werden keine Zeichen der MS-DOS Datei konvertiert oder + interpretiert, so daß also auch alle Steuerzeichen erhalten bleiben. + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Hier bezeichnet 'filename' einen Datenraum der Struktur: + + STRUCT (INT benutzte texte, ROW 4000 TEXT datensatz) + + Dieser Datenraum muß den Type 1000 haben. + Es werden die benutzten Texte (1 bis benutzte texte) aneinandergehängt und ohne + irgendwelche Konvertierungen bzw. Interpretationen als MS-DOS Datei 'filename' + geschrieben. Dies bedeutet, daß die Texte auch alle von MS-DOS benötigten + Steuerzeichen (z.B. 'ctrl z' als Dateiendekennzeichen) enthalten müssen. + + +#on("bold")# +#ib#6.7 Betriebsart: ds#ie# +#off ("b")# +Diese Betriebsart ist nur für den Programmierer interessant. Sie ermöglicht das Abbil­ +den von Datenstrukturen zwischen MS-DOS und EUMEL. + +#on("bold")# +fetch ("filename", dostask) +#off ("b")# + Die MS-DOS Datei 'filename' wird blockweise in den Datenraum 'filename' ko­ + piert. Hierbei wird der erste Block der MS-DOS Datei in die 2. Seite des Daten­ + raums kopiert. (Die 2. Seite eines Datenraums ist die erste, die von einer Daten­ + struktur voll überdeckt werden kann). + + +#on("bold")# +save ("filename", dostask) +#off ("b")# + Der Datenraum 'filename' wird ab seiner 2. Seite in die MS-DOS Datei 'filename' + geschrieben. Hierbei werden alle Seiten des Datenraums (auch die nicht allokier­ + ten) bis einschließlich der letzten allokierten Datenraumseite geschrieben. + + +#on("bold")# +#ib#7. Installation#ie# +#off ("b")# + +Die Software zur Generierung der Tasks /"DOS" und /"DOS HD" wird auf einem +EUMEL-Archiv ausgeliefert. + +#on("bold")# +#ib#7.1 Installation der Task /"DOS"#ie# + +#ib#7.1.1 Installation im Multi-User#ie# +#off ("b")# + +Die Software muß in einer privilegierten Task mit dem Namen 'DOS' installiert wer­ +den. Dies geschieht folgendermaßen: + + + begin ("DOS", "SYSUR") + + archive ("austausch"); + fetch ("dos inserter", archive); + run ("dos inserter") + + +Danach stehen die Prozeduren + + + PROC dos manager + PROC dos manager (INT CONST channel) + + +zur Verfügung. Beide Prozeduren machen die aufrufende Task zur Kommunikations­ +task für das Schreiben und Lesen von MS-DOS Disketten. Die erste benutzt dazu +den Archivkanal (Kanal 31), bei der zweiten ist der Kanal über den Parameter ein­ +stellbar. Eine dieser Prozeduren muß jetzt aufgerufen werden. + +#on("bold")# +#ib#7.1.2. Installation im Single-User#ie# +#off ("b")# + +Die Software wird im Monitor ('gib Kommando'-Modus) durch folgende Kommandos +installiert: + + + archive ("austausch"); + fetch ("dos inserter", archive); + run ("dos inserter") + + +Für das Schreiben und Lesen von MS-DOS Disketten wird der Archivkanal (Kanal +31) benutzt. + + +#on("bold")# +#ib#7.2 Installation der Task /"DOS HD"#ie# +#off ("b")# + +Die Software muß in einer privilegierten Task mit dem Namen 'DOS HD' installiert +werden. Dies geschieht folgendermaßen: + + + begin ("DOS HD", "SYSUR") + + archive ("austausch"); + fetch ("dos hd inserter", archive); + run ("dos hd inserter") + + +Danach steht die Prozedur + + + PROC dos manager + + +zur Verfügung. Sie macht die aufrufende Task zur Kommunikationstask für das +Schreiben und Lesen in der MS-DOS Partition der Platte. Sie benutzt dazu den +Kanal 29, der, wie im Portierungshandbuch für den 8086 beschrieben, implementiert +sein muß. + +#page# +#headeven# +#end# + + + + + +Herausgegeben von: + + Gesellschaft für Mathematik und Datenverarbeitung mbH + (GMD) + Schloß Birlinghoven + 5205 Sankt Augustin 1 + + und + + Hochschulrechenzentrum der Universität Bielefeld + (HRZ) + Universitätsstraße + 4800 Bielefeld 1 + +Autor: + + Frank Klapper + +überarbeitet von: + + Thomas Müller + Hansgeorg Freese (GMD) + +Umschlaggestaltung: + + Hannelotte Wecken + + + + + + diff --git a/system/dos/1.8.7/source-disk b/system/dos/1.8.7/source-disk new file mode 100644 index 0000000..cc5ebe0 --- /dev/null +++ b/system/dos/1.8.7/source-disk @@ -0,0 +1 @@ +187_ergos/04_dos.img diff --git a/system/dos/1.8.7/src/block i-o b/system/dos/1.8.7/src/block i-o new file mode 100644 index 0000000..554fcca --- /dev/null +++ b/system/dos/1.8.7/src/block i-o @@ -0,0 +1,180 @@ +PACKET disk block io DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + (* 05.01.87 *) + read disk block, + read disk block and close work if error, + read disk cluster, + write disk block, + write disk block and close work if error, + write disk cluster, + first non dummy ds page, + + block no dump modus: + +BOOL VAR block no dump flag := FALSE; + +LET write normal = 0; + +INT CONST first non dummy ds page := 2; + +INT VAR error; + +PROC read disk block (DATASPACE VAR ds, + INT CONST ds page no, + INT CONST block no): + IF block no dump flag THEN dump ("READ ", block no) FI; + check rerun; + read block (ds, ds page no, eublock (block no), error); + IF error > 0 + THEN lesefehler (error) + FI. + +END PROC read disk block; + +PROC read disk block (DATASPACE VAR ds, + INT CONST ds page no, + REAL CONST block no): + IF block no dump flag THEN dump ("READ ", block no) FI; + check rerun; + read block (ds, ds page no, eublock (block no), error); + IF error > 0 + THEN lesefehler (error) + FI. + +END PROC read disk block; + +PROC read disk block and close work if error (DATASPACE VAR ds, + INT CONST ds page no, + INT CONST block no): + IF block no dump flag THEN dump ("READ ", block no) FI; + check rerun; + read block (ds, ds page no, eublock (block no), error); + IF error > 0 + THEN close work; + lesefehler (error) + FI. + +END PROC read disk block and close work if error; + +PROC read disk block and close work if error (DATASPACE VAR ds, + INT CONST ds page no, + REAL CONST block no): + IF block no dump flag THEN dump ("READ ", block no) FI; + check rerun; + read block (ds, ds page no, eublock (block no), error); + IF error > 0 + THEN close work; + lesefehler (error) + FI. + +END PROC read disk block and close work if error; + +PROC read disk cluster (DATASPACE VAR ds, + INT CONST first ds page no, + REAL CONST cluster no): + IF block no dump flag THEN dump ("CLUSTER ", cluster no) FI; + INT VAR i; + FOR i FROM 0 UPTO sectors per cluster - 1 REP + read disk block (ds, first ds page no + i, block no + real (i)) + PER. + +block no: + begin of cluster (cluster no). + +END PROC read disk cluster; + +PROC lesefehler (INT CONST fehler code): + error stop (fehlertext). + +fehlertext: + SELECT fehler code OF + CASE 1: "Diskettenlaufwerk nicht betriebsbereit" + CASE 2: "Lesefehler" + OTHERWISE "Lesefehler " + text (fehler code) + END SELECT. + +END PROC lesefehler; + +PROC write disk block (DATASPACE CONST ds, + INT CONST ds page no, + INT CONST block no): + IF block no dump flag THEN dump ("WRITE", block no) FI; + check rerun; + write block (ds, ds page no, write normal, eublock (block no), error); + IF error > 0 + THEN schreibfehler (error) + FI. + +END PROC write disk block; + +PROC write disk block (DATASPACE CONST ds, + INT CONST ds page no, + REAL CONST block no): + IF block no dump flag THEN dump ("WRITE", block no) FI; + check rerun; + write block (ds, ds page no, write normal, eublock (block no), error); + IF error > 0 + THEN schreibfehler (error) + FI. + +END PROC write disk block; + +PROC write disk block and close work if error (DATASPACE CONST ds, + INT CONST ds page no, + INT CONST block no): + IF block no dump flag THEN dump ("WRITE", block no) FI; + check rerun; + write block (ds, ds page no, write normal, eublock (block no), error); + IF error > 0 + THEN close work; + schreibfehler (error) + FI. + +END PROC write disk block and close work if error; + +PROC write disk block and close work if error (DATASPACE CONST ds, + INT CONST ds page no, + REAL CONST block no): + IF block no dump flag THEN dump ("WRITE", block no) FI; + check rerun; + write block (ds, ds page no, write normal, eublock (block no), error); + IF error > 0 + THEN close work; + schreibfehler (error) + FI. + +END PROC write disk block and close work if error; + +PROC write disk cluster (DATASPACE CONST ds, + INT CONST first ds page no, + REAL CONST cluster no): + IF block no dump flag THEN dump ("CLUSTER ", cluster no) FI; + INT VAR i; + FOR i FROM 0 UPTO sectors per cluster - 1 REP + write disk block (ds, first ds page no + i, block no + real (i)) + PER. + +block no: + begin of cluster (cluster no). + +END PROC write disk cluster; + +PROC schreibfehler (INT CONST fehler code): + error stop (fehlertext). + +fehlertext: + SELECT fehler code OF + CASE 1: "Diskettenlaufwerk nicht betriebsbereit" + CASE 2: "Schreibfehler" + OTHERWISE "Schreibfehler " + text (fehler code) + END SELECT. + +END PROC schreibfehler; + +PROC block no dump modus (BOOL CONST status): + block no dump flag := status + +END PROC block no dump modus; + +END PACKET disk block io; + diff --git a/system/dos/1.8.7/src/bpb ds b/system/dos/1.8.7/src/bpb ds new file mode 100644 index 0000000..dabf721 Binary files /dev/null and b/system/dos/1.8.7/src/bpb ds differ diff --git a/system/dos/1.8.7/src/dir.dos b/system/dos/1.8.7/src/dir.dos new file mode 100644 index 0000000..08456b5 --- /dev/null +++ b/system/dos/1.8.7/src/dir.dos @@ -0,0 +1,693 @@ +PACKET dir DEFINES (* Copyright (c) 1986, 87 *) + (* Frank Klapper *) + open dir, (* 02.03.88 *) + insert dir entry, + delete dir entry, + init dir ds, + file info, + format dir, + + dir list, + file exists, + subdir exists, + all files, + all subdirs: + +LET max dir entrys = 1000; + +(*-------------------------------------------------------------------------*) + +INITFLAG VAR dir block ds used := FALSE; +DATASPACE VAR dir block ds; +BOUND STRUCT (ALIGN dummy, ROW 64 REAL daten) VAR dir block; +REAL VAR last read dir block no; + +PROC init dir block io: + last read dir block no := -1.0; + IF NOT initialized (dir block ds used) + THEN dir block ds := nilspace; + dir block := dir block ds + FI. + +END PROC init dir block io; + +PROC read dir block (REAL CONST block nr): + IF last read dir block no <> block nr + THEN last read dir block no := -1.0; + read disk block and close work if error (dir block ds, 2, block nr); + last read dir block no := block nr + FI. + +END PROC read dir block; + +PROC write dir block (REAL CONST block nr): + write disk block and close work if error (dir block ds, 2, block nr); + last read dir block no := block nr. + +END PROC write dir block; + +PROC write dir block: + IF last read dir block no < 0.0 + THEN error stop ("Lesefehler") + FI; + write dir block (last read dir block no) + +END PROC write dir block; + +PROC get dir entry (TEXT VAR entry buffer, INT CONST block entry no): + (* 0 <= block entry no <= 15 *) + entry buffer := 32 * "."; + INT CONST replace offset := 4 * block entry no; + replace (entry buffer, 1, dir block.daten [replace offset + 1]); + replace (entry buffer, 2, dir block.daten [replace offset + 2]); + replace (entry buffer, 3, dir block.daten [replace offset + 3]); + replace (entry buffer, 4, dir block.daten [replace offset + 4]). + +END PROC get dir entry; + +PROC put dir entry (TEXT CONST entry buffer, INT CONST block entry no): + (* 0 <= block entry no <= 15 *) + INT CONST offset := 4 * block entry no; + dir block.daten [offset + 1] := entry buffer RSUB 1; + dir block.daten [offset + 2] := entry buffer RSUB 2; + dir block.daten [offset + 3] := entry buffer RSUB 3; + dir block.daten [offset + 4] := entry buffer RSUB 4. + +END PROC put dir entry; + +(*-------------------------------------------------------------------------*) + +LET DIRPOS = REAL; (* 16.0 * msdos block nr + entry no *) + (* 0 <= entry no <= 15 *) + +DIRPOS PROC dirpos (REAL CONST block nr, INT CONST entry nr): + block nr * 16.0 + real (entry nr). + +END PROC dir pos; + +REAL PROC block no (DIRPOS CONST p): + floor (p / 16.0) + +END PROC block no; + +INT PROC entry no (DIRPOS CONST p): + int (p MOD 16.0) + +END PROC entry no; + +PROC incr (DIRPOS VAR p): + p INCR 1.0. + +END PROC incr; + +(*-------------------------------------------------------------------------*) + +LET FREELIST = STRUCT (ROW max dir entrys DIRPOS stack, + INT stacktop, + DIRPOS begin of free area, + end of dir, + REAL dir root); (* erste Clusterno, 0 für Main Dir *) + +PROC init free list (FREELIST VAR flist, REAL CONST root): + flist.stacktop := 0; + flist.begin of free area := dir pos (9.0e99, 0); + flist.end of dir := dir pos (-1.0, 0); + flist.dir root := root. + +END PROC init free list; + +PROC store (FREELIST VAR flist, DIRPOS CONST free pos): + flist.stacktop INCR 1; + flist.stack [flist.stack top] := free pos. + +END PROC store; + +PROC store begin of free area (FREELIST VAR flist, DIRPOS CONST begin): + flist.begin of free area := begin + +END PROC store begin of free area; + +PROC store end of dir (FREELIST VAR flist, DIRPOS CONST end): + flist.end of dir := end + +END PROC store end of dir; + +DIRPOS PROC free dirpos (FREELIST VAR flist): + enable stop; + DIRPOS VAR result; + IF flist.stacktop > 0 + THEN pop + ELIF NOT free area empty + THEN first of free area + ELIF expansion alloweded + THEN allocate new dir cluster; + result := free dirpos (flist) + ELSE error stop ("Directory voll") + FI; + result. + +pop: + result := flist.stack [flist.stacktop]; + flist.stacktop DECR 1. + +free area empty: + flist.begin of free area > flist.end of dir. + +first of free area: + result := flist.begin of free area; + incr (flist.begin of free area). + +expansion alloweded: + flist.dir root >= 2.0. + +allocate new dir cluster: + REAL CONST new dir cluster :: available fat entry; + REAL VAR last entry no; + search last entry no of fat chain; + fat entry (new dir cluster, last fat chain entry); + fat entry (last entry no, new dir cluster); + write fat; + store begin of free area (flist, dir pos (first new block, 0)); + store end of dir (flist, dir pos (last new block, 15)); + init new dir cluster. + +search last entry no of fat chain: + last entry no := flist.dir root; + WHILE NOT is last fat chain entry (fat entry (last entry no)) REP + last entry no := fat entry (last entry no) + PER. + +first new block: + begin of cluster (new dir cluster). + +last new block: + begin of cluster (new dir cluster) + real (sectors per cluster - 1). + +init new dir cluster: + TEXT CONST empty dir entry :: 32 * ""0""; + INT VAR i; + FOR i FROM 0 UPTO 15 REP + put dir entry (empty dir entry, i) + PER; + disable stop; + REAL VAR block no := first new block; + WHILE block no <= last new block REP + write dir block (block no) + PER. + +END PROC free dirpos; + +(*-------------------------------------------------------------------------*) + +LET FILEENTRY = STRUCT (TEXT date and time, + REAL size, + first cluster, + DIRPOS dirpos), + + FILELIST = STRUCT (THESAURUS thes, + ROW max dir entrys FILEENTRY entry); + +PROC init file list (FILELIST VAR flist): + flist.thes := empty thesaurus. + +END PROC init file list; + +PROC store file entry (FILELIST VAR flist, TEXT CONST entry text, DIRPOS CONST position): + INT VAR entry index; + insert (flist.thes, file name, entry index); + store file entry (flist.entry [entry index], entry text, position). + +file name: + TEXT CONST name pre :: compress (subtext (entry text, 1, 8)), + name post :: compress (subtext (entry text, 9, 11)); + IF name post <> "" + THEN name pre + "." + name post + ELSE name pre + FI. + +END PROC store file entry; + +PROC store file entry (FILEENTRY VAR fentry, TEXT CONST entry text, DIRPOS CONST position): + fentry.first cluster := real (entry text ISUB 14); + fentry.date and time := dos date + " " + dos time; + fentry.size := dint (entry text ISUB 15, entry text ISUB 16); + fentry.dirpos := position. + +dos date: + day + "." + month + "." + year. + +day: + text2 (code (entry text SUB 25) MOD 32). + +month: + text2 (code (entry text SUB 25) DIV 32 + 8 * (code (entry text SUB 26) MOD 2)). + +year: + text (80 + code (entry text SUB 26) DIV 2, 2). + +dos time: + hour + ":" + minute. + +hour: + text2 (code (entry text SUB 24) DIV 8). + +minute: + text2 (code (entry text SUB 23) DIV 32 + 8 * (code (entry text SUB 24) MOD 8)). + +END PROC store file entry; + +TEXT PROC text2 (INT CONST intvalue): + IF intvalue < 10 + THEN "0" + text (intvalue) + ELSE text (int value) + FI. + +END PROC text2; + +DIRPOS PROC file entry pos (FILELIST CONST flist, TEXT CONST file name): + INT CONST link index :: link (flist.thes, file name); + IF link index = 0 + THEN error stop ("Die Datei """ + file name + """ gibt es nicht") + FI; + flist.entry [link index].dir pos. + +END PROC file entry pos; + +PROC delete (FILELIST VAR flist, TEXT CONST file name): + INT VAR dummy; + delete (flist.thes, file name, dummy). + +END PROC delete; + +PROC file info (FILELIST CONST flist, TEXT CONST file name, REAL VAR first cluster no, storage): + INT CONST link index :: link (flist.thes, file name); + IF link index = 0 + THEN error stop ("Die Datei """ + file name + """ gibt es nicht") + FI; + first cluster no := flist.entry [link index].first cluster; + storage := flist.entry [link index].size + +END PROC file info; + +BOOL PROC contains (FILELIST VAR flist, TEXT CONST file name): + flist.thes CONTAINS file name + +END PROC contains; + +PROC list (FILE VAR f, FILELIST CONST flist): + INT VAR index := 0; + TEXT VAR name; + get (flist.thes, name, index); + WHILE index > 0 REP + list file; + get (flist.thes, name, index) + PER. + +list file: + write (f, centered name); + write (f, " "); + write (f, text (flist.entry [index].size, 11, 0)); + write (f, " Bytes belegt "); + write (f, flist.entry [index].date and time); +(*COND TEST*) + write (f, " +++ "); + write (f, text (flist.entry [index].first cluster)); +(*ENDCOND*) + line (f). + +centered name: + INT VAR point pos := pos (name, "."); + IF point pos > 0 + THEN name pre + "." + name post + ELSE text (name, 12) + FI. + +name pre: + text (subtext (name, 1, point pos - 1), 8). + +name post: + text (subtext (name, point pos + 1, point pos + 4), 3). + +END PROC list; + +(*-------------------------------------------------------------------------*) + +LET DIRENTRY = REAL, + + DIRLIST = STRUCT (THESAURUS thes, + ROW max dir entrys DIRENTRY entry); + +PROC init dir list (DIRLIST VAR dlist): + dlist.thes := empty thesaurus. + +END PROC init dir list; + +PROC store subdir entry (DIRLIST VAR dlist, TEXT CONST entry text): + INT VAR entry index; + insert (dlist.thes, subdir name, entry index); + dlist.entry [entry index] := real (entry text ISUB 14). + +subdir name: + TEXT CONST name pre :: compress (subtext (entry text, 1, 8)), + name post :: compress (subtext (entry text, 9, 11)); + IF name post <> "" + THEN name pre + "." + name post + ELSE name pre + FI. + +END PROC store subdir entry; + +REAL PROC first cluster of subdir (DIRLIST CONST dlist, TEXT CONST name): + INT CONST link index := link (dlist.thes, name); + IF link index = 0 + THEN error stop ("Das Unterverzeichnis """ + name + """ gibt es nicht") + FI; + dlist.entry [link index]. + +END PROC first cluster of subdir; + +BOOL PROC contains (DIRLIST CONST dlist, TEXT CONST subdir name): + dlist.thes CONTAINS subdir name + +END PROC contains; + +PROC list (FILE VAR f, DIRLIST CONST dlist): + INT VAR index := 0; + TEXT VAR name; + get (dlist.thes, name, index); + WHILE index > 0 REP + list dir; + get (dlist.thes, name, index) + PER. + +list dir: + write (f, centered name); + write (f, "

"); +(*COND TEST*) + write (f, " +++ "); + write (f, text (dlist.entry [index])); +(*ENDCOND*) + line (f). + +centered name: + INT VAR point pos := pos (name, "."); + IF point pos > 0 + THEN name pre + "." + name post + ELSE text (name, 12) + FI. + +name pre: + text (subtext (name, 1, point pos - 1), 8). + +name post: + text (subtext (name, point pos + 1, point pos + 4), 3). + +END PROC list; + +(*-------------------------------------------------------------------------*) + +LET DIR = BOUND STRUCT (FILELIST filelist, + DIRLIST dirlist, + FREELIST freelist, + TEXT path); + +DIR VAR dir; +DATASPACE VAR dir ds; +INITFLAG VAR dir ds used := FALSE; + +PROC open dir (TEXT CONST path string): + init dir block io; + init dir ds; + dir.path := path string; + load main dir; + TEXT VAR rest path := path string; + WHILE rest path <> "" REP + TEXT CONST sub dir name := next sub dir name (rest path); + load sub dir + PER. + +load main dir: + init file list (dir.filelist); + init dir list (dir.dirlist); + init free list (dir.free list, 0.0); + store end of dir (dir.freelist, dirpos (last main dir sector, 15)); + BOOL VAR was last dir sector := FALSE; + REAL VAR block no := first main dir sector; + INT VAR i; + FOR i FROM 1 UPTO dir sectors REP + load dir block (block no, was last dir sector); + block no INCR 1.0 + UNTIL was last dir sector + PER. + +first main dir sector: + real (begin of dir). + +last main dir sector: + real (begin of dir + dir sectors - 1). + +load sub dir: + REAL VAR cluster no := first cluster of sub dir (dir.dirlist, sub dir name); + was last dir sector := FALSE; + init file list (dir.filelist); + init dir list (dir.dirlist); + init free list (dir.free list, cluster no); + WHILE NOT is last fat chain entry (cluster no) REP + load sub dir entrys of cluster; + cluster no := fat entry (cluster no) + UNTIL was last dir sector + PER. + +load sub dir entrys of cluster: + store end of dir (dir.freelist, dirpos (last block no of cluster, 15)); + block no := begin of cluster (cluster no); + FOR i FROM 1 UPTO sectors per cluster REP + load dir block (block no, was last dir sector); + block no INCR 1.0 + UNTIL was last dir sector + PER. + +last block no of cluster: + begin of cluster (cluster no) + real (sectors per cluster - 1). + +END PROC open dir; + +PROC load dir block (REAL CONST block no, BOOL VAR was last block): + was last block := FALSE; + read dir block (block no); + INT VAR entry no; + TEXT VAR entry; + FOR entry no FROM 0 UPTO 15 REP + get dir entry (entry, entry no); + process entry + UNTIL was last block + PER. + +process entry: + SELECT pos (""0"."229"", entry SUB 1) OF + CASE 1: end of dir search + CASE 2: (* root des aktuellen directorys oder des übergeordneten, also nichts tun *) + CASE 3: free entry + OTHERWISE volume label or file entry or subdir entry + END SELECT. + +end of dir search: + was last block := TRUE; + store begin of free area (dir.freelist, dir pos (block no, entry no)). + +free entry: + store (dir.freelist, dir pos (block no, entry no)). + +volume label or file entry or subdir entry: + INT CONST byte 11 :: code (entry SUB 12); + IF (byte 11 AND 8) > 0 + THEN (* volume label *) + ELIF (byte 11 AND 16) > 0 + THEN sub dir entry + ELSE file entry + FI. + +sub dir entry: + store subdir entry (dir.dir list, entry). + +file entry: + store file entry (dir.file list, entry, dir pos (block no, entry no)). + +END PROC load dir block; + +TEXT PROC next subdir name (TEXT VAR path string): + TEXT VAR subdir name; + IF (path string SUB 1) <> "\" + THEN error stop ("ungültige Pfadbezeichnung") + FI; + INT CONST backslash pos :: pos (path string, "\", 2); + IF backslash pos = 0 + THEN subdir name := subtext (path string, 2); + path string := "" + ELSE subdir name := subtext (path string, 2, backslash pos - 1); + path string := subtext (path string, backslash pos) + FI; + dos name (subdir name, read modus). + +END PROC next subdir name; + +PROC init dir ds: + IF initialized (dir ds used) + THEN forget (dir ds) + FI; + dir ds := nilspace; + dir := dir ds. + +END PROC init dir ds; + +PROC insert dir entry (TEXT CONST name, REAL CONST start cluster, storage): + DIRPOS CONST ins pos :: free dirpos (dir.free list); + TEXT CONST entry string :: entry name + ""32"" + (10 * ""0"") + dos time + + dos date + entry start cluster + entry storage; + write entry on disk; + write entry in dir ds. + +entry name: + INT CONST point pos := pos (name, "."); + IF point pos > 0 + THEN subtext (name, 1, point pos - 1) + (9 - point pos) * " " + + subtext (name, point pos + 1) + (3 - LENGTH name + point pos) * " " + ELSE name + (11 - LENGTH name) * " " + FI. + +dos time: + TEXT CONST akt time :: time of day (clock (1)); + code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8). + +hour: + int (subtext (akt time, 1, 2)). + +minute: + int (subtext (akt time, 4, 5)). + +dos date: + TEXT CONST akt date :: date (clock (1)); + code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8). + +day: + int (subtext (akt date, 1, 2)). + +month: + int (subtext (akt date, 4, 5)). + +year: + int (subtext (akt date, 7, 8)). + +entry start cluster: + TEXT VAR buffer2 := "12"; + replace (buffer2, 1, low word (start cluster)); + buffer2. + +entry storage: + TEXT VAR buffer4 := "1234"; + replace (buffer4, 1, low word (storage)); + replace (buffer4, 2, high word (storage)); + buffer4. + +write entry on disk: + read dir block (block no (ins pos)); + put dir entry (entry string, entry no (ins pos)); + write dir block. + +write entry in dir ds: + store file entry (dir.file list, entry string, ins pos). + +END PROC insert dir entry; + +PROC delete dir entry (TEXT CONST name): + TEXT VAR entry; + DIRPOS CONST del pos :: file entry pos (dir.filelist, name); + read dir block (block no (del pos)); + get dir entry (entry, entry no (del pos)); + put dir entry (""229"" + subtext (entry, 2, 32), entry no (del pos)); + write dir block; + delete (dir.filelist, name); + store (dir.freelist, del pos). + +END PROC delete dir entry; + +PROC format dir: + init dir block io; + init dir ds; + build empty dir block; + REAL VAR block no := real (begin of dir); + disable stop; + FOR i FROM 1 UPTO dir sectors REP + write dir block (block no); + block no INCR 1.0 + PER; + enable stop; + dir.path := ""; + init file list (dir.file list); + init dir list (dir.dir list); + init free list (dir.free list, 0.0); + store begin of free area (dir.free list, dir pos (real (begin of dir), 0)); + store end of dir (dir.free list, dir pos (last main dir sector, 15)). + +build empty dir block: + INT VAR i; + FOR i FROM 0 UPTO 15 REP + put dir entry (32 * ""0"", i) + PER. + +last main dir sector: + real (begin of dir + dir sectors - 1). + +END PROC format dir; + +PROC file info (TEXT CONST file name, REAL VAR start cluster, size): + file info (dir.file list, file name, start cluster, size) + +END PROC file info; + +THESAURUS PROC all files: + THESAURUS VAR t := dir.filelist.thes; + t + +END PROC all files; + +THESAURUS PROC all subdirs: + dir.dirlist.thes + +END PROC all subdirs; + +BOOL PROC file exists (TEXT CONST file name): + contains (dir.filelist, file name) + +END PROC file exists; + +BOOL PROC subdir exists (TEXT CONST subdir name): + contains (dir.dirlist, subdir name) + +END PROC subdir exists; + +PROC dir list (DATASPACE VAR ds): + open list file; + head line (list file, list file head); + list (list file, dir.file list); + list (list file, dir.dir list). + +open list file: + forget (ds); + ds := nilspace; + FILE VAR list file := sequential file (output, ds); + putline (list file, ""). + +list file head: + "DOS" + path string. + +path string: + IF dir.path <> "" + THEN " PATH: " + dir.path + ELSE "" + FI. + +END PROC dir list; + +END PACKET dir; + diff --git a/system/dos/1.8.7/src/disk descriptor.dos b/system/dos/1.8.7/src/disk descriptor.dos new file mode 100644 index 0000000..0b0d7fc --- /dev/null +++ b/system/dos/1.8.7/src/disk descriptor.dos @@ -0,0 +1,339 @@ +PACKET dos disk DEFINES (* Copyright (C) 1986, 87 *) + (* Frank Klapper *) + (* Referenz: 3-22 *) (* 11.09.87 *) + + open dos disk, + + sectors per cluster, + fat copies, + dir sectors, + media descriptor, + fat sectors, + + begin of fat, + fat entrys, + begin of dir, + begin of cluster, + cluster size, + + bpb exists, + write bpb, + + eu block, + + bpb dump modus: + +INITFLAG VAR bpb ds initialisiert := FALSE; +DATASPACE VAR bpb ds; +BOUND STRUCT (ALIGN dummy, ROW 512 INT daten) VAR bpb; + +BOOL VAR bpb dump flag := FALSE; + +REAL VAR begin of data area; +INT VAR sectors per track, + heads; + +IF exists ("shard interface") + THEN load shard interface table +FI; + +TEXT CONST bpb type 254 :: ""00""00""00"" + + ""69""85""77""69""76""66""80""66"" + + ""00""02"" + + ""01"" + + ""01""00"" + + ""02"" + + ""64""00"" + + ""64""01"" + + ""254"" + + ""01""00"" + + ""08""00"" + + ""01""00"" + + ""00""00"", + bpb type 255 :: ""00""00""00"" + + ""69""85""77""69""76""66""80""66"" + + ""00""02"" + + ""02"" + + ""01""00"" + + ""02"" + + ""112""00"" + + ""128""02"" + + ""255"" + + ""01""00"" + + ""08""00"" + + ""02""00"" + + ""00""00""; + +PROC open dos disk: + enable stop; + bpb ds an bound koppeln; + bpb lesen; + IF bpb ungueltig + THEN versuche pseudo bpb zu verwenden + FI; + ueberpruefe bpb auf gueltigkeit; + globale variablen initialisieren; + IF bpb dump flag + THEN dump schreiben + FI. + +bpb ds an bound koppeln: + IF NOT initialized (bpb ds initialisiert) + THEN bpb ds := nilspace; + bpb := bpb ds + FI. + +bpb lesen: + INT VAR return; + check rerun; + read block (bpb ds, 2, 0, return); + IF return <> 0 + THEN lesefehler (return) + FI. + +bpb ungueltig: + (* Byte 12 = Byte 13 = ... = Byte 23 <==> Word 6 = ... = Word 11 *) + INT VAR word no; + FOR word no FROM 6 UPTO 10 REP + IF bpb.daten [word no + 1] <> bpb.daten [word no + 2] + THEN LEAVE bpb ungueltig WITH FALSE + FI + PER; + TRUE. + +versuche pseudo bpb zu verwenden: + lies ersten fat sektor; + IF fat sektor gueltig und pseudo bpb vorhanden + THEN pseudo bpb laden + ELSE error stop ("Format unbekannt") + FI. + +lies ersten fat sektor: + (* da der bpb in diesem Fall ungültig, lese ich den fat sektor in den bpb + Datenraum *) + check rerun; + read block (bpb ds, 2, 1, return); + IF return <> 0 + THEN lesefehler (return) + FI. + +fat sektor gueltig und pseudo bpb vorhanden: + TEXT VAR fat start := "1234"; + replace (fat start, 1, bpb.daten [1]); + replace (fat start, 2, bpb.daten [2]); + (fat start SUB 2) = ""255"" CAND (fat start SUB 3) = ""255"" CAND + pseudo bpb vorhanden. + +pseudo bpb vorhanden: + pos (""254""255"", fat start SUB 1) > 0. + +pseudo bpb laden: + INT VAR i; + FOR i FROM 1 UPTO 15 REP + bpb.daten [i] := bpb puffer ISUB i + PER. + +bpb puffer: + IF pseudo bpb name = ""255"" + THEN bpb type 255 + ELSE bpb type 254 + FI. + +pseudo bpb name: + fat start SUB 1. + +ueberpruefe bpb auf gueltigkeit: + IF bytes per sector <> 512 + THEN error stop ("DOS Format nicht implementiert (unzulässige Sektorgröße)") + FI; + IF (fat sectors > 64) + THEN error stop ("ungültige DOS Disk (BPB)") + FI. + +globale variablen initialisieren: + sectors per track := bpb byte (25) * 256 + bpb byte (24); + heads := bpb byte (27) * 256 + bpb byte (26); + begin of data area := real (reserved sectors + fat copies * fat sectors + dir sectors). + +dump schreiben: + dump ("Sektoren pro Cluster", sectors per cluster); + dump ("Fat Kopien ", fat copies); + dump ("Dir Sektoren ", dir sectors); + dump ("Media Descriptor ", media descriptor); + dump ("Sektoren pro Fat ", fat sectors); + dump ("Fat Anfang (0) ", begin of fat (0)); + dump ("Fat Einträge ", fat entrys); + dump ("Dir Anfang ", begin of dir). + +END PROC open dos disk; + +PROC lesefehler (INT CONST fehler code): + error stop (fehlertext). + +fehlertext: + SELECT fehler code OF + CASE 1: "Diskettenlaufwerk nicht betriebsbereit" + CASE 2: "Lesefehler" + OTHERWISE "Lesefehler " + text (fehler code) + END SELECT. + +END PROC lesefehler; + +TEXT VAR konvertier puffer := "12"; + +INT PROC bpb byte (INT CONST byte no): + replace (konvertier puffer, 1, bpb.daten [byte no DIV 2 + 1]); + code (konvertier puffer SUB puffer pos). + +puffer pos: + IF even byte no + THEN 1 + ELSE 2 + FI. + +even byte no: + (byte no MOD 2) = 0. + +END PROC bpb byte; + +INT PROC bytes per sector: + bpb byte (12) * 256 + bpb byte (11) + +END PROC bytes per sector; + +INT PROC sectors per cluster: + bpb byte (13) + +END PROC sectors per cluster; + +INT PROC reserved sectors: + bpb byte (15) * 256 + bpb byte (14) + +END PROC reserved sectors; + +INT PROC fat copies: + bpb byte (16) + +END PROC fat copies; + +INT PROC dir sectors: + dir entrys DIV dir entrys per sector. + +dir entrys: + bpb byte (18) * 256 + bpb byte (17). + +dir entrys per sector: + 16. + +END PROC dir sectors; + +REAL PROC dos sectors: + real (bpb byte (20)) * 256.0 + real (bpb byte (19)) + +END PROC dos sectors; + +INT PROC media descriptor: + bpb byte (21) + +END PROC media descriptor; + +INT PROC fat sectors: + bpb byte (23) * 256 + bpb byte (22) + +END PROC fat sectors; + +INT PROC begin of fat (INT CONST fat copy no): + (* 0 <= fat copy no <= fat copies - 1 *) + reserved sectors + fat copy no * fat sectors + +END PROC begin of fat; + +INT PROC fat entrys: + anzahl daten cluster + 2. + +anzahl daten cluster: + int ((dos sectors - tabellen sektoren) / real (sectors per cluster)). + +tabellen sektoren: + real (reserved sectors + fat copies * fat sectors + dir sectors). + +END PROC fat entrys; + +INT PROC begin of dir: + reserved sectors + fat copies * fat sectors. + +END PROC begin of dir; + +REAL PROC begin of cluster (REAL CONST cluster no): + begin of data area + (cluster no - 2.0) * real (sectors per cluster) + +END PROC begin of cluster; + +INT PROC cluster size: + 512 * sectors per cluster + +END PROC cluster size; + +BOOL PROC bpb exists (INT CONST no): + + exists ("bpb ds") AND no > 0 AND no < 4. + +END PROC bpb exists; + +PROC write bpb (INT CONST no): + INT VAR return; + write block (old ("bpb ds"), no + 1, 0, 0, return); + IF return <> 0 + THEN error stop ("Schreibfehler") + FI. + +END PROC write bpb; + +(* Da DOS-Partitionen maximal 32 MByte groß sein können, können die Blocknummern + durch 16 BIT unsigned Integer dargestellt werden. Die Werte die die 'eublock'- + Prozeduren liefern sind als solche zu verstehen *) + +INT PROC eu block (INT CONST dos block no): + IF hd version + THEN dos block no + ELSE dos block no floppy format + FI. + +dos block no floppy format: + IF page format + THEN head * eu sectors per head + trac * eu sectors + sector + ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector + FI. + +page format: + eu heads < 0. + +sector: + dos block no MOD sectors per track. + +trac: + (dos block no DIV sectors per track) DIV heads. + +head: + (dos block no DIV sectors per track) MOD heads. + +eu sectors per head: + eu sectors * eu tracks. + +eu sectors: + eu last sector - eu first sector + 1. + +END PROC eu block; + +INT PROC eu block (REAL CONST dos block no): + eublock (low word (dos block no)). + +END PROC eublock; + +PROC bpb dump modus (BOOL CONST status): + bpb dump flag := status + +END PROC bpb dump modus; + +END PACKET dos disk; + diff --git a/system/dos/1.8.7/src/dos hd inserter b/system/dos/1.8.7/src/dos hd inserter new file mode 100644 index 0000000..24be82b --- /dev/null +++ b/system/dos/1.8.7/src/dos hd inserter @@ -0,0 +1,41 @@ +IF NOT single user + THEN do ("IF name (myself) <> ""DOS HD"" THEN error stop (""Bitte der Task den Namen 'DOS HD' geben und neu starten"") FI"); +FI; + +archive ("austausch"); +check off; +command dialogue (FALSE); +fetch ("insert.dos", archive); +fetch ("bpb ds", archive); +IF single user + THEN do (PROC (TEXT CONST) gen s, ALL "insert.dos"); + gen s ("manager/S.dos") + ELSE fetch (ALL "insert.dos", archive); + fetch ("manager/M.dos", archive); + release (archive); + do (PROC (TEXT CONST) gen m, ALL "insert.dos"); + gen m ("manager/M.dos"); +FI; +do ("hd version (TRUE)"); +forget ("insert.dos", quiet); +forget ("dos hd inserter", quiet); +IF NOT single user + THEN do ("dos manager (29)") +FI. + +single user: + (pcb (9) AND 255) = 1. + +PROC gen m (TEXT CONST name): + insert (name); + forget (name, quiet) + +END PROC gen m; + +PROC gen s (TEXT CONST t): + fetch (t, archive); + insert (t); + forget (t, quiet) + +END PROC gen s; + diff --git a/system/dos/1.8.7/src/dos inserter b/system/dos/1.8.7/src/dos inserter new file mode 100644 index 0000000..2f70b28 --- /dev/null +++ b/system/dos/1.8.7/src/dos inserter @@ -0,0 +1,59 @@ +IF NOT single user + THEN do ("IF name (myself) <> ""DOS"" THEN error stop (""Bitte der Task den Namen 'DOS' geben und neu starten"") FI"); +FI; + +archive ("austausch"); +check off; +command dialogue (FALSE); +hol ("shard interface"); +hol ("bpb ds"); +hol ("insert.dos"); +IF single user + THEN do (PROC (TEXT CONST) gen s, ALL "insert.dos"); + gen s ("manager/S.dos") + ELSE do (PROC (TEXT CONST) hol, ALL "insert.dos"); + hol ("manager/M.dos"); + release (archive); + do (PROC (TEXT CONST) gen m, ALL "insert.dos"); + gen m ("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). + +single user: + (pcb (9) AND 255) = 1. + +PROC gen m (TEXT CONST name): + insert (name); + forget (name, quiet) + +END PROC gen m; + +PROC gen s (TEXT CONST t): + hol (t); + insert (t); + forget (t, quiet) + +END PROC gen s; + +PROC hol (TEXT CONST t): + IF NOT exists (t) + THEN fetch (t, archive) + FI + +END PROC hol; + + + + + + + + + + + diff --git a/system/dos/1.8.7/src/dump b/system/dos/1.8.7/src/dump new file mode 100644 index 0000000..5138162 --- /dev/null +++ b/system/dos/1.8.7/src/dump @@ -0,0 +1,49 @@ +PACKET dump DEFINES + + dump: + +TEXT VAR ergebnis := ""; + +PROC dump (TEXT CONST kommentar, dump text): + ergebnis := kommentar; + ergebnis CAT ": "; + INT VAR i; + FOR i FROM 1 UPTO LENGTH dump text REP + zeichen schreiben + PER; + ergebnis schreiben. + +zeichen schreiben: + INT CONST char code :: code (dump text SUB i); + IF char code < 32 + THEN ergebnis CAT ("$" + text (char code) + "$") + ELSE ergebnis CAT code (char code) + FI. + +END PROC dump; + +PROC dump (TEXT CONST kommentar, INT CONST dump int): + ergebnis := kommentar; + ergebnis CAT ": "; + ergebnis CAT text (dump int); + ergebnis schreiben. + +END PROC dump; + +PROC dump (TEXT CONST kommentar, REAL CONST dump real): + ergebnis := kommentar; + ergebnis CAT ": "; + ergebnis CAT text (dump real); + ergebnis schreiben. + +END PROC dump; + +PROC ergebnis schreiben: + FILE VAR f := sequential file (output, "logbuch"); + putline (f, ergebnis); + ergebnis := "". + +END PROC ergebnis schreiben; + +END PACKET dump; + diff --git a/system/dos/1.8.7/src/eu disk descriptor b/system/dos/1.8.7/src/eu disk descriptor new file mode 100644 index 0000000..5a61367 --- /dev/null +++ b/system/dos/1.8.7/src/eu disk descriptor @@ -0,0 +1,107 @@ +PACKET eu disk DEFINES (* Copyright (C) 1986, 87 *) + (* Frank Klapper *) + (* 05.01.87 *) + load shard interface table, + open eu disk, + eu size, + eu heads, + eu tracks, + eu first sector, + eu last sector: + +LET table length = 15, + + size field = 1, + head field = 2, + track field = 3, + first sector field = 4, + last sector field = 5; + +ROW table length ROW 5 INT VAR format table; + +INT VAR table top := 0, + table pointer; + +PROC open eu disk: + enable stop; + init check rerun; + IF hd version + THEN LEAVE open eu disk + FI; + INT CONST blocks := archive blocks; + IF blocks <= 0 + THEN error stop ("keine Diskette eingelegt") + FI; + search format table entry. + +search format table entry: + IF table top < 1 + THEN error stop ("SHard-Interfacetabelle nicht geladen") + FI; + table pointer := 1; + WHILE format table [table pointer][size field] <> blocks REP + table pointer INCR 1; + IF table pointer > table top + THEN error stop ("Diskettenformat nicht implementiert") + FI + PER. + +END PROC open eu disk; + +PROC load shard interface table: + FILE VAR f := sequential file (input, "shard interface"); + TEXT VAR line; + table top := 0; + WHILE NOT eof (f) REP + get line (f, line); + IF (line SUB 1) <> ";" + THEN load line + FI + PER. + +load line: + table top INCR 1; + IF table top > table length + THEN error stop ("Shard Interface Tabelle zu groß") + FI; + INT VAR blank pos := 1; + format table [table top][size field] := next int; + format table [table top][head field] := next int; + format table [table top][track field] := next int; + format table [table top][first sector field] := next int; + format table [table top][last sector field] := next int. + +next int: + line := compress (subtext (line, blank pos)) + " "; + blank pos := pos (line, " "); + int (subtext (line, 1, blank pos - 1)). + +END PROC load shard interface table; + +INT PROC eu size: + format table [table pointer][size field] + +END PROC eu size; + +INT PROC eu heads: + format table [table pointer][head field] + +END PROC eu heads; + +INT PROC eu tracks: + format table [table pointer][track field] + +END PROC eu tracks; + +INT PROC eu first sector: + format table [table pointer][first sector field] + +END PROC eu first sector; + +INT PROC eu last sector: + format table [table pointer][last sector field] + +END PROC eu last sector; + +END PACKET eu disk; + diff --git a/system/dos/1.8.7/src/fat.dos b/system/dos/1.8.7/src/fat.dos new file mode 100644 index 0000000..2890b1a --- /dev/null +++ b/system/dos/1.8.7/src/fat.dos @@ -0,0 +1,369 @@ +PACKET dos fat DEFINES (* Copyright (C) 1985, 86, 87 *) + (* Frank Klapper *) + (* 11.09.87 *) + read fat, + write fat, + first fat block ok, + clear fat ds, + format fat, + + fat entry, + last fat chain entry, + is last fat chain entry, + erase fat chain, + available fat entry: + + (* Referenz: 4. *) + +LET fat size = 16 384, (* maximal 64 Sektoren a 512 Byte (256 Worte) *) + max anzahl fat sektoren = 64; + +LET FAT = BOUND STRUCT (ALIGN dummy, + ROW 256 INT block row, (* für Kopie des 1. Fatsektors *) + ROW fat size INT fat row); + +DATASPACE VAR fat ds; +INITFLAG VAR fat ds used := FALSE; +FAT VAR fat struktur; + +.fat: fat struktur.fat row. + +REAL VAR erster moeglicher freier eintrag; + +BOOL VAR kleines fat format; + +PROC read fat: + fat ds initialisieren; + fat bloecke lesen; + fat format bestimmen; + erster moeglicher freier eintrag := 2.0. + +fat ds initialisieren: + clear fat ds; + fat struktur := fat ds. + +fat bloecke lesen: + LET kein testblock = FALSE; + INT VAR block no; + FOR block no FROM 0 UPTO fat sectors - 1 REP + fat block lesen (block no, kein testblock) + PER. + +fat format bestimmen: + IF fat entrys <= 4086 + THEN kleines fat format := TRUE + ELSE kleines fat format := FALSE + FI. + +END PROC read fat; + +PROC write fat: + disable stop; + INT VAR block nr; + FOR block nr FROM 0 UPTO fat sectors - 1 REP + fat block schreiben (block nr) + PER. + +END PROC write fat; + +BOOL PROC first fat block ok: + (* überprüft, ob der erste Block der Fat auf Diskette und im Speicher + gleich ist *) + enable stop; + LET testblock = TRUE; + fat block lesen (0, testblock); + INT VAR i; + FOR i FROM 1 UPTO 256 REP + vergleiche woerter + PER; + TRUE. + +vergleiche woerter: + IF fat [i] <> fat struktur.block row [i] + THEN LEAVE first fat block ok WITH FALSE + FI. + +END PROC first fat block ok; + +PROC clear fat ds: + IF initialized (fat ds used) + THEN forget (fat ds) + FI; + fat ds := nilspace. + +END PROC clear fat ds; + +PROC format fat: + fat ds initialisieren; + fat format bestimmen; + erster moeglicher freier eintrag := 2.0; + write first four fat bytes; + write other fat bytes; + vermerke schreibzugriffe; + write fat. + +fat ds initialisieren: + clear fat ds; + fat struktur := fat ds. + +fat format bestimmen: + IF fat entrys <= 4086 + THEN kleines fat format := TRUE + ELSE kleines fat format := FALSE + FI. + +write first four fat bytes: + fat [1] := word (media descriptor, 255); + IF kleines fat format + THEN fat [2] := word (255, 0) + ELSE fat [2] := word (255, 255) + FI. + +write other fat bytes: + INT VAR i; + FOR i FROM 3 UPTO 256 * fat sectors REP + fat [i] := 0 + PER. + +vermerke schreibzugriffe: + FOR i FROM 0 UPTO fat sectors - 1 REP + schreibzugriff (i) + PER. + +END PROC format fat; + +(*-------------------------------------------------------------------------*) + +REAL PROC fat entry (REAL CONST real entry no): + (* 0 <= entry no <= 22 000 *) + INT CONST entry no :: int (real entry no); + IF kleines fat format + THEN construct 12 bit value + ELSE dint (fat [entry no + 1], 0) + FI. + +construct 12 bit value: + INT CONST first byte no := entry no + entry no DIV 2; + IF entry no MOD 2 = 0 + THEN real ((right byte MOD 16) * 256 + left byte) + ELSE real (right byte * 16 + left byte DIV 16) + FI. + +left byte: + fat byte (first byte no). + +right byte: + fat byte (first byte no + 1). + +END PROC fat entry; + +TEXT VAR convert buffer := "12"; + +INT PROC fat byte (INT CONST no): + replace (convert buffer, 1, word); + IF even byte no + THEN code (convert buffer SUB 1) + ELSE code (convert buffer SUB 2) + FI. + +even byte no: + no MOD 2 = 0. + +word: + fat [no DIV 2 + 1]. + +END PROC fat byte; + +PROC fat entry (REAL CONST real entry no, real value): + (* 0 <= entry no <= 22 000 *) + INT CONST entry no :: int (real entry no), + value :: low word (real value); + IF kleines fat format + THEN write 12 bit value + ELSE fat [entry no + 1] := value; + schreibzugriff (entry no DIV 256) + FI; + update first possible available entry. + +write 12 bit value: + INT CONST first byte no :: entry no + entry no DIV 2; + schreibzugriff (fat block of first byte); + schreibzugriff (fat block of second byte); + write value. + +fat block of first byte: + first byte no DIV 512. + +fat block of second byte: + second byte no DIV 512. + +write value: + IF even entry no + THEN write fat byte (first byte no, value MOD 256); + write fat byte (second byte no, + (right byte DIV 16) * 16 + value DIV 256) + ELSE write fat byte (first byte no, + (left byte MOD 16) + 16 * (value MOD 16)); + write fat byte (second byte no, value DIV 16) + FI. + +even entry no: + entry no MOD 2 = 0. + +second byte no: + first byte no + 1. + +left byte: + fat byte (first byte no). + +right byte: + fat byte (second byte no). + +update first possible available entry: + IF value = 0 + THEN erster moeglicher freier eintrag := + min (erster moeglicher freier eintrag, real entry no) + FI. + +END PROC fat entry; + +PROC write fat byte (INT CONST byte no, new value): + read old word; + change byte; + write new word. + +read old word: + replace (convert buffer, 1, word). + +write new word: + word := convert buffer ISUB 1. + +word: + fat [byte no DIV 2 + 1]. + +change byte: + replace (convert buffer, byte pos, code (new value)). + +byte pos: + byte no MOD 2 + 1. + +END PROC write fat byte; + +REAL PROC last fat chain entry: + IF kleines fat format + THEN 4 088.0 + ELSE 65 528.0 + FI. + +END PROC last fat chain entry; + +BOOL PROC is last fat chain entry (REAL CONST value): + value >= last fat chain entry + +END PROC is last fat chain entry; + +PROC erase fat chain (REAL CONST first entry no): + REAL VAR next entry no := first entry no, + act entry no := 0.0; + WHILE next entry exists REP + act entry no := next entry no; + next entry no := fat entry (act entry no); + fat entry (act entry no, 0.0) + PER. + +next entry exists: + NOT is last fat chain entry (next entry no). + +END PROC erase fat chain; + +REAL PROC available fat entry: + (* da die fat weniger als 22 000 Einträge umfaßt, kann ich diese als + INTEGER berechnen *) + INT VAR i; + REAL VAR real i := erster moeglicher freier eintrag; + FOR i FROM int (erster moeglicher freier eintrag) UPTO fat entrys - 1 REP + IF fat entry (real i) = 0.0 + THEN erster moeglicher freier eintrag := real i; + LEAVE available fat entry WITH erster moeglicher freier eintrag + FI; + real i INCR 1.0 + PER; + close work; + error stop ("MS-DOS Datentraeger voll"); + 1.0e99. + +END PROC available fat entry; + +(*-------------------------------------------------------------------------*) + +PROC fat block lesen (INT CONST block nr, BOOL CONST test block): + (* 0 <= block nr <= fat sectors - 1 *) + disable stop; + IF NOT test block + THEN kein schreibzugriff (block nr) + FI; + INT VAR kopie nr; + FOR kopie nr FROM 0 UPTO fat copies - 1 REP + clear error; + read disk block (fat ds, ds seiten nr, disk block nr) + UNTIL NOT is error + PER; + IF is error + THEN close work + FI. + +ds seiten nr: + IF test block + THEN 2 + ELSE block nr + 2 + 1 + FI. + +disk block nr: + begin of fat (kopie nr) + block nr. + +END PROC fat block lesen; + +PROC fat block schreiben (INT CONST block nr): + IF war schreibzugriff (block nr) + THEN wirklich schreiben + FI. + +wirklich schreiben: + disable stop; + INT VAR kopie nr; + FOR kopie nr FROM 0 UPTO fat copies - 1 REP + write disk block and close work if error (fat ds, ds seiten nr, disk block nr) + PER; + kein schreibzugriff (block nr). + +ds seiten nr: + block nr + 2 + 1. + +disk block nr: + begin of fat (kopie nr) + block nr. + +END PROC fat block schreiben; + +(*-------------------------------------------------------------------------*) + +ROW max anzahl fat sektoren BOOL VAR schreib zugriff tabelle; + +PROC schreibzugriff (INT CONST fat sektor): + schreibzugriff tabelle [fat sektor + 1] := TRUE + +END PROC schreibzugriff; + +PROC kein schreibzugriff (INT CONST fat sektor): + schreibzugriff tabelle [fat sektor + 1] := FALSE + +END PROC kein schreibzugriff; + +BOOL PROC war schreibzugriff (INT CONST fat sektor): + schreibzugriff tabelle [fat sektor + 1] + +END PROC war schreibzugriff; + +(*-------------------------------------------------------------------------*) + +END PACKET dos fat; + diff --git a/system/dos/1.8.7/src/fetch b/system/dos/1.8.7/src/fetch new file mode 100644 index 0000000..7cb7571 --- /dev/null +++ b/system/dos/1.8.7/src/fetch @@ -0,0 +1,371 @@ +PACKET fetch DEFINES (* Copyright (C) 1985, 86, 87 *) + (* Frank Klapper *) + (* 27.04.87 *) + fetch, + check file: + +LET ascii = 1, + ascii german = 2, + transparent = 3, + row text = 5, + ds = 6, + dump = 7, + atari st = 10, + ibm = 11, + + (*line end chars = ""10""12""13"",*) + min line end char = ""10"", + max line end char = ""13"", + lf = ""10"", + cr = ""13"", + tab code = 9, + lf code = 10, + ff code = 12, + cr code = 13, + ctrl z = ""26"", + + page cmd = "#page#", + + row text length = 4000, + row text type = 1000; + +BOUND STRUCT (INT size, + ROW row text length TEXT cluster row) VAR cluster struct; + +FILE VAR file; + +TEXT VAR buffer; +INT VAR buffer length; + +PROC fetch (TEXT CONST name, DATASPACE VAR file ds, INT CONST mode): + + SELECT mode OF + CASE ascii, ascii german, atari st, ibm, transparent: + fetch filemode (file ds, name, mode) + CASE row text : fetch row textmode (file ds, name) + CASE ds : fetch dsmode (file ds, name) + CASE dump : fetch dumpmode (file ds, name) + OTHERWISE error stop ("Unzulässige Betriebsart") + END SELECT. + +END PROC fetch; + +PROC fetch filemode (DATASPACE VAR file space, TEXT CONST name, + INT CONST code type): + enable stop; + initialize fetch filemode; + open fetch dos file (name); + WHILE NOT was last fetch cluster REP + get text of cluster; + write lines; +(***************************************) + IF lines (file) > 3900 + THEN putline (file, ">>> FREMDDATEI FUER EUMEL ZU LANG. ES KÖNNEN DATEN FEHLEN <<<"); + LEAVE fetch filemode + FI; +(***************************************) + UNTIL file end via ctrl z + PER; + write last line if necessary; + close fetch dos file. + +initialize fetch filemode: + buffer := ""; + buffer length := 0; + forget (file space); + file space := nilspace; + file := sequential file (output, file space); + BOOL VAR file end via ctrl z := FALSE. + +get text of cluster: + cat next fetch dos cluster (buffer); + IF ascii code + THEN ctrl z is buffer end + FI; + adapt code (buffer, buffer length + 1, code type); + buffer length := length (buffer). + +ascii code: + (code type = ascii) OR (code type = ascii german). + +ctrl z is buffer end: + INT CONST ctrl z pos :: pos (buffer, ctrl z, buffer length + 1); + file end via ctrl z := ctrl z pos > 0; + IF file end via ctrl z + THEN buffer := subtext (buffer, 1, ctrl z pos - 1); + buffer length := length (buffer) + FI. + +write lines: + INT VAR line begin pos := 1, line end pos; + compute line end pos; + WHILE line end pos > 0 REP + putline (file, subtext (buffer, line begin pos, line end pos)); + exec (PROC (TEXT CONST, INT CONST) control char conversion, file, code type); + line begin pos := line end pos + 1; + compute line end pos + PER; + buffer := subtext (buffer, line begin pos); + buffer length := length (buffer); + IF buffer length > 5 000 + THEN putline (file, buffer); + exec (PROC (TEXT CONST, INT CONST) control char conversion, file, code type); + buffer := ""; + buffer length := 0 + FI. + +compute line end pos: + line end pos := line begin pos; + REP + line end pos := pos (buffer, min line end char, max line end char, line end pos); + INT CONST line end code :: code (buffer SUB line end pos); + SELECT line end code OF + CASE lf code: look for cr + CASE 11 : line end pos INCR 1 + CASE cr code: look for lf + END SELECT + UNTIL line end code <> 11 + PER. + +look for cr: + IF line end pos = buffer length + THEN line end pos := 0 + ELIF (buffer SUB line end pos + 1) = cr + THEN line end pos INCR 1 + FI. + +look for lf: + IF line end pos = buffer length + THEN line end pos := 0 + ELIF (buffer SUB line end pos + 1) = lf + THEN line end pos INCR 1 + FI. + +write last line if necessary: + IF buffer length > 0 + THEN putline (file, buffer); + exec (PROC (TEXT CONST, INT CONST) control char conversion, file, code type); + FI. + +END PROC fetch filemode; + +PROC adapt code (TEXT VAR text buffer, INT CONST start pos, code type): + SELECT code type OF + CASE ascii : cancel bit 8 + CASE ascii german: cancel bit 8; ascii german adaption + CASE atari st : atari st adaption + CASE ibm : ibm adaption + (*CASE transparent : do nothing *) + END SELECT. + +cancel bit 8: + INT VAR set pos := pos (text buffer, ""128"", ""255"", start pos); + WHILE set pos > 0 REP + replace (text buffer, set pos, seven bit char); + set pos := pos (text buffer, ""128"", ""255"", set pos + 1) + PER. + +seven bit char: + code (code (text buffer SUB set pos) AND 127). + +ascii german adaption: + change all by replace (text buffer, start pos, "[", "Ä"); + change all by replace (text buffer, start pos, "\", "Ö"); + change all by replace (text buffer, start pos, "]", "Ü"); + change all by replace (text buffer, start pos, "{", "ä"); + change all by replace (text buffer, start pos, "|", "ö"); + change all by replace (text buffer, start pos, "}", "ü"); + change all by replace (text buffer, start pos, "~", "ß"). + +atari st adaption: + change all by replace (text buffer, start pos, ""142"", "Ä"); + change all by replace (text buffer, start pos, ""153"", "Ö"); + change all by replace (text buffer, start pos, ""154"", "Ü"); + change all by replace (text buffer, start pos, ""132"", "ä"); + change all by replace (text buffer, start pos, ""148"", "ö"); + change all by replace (text buffer, start pos, ""129"", "ü"); + change all by replace (text buffer, start pos, ""158"", "ß"). + +ibm adaption: + change all by replace (text buffer, start pos, ""142"", "Ä"); + change all by replace (text buffer, start pos, ""153"", "Ö"); + change all by replace (text buffer, start pos, ""154"", "Ü"); + change all by replace (text buffer, start pos, ""132"", "ä"); + change all by replace (text buffer, start pos, ""148"", "ö"); + change all by replace (text buffer, start pos, ""129"", "ü"); + change all by replace (text buffer, start pos, ""225"", "ß"). + +END PROC adapt code; + +PROC change all by replace (TEXT VAR string, INT CONST begin pos, + TEXT CONST old, new): + + INT VAR p := pos (string, old, begin pos); + WHILE p > 0 REP + replace (string, p, new); + p := pos (string, old, p + 1) + PER. + +END PROC change all by replace; + +PROC control char conversion (TEXT VAR string, INT CONST code type): + + IF code type <> transparent + THEN code conversion + FI. + +code conversion: + INT VAR p := pos (string, ""0"", ""31"", 1); + WHILE p > 0 REP + convert char; + p := pos (string, ""0"", ""31"", p) + PER. + +convert char: + INT CONST char code := code (string SUB p); + SELECT char code OF + CASE tab code: expand tab + CASE lf code: change (string, p, p, "") + CASE ff code: change (string, p, p, page cmd) + CASE cr code: change (string, p, p, "") + OTHERWISE ersatzdarstellung + END SELECT. + +expand tab: + change (string, p, p, (8 - (p - 1) MOD 8) * " "). + +ersatzdarstellung: + TEXT CONST t := text (char code); + change (string, p, p, "#" + (3 - length (t)) * "0" + t + "#"). + +END PROC control char conversion; + +PROC fetch rowtextmode (DATASPACE VAR file space, + TEXT CONST name): + enable stop; + open fetch dos file (name); + initialize fetch rowtext mode; + WHILE NOT was last fetch cluster REP + cluster struct.size INCR 1; + cluster struct.cluster row [cluster struct.size] := ""; + cat next fetch dos cluster (cluster struct.cluster row [cluster struct.size]) + PER; + close fetch dos file. + +initialize fetch row text mode: + forget (file space); + file space := nilspace; + cluster struct := file space; + type (file space, row text type); + cluster struct.size := 0. + +END PROC fetch rowtext mode; + +PROC fetch ds mode (DATASPACE VAR in ds, TEXT CONST name): + enable stop; + open fetch dos file (name); + init fetch dsmode; + WHILE NOT was last fetch cluster REP + read next fetch dos cluster (in ds, ds block no); + PER; + close fetch dos file. + +init fetch dsmode: + forget (in ds); + in ds := nilspace; + INT VAR ds block no := 2. + +END PROC fetch ds mode; + +PROC fetch dumpmode (DATASPACE VAR file space, TEXT CONST name): + enable stop; + open fetch dos file (name); + initialize fetch dumpmode; + WHILE NOT was last fetch cluster REP + TEXT VAR cluster buffer := ""; + cat next fetch dos cluster (cluster buffer); + dump cluster + UNTIL offset > 50 000.0 + PER; + close fetch dos file. + +initialize fetch dump mode: + BOOL VAR fertig := FALSE; + REAL VAR offset := 0.0; + forget (file space); + file space := nilspace; + file := sequential file (output, file space). + +dump cluster: + TEXT VAR dump line; + INT VAR line, column; + FOR line FROM 0 UPTO (cluster size DIV 16) - 1 REP + build dump line; + putline (file, dump line); + offset INCR 16.0 + UNTIL fertig + PER. + +build dump line: + TEXT VAR char line := ""; + dump line := text (offset, 6, 0); + dump line := subtext (dump line, 1, 5); + dump line CAT " "; + FOR column FROM 0 UPTO 7 REP + convert char; + dump line CAT " " + PER; + dump line CAT " "; + FOR column FROM 8 UPTO 15 REP + convert char; + dump line CAT " " + PER; + dump line CAT " "; + dump line CAT char line. + +convert char: + TEXT CONST char :: cluster buffer SUB (line * 16 + column + 1); + IF char = "" + THEN fertig := TRUE; + dump line CAT " "; + LEAVE convert char + FI; + INT CONST char code := code (char); + LET hex chars = "0123456789ABCDEF"; + dump line CAT (hex chars SUB (char code DIV 16 + 1)); + dump line CAT (hex chars SUB (char code MOD 16 + 1)); + charline CAT show char. + +show char: + IF (char code > 31 AND char code < 127) + THEN char + ELSE "." + FI. + +END PROC fetch dump mode; + +PROC check file (TEXT CONST name): + disable stop; + DATASPACE VAR test ds := nilspace; + enable check file (name, test ds); + forget (test ds); + IF is error + THEN clear error; + error stop ("Fehler beim Prüflesen der Datei """ + name + """") + FI. + +END PROC check file; + +PROC enable check file (TEXT CONST name, DATASPACE VAR test ds): + enable stop; + open fetch dos file (name); + WHILE NOT was last fetch cluster REP + INT VAR dummy := 2; + read next fetch dos cluster (test ds, dummy) + PER; + close fetch dos file. + +END PROC enable check file; + +END PACKET fetch; + diff --git a/system/dos/1.8.7/src/fetch save interface b/system/dos/1.8.7/src/fetch save interface new file mode 100644 index 0000000..27b4925 --- /dev/null +++ b/system/dos/1.8.7/src/fetch save interface @@ -0,0 +1,70 @@ +PACKET fetch save DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + save fetch mode, (* 22.04.87 *) + path: + +LET ascii = 1, + ascii german = 2, + transparent = 3, + row text = 5, + ds = 6, + dump = 7, + atari st = 10, + ibm = 11; + +INT PROC save fetch mode (TEXT CONST reserve string): + TEXT VAR modus; + INT CONST p := pos (reserve string, ":"); + IF p = 0 + THEN modus := reserve string + ELSE modus := subtext (reserve string, 1, p - 1) + FI; + modus normieren; + IF modus = "FILEASCII" + THEN ascii + ELIF modus = "FILEASCIIGERMAN" + THEN asciigerman + ELIF modus = "FILEATARIST" + THEN atari st + ELIF modus = "FILEIBM" + THEN ibm + ELIF modus = "FILETRANSPARENT" + THEN transparent + ELIF modus = "ROWTEXT" + THEN row text + ELIF modus = "DS" + THEN ds + ELIF modus = "DUMP" + THEN dump + ELSE error stop ("Unzulässige Betriebsart"); -1 + FI. + +modus normieren: + change all (modus, " ", ""); + INT VAR i; + FOR i FROM 1 UPTO LENGTH modus REP + INT CONST char code :: code (modus SUB i); + IF is lower case + THEN replace (modus, i, upper case char) + FI + PER. + +is lower case: + char code > 96 AND char code < 123. + +upper case char: + code (char code - 32). + +END PROC save fetch mode; + +TEXT PROC path (TEXT CONST reserve string): + INT CONST p :: pos (reserve string, ":"); + IF p = 0 + THEN "" + ELSE subtext (reserve string, p + 1) + FI. + +END PROC path; + +END PACKET fetch save; + diff --git a/system/dos/1.8.7/src/get put interface.dos b/system/dos/1.8.7/src/get put interface.dos new file mode 100644 index 0000000..1d6de92 --- /dev/null +++ b/system/dos/1.8.7/src/get put interface.dos @@ -0,0 +1,368 @@ +PACKET dos get put DEFINES (* Copyright (C) 1986, 87 *) + (* Frank Klapper *) + (* 11.12.87 *) + log modus, + + open dos disk, + close dos disk, + access dos disk, + + open fetch dos file, + close fetch dos file, + cat next fetch dos cluster, + read next fetch dos cluster, + was last fetch cluster, + + open save dos file, + write next save dos cluster, + close save dos file, + + erase dos file, + + all dosfiles, + all dossubdirs, + dosfile exists, + dos list, + + clear dos disk, + format dos disk: + +BOOL VAR log flag := FALSE; + +PROC log modus (BOOL CONST status): + log flag := status + +END PROC log modus; + +(*-------------------------------------------------------------------------*) + +LET max cluster size = 8192, (* 8192 * 8 = 64 KB *) + reals per sector = 64; + +LET CLUSTER = BOUND STRUCT (ALIGN dummy, + ROW max cluster size REAL cluster row); + +CLUSTER VAR cluster; +DATASPACE VAR cluster ds; +INITFLAG VAR cluster ds used := FALSE; + +TEXT VAR convert buffer; +INT VAR convert buffer length; + +PROC init cluster handle: + IF initialized (cluster ds used) + THEN forget (cluster ds) + FI; + cluster ds := nilspace; + cluster := cluster ds; + convert buffer := ""; + convert buffer length := 0. + +END PROC init cluster handle; + +PROC cat cluster text (REAL CONST cluster no, TEXT VAR destination, INT CONST to): + read disk cluster (cluster ds, 2, cluster no); + init convert buffer; + INT VAR i; + FOR i FROM 1 UPTO sectors per cluster * reals per sector REP + replace (convert buffer, i, cluster.cluster row [i]) + PER; + destination CAT subtext (convert buffer, 1, to). + +init convert buffer: + IF convert buffer length < cluster size + THEN convert buffer CAT (cluster size - convert buffer length) * "*"; + convert buffer length := cluster size + FI. + +END PROC cat cluster text; + +PROC write text to cluster (REAL CONST cluster no, TEXT CONST string): + IF LENGTH string < cluster size + THEN execute write text (text (string, cluster size)) + ELSE execute write text (string) + FI; + write disk cluster (cluster ds, 2, cluster no). + +END PROC write text to cluster; + +PROC execute write text (TEXT CONST string): + INT VAR i; + FOR i FROM 1 UPTO sectors per cluster * reals per sector REP + cluster.cluster row [i] := string RSUB i + PER. + +END PROC execute write text; + +(*-------------------------------------------------------------------------*) + +BOOL VAR disk open := FALSE; +TEXT VAR act path; + +REAL VAR last access time; + +PROC open dos disk (TEXT CONST path): + IF log flag THEN dump ("open dos disk", path) FI; + enable stop; + close work; + init cluster handle; + act path := path; + disk open := TRUE + +END PROC open dos disk; + +PROC close dos disk: + IF log flag THEN dump ("close dos disk", "") FI; + enable stop; + disk open := FALSE; + close work; + init cluster handle; (* Datenraumespeicher freigeben *) + clear fat ds; + init dir ds. + +END PROC close dos disk; + +PROC access dos disk: + enable stop; + IF NOT disk open + THEN error stop ("DOS-Arbeit nicht eröffnet") + FI; + IF work closed COR (last access more than 5 seconds ago CAND disk changed) + THEN open eu disk; (* hier wird der RERUN Check initialisiert *) + open dos disk; + read fat; + open dir (act path); + last access time := clock (1); + open work + FI. + +last access more than 5 seconds ago: + abs (clock (1) - last access time) > 5.0. + +disk changed: + IF hd version + THEN FALSE + ELSE last access time := clock (1); + NOT first fat block ok + FI. + +END PROC access dos disk; + +(*-------------------------------------------------------------------------*) + +REAL VAR next fetch cluster, + fetch rest; (* in Bytes *) + +PROC open fetch dos file (TEXT CONST file name): + IF log flag THEN dump ("open fetch dos file", file name) FI; + enable stop; + access dos disk; + file info (file name, next fetch cluster, fetch rest). + +END PROC open fetch dos file; + +BOOL PROC was last fetch cluster: + IF log flag THEN dump ("was last fetch cluster", "") FI; + is last fat chain entry (next fetch cluster) OR fetch rest <= 0.0. + +END PROC was last fetch cluster; + +PROC cat next fetch dos cluster (TEXT VAR buffer): + IF log flag THEN dump ("cat next fetch dos cluster", "") FI; + enable stop; + IF was last fetch cluster + THEN error stop ("fetch nach Dateiende") + FI; + IF fetch rest < real (cluster size) + THEN cat cluster text (next fetch cluster, buffer, int (fetch rest)); + fetch rest := 0.0 + ELSE cat cluster text (next fetch cluster, buffer, cluster size); + fetch rest DECR real (cluster size) + FI; + last access time := clock (1); + next fetch cluster := fat entry (next fetch cluster). + +END PROC cat next fetch dos cluster; + +PROC read next fetch dos cluster (DATASPACE VAR read ds, INT VAR start page): + IF log flag THEN dump ("read next fetch dos cluster", start page) FI; + enable stop; + IF was last fetch cluster + THEN error stop ("fetch nach Dateiende") + FI; + read disk cluster (read ds, start page, next fetch cluster); + last access time := clock (1); + start page INCR sectors per cluster; + next fetch cluster := fat entry (next fetch cluster); + IF fetch rest < real (cluster size) + THEN fetch rest := 0.0 + ELSE fetch rest DECR real (cluster size) + FI. + +END PROC read next fetch dos cluster; + +PROC close fetch dos file: + IF log flag THEN dump ("close fetch dos file", "") FI; + +END PROC close fetch dos file; + +(*-------------------------------------------------------------------------*) + +TEXT VAR save name; +REAL VAR first save cluster, + last save cluster, + save size; + +PROC open save dos file (TEXT CONST file name): + IF log flag THEN dump ("open save dos file", file name) FI; + enable stop; + access dos disk; + IF file exists (file name) OR subdir exists (file name) + THEN error stop ("die Datei """ + file name + """ gibt es schon") + FI; + save name := file name; + first save cluster := -1.0; + save size := 0.0. + +END PROC open save dos file; + +PROC write next save dos cluster (TEXT CONST buffer): + IF log flag THEN dump ("write next save dos cluster", "") FI; + enable stop; + REAL CONST save cluster := available fat entry; + write text to cluster (save cluster, buffer); + last access time := clock (1); + save size INCR real (LENGTH buffer); + IF first save cluster < 2.0 + THEN first save cluster := save cluster + ELSE fat entry (last save cluster, save cluster) + FI; + fat entry (save cluster, last fat chain entry); + last save cluster := save cluster. + +END PROC write next save dos cluster; + +PROC write next save dos cluster (DATASPACE CONST save ds, INT VAR start page): + IF log flag THEN dump ("write next save dos cluster", start page) FI; + enable stop; + REAL CONST save cluster := available fat entry; + write disk cluster (save ds, start page, save cluster); + last access time := clock (1); + start page INCR sectors per cluster; + save size INCR real (cluster size); + IF first save cluster < 2.0 + THEN first save cluster := save cluster + ELSE fat entry (last save cluster, save cluster) + FI; + fat entry (save cluster, last fat chain entry); + last save cluster := save cluster. + +END PROC write next save dos cluster; + +PROC close save dos file: + IF log flag THEN dump ("close save dos file", "") FI; + enable stop; + IF first save cluster < 2.0 + THEN LEAVE close save dos file + FI; + fat entry (last save cluster, last fat chain entry); + write fat; + insert dir entry (save name, first save cluster, save size); + last access time := clock (1). + +END PROC close save dos file; + +(*-------------------------------------------------------------------------*) + +PROC erase dos file (TEXT CONST file name): + IF log flag THEN dump ("erase dos file", file name) FI; + enable stop; + access dos disk; + REAL VAR first cluster, size; + file info (file name, first cluster, size); + delete dir entry (file name); + erase fat chain (first cluster); + write fat; + last access time := clock (1). + +END PROC erase dos file; + +(*-------------------------------------------------------------------------*) + +THESAURUS PROC all dosfiles: + IF log flag THEN dump ("all dosfile", "") FI; + enable stop; + access dos disk; + all files. + +END PROC all dosfiles; + +THESAURUS PROC all dossubdirs: + IF log flag THEN dump ("all subdirs", "") FI; + enable stop; + access dos disk; + all subdirs. + +END PROC all dossubdirs; + +BOOL PROC dos file exists (TEXT CONST file name): + IF log flag THEN dump ("dos file exists", file name) FI; + enable stop; + access dos disk; + file exists (file name). + +END PROC dos file exists; + +PROC dos list (DATASPACE VAR list ds): + IF log flag THEN dump ("dos list", "") FI; + enable stop; + access dos disk; + dir list (list ds). + +END PROC dos list; + +(*-------------------------------------------------------------------------*) + +PROC clear dos disk: + IF log flag THEN dump ("clear dos disk", "") FI; + enable stop; + IF hd version + THEN error stop ("nicht implementiert") + ELSE access dos disk; + format dir; + format fat; + last access time := clock (1) + FI. + +END PROC clear dos disk; + +PROC format dos disk (INT CONST format code): + + IF log flag THEN dump ("format dos disk (" + text (format code) + ")", "") FI; + enable stop; + IF NOT disk open + THEN error stop ("DOS-Arbeit nicht eröffnet") + FI; + IF hd version + THEN error stop ("nicht implementiert") + ELSE do format + FI. + +do format: + IF bpb exists (format code) + THEN close work; + format archive (format code); + open eu disk; + write bpb (format code); + open dos disk; + format dir; (* enthält 'open dir' *) + format fat; (* enthält 'read fat' *) + open work + ELSE error stop ("Format unzulässig") + FI; + last access time := clock (1). + +END PROC format dos disk; + +END PACKET dos get put; + diff --git a/system/dos/1.8.7/src/insert.dos b/system/dos/1.8.7/src/insert.dos new file mode 100644 index 0000000..14f98cd --- /dev/null +++ b/system/dos/1.8.7/src/insert.dos @@ -0,0 +1,14 @@ +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/system/dos/1.8.7/src/konvert b/system/dos/1.8.7/src/konvert new file mode 100644 index 0000000..c5c4c43 --- /dev/null +++ b/system/dos/1.8.7/src/konvert @@ -0,0 +1,75 @@ +PACKET konvert DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + (* 28.10.86 *) + high byte, + low byte, + word, + change low byte, + change high byte, + dint, + high word, + low word: + +INT PROC high byte (INT CONST value): + TEXT VAR x := " "; + replace (x, 1, value); + code (x SUB 2) + +END PROC high byte; + +INT PROC low byte (INT CONST value): + TEXT VAR x := " "; + replace (x, 1, value); + code (x SUB 1) + +END PROC low byte; + +INT PROC word (INT CONST low byte, high byte): + TEXT CONST x :: code (low byte) + code (high byte); + x ISUB 1 + +END PROC word; + +PROC change low byte (INT VAR word, INT CONST low byte): + TEXT VAR x := " "; + replace (x, 1, word); + replace (x, 1, code (low byte)); + word := x ISUB 1 + +END PROC change low byte; + +PROC change high byte (INT VAR word, INT CONST high byte): + TEXT VAR x := " "; + replace (x, 1, word); + replace (x, 2, code (high byte)); + word := x ISUB 1 + +END PROC change high byte; + +REAL PROC dint (INT CONST low word, high word): + real low word + 65536.0 * real high word. + +real low word: + real (low byte (low word)) + 256.0 * real (high byte (low word)). + +real high word: + real (low byte (high word)) + 256.0 * real (high byte (high word)). + +END PROC dint; + +INT PROC high word (REAL CONST double precission int): + int (double precission int / 65536.0) + +END PROC high word; + +INT PROC low word (REAL CONST double precission int): + string of low bytes ISUB 1. + +string of low bytes: + code (int (double precission int MOD 256.0)) + + code (int ((double precission int MOD 65536.0) / 256.0)). + +END PROC low word; + +END PACKET konvert; + diff --git a/system/dos/1.8.7/src/manager-M.dos b/system/dos/1.8.7/src/manager-M.dos new file mode 100644 index 0000000..e27c513 --- /dev/null +++ b/system/dos/1.8.7/src/manager-M.dos @@ -0,0 +1,211 @@ +PACKET dos manager multi DEFINES (* Copyright (C) 1985, 86, 87 *) + (* Frank Klapper *) + provide channel, (* 16.10.87 *) + dos manager: + +LET std archive channel = 31, + + ack = 0, + second phase ack = 5, + false code = 6, + + fetch code = 11, + save code = 12, + exists code = 13, + erase code = 14, + list code = 15, + all code = 17, + clear code = 18, + reserve code = 19, + free code = 20, + check read code = 22, + format code = 23, + + log code = 78, + + quote = """"; + +BOUND STRUCT (TEXT name, pass) VAR msg; + +TASK VAR order task; + +INT VAR dos channel; + +INT VAR fetch save modus; + +REAL VAR last access time := 0.0; + +TASK VAR disk owner := niltask; + +TEXT VAR save file name; + +PROC provide channel (INT CONST channel): + dos channel := channel + +END PROC provide channel; + +IF hd version + THEN provide channel (29) + ELSE provide channel (std archive channel) +FI; + +PROC dos manager: + dos manager (dos channel) + +END PROC dos manager; + +PROC dos manager (INT CONST channel): + dos channel := channel; + task password ("-"); + global manager + (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager) + +END PROC dos manager; + +PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase, + TASK CONST from task): + enable stop; + order task := from task; + msg := ds; + IF NOT (order task = disk owner) AND + order code <> free code AND order code <> reserve code + THEN errorstop ("DOS nicht angemeldet") + FI; + IF order task = disk owner + THEN last access time := clock (1) + FI; + SELECT order code OF + CASE fetch code : fetch file + CASE save code : save file + CASE erase code : erase file + CASE clear code : clear disk + CASE exists code : exists file + CASE list code : list disk + CASE all code : deliver directory + CASE reserve code : reserve + CASE free code : free + CASE check read code: check + CASE format code : format + CASE log code : send log + OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself)) + END SELECT. + +fetch file: + fetch (dos name (msg.name, read modus), ds, fetch save modus); + manager ok (ds). + +check: + check file (dos name (msg.name, read modus)); + manager message (expanded name (msg.name, read modus) + " ohne Fehler gelesen"). + +format: + IF phase = 1 + THEN manager question ("Diskette formatieren") + ELSE format dos disk (int (msg.name)); + manager ok (ds) + FI. + +save file: + IF phase = 1 + THEN save first phase + ELSE save second phase + FI. + +save first phase: + save file name := dos name (msg.name, write modus); + IF dos file exists (save file name) + THEN manager question (expanded name (msg.name, write modus) + " auf der MS-DOS Disk ueberschreiben") + ELSE send (order task, second phase ack, ds) + FI. + +save second phase: + IF dos file exists (save file name) + THEN erase dos file (save file name) + FI; + save (save file name, ds, fetch save modus); + forget (ds) ; + ds := nilspace ; + manager ok (ds). + +clear disk: + IF phase = 1 + THEN manager question ("Diskette loeschen") + ELSE clear dos disk; + manager ok (ds) + FI. + +erase file: + IF dos file exists (dos name (msg.name, read modus)) + THEN IF phase = 1 + THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen") + ELSE erase dos file (dos name (msg.name, read modus)); + manager ok (ds) + FI + ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk") + FI. + +exists file: + IF dos file exists (dos name (msg.name, read modus)) + THEN manager ok (ds) + ELSE send (order task, false code, ds) + FI. + +list disk: + dos list (ds); + manager ok (ds). + +send log: + forget (ds); + ds := old ("logbuch"); + manager ok (ds). + +deliver directory: + forget (ds); + ds := nilspace; + BOUND THESAURUS VAR all names := ds; + all names := all dos files; + manager ok (ds). + +reserve: + IF reserve or free permitted + THEN continue channel (dos channel); + disk owner := from task; + fetch save modus := save fetch mode (msg.name); + open dos disk (path (msg.name)); + forget ("logbuch", quiet); + manager ok (ds) + ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt") + FI. + +reserve or free permitted : + from task = disk owner OR last access more than five minutes ago + OR disk owner = niltask OR NOT + (exists (disk owner) OR station(disk owner) <> station (myself)). + +last access more than five minutes ago : + abs (last access time - clock (1)) > 300.0. + +free: + IF reserve or free permitted + THEN close dos disk; + disk owner := niltask; + break (quiet); + manager ok (ds) + ELSE manager message ("DOS nicht angemeldet") + FI. + +END PROC dos manager; + +PROC manager ok (DATASPACE VAR ds): + send (order task, ack, ds); + last access time := clock (1). + +END PROC manager ok; + +TEXT PROC expanded name (TEXT CONST name, BOOL CONST status): + text (quote + dos name (name, status) + quote, 14) + +END PROC expanded name; + +END PACKET dos manager multi; + diff --git a/system/dos/1.8.7/src/manager-S.dos b/system/dos/1.8.7/src/manager-S.dos new file mode 100644 index 0000000..23885e6 --- /dev/null +++ b/system/dos/1.8.7/src/manager-S.dos @@ -0,0 +1,268 @@ +PACKET dos single DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + (* 11.09.87 *) + /, + dos, + provide dos channel, + archive, + reserve, + release, + save, + fetch, + erase, + check, + exists, + ALL, + SOME, + clear, + list, + format: + +LET std archive channel = 31, + main channel = 1; + +INT VAR dos channel := std archive channel; +INT VAR fetch save modus; + +TYPE DOSTASK = TEXT; + +DOSTASK CONST dos := "DOS"; + +OP := (DOSTASK VAR d, TEXT CONST t): + CONCR (d) := t + +END OP :=; + +DOSTASK OP / (TEXT CONST text): + DOSTASK VAR d; + CONCR (d) := text; + d + +END OP /; + +BOOL PROC is dostask (DOSTASK CONST d): + CONCR (d) = "DOS" + +END PROC is dos task; + +PROC provide dos channel (INT CONST channel no): + dos channel := channel no + +END PROC provide dos channel; + +DATASPACE VAR space := nilspace; +forget (space); + +PROC reserve (TEXT CONST string, DOSTASK CONST task): + IF is dostask (task) + THEN fetch save modus := save fetch mode (string); + open dos disk (path (string)) + ELSE error stop ("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 is dos task (task) + THEN close dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +END PROC release; + +PROC fetch (TEXT CONST name, DOSTASK CONST from): + IF is dostask (from) + THEN fetch from dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +fetch from dos disk: + IF NOT exists (name) COR overwrite permitted + THEN do fetch + FI. + +overwrite permitted: + say ("eigene Datei """) ; + say (name) ; + yes (""" auf der Diskette ueberschreiben"). + +do fetch: + last param (name); + disable stop; + continue (dos channel); + fetch (dos name (name, read modus), space, fetch save modus); + continue (main channel); + IF NOT is error + THEN forget (name, quiet); + copy (space, name) + FI; + forget (space). + +END PROC fetch; + +PROC erase (TEXT CONST name, DOSTASK CONST task): + IF is dos task (task) + THEN do erase dos file + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +do erase dos file: + IF NOT exists (name, /"DOS") + THEN error stop ("die Datei """ + name + """ gibt es nicht") + ELIF yes ("""" + dos name (name, read modus)+ """ auf Der Diskette loeschen") + THEN disable stop; + continue (dos channel); + erase dos file (dos name (name, read modus)); + continue (main channel) + FI. + +END PROC erase; + +PROC save (TEXT CONST name, DOSTASK CONST task): + IF is dos task (task) + THEN save to dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +save to dos disk: + TEXT CONST save file name :: dos name (name, write modus); + disable stop; + continue (dos channel); + IF NOT dos file exists (save file name) COR overwrite permitted + THEN IF dos file exists (save file name) + THEN erase dos file (save file name) + FI; + save (save file name, old (name), fetch save modus); + FI; + continue (main channel). + +overwrite permitted: + continue (main channel); + BOOL CONST result :: yes ("""" + save file name + """ auf der Diskette ueberschreiben"); + continue (dos channel); + result. + +END PROC save; + +PROC check (TEXT CONST name, DOSTASK CONST from): + IF is dostask (from) + THEN disable stop; + continue (dos channel); + check file (dos name (name, read modus)); + continue (main channel) + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +END PROC check; + +BOOL PROC exists (TEXT CONST name, DOSTASK CONST task): + IF is dos task (task) + THEN disable stop; + continue (dos channel); + BOOL VAR dummy := dos file exists (dos name (name, read modus)); + continue (main channel); + enable stop; + dummy + ELSE error stop ("die angesprochene Task existiert nicht"); FALSE + FI. + +END PROC exists; + +PROC list (DOSTASK CONST from): + forget (space); + space := nilspace; + FILE VAR list file := sequential file (output, space); + list (list file, from); + modify (list file); + show (list file); + forget (space). + +ENDPROC list; + +PROC list (FILE VAR list file, DOSTASK CONST from): + IF is dos task (from) + THEN list dos disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +list dos disk: + disable stop; + continue (dos channel); + dos list (space); + continue (main channel); + enable stop; + output (list file); + FILE VAR list source := sequential file (output, space); + TEXT VAR line; + WHILE NOT eof (list source) REP + getline (list source, line); + putline (list file, line) + PER. + +END PROC list; + +THESAURUS OP ALL (DOSTASK CONST task): + IF is dos task (task) + THEN disable stop; + continue (dos channel); + THESAURUS VAR dummy := all dos files; + continue (main channel); + enable stop; + dummy + ELSE error stop ("die angesprochene Task existiert nicht"); empty thesaurus + FI. + +END OP ALL; + +THESAURUS OP SOME (DOSTASK CONST task): + IF is dos task (task) + THEN disable stop; + continue (dos channel); + THESAURUS VAR dummy := all dos files; + continue (main channel); + enable stop; + SOME dummy + ELSE error stop ("die angesprochene Task existiert nicht"); empty thesaurus + FI. + +END OP SOME; + +PROC clear (DOSTASK CONST task): + IF is dos task (task) + THEN clear disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +clear disk: + disable stop; + IF yes ("Diskette loeschen") + THEN continue (dos channel); + clear dos disk; + continue (main channel) + FI. + +END PROC clear; + +PROC format (INT CONST format code, DOSTASK CONST task): + IF is dos task (task) + THEN format disk + ELSE error stop ("die angesprochene Task existiert nicht") + FI. + +format disk: + disable stop; + IF yes ("Diskette formatieren") + THEN continue (dos channel); + format dos disk (format code); + continue (main channel) + FI. + +END PROC format; + +END PACKET dos single; + diff --git a/system/dos/1.8.7/src/name conversion.dos b/system/dos/1.8.7/src/name conversion.dos new file mode 100644 index 0000000..e72d838 --- /dev/null +++ b/system/dos/1.8.7/src/name conversion.dos @@ -0,0 +1,77 @@ +PACKET name conversion DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + dos name, (* 31.12.86 *) + + read modus, + write modus: + +BOOL CONST read modus :: TRUE, + write modus :: NOT read modus; + +LET upper case chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&§!()-{}`_", + lower case chars = "abcdefghijklmnopqrstuvwxyz"; + +TEXT PROC dos name (TEXT CONST eu name, BOOL CONST read write modus): + enable stop; + INT CONST point pos :: pos (eu name, "."); + IF name extension exists + THEN changed name with extension + ELSE changed name without extension + FI. + +name extension exists: + point pos > 0. + +changed name with extension: + TEXT CONST name pre :: compress (subtext (eu name, 1, point pos - 1)), + name post :: compress (subtext (eu name, point pos + 1)); + IF LENGTH name pre = 0 OR LENGTH name pre > 8 OR LENGTH name post > 3 + THEN error + FI; + IF LENGTH name post = 0 + THEN new name (name pre, read write modus) + ELSE new name (name pre, read write modus) + "." + + new name (name post, read write modus) + FI. + +changed name without extension: + IF LENGTH eu name > 8 OR LENGTH euname < 1 + THEN error + FI; + new name (eu name, read write modus). + +error: + error stop ("Unzulässiger Name"). + +END PROC dos name; + +TEXT PROC new name (TEXT CONST old name, BOOL CONST read write modus): + TEXT VAR new := ""; + INT VAR count; + FOR count FROM 1 UPTO LENGTH old name REP + convert char + PER; + new. + +convert char: + TEXT CONST char :: old name SUB count; + IF is lower case char + THEN new CAT (upper case chars SUB string pos) + ELIF is upper case char OR read write modus + THEN new CAT char + ELSE error stop ("Unzulässiger Name") + FI. + +is lower case char: + pos (lower case chars, char) > 0. + +is upper case char: + pos (upper case chars, char) > 0. + +string pos: + pos (lower case chars, char). + +END PROC new name; + +END PACKET name conversion; + diff --git a/system/dos/1.8.7/src/open b/system/dos/1.8.7/src/open new file mode 100644 index 0000000..518c4b8 --- /dev/null +++ b/system/dos/1.8.7/src/open @@ -0,0 +1,66 @@ +PACKET open DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + open work, (* 05.01.87 *) + close work, + work opened, + work closed, + init check rerun, + check rerun, + + hd version: + +BOOL VAR open; +INT VAR old session; + +BOOL VAR hd flag := FALSE; + +INITFLAG VAR packet := FALSE; + +PROC open work: + open := TRUE + +END PROC open work; + +PROC close work: + open := FALSE + +END PROC close work; + +BOOL PROC work opened: + IF NOT initialized (packet) + THEN close work + FI; + open + +END PROC work opened; + +BOOL PROC work closed: + NOT work opened + +END PROC work closed; + +PROC init check rerun: + old session := session + +END PROC init check rerun; + +PROC check rerun: + IF session <> old session + THEN close work; + error stop ("Diskettenzugriff im RERUN") + FI. + +END PROC check rerun; + +PROC hd version (BOOL CONST status): + hd flag := status + +END PROC hd version; + +BOOL PROC hd version: + hd flag + +END PROC hd version; + +END PACKET open; + diff --git a/system/dos/1.8.7/src/save b/system/dos/1.8.7/src/save new file mode 100644 index 0000000..7e67e91 --- /dev/null +++ b/system/dos/1.8.7/src/save @@ -0,0 +1,233 @@ +PACKET save DEFINES (* Copyright (C) 1985, 86, 87 *) + (* Frank Klapper *) + (* 27.04.87 *) + save: + +LET ascii = 1, + ascii german = 2, + transparent = 3, + row text = 5, + ds = 6, + atari st = 10, + ibm = 11, + + ff = ""12"", + ctrl z = ""26"", + cr lf = ""13""10"", + + row text mode length = 4000; + +TEXT VAR buffer; + +BOUND STRUCT (INT size, + ROW row text mode length TEXT cluster row) VAR cluster struct; + +PROC save (TEXT CONST file name, DATASPACE CONST file ds, INT CONST mode): + + SELECT mode OF + CASE ascii, ascii german, atari st, ibm, transparent: + save filemode (file ds, filename, mode) + CASE row text : save row textmode (file ds, filename) + CASE ds : save dsmode (file ds, filename) + OTHERWISE error stop ("Unzulässige Betriebsart") + END SELECT. + +END PROC save; + +PROC save filemode (DATASPACE CONST file space, TEXT CONST name, INT CONST code type): + + enable stop; + open save dos file (name); + FILE VAR file := sequential file (modify, file space); + buffer := ""; + INT VAR line no; + FOR line no FROM 1 UPTO lines (file) REP + to line (file, line no); + buffer cat file line; + WHILE length (buffer) >= cluster size REP + write next save dos cluster (subtext (buffer, 1, cluster size)); + buffer := subtext (buffer, cluster size + 1) + PER + PER; + IF ascii code + THEN buffer CAT ctrl z + FI; + write rest; + close save dos file; + buffer := "". + +buffer cat file line: + exec (PROC (TEXT CONST, INT CONST) cat adapted line, file, code type). + +ascii code: + (code type = ascii) OR (code type = ascii german). + +write rest: + WHILE buffer <> "" + REP write next save dos cluster (subtext (buffer, 1, cluster size)); + buffer := subtext (buffer, cluster size + 1) + PER. + +END PROC save filemode; + +PROC cat adapted line (TEXT VAR line, INT CONST code type): + + IF code type = transparent + THEN buffer CAT line + ELSE change esc sequences; + change eumel print chars; + SELECT code type OF + CASE ascii : ascii change + CASE ascii german: ascii german change + CASE atari st : atari st change + CASE ibm : ibm change + END SELECT; + buffer CAT line; + IF (line SUB length (line)) <> ff + THEN buffer CAT cr lf + FI + FI. + +change esc sequences: + change all (line, "#page#", ff); + INT VAR p := pos (line, "#"); + WHILE p > 0 REP + IF is esc sequence + THEN change (line, p, p+4, coded char) + FI; + p := pos (line, "#", p+1) + PER. + +is esc sequence: + LET digits = "0123456789"; + (line SUB (p+4)) = "#" CAND pos (digits, line SUB p+1) > 0 CAND + pos (digits, line SUB p+2) > 0 CAND pos (digits, line SUB p+3) > 0. + +coded char: + code (int (subtext (line, p+1, p+3))). + +change eumel print chars: + p := pos (line, ""220"", ""223"", 1); + WHILE p > 0 REP + replace (line, p, std char); + p := pos (line, ""220"", ""223"", p + 1) + PER. + +std char: + "k-# " SUB (code (line SUB p) - 219). + +ascii change: + change all (line, "ß", "#251#"); + p := pos (line, "Ä", "ü", 1); + WHILE p > 0 REP + change (line, p, p, ersatzdarstellung (line SUB p)); + p := pos (line, "Ä", "ü", p + 1) + PER. + +ascii german change: + change all (line, "[", "#091#"); + change all (line, "\", "#092#"); + change all (line, "]", "#093#"); + change all (line, "{", "#123#"); + change all (line, "|", "#124#"); + change all (line, "}", "#125#"); + change all (line, "~", "#126#"); + change all (line, "ß", ""126""); + p := pos (line, "Ä", "ü", 1); + WHILE p > 0 REP + replace (line, p, umlaut in ascii german); + p := pos (line, "Ä", "ü", p + 1) + PER. + +umlaut in ascii german: + "[\]{|}" SUB (code (line SUB p) - 213). + +ibm change: + change all (line, "ß", ""225""); + p := pos (line, "Ä", "ü", 1); + WHILE p > 0 REP + replace (line, p, umlaut in ibm); + p := pos (line, "Ä", "ü", p + 1) + PER. + +atari st change: + change all (line, "ß", ""158""); + p := pos (line, "Ä", "ü", 1); + WHILE p > 0 REP + replace (line, p, umlaut in ibm); + p := pos (line, "Ä", "ü", p + 1) + PER. + +umlaut in ibm: + ""142""153""154""132""148""129"" SUB (code (line SUB p) - 213). + +END PROC cat adapted line; + +TEXT PROC ersatzdarstellung (TEXT CONST char): + + TEXT CONST t :: text (code (char SUB 1)); + "#" + (3 - length (t)) * "0" + t + "#" + +END PROC ersatzdarstellung; + +PROC save rowtextmode (DATASPACE CONST space, TEXT CONST name): + + enable stop; + open save dos file (name); + init save row textmode; + WHILE line no < cluster struct.size REP + fill buffer; + write next save dos cluster (subtext (buffer, 1, cluster size)); + remember rest + PER; + write rest; + close save dos file; + buffer := "". + +init save rowtextmode: + cluster struct := space; + buffer := ""; + INT VAR line no := 0. + +fill buffer: + WHILE line no < cluster struct.size AND NOT buffer full REP + line no INCR 1; + buffer CAT cluster struct.cluster row [line no] + PER. + +buffer full: + LENGTH buffer >= cluster size. + +remember rest: + buffer := subtext (buffer, cluster size + 1). + +write rest: + WHILE buffer <> "" + REP write next save dos cluster (subtext (buffer, 1, cluster size)); + remember rest + PER. + +END PROC save rowtextmode; + +PROC save ds mode (DATASPACE CONST out ds, TEXT CONST name): + + enable stop; + open save dos file (name); + INT VAR page no := first non dummy ds page; + get last allocated ds page; + WHILE page no <= last allocated ds page REP + write next save dos cluster (out ds, page no); + PER; + close save dos file. + +get last allocated ds page: + INT VAR last allocated ds page := -1, + i; + FOR i FROM 1 UPTO ds pages (out ds) REP + last allocated ds page := next ds page (out ds, last allocated ds page) + PER. + +END PROC save ds mode; + +END PACKET save; + diff --git a/system/dos/1.8.7/src/shard interface b/system/dos/1.8.7/src/shard interface new file mode 100644 index 0000000..20d9b76 --- /dev/null +++ b/system/dos/1.8.7/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/system/eumel-coder/1.8.0/src/eumel coder 1.8.0 b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0 new file mode 100644 index 0000000..d9f489f --- /dev/null +++ b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0 @@ -0,0 +1,2594 @@ +PACKET eumel coder (* Autor: U. Bartling *) + DEFINES coder on, coder off, + declare, define, apply, identify, + :=, =, + dump, + + LABEL, + gosub, goret, + complement condition code, + + ADDRESS , + GLOB, LOC, REF, DEREF, + ref length, + +, + adjust, + is global, is local, is ref, + + DTYPE, + type class, type name, + void type, int type, real type, text type, bool type, + dataspace type, undefined type, + row type, struct type, proc type, end type, + + OPN, + set length of local storage, + begin module, end module, + is proc, is eumel 0 instruction, + address, operation, + nop, + init op codes, + mnemonic, + + parameter, + next param, + NEXTPARAM, + access , + dtype , + param address, + same type , + + reserve storage, + allocate denoter , + allocate variable, + data allocation by coder , + data allocation by user, + + run, run again, + insert, + prot, prot off, + check, check on, check off, + + help, bulletin, packets : + +(**************************************************************************) +(* *) +(* E U M E L - C O D E R *) +(* *) +(* *) +(* Zur Beschreibung des Coders siehe *) +(* U.Bartling, J. Liedtke: EUMEL-Coder-Interface *) +(* *) +(* Stand der Dokumentation : 13.02.1986 *) +(* Stand der Implementation : 21.03.1986 *) +(* *) +(* *) +(**************************************************************************) + + + (***** Globale Variable *****) + +TEXT VAR object name; + +FILE VAR bulletin file; + +INT VAR memory management mode, global address offset, hash table pointer, + nt link, permanent pointer, param link, index, mode, field pointer, + word, number of errors := 0 ; + +BOOL VAR found, end of params; + +#page# +(**************************************************************************) +(* *) +(* 1. Interface zum ELAN-Compiler 12.03.1986 *) +(* 1.7.5.4 *) +(* *) +(* Beschreibung der Tabellen (-groessen), *) +(* internen Vercodung von Typen *) +(* und Kennungen . *) +(* Initialisieren und Beenden des Compilers, *) +(* Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle *) +(* *) +(**************************************************************************) + + +LET begin of hash table = 0 , + end of hash table = 1023 , + + begin of permanent table = 22784 , + before first pt entry = 22784 , + first permanent entry = 22785 , + end of permanent table = 32767 , + + wordlength = 1 , (* compile u n d run time *) + two word length = 2 , + three word length = 3 , + four word length = 4 , + + permanent param const = 10000 , + permanent param var = 20000 , + permanent proc op = 30000 , + permanent type = 30000 , + permanent row = 10 , + permanent struct = 11 , + permanent param proc = 12 , +(* permanent param proc end marker = 0 , *) + permanent type field = 0 , + + ptt limit = 10000 , + begin of pt minus ptt limit = 12784 , + offset to row size = 12785 , + + void = 0 , + int = 1 , + real = 2 , + string = 3 , + bool = 5 , + bool result = 6 , + dataspace = 7 , + undefined = 9 , + row = 10 , + struct = 11 , + end = 0 , + + const = 1 , + var = 2 , +(* proc = 3 , *) +(* denoter = 5 , *) + bold = 2 , + + ins = TRUE , + no ins = FALSE , + no lst = FALSE , + sermon = TRUE , + no sermon = FALSE , + + run again mode = 0 , + compile file mode = 1 , + prep coder mode = 5 , + + warning message = 2 , + error message = 4 , + + point line = "..............." ; + +INT CONST permanent packet := -2 , + permanent end := -3 ; + +BOOL VAR coder active := FALSE ; + +INT VAR run again mod nr := 0 ; + + + (***** Start/Ende *****) + +LET invalid coder off = "CODER not active" ; + +PROC coder on (INT CONST data allocation mode) : + mark coder on ; + init memory management ; + init opn section ; + init compiler . + +mark coder on : + coder active := TRUE . + +init memory management : + memory management mode := data allocation mode ; + prep pbase (global address offset) . + +init compiler : + no do again ; + elan (prep coder mode, bulletin file, "", run again mod nr, + no ins, no lst, check option, no sermon) + +ENDPROC coder on; + +PROC coder off (BOOL CONST insert, sermon, OPN CONST start proc) : + IF coder active + THEN mark coder off ; + end coder (insert, sermon, start mod nr if no insert) + ELSE errorstop (invalid coder off) + FI . + +start mod nr if no insert : + IF insert THEN run again mod nr := 0 + ELSE run again mod nr := start proc.mod nr + FI ; + run again mod nr . + +mark coder off : + reset memory management mode ; + init opn section ; + coder active := FALSE +ENDPROC coder off ; + +PROC end coder (BOOL CONST insert wanted, sermon wanted, INT CONST mod) : + EXTERNAL 10021 +ENDPROC end coder ; + +PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, + INT VAR start module number, BOOL CONST ins, lst, rtc, ser) : + EXTERNAL 256 +ENDPROC elan ; + + (***** Hash/Namenstabelle *****) +. +next hash entry : + hash table pointer INCR wordlength . + +end of hash table reached : + hash table pointer > end of hash table . + +yet another nt entry : + nt link := cdb int (nt link) ; + nt link <> 0 . ; + +PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : + EXTERNAL 10031 +ENDPROC declare object ; + +PROC to object (TEXT CONST searched object) : + hash ; + search nt entry . + +hash : + hash code := 0 ; + FOR index FROM 1 UPTO LENGTH searched object REP + addmult cyclic + ENDREP . + +addmult cyclic : + hash code INCR hash code ; + IF hash code > end of hash table THEN wrap around FI ; + hash code := (hash code + code (searched object SUB index)) MOD 1024 . + +wrap around : + hash code DECR end of hash table . + +hash code : nt link . + +search nt entry : + found := FALSE ; + WHILE yet another nt entry REP + read current entry ; + IF object name = searched object + THEN found := TRUE ; + LEAVE to object + FI + PER . + +read current entry : + permanent pointer := cdb int (nt link + wordlength) ; + object name := cdb text (nt link + two word length) +ENDPROC to object ; + + + (***** Permanent Tabelle *****) +. +next procedure : + permanent pointer := cdb int (permanent pointer) . ; + +PROC next pt param : + mode := cdb int (param link) MOD ptt limit ; + param link INCR wordlength ; + IF mode = permanent row THEN skip over permanent row + ELIF mode = permanent struct THEN skip over permanent struct + FI ; + set end marker if end of list . + +skip over permanent row : + param link INCR wordlength ; + next pt param . + +skip over permanent struct : + REP + next pt param ; + mode := cdb int (param link) + UNTIL mode = permanent type field PER ; + param link INCR wordlength +ENDPROC next pt param ; + +PROC set end marker if end of list : + mode := cdb int (param link) ; + end of params := mode >= permanent proc op OR mode <= 0 +ENDPROC set end marker if end of list ; + +PROC get type and mode (INT VAR type) : + mode := cdb int (param link) ; + IF mode = permanent param proc THEN type of param proc + ELSE type of object + FI . + +type of param proc : + param link INCR wordlength ; + get type and mode (type) ; + mode := permanent param proc . + +type of object : + IF mode < 0 THEN type := 2769 + (32767 + mode) ; + mode := 0 + ELSE type := mode MOD ptt limit ; + mode DECR type ; + translate type if necessary ; + translate mode if necessary + FI . + +translate type if necessary : + IF permanent row or struct THEN translate type FI . + +translate type : + type := param link - begin of pt minus ptt limit . + +translate mode if necessary : + IF mode = permanent param const THEN mode := const + ELIF mode = permanent param var THEN mode := var + FI . + +permanent row or struct : + type = permanent row OR type = permanent struct +ENDPROC get type and mode ; + + + (***** Allgemeine Zugriffsprozeduren *****) + +INT PROC cdb int (INT CONST index) : + EXTERNAL 116 +ENDPROC cdb int ; + +TEXT PROC cdb text (INT CONST index) : + EXTERNAL 117 +ENDPROC cdb text ; + + +#page# +(**************************************************************************) +(* *) +(* 2. Spruenge und Marken 07.03.1986 *) +(* *) +(* Definition des Datentyps LABEL *) +(* *) +(* Deklaration, Definition und Applikation von Marken *) +(* *) +(**************************************************************************) + + +TYPE LABEL = INT ; + +BOOL VAR invers :: FALSE ; + +PROC declare (LABEL VAR label) : + CONCR (label) := 0 +ENDPROC declare ; + +PROC define (LABEL VAR label) : + EXTERNAL 10084 +ENDPROC define ; + +PROC complement condition code : + invers := TRUE +ENDPROC complement condition code ; + +PROC apply (LABEL VAR label) : + EXTERNAL 10149 +ENDPROC apply ; + +PROC apply (LABEL VAR label, BOOL CONST condition) : + IF condition xor invers THEN branch true (label) + ELSE branch false (label) + FI ; + invers := FALSE . + +condition xor invers : + IF condition THEN NOT invers + ELSE invers + FI +ENDPROC apply ; + +OP := (LABEL VAR global label, local label) : (* EQUATE ! *) + EXTERNAL 10014 +ENDOP := ; + +TEXT PROC dump (LABEL CONST label) : + "LAB " + text (CONCR (label)) +ENDPROC dump ; + +PROC gosub (LABEL VAR label) : + EXTERNAL 10015 +ENDPROC gosub ; + +PROC goret : + s0 (q goret code) +ENDPROC goret ; + +PROC branch true (LABEL VAR label) : + EXTERNAL 10028 +ENDPROC branch true ; + +PROC branch false (LABEL VAR label) : + EXTERNAL 10029 +ENDPROC branch false ; + + +#page# +(**************************************************************************) +(* *) +(* 3. Datenaddressen 21.03.1986 *) +(* *) +(* Definition des Datentyps ADDRESS *) +(* *) +(* Aufbau von Datenaddressen (Vercodung) *) +(* Fortschalten und Ausrichten von Adressen *) +(* Bereitstellen der Fehlermeldung "address overflow" (Coder-intern) *) +(* *) +(**************************************************************************) + + + +TYPE ADDRESS = STRUCT (INT kind, value) ; + +LET global = 0 , + local = 1 , + ref mask = 2 , + global ref = 2 , + local ref = 3 , + module nr = 4 , + immediate value = 5 , + + eumel0 stack offset = 4 , + local address limit = 16 384 , + + illegal ref operation = "REF not allowed" , + deref on non ref = "DEREF on non-ref address" , + global ref not allowed = "GLOBAL REF not allowed" , + unknown kind = "Unknown address kind" , + address overflow = "Address Overflow" , + illegal plus operation = "+ not allowed" ; + +ADDRESS VAR result addr; + +INT CONST ref length :: 2 ; + +OP := (ADDRESS VAR l, ADDRESS CONST r) : + CONCR (l) := CONCR (r) +ENDOP := ; + +ADDRESS OP GLOB (INT CONST address level) : + result addr.kind := global ; + result addr.value := address level ; + IF memory management mode = data allocation by user + THEN result addr.value INCR global address offset + FI ; + result addr +ENDOP GLOB ; + +ADDRESS OP LOC (INT CONST address level) : + result addr.kind := local ; + result addr.value := address level + eumel0 stack offset ; + result addr +ENDOP LOC ; + +ADDRESS OP REF (ADDRESS CONST addr) : + CONCR (result addr) := CONCR (addr) ; + IF result addr.kind = local THEN result addr.kind INCR ref mask + ELIF result addr.kind = global THEN errorstop (global ref not allowed) + ELSE errorstop (illegal ref operation) + FI ; + result addr +ENDOP REF ; + +ADDRESS OP DEREF (ADDRESS CONST ref address) : + CONCR (result addr) := CONCR (ref address) ; + IF is not local ref THEN errorstop (deref on non ref) FI ; + result addr.kind DECR ref mask ; + result addr . + +is not local ref : + result addr.kind <> local ref +ENDOP DEREF ; + +INT OP REPR (ADDRESS CONST addr) : + CONCR (result addr) := CONCR (addr) ; + SELECT result addr.kind OF + CASE global : + CASE local : set bit (result addr.value, 15) + CASE global ref : errorstop (global ref not allowed) + CASE local ref : prep local ref + OTHERWISE errorstop (unknown kind) + ENDSELECT ; + result addr.value . + +prep local ref : + IF address limit exceeded THEN errorstop (address overflow) FI ; + set bit (result addr.value, 14) ; + set bit (result addr.value, 15) . + +address limit exceeded : + result addr.value < eumel0 stack offset OR + result addr.value > local address limit +ENDOP REPR ; + +BOOL PROC is ref (ADDRESS CONST addr) : + addr.kind = local ref +ENDPROC is ref ; + +BOOL PROC is global (ADDRESS CONST addr) : + addr.kind = global +ENDPROC is global ; + +BOOL PROC is local (ADDRESS CONST addr) : + addr.kind = local +ENDPROC is local ; + +ADDRESS OP + (ADDRESS CONST addr, INT CONST offset) : + CONCR (result addr) := CONCR (addr) ; + SELECT result addr.kind OF + CASE global : inc global + CASE local : inc local + OTHERWISE errorstop (illegal plus operation) + ENDSELECT ; + result addr . + +inc global : + result addr.value INCR offset ; + IF result addr.value < 0 THEN errorstop (address overflow) FI . + +inc local : + result addr.value INCR offset ; + IF result addr.value < eumel 0 stack offset OR + result addr.value > local address limit + THEN errorstop (address overflow) + FI +ENDOP + ; + +PROC adjust (ADDRESS VAR addr, INT CONST adjust length) : + IF is local or global THEN adjust to length FI . + +is local or global : + addr.kind <= local . + +adjust to length : + mode := addr.value MOD adjust length ; + IF mode <> 0 THEN addr.value INCR (adjust length-mode) FI +ENDPROC adjust ; + +TEXT PROC dump (ADDRESS CONST addr) : + kind + text (addr.value) . + +kind : + SELECT addr.kind OF + CASE global : "GLOBAL " + CASE local : "LOCAL " + CASE immediate value : "IMMEDIATE " + CASE module nr : "PARAM PROC " + CASE global ref : "GLOBAL REF " + CASE local ref : "LOCAL REF " + OTHERWISE "undef. Addr:" + ENDSELECT +ENDPROC dump; + + +#page# +(**************************************************************************) +(* *) +(* 4. Datentypen Teil I 03.12.1985 *) +(* *) +(* Definition des Datentyps DTYPE *) +(* *) +(* Interne Repraesentation der primitiven Datentypen *) +(* Identifikation von DTYPEs *) +(* *) +(**************************************************************************) + + + +TYPE DTYPE = INT ; + +OP := (DTYPE VAR l, DTYPE CONST r) : + CONCR (l) := CONCR (r) +ENDOP := ; + +BOOL OP = (DTYPE CONST l, r) : + CONCR (l) = CONCR (r) +ENDOP = ; + +DTYPE PROC void type : DTYPE :(void) ENDPROC void type ; + +DTYPE PROC int type : DTYPE :(int ) ENDPROC int type ; + +DTYPE PROC real type : DTYPE :(real) ENDPROC real type ; + +DTYPE PROC text type : DTYPE :(string) ENDPROC text type ; + +DTYPE PROC bool type : DTYPE :(bool) ENDPROC bool type ; + +DTYPE PROC dataspace type : DTYPE :(dataspace) ENDPROC dataspace type ; + +DTYPE PROC undefined type : DTYPE :(undefined) ENDPROC undefined type ; + +DTYPE PROC row type : DTYPE :(row) ENDPROC row type ; + +DTYPE PROC struct type : DTYPE :(struct) ENDPROC struct type ; + +DTYPE PROC proc type : DTYPE :(permanent param proc) ENDPROC proc type ; + +DTYPE PROC end type : DTYPE :(end) ENDPROC end type ; + +INT PROC type class (DTYPE CONST type) : + SELECT type id OF + CASE int, real, bool, string, dataspace, undefined : 1 + CASE void : 0 + CASE row : 3 + CASE struct : 4 + CASE permanent param proc : 5 + OTHERWISE pt type + ENDSELECT . + +pt type : + IF type id > ptt limit THEN permanent row or struct + ELSE abstract type + FI . + +abstract type : 2 . + +permanent row or struct : + mode := cdbint (type link into pt) MOD ptt limit ; + IF mode = struct THEN 4 + ELIF mode = row THEN 3 + ELSE 2 + FI . + +type link into pt : + type id + begin of pt minus ptt limit . + +type id : CONCR (type) +ENDPROC type class ; + +PROC identify (TEXT CONST name,INT VAR size, align, DTYPE VAR type) : + SELECT type pos OF + CASE 1 : size := 0; align := 0; type id := void + CASE 6 : size := 1; align := 1; type id := int + CASE 10 : size := 4; align := 4; type id := real + CASE 15 : size := 8; align := 4; type id := string + CASE 20 : size := 1; align := 1; type id := bool + CASE 25 : size := 1; align := 1; type id := dataspace + OTHERWISE search for type in permanent table + ENDSELECT . + +type pos : + enclose in delimiters ; + pos (".VOID.INT.REAL.TEXT.BOOL.DATASPACE.", object name) . + +enclose in delimiters : + object name := "." ; + object name CAT name ; + object name CAT "." . + +search for type in permanent table : + to object (name) ; + IF NOT found THEN size := 0; align := 0; type id := undefined + ELSE size := cdbint (permanent pointer + two wordlength) ; + type id := permanent pointer - begin of permanent table ; + IF size < two wordlength THEN align := 1 + ELIF size < four wordlength THEN align := 2 + ELSE align := 4 + FI + FI . + +type id : CONCR (type) +ENDPROC identify ; + + +#page# +(**************************************************************************) +(* *) +(* 5. Operationen Teil I 21.03.1986 *) +(* *) +(* Definition des Datentyps OPN *) +(* Primitive Operationen (:= etc.) *) +(* Bereitstellen dee Fehlermeldung 'proc op expected' (coder-intern) *) +(* *) +(**************************************************************************) + + +TYPE OPN = STRUCT (INT kind, mod nr, top of stack) ; + +LET proc op = 0 , + param proc = 1 , + eumel 0 = 2 , + nil = 3 , + + param proc at non ref = "PARAM PROC at non-ref address" , + proc op expected = "PROC expected" ; + +OPN VAR eumel0 opn; +eumel0 opn.kind := eumel0 ; +eumel0 opn.top of stack := 0 ; + +eumel0 opn.mod nr := q pp ; +OPN CONST pp :: eumel0 opn , + nop code :: OPN :(nil, 0, 0) ; + +THESAURUS VAR eumel 0 opcodes :: empty thesaurus ; + +PROC init op codes (FILE VAR eumelcodes) : + eumel 0 opcodes := empty thesaurus ; + WHILE NOT eof (eumelcodes) REP + getline (eumelcodes, object name) ; + delete trailing blanks ; + IF object name <> "" CAND NOT (eumel 0 opcodes CONTAINS object name) + THEN insert (eumel 0 opcodes, object name) + FI + PER . + +delete trailing blanks : + WHILE (object name SUB LENGTH object name) = " " REP + object name := subtext (object name, 1, LENGTH object name - 1) + PER +ENDPROC init op codes ; + +ADDRESS PROC address (OPN CONST opn) : + IF opn.kind <> proc op THEN errorstop (proc op expected) FI ; + result addr.kind := module nr ; + result addr.value := opn.mod nr ; + result addr +ENDPROC address ; + +OPN PROC operation (ADDRESS CONST addr) : + IF addr.kind <> local ref THEN errorstop (param proc at non ref) FI ; + OPN VAR opn ; + opn.kind := param proc ; + opn.mod nr :=addr.value ; + opn.top of stack := 0 ; + opn +ENDPROC operation ; + +TEXT PROC mnemonic (OPN CONST op code) : + name (eumel 0 opcodes, op code.mod nr) +ENDPROC mnemonic ; + +OPN PROC nop : + nop code +ENDPROC nop ; + +OP := (OPN VAR r, OPN CONST l) : + CONCR (r) := CONCR (l) +ENDOP := ; + +BOOL PROC is proc (OPN CONST operation) : + operation.kind = proc op +ENDPROC is proc ; + +BOOL PROC is eumel 0 instruction (TEXT CONST op code name) : + link (eumel 0 opcodes, op code name) <> 0 +ENDPROC is eumel 0 instruction ; + + +#page# +(**************************************************************************) +(* *) +(* 6. Parameterfeld 10.01.1986 *) +(* *) +(* Bereitstellen des Parameterfeldes *) +(* Schreiben und Lesen von Eintraegen im Parameterfeld *) +(* Fortschalten von Zeigern in das Parameterfeld *) +(* Bereitstellen der Konstanten 'size of param field' (Coder-intern) *) +(* *) +(**************************************************************************) + + + +LET PARAMDESCRIPTOR = STRUCT (DTYPE type, INT access, + ADDRESS addr, OPN push opn) , + + size of param field = 100 , + param field exceeded = "Param Field Overflow", + param nr out of range = "Illegal Param Number" ; + +ROW size of param field PARAMDESCRIPTOR VAR param field ; + + + (***** Schreiben *****) + +PROC test param pos (INT CONST param nr) : + IF param nr < 1 OR param nr > size of param field + THEN errorstop (param nr out of range) + FI +ENDPROC test param pos ; + +PROC declare (INT CONST param nr, DTYPE CONST type) : + test param pos (param nr) ; + enter type . + +enter type : + CONCR (param field [param nr].type) := CONCR (type) +ENDPROC declare ; + +PROC declare (INT CONST param nr, access) : + test param pos (param nr) ; + enter access . + +enter access : + param field [param nr].access := access +ENDPROC declare ; + +PROC define (INT CONST param nr, ADDRESS CONST addr) : + test param pos (param nr) ; + enter address . + +enter address : + CONCR (param field [param nr].addr) := CONCR (addr) +ENDPROC define ; + +PROC define (INT CONST param nr, value) : + result addr.kind := immediate value ; + result addr.value := value ; + define (param nr, result addr) +ENDPROC define ; + +PROC apply (INT CONST param nr, OPN CONST opn) : + test param pos (param nr) ; + enter push opn . + +enter push opn : + CONCR (param field [param nr].push opn) := CONCR (opn) +ENDPROC apply ; + +PROC parameter (INT CONST param nr, DTYPE CONST type, + INT CONST access, ADDRESS CONST addr) : + test param pos (param nr) ; + enter type ; + enter access ; + enter address ; + enter pp as default . + +enter type : + CONCR (param field [param nr].type) := CONCR (type) . + +enter access : + param field [param nr].access := access . + +enter address : + CONCR (param field [param nr].addr) := CONCR (addr) . + +enter pp as default : + CONCR (param field [param nr].push opn) := CONCR (pp) +ENDPROC parameter ; + + + (***** Lesen *****) + +ADDRESS PROC param address (INT CONST param nr) : + test param pos (param nr) ; + param field [param nr].addr +ENDPROC param address ; + +DTYPE PROC dtype (INT CONST param nr) : + test param pos (param nr) ; + param field [param nr].type +ENDPROC dtype ; + +INT PROC access (INT CONST param nr) : + test param pos (param nr) ; + param field [param nr].access +ENDPROC access ; + + + (***** Fortschalten *****) + +OP NEXTPARAM (INT VAR param nr) : + test param pos (param nr) ; + IF long entry THEN read until end FI ; + param nr INCR 1 . + +long entry : + type class (param field [param nr].type) > 2 . + +read until end : + REP + param nr INCR 1 ; + NEXTPARAM param nr + UNTIL end marker read or end of field PER . + +end marker read or end of field : + param nr > size of param field OR + CONCR (param field [param nr].type) = end +ENDOP NEXTPARAM ; + +INT PROC next param (INT CONST p) : + index := p ; + NEXTPARAM index ; + index +ENDPROC next param ; + +TEXT PROC dump (INT CONST p) : + IF p > 0 AND p <= 100 THEN dump entry (param field (p)) + ELSE param nr out of range + FI +ENDPROC dump ; + +TEXT PROC dump entry (PARAMDESCRIPTOR CONST id) : + object name := dump (id.type) ; + object name CAT text (id.access) ; + object name CAT dump (id.addr) ; + object name CAT dump (id.push opn) ; + object name +ENDPROC dump entry ; + + +#page# +(**************************************************************************) +(* *) +(* 7. Datentypen Teil II 20.01.1986 *) +(* *) +(* Deklaration neuer Datentypen *) +(* Vergleich von DTYPEs im Parameterfeld und in der Permanent-Tabelle *) +(* *) +(**************************************************************************) + + + +DTYPE VAR pt type ; + +PROC declare (TEXT CONST name, INT CONST size, align, DTYPE VAR type) : + entry into name table ; + put next permanent (permanent type) ; + put next permanent (size) ; + put next permanent (nt link) ; + mark no offsets of text elements . + +entry into name table : + declare object (name, nt link, CONCR (type)) . + +mark no offsets of text elements : + put next permanent (0) +ENDPROC declare ; + +BOOL PROC same type (INT CONST param 1, param 2) : + INT CONST left type :: CONCR (param field [param 1].type) ; + IF left type = right type + THEN same fine structure if there is one + ELSE left type = undefined OR right type = undefined + FI . + +right type : CONCR (param field [param 2].type) . + +same fine structure if there is one : + IF left type = row THEN compare row + ELIF left type = struct THEN compare struct + ELSE TRUE + FI . + +compare row : + equal sizes AND same type (param1 + 1, param2 + 1) . + +equal sizes : + param field [param1+1].access = param field [param2+1].access . + +compare struct : + INT VAR p1 :: param1+1, p2 :: param2+1 ; + REP + IF NOT same type (p1, p2) THEN LEAVE same type WITH FALSE + ELIF end type found THEN LEAVE same type WITH TRUE + FI ; + NEXTPARAM p1 ; + NEXTPARAM p2 + UNTIL end of field PER ; + FALSE . + +end type found : + CONCR (param field [p1].type) = end . + +end of field : + p1 > size of param field OR p2 > size of param field +ENDPROC same type ; + +BOOL PROC same type (INT CONST param nr, DTYPE CONST type) : + field pointer := param nr ; + CONCR (pt type) := CONCR (type) ; + equal types +ENDPROC same type ; + +BOOL PROC equal types : + identical types OR one type is undefined . + +one type is undefined : + type of actual field = undefined OR CONCR(pt type) = undefined . + +identical types : + SELECT type class (pt type) OF + CASE 0, 1, 2 : type of actual field = CONCR (pt type) + CASE 3 : perhaps equal rows + CASE 4 : perhaps equal structs + OTHERWISE FALSE + ENDSELECT . + +perhaps equal rows : + is row AND equal row sizes AND equal row types . + +is row : + type of actual field = row . + +perhaps equal structs : + is struct AND same type fields . + +is struct : + type of actual field = struct . + +equal row sizes : + pt row size = row size within param field . + +equal row types : + same type (field pointer + 1, pt row type) . + +pt row size : + cdb int (CONCR(pt type) + offset to row size) . + +pt row type : + CONCR (pt type) INCR 2 ; + pt type . + +row size within param field : + param field [field pointer].access . + +same type fields : + field pointer INCR 1 ; + CONCR (pt type) INCR 1 ; + REP + IF NOT equal types THEN LEAVE same type fields WITH FALSE FI ; + IF type of actual field = end + THEN LEAVE same type fields WITH TRUE + FI ; + NEXTPARAM field pointer + UNTIL end of field PER ; + FALSE . + +end of field : + field pointer > size of param field . + +type of actual field : + CONCR (param field [field pointer].type) . +ENDPROC equal types ; + +BOOL PROC is not void bool or undefined (DTYPE CONST dtype) : + type <> void AND type <> bool AND type <> undefined . + +type : CONCR (dtype) +ENDPROC is not void bool or undefined ; + + +#page# +(**************************************************************************) +(* *) +(* 8. Operationen Teil II 07.03.1986 *) +(* *) +(* Definition der Opcodes *) +(* Deklaration, Definition, Identifikation und Applikation *) +(* Eroeffnen und Schliessen eines Moduls *) +(* *) +(**************************************************************************) + + + +LET module not opened = "Module not opened" , + define missing = "DEFINE missing" , + wrong nr of params = "Wrong Nr. of Params:" , + illegal kind = "Opcode expected" , + nested module = "Nested Modules" , + no mod nr = "Param Proc expected" , + no immediate value = "Value expected" , + type error = "Type Error" , + + q ln = 1 , + q move = 2 , q move code = 2 048 , + q inc1 = 3 , q inc1 code = 3 072 , + q dec1 = 4 , q dec1 code = 4 096 , + q inc = 5 , q inc code = 5 120 , + q dec = 6 , q dec code = 6 144 , + q add = 7 , q add code = 7 168 , + q sub = 8 , q sub code = 8 192 , + q clear = 9 , q clear code = 9 216 , + q test = 10 , + q equ = 11 , q equ code = 11 264 , + q lsequ = 12 , q lsequ code = 12 288 , + q fmove = 13 , q fmove code = 13 312 , + q fadd = 14 , q fadd code = 14 336 , + q fsub = 15 , q fsub code = 15 360 , + q fmult = 16 , q fmult code = 16 384 , + q fdiv = 17 , q fdiv code = 17 408 , + q flsequ = 18 , q flsequ code = 18 432 , + q tmove = 19 , q tmove code = 19 456 , + q tequ = 20 , q tequ code = 20 480 , + q accds = 21 , q access ds code = 22 528 , + q ref = 22 , q ref code = 23 552 , + q subscript = 23 , q subscript code = 24 576 , + q select = 24 , q select code = 25 600 , + q ppv = 25 , + q pp = 26 , + q make false = 27 , (* q make false code = 65 513 *) + q movex = 28 , +(* q longa subs q longa subs code = 65 376 *) + q return = 29 , q return code = 32 512 , + q true return = 30 , q true return code = 32 513 , + q false return = 31 , q false return code = 32 514 , + q goret code = 32 519 , + q esc mult = 32 , q esc mult code = 32 553 , + q esc div = 33 , q esc div code = 32 554 , + q esc mod = 34 , q esc mod code = 32 555 , + q pproc = 35 , + q compl int = 36 , q compl int code = 32 551 , + q compl real = 37 , q compl real code = 32 550 , +(* q alias ds = 38 , *) + q movim = 39 , q esc movim code = 32 547 , + q fequ = 40 , q fequ code = 32 548 , + q tlsequ = 41 , q tlsequ code = 32 549 , +(* q case = 42 , *) + q plus = 43 , + q minus = 44 , + q mult = 45 , + q int div = 46 , + q real div = 47 , + q equal = 48 , + q lessequal = 49 ; + +INT CONST q make false code :: - 1 022 , + q longa subs code :: - 159 ; + + + (***** Deklaration *****) + +PROC declare (OPN VAR operation) : + operation.kind := proc op ; + get module nr (operation.mod nr) ; + operation.top of stack := 0 +ENDPROC declare ; + +PROC declare (TEXT CONST name, INT CONST first, params, OPN VAR operation) : + declare (operation) ; + entry into name and pt table if necessary ; + enter params ; + enter result ; + enter module number . + +entry into name and pt table if necessary : + declare object (name, nt link, permanent pointer) . + +enter params : + field pointer := first ; + FOR index FROM 1 UPTO params REP + enter param (param field [field pointer]) ; + NEXTPARAM field pointer + PER . + +enter result : + enter param (param field[field pointer].type, permanent proc op) . + +enter module number : + put next permanent (operation.mod nr) +ENDPROC declare ; + +PROC enter param (PARAMDESCRIPTOR CONST param) : + IF param.access = const + THEN enter param (param.type, permanent param const) + ELIF param.access = var + THEN enter param (param.type, permanent param var) + ELSE errorstop ("Unknown Access") + FI +ENDPROC enter param ; + +PROC enter param (DTYPE CONST type, INT CONST permanent mode) : + SELECT type class (type) OF + CASE 0, 1, 2 : put next permanent (CONCR(type) + permanent mode) + OTHERWISE errorstop ("Illegal Type") + ENDSELECT +ENDPROC enter param ; + + + (***** Definition *****) + +PROC define (OPN VAR opn) : + IF NOT module open THEN errorstop (module not opened) + ELSE proc head (opn.mod nr, opn.top of stack) + FI +ENDPROC define ; + +PROC set length of local storage (OPN VAR opn, INT CONST size) : + IF size < 0 OR size > local address limit + THEN errorstop (address overflow) + ELIF opn.top of stack = 0 + THEN errorstop (define missing) + ELIF opn.kind <> proc op + THEN errorstop (proc op expected) + FI ; + set length (opn.top of stack, size + eumel0 stack offset) +ENDPROC set length of local storage ; + +PROC define (OPN VAR operation, INT CONST size) : + define (operation) ; + set length of local storage (operation, size) +ENDPROC define ; + + + (***** Identifikation *****) + +INT VAR counter, result index, result type repr; + +PROC identify (TEXT CONST name, INT CONST first, params, OPN VAR operation, + BOOL VAR object exists) : + find result entry ; + to object (name) ; + IF found THEN first fit and leave if found FI ; + IF eumel0 THEN identify eumel0 instruction + ELSE yield undefined operation + FI . + +find result entry : + result index := first; + counter := 0 ; + WHILE counter < params REP + NEXTPARAM result index ; + counter INCR 1 + PER ; + check on param field exceeded . + +check on param field exceeded : + IF result index > size of param field + THEN errorstop (param field exceeded) + FI . + +yield undefined operation : + declare (result index, undefined type) ; + apply (result index, nop) ; + object exists := FALSE . + +first fit and leave if found : + WHILE yet another procedure exists REP + check one procedure and leave if match ; + next procedure + PER . + +yet another procedure exists : + permanent pointer <> 0 . + +check one procedure and leave if match: + param link := permanent pointer + wordlength ; + set end marker if end of list ; + counter := params ; + field pointer := 1 ; + REP + IF end of params AND counter = 0 + THEN procedure found + ELIF end of params OR counter = 0 + THEN LEAVE check one procedure and leave if match + ELSE check next param + FI + PER . + +check next param : + get type and mode (CONCR(pt type)) ; + IF same types THEN set param mode ; + counter DECR 1 ; + field pointer INCR 1 ; + next pt param + ELSE LEAVE check one procedure and leave if match + FI . + +same types : (* inline version ! *) + equal types . + +set param mode : + param field [field pointer].access := mode . + +procedure found : + get result ; + operation.kind := proc op ; + operation.mod nr := module number ; + operation.top of stack := 0 ; + object exists := TRUE ; + LEAVE identify . + +get result : + get type and mode (result type) ; + declare (result index, mode) . + +module number : + cdbint (param link + 1) . + +result type : + CONCR (param field [result index].type) . + +eumel0 : + eumel0 opn.mod nr := link (eumel 0 opcodes, name) ; + eumel0 opn.mod nr <> 0 . + +identify eumel 0 instruction : + init result type with void ; + CONCR (operation) := CONCR (eumel0 opn) ; + object exists := check params and set result ; + declare (result index, DTYPE:(result type repr)) ; + declare (result index, const) . + +init result type with void : + result type repr := void . + +check params and set result : + SELECT operation.mod nr OF + CASE q return, q false return, q true return : no params + CASE q inc1, q dec1 : one int param yielding void + CASE q pproc, q pp, q ln : one param yielding void + CASE q test : one param yielding bool + CASE q clear, q ppv : one int or bool param yielding void + CASE q make false : one bool param yielding void + CASE q move : two int or bool params yielding void + CASE q compl int, q inc, q dec : two int params yielding void + CASE q compl real, q fmove : two real params yielding void + CASE q equ, q lsequ : two int params yielding bool + CASE q fequ, q flsequ : two real params yielding bool + CASE q tequ, q tlsequ : two text params yielding bool + CASE q tmove : two text params yielding void + CASE q accds, q ref : two params yielding void + CASE q add, q sub, q esc mult, + q esc div, q esc mod : three int params yielding void + CASE q fadd, q fsub, q fmult, q fdiv : three real params yielding void + CASE q select, q movex : three params + CASE q subscript : five params + CASE q plus, q minus, q mult : two intreals yielding intreal + CASE q int div : two int params yielding int + CASE q real div : two real params yielding real + CASE q equal, q lessequal : two intrealtexts yielding bool + OTHERWISE FALSE + ENDSELECT . + +no params : + params = 0 . + +one int param yielding void : + p1 void (int type, first, params) . + +one param yielding void : + params = 1 . + +one param yielding bool : + IF params = 1 THEN result type repr := bool ; + TRUE + ELSE FALSE + FI . + +one int or bool param yielding void : + p1 void (int type, first, params) OR p1 void (bool type, first, params) . + +one bool param yielding void : + p1 void (bool type, first, params) . + +two int or bool params yielding void : + p2 (int type, first, params, void) OR + p2 (bool type, first, params, void) . + +two int params yielding void : + p2 (int type, first, params, void) . + +two real params yielding void : + p2 (real type, first, params, void) . + +two text params yielding void : + p2 (text type, first, params, void) . + +two int params yielding bool : + p2 (int type, first, params, bool) . + +two real params yielding bool : + p2 (real type, first, params, bool) . + +two text params yielding bool : + p2 (text type, first, params, bool) . + +two params yielding void : + params = 2 . + +three int params yielding void : + p3 void (int type, first, params) . + +three real params yielding void : + p3 void (real type, first, params) . + +three params : + params = 3 . + +five params : + params = 5 . + +two intreals yielding intreal : + two int params yielding int OR two real params yielding real . + +two intrealtexts yielding bool : + two int params yielding bool OR two real params yielding bool OR + two text params yielding bool . + +two int params yielding int : + p2 (int type, first, params, int) . + +two real params yielding real : + p2 (real type, first, params, real) +ENDPROC identify ; + +BOOL PROC p1 void (DTYPE CONST requested type, INT CONST first, param nr) : + param nr = 1 AND param type is requested plain type . + +param type is requested plain type : + CONCR (param field [first].type) = CONCR (requested type) + +ENDPROC p1 void ; + +BOOL PROC p2 (DTYPE CONST requested type, INT CONST first, param nr, + INT CONST result type) : + IF param nr = 2 AND param types equal requested plain type + THEN result type repr := result type ; + TRUE + ELSE FALSE + FI . + +param types equal requested plain type : + CONCR (param field [first] .type) = CONCR (requested type) AND + CONCR (param field [first+1].type) = CONCR (requested type) + +ENDPROC p2 ; + +BOOL PROC p3 void (DTYPE CONST requested type, INT CONST first, param nr) : + param nr = 3 AND param types ok . + +param types ok : + FOR index FROM first UPTO first+2 REP + IF different param types THEN LEAVE p3 void WITH FALSE FI + PER ; + TRUE . + +different param types : + CONCR (param field [index].type) <> CONCR (requested type) +ENDPROC p3 void; + + + (***** Applikation *****) + +INT VAR address representation, left repr, right repr, result repr; + +PROC apply (INT CONST first, nr of params, OPN CONST opn) : + IF NOT module open THEN errorstop (module not opened) FI ; + SELECT opn.kind OF + CASE eumel 0 : generate eumel0 instruction + CASE proc op : call operation + CASE param proc : call param proc + CASE nil : + OTHERWISE errorstop (illegal kind) + ENDSELECT . + +call operation : + push params if necessary (first, nr of params, opn.mod nr) ; + call (opn.mod nr) . + +call param proc : + result addr.kind := local ref ; + result addr.value := opn.mod nr ; + address representation := REPR result addr ; + push params if necessary (first, nr of params, address representation) ; + call param (address representation) . + +generate eumel0 instruction : + SELECT real nr of params OF + CASE 0 : p0 instruction + CASE 1 : apply p1 (opn, first addr) + CASE 2 : apply p2 (opn, first addr, second addr) + CASE 3 : apply p3 (opn, left type, first addr, second addr, third addr) + CASE 5 : subscript operation + OTHERWISE errorstop (wrong nr of params + text (nr of params)) + ENDSELECT . + +real nr of params : + IF operator denotation THEN nr of params + 1 + ELSE nr of params + FI . + +operator denotation : + opn.mod nr >= q plus . + +p0 instruction : + IF opn.mod nr = q return THEN s0 (q return code) + ELIF opn.mod nr = q true return THEN s0 (q true return code) + ELIF opn.mod nr = q false return THEN s0 (q false return code) + ELSE errorstop (wrong nr of params + + mnemonic (opn)) + FI . + +subscript operation : + IF opn.mod nr = q subscript + THEN subscription + ELSE errorstop (wrong nr of params + text (nr of params)) + FI . + +subscription : + ADDRESS CONST element length :: param field [first+2].addr , + limit :: param field [first+3].addr ; + check on immediates ; + IF element length.value < 1024 + THEN s0 (q subscript code + element length.value) + ELSE s0 (q longa subs code) ; + s0 (element length.value) + FI ; + s3 (limit.value - 1, subs index, base addr, subs result) . + +check on immediates : + IF element length.kind <> immediate value OR + limit.kind <> immediate value + THEN errorstop (no immediate value) + FI . + +subs index : REPR param field [first+1].addr . + +base addr : REPR param field [first].addr . + +subs result : REPR param field [first+4].addr . + +first addr : + param field [first].addr . + +left type : + param field [first].type . + +second addr : + param field [nextparam (first)].addr . + +third addr : + param field [nextparam(nextparam(first))].addr +ENDPROC apply ; + +PROC push params if necessary (INT CONST first, nr of params, mod nr) : + init param push (mod nr) ; + IF nr of params > 0 THEN push params ; + push result if there is one + FI . + +push params : + field pointer := first ; + FOR index FROM 1 UPTO nr of params REP + apply p1 (push code, param addr) ; + NEXTPARAM field pointer + PER . + +push code : + param field [field pointer].push opn . + +param addr : + param field [field pointer].addr . + +push result if there is one : + IF push result necessary + THEN push result address (REPR param field [field pointer].addr) + FI . + +push result necessary : + param field [field pointer].push opn.kind <> nil AND + is not void bool or undefined (param field [field pointer].type) +ENDPROC push params if necessary ; + +PROC apply p1 (OPN CONST opn, ADDRESS CONST addr) : + IF opn.mod nr = q ln THEN generate line number + ELIF opn.mod nr = q pproc THEN push module nr + ELSE gen p1 instruction + FI . + +gen p1 instruction : + address representation := REPR addr ; + SELECT opn.mod nr OF + CASE q inc1 : t1 (q inc1 code, address representation) + CASE q dec1 : t1 (q dec1 code, address representation) + CASE q clear : t1 (q clear code,address representation) + CASE q test : test bool object (address representation) + CASE q pp : push param (address representation) + CASE q make false : s1 (q make false code, address representation) + OTHERWISE errorstop (wrong nr of params + mnemonic (opn)) + ENDSELECT . + +generate line number : + IF addr.kind = immediate value THEN mark line (addr.value) + ELSE errorstop (no immediate value) + FI . + +push module nr : + IF addr.kind = module nr THEN push param proc (addr.value) + ELSE errorstop (no mod nr) + FI +ENDPROC apply p1; + +PROC apply p2 (OPN CONST opn, ADDRESS CONST left addr, right addr): + left repr := REPR left addr ; + IF opn.mod nr = q movim THEN move immediate + ELSE gen p2 instruction + FI . + +gen p2 instruction : + right repr := REPR right addr ; + SELECT opn.mod nr OF + CASE q move : t2 (q move code, right repr, left repr) + CASE q inc : t2 (q inc code, right repr, left repr) + CASE q dec : t2 (q dec code, right repr, left repr) + CASE q equ : compare (q equ code, left repr, right repr) + CASE q lsequ : compare (q lsequ code, left repr, right repr) + CASE q fmove : t2 (q fmove code, right repr, left repr) + CASE q flsequ : compare (q flsequ code, left repr, right repr) + CASE q tmove : t2 (q tmove code, right repr, left repr) + CASE q tequ : compare (q tequ code, left repr, right repr) + CASE q compl int : s2 (q compl int code, left repr, right repr) + CASE q compl real : s2 (q compl real code, left repr, right repr) + CASE q fequ : compare (q fequ code, left repr, right repr) + CASE q tlsequ : compare (q tlsequ code, left repr, right repr) + CASE q accds : t2 (q access ds code, left repr, right repr) + CASE q ref : t2 (q ref code, left repr, right repr) + OTHERWISE errorstop (wrong nr of params + mnemonic (opn)) + ENDSELECT . + +move immediate : + IF right addr.kind = immediate value + THEN s0 (q esc movim code) ; + s1 (left repr, right addr.value) + ELSE errorstop (no immediate value) + FI +ENDPROC apply p2; + +PROC apply p3 (OPN CONST opn, DTYPE CONST left dtype, + ADDRESS CONST left addr, right addr, result addr ): + left repr := REPR left addr ; + result repr := REPR result addr ; + IF opn.mod nr = q select THEN gen select instruction + ELIF opn.mod nr = q movex THEN gen long move + ELSE gen p3 instruction + FI . + +gen p3 instruction : + right repr := REPR right addr ; + SELECT opn.mod nr OF + CASE q add : int add + CASE q sub : int sub + CASE q fadd : real add + CASE q fsub : real sub + CASE q fmult : real mult + CASE q fdiv, q real div : real div + CASE q esc mult : int mult + CASE q esc div, q int div : int div + CASE q esc mod : int mod + CASE q plus : int real add + CASE q minus : int real sub + CASE q mult : int real mult + CASE q equal, q lessequal : compare (comp code, left repr, right repr) + OTHERWISE errorstop (wrong nr of params + mnemonic (opn)) + ENDSELECT . + +gen select instruction : + IF right addr.kind = immediate value + THEN t1 (q select code, left repr) ; + s1 (right addr.value, result repr) + ELSE errorstop (no immediate value) + FI . + +gen long move : + IF right addr.kind = immediate value + THEN long move (left repr, result repr, right addr.value) + ELSE errorstop (no immediate value) + FI . + +int add : compute (q add code, left repr, right repr, result repr) . + +int sub : compute (q sub code, left repr, right repr, result repr) . + +real add : compute (q fadd code, left repr, right repr, result repr) . + +real sub : compute (q fsub code, left repr, right repr, result repr) . + +real mult : compute (q fmult code, left repr, right repr, result repr) . + +real div : compute (q fdiv code, left repr, right repr, result repr) . + +int mult : s3 (q esc mult code, left repr, right repr, result repr) . + +int div : s3 (q esc div code, left repr, right repr, result repr) . + +int mod : s3 (q esc mod code, left repr, right repr, result repr) . + +int real add : + IF left type = int THEN int add + ELSE real add + FI . + +int real sub : + IF left type = int THEN int sub + ELSE real sub + FI . + +int real mult : + IF left type = int THEN int mult + ELSE real mult + FI . + +comp code : + SELECT left type OF + CASE int : IF opn.mod nr = q equal THEN q equ ELSE q lsequ FI + CASE real : IF opn.mod nr = q equal THEN q fequ ELSE q flsequ FI + CASE string : IF opn.mod nr = q equal THEN q tequ ELSE q tlsequ FI + OTHERWISE errorstop (type error); q equ + ENDSELECT . + +left type : CONCR (left dtype) + +ENDPROC apply p3; + + + (***** Modul *****) + +BOOL VAR module open ; + +.init opn section : + module open := FALSE .; + +PROC begin module : + IF module open THEN errorstop (nested module) + ELSE begin modul ; + module open := TRUE + FI +ENDPROC begin module ; + +PROC end module : + IF NOT module open + THEN errorstop (module not opened) + ELSE end modul ; + module open := FALSE + FI +ENDPROC end module ; + +TEXT PROC dump (OPN CONST operation) : + IF operation.kind = proc op THEN " PROC" + text (operation.mod nr, 5) + ELIF operation.kind = eumel 0 THEN " EUMEL0: " + mnemonic (operation) + ELSE " undef. Opn" + FI +ENDPROC dump ; + +PROC begin modul : + EXTERNAL 10072 +ENDPROC begin modul ; + +PROC end modul : + EXTERNAL 10011 +ENDPROC end modul ; + +PROC proc head (INT VAR mod nr, top of stack) : + EXTERNAL 10012 +ENDPROC proc head ; + +PROC set length (INT CONST top of stack, size) : + EXTERNAL 10013 +ENDPROC set length ; + +PROC get module nr (INT VAR module nr) : + EXTERNAL 10016 +ENDPROC get module nr ; + +PROC compute (INT CONST op code, l addr, r addr, result address) : + EXTERNAL 10017 +ENDPROC compute ; + +PROC compare (INT CONST op code, l addr, r addr) : + EXTERNAL 10018 +ENDPROC compare ; + +PROC long move (INT CONST to, from, length) : + EXTERNAL 10019 +ENDPROC long move ; + +PROC put next permanent (INT CONST permanent value) : + EXTERNAL 10020 +ENDPROC put next permanent ; + +PROC call (INT CONST mod nr) : + EXTERNAL 10022 +ENDPROC call ; + +PROC call param (INT CONST mod nr) : + EXTERNAL 10023 +ENDPROC call param ; + +PROC push param (INT CONST addr) : + EXTERNAL 10024 +ENDPROC push param ; + +PROC push param proc (INT CONST mod nr) : + EXTERNAL 10025 +ENDPROC push param proc ; + +PROC init param push (INT CONST mod nr) : + EXTERNAL 10026 +ENDPROC init param push ; + +PROC push result address (INT CONST addr) : + EXTERNAL 10027 +ENDPROC push result address ; + +PROC test bool object (INT CONST addr) : + EXTERNAL 10187 +ENDPROC test bool object ; + +PROC mark line (INT CONST line number) : + EXTERNAL 10030 +ENDPROC mark line ; + +PROC s0 (INT CONST op code) : + EXTERNAL 10038 +ENDPROC s0 ; + +PROC s1 (INT CONST op code, addr) : + EXTERNAL 10039 +ENDPROC s1 ; + +PROC s2 (INT CONST op code , addr1, addr2) : + EXTERNAL 10040 +ENDPROC s2 ; + +PROC s3 (INT CONST op code, addr1, addr2, addr3) : + EXTERNAL 10041 +ENDPROC s3 ; + +PROC t1 (INT CONST op code, addr) : + EXTERNAL 10042 +ENDPROC t1 ; + +PROC t2 (INT CONST op code, addr1, addr2) : + EXTERNAL 10043 +ENDPROC t2 ; + +#page# +(**************************************************************************) +(* *) +(* 9. Speicherverwaltung 21.03.1986 *) +(* *) +(* Ablage der Paketdaten *) +(* *) +(**************************************************************************) + + + +INT VAR address value; + +INT CONST data allocation by coder := 1 , + data allocation by user := 2 ; + +LET not initialized = 0 , + wrong mm mode = "Wrong MM Mode" , + define on non global = "Define for GLOB only" , + text too long = "TEXT too long" ; + +TEXT VAR const buffer :: point line ; + +.reset memory management mode : + memory management mode := not initialized . ; + +PROC reserve storage (INT CONST size) : + IF memory management mode <> data allocation by user + THEN errorstop (wrong mm mode) + FI ; + allocate var (address value, size) ; + memory management mode := not initialized +ENDPROC reserve storage ; + +PROC allocate variable (ADDRESS VAR addr, INT CONST size) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate var (addr.value, size) ; + addr.kind := global +ENDPROC allocate variable ; + +PROC allocate denoter (ADDRESS VAR addr, INT CONST value) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate int denoter (addr.value) ; + put data word (value, addr.value) ; + addr.kind := global +ENDPROC allocate denoter ; + +PROC allocate denoter (ADDRESS VAR addr, REAL CONST value) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate real denoter (addr.value) ; + addr.kind := global ; + define (addr, value) +ENDPROC allocate denoter ; + +PROC allocate denoter (ADDRESS VAR addr, TEXT CONST value) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate text denoter (addr.value, (LENGTH value+1) DIV 2 + 2) ; + addr.kind := global ; + skip heaplink; + define (addr, value) ; + reset heaplink . + +skip heaplink : + addr.value INCR 1 . + +reset heaplink : + addr.value DECR 1 +ENDPROC allocate denoter ; + +PROC define (ADDRESS CONST addr, INT CONST value) : + IF addr.kind <> global + THEN errorstop (define on non global) + FI ; + put data word (value, addr.value) +ENDPROC define ; + +PROC define (ADDRESS CONST addr, REAL CONST value) : + IF addr.kind <> global + THEN errorstop (define on non global) + FI ; + replace (const buffer, 1, value) ; + address value := addr.value ; + FOR index FROM 1 UPTO 4 REP + put data word (const buffer ISUB index, address value) ; + address value INCR 1 + PER +ENDPROC define ; + +PROC define (ADDRESS CONST addr, TEXT CONST value) : + IF addr.kind <> global THEN errorstop (define on non global) + ELIF LENGTH value > 255 THEN errorstop (text too long) + FI ; + address value := addr.value ; + const buffer := code (LENGTH value) ; + const buffer CAT value ; + const buffer CAT " " ; + FOR index FROM 1 UPTO LENGTH const buffer DIV 2 REP + put data word (const buffer ISUB index, address value) ; + address value INCR 1 + PER ; + const buffer := point line +ENDPROC define ; + +PROC prep pbase (INT VAR offset) : + EXTERNAL 10032 +ENDPROC prep pbase; + +PROC allocate var (INT VAR addr, INT CONST length) : + EXTERNAL 10033 +ENDPROC allocate var ; + +PROC allocate int denoter (INT VAR addr) : + EXTERNAL 10034 +ENDPROC allocate int denoter ; + +PROC allocate real denoter (INT VAR addr) : + EXTERNAL 10035 +ENDPROC allocate real denoter ; + +PROC allocate text denoter (INT VAR addr, INT CONST length) : + EXTERNAL 10036 +ENDPROC allocate text denoter ; + +PROC put data word (INT CONST value, INT CONST addr) : + EXTERNAL 10037 +ENDPROC put data word ; + + +#page# +(**************************************************************************) +(* *) +(* 10. Inspector 08.01.1986 *) +(* *) +(**************************************************************************) + + + +INT VAR line number, pattern length, packet link, + begin of packet, last packet entry, indentation; + +TEXT VAR bulletin name, type and mode, pattern, buffer; + +DATASPACE VAR bulletin ds :: nilspace ; + +.packet name : + cdb text (cdb int(packet link + wordlength) + two word length) . + +.within editor : + aktueller editor > 0 . ; + +TEXT PROC type name (DTYPE CONST type) : + type and mode := "" ; + name of type (CONCR (type)) ; + type and mode +ENDPROC type name ; + +TEXT PROC dump (DTYPE CONST type) : + type and mode := "TYPE " ; + name of type (CONCR (type)) ; + type and mode +ENDPROC dump ; + +PROC name of type (INT CONST type) : + SELECT type OF + CASE void : + CASE int : type and mode CAT "INT" + CASE real : type and mode CAT "REAL" + CASE string : type and mode CAT "TEXT" + CASE bool, bool result : type and mode CAT "BOOL" + CASE dataspace : type and mode CAT "DATASPACE" + OTHERWISE : complex type + ENDSELECT . + +complex type : + IF type > ptt limit THEN perhaps permanent struct or row + ELSE get complex type + FI . + +perhaps permanent struct or row : + index := type + begin of pt minus ptt limit ; + mode := cdb int (index) MOD ptt limit ; + IF mode = permanent row THEN get permanent row + ELIF mode = permanent struct THEN get permanent struct + ELSE type and mode CAT "-" + FI . + +get complex type : + index := type + begin of permanent table ; + IF is complex type THEN get name + ELSE type and mode CAT "-" + FI . + +is complex type : + permanent type definition mode = permanent type . + +get name : + type and mode CAT cdb text (link to type name + two word length) . + +link to type name : + cdb int (index + three word length) . + +permanent type definition mode : + cdb int (index + wordlength) . + +get permanent row : + INT VAR t; + type and mode CAT "ROW " ; + type and mode CAT text (cdb int (index + wordlength)) ; + type and mode CAT " " ; + param link := index + two wordlength ; + get type and mode (t) ; + name of type (t) . + +get permanent struct : + type and mode CAT "STRUCT ( ... )" +ENDPROC name of type ; + +PROC help (TEXT CONST proc name) : + prep bulletin ; + prep help ; + scan (object name) ; + next symbol (pattern) ; + packet link := end of permanent table ; + IF function = 0 THEN standard help + ELSE asterisk help + FI . + +prep help : + object name := compress (proc name) ; + INT VAR function :: 0 ; + INT CONST l :: LENGTH object name ; + IF l > 1 AND object name <> "**" + THEN IF (object name SUB l) = "*" + THEN function INCR 2 ; + delete char (object name, l) + FI ; + IF (object name SUB 1) = "*" + THEN function INCR 1 ; + delete char (object name, 1) + FI ; + IF another asterisk THEN wrong function FI + FI. + +another asterisk : + pos (object name, "*") <> 0 . + +wrong function : + errorstop ("unzulaessige Sternfunktion") . + +standard help : + to object (pattern) ; + IF found THEN display + ELSE error stop ("unbekannt: " + proc name) + FI . + +display : + WHILE permanent pointer <> 0 REP + put name of packet if necessary ; + put specifications (pattern) ; + next procedure + ENDREP ; + show bulletin file . + +put name of packet if necessary : + IF new packet THEN packet link := permanent pointer ; + find begin of packet ; + writeline (2) ; + write packet name + FI . + +find begin of packet : + REP + packet link DECR wordlength + UNTIL begin of packet found PER . + +begin of packet found : + cdb int (packet link) = permanent packet . + +new packet : + permanent pointer < packet link . + +asterisk help : + hash table pointer := begin of hash table ; + pattern length := LENGTH pattern - 1 ; + REP + list all objects in current hash table chain ; + next hash entry + UNTIL end of hash table reached ENDREP ; + show bulletin file . + +list all objects in current hash table chain : + nt link := hash table pointer ; + WHILE yet another nt entry REP + permanent pointer := cdb int (nt link + wordlength) ; + object name := cdb text (nt link + two word length) ; + IF matching THEN into bulletin FI + PER . + +matching : + INT CONST p :: pos (object name, pattern) ; + SELECT function OF + CASE 1 : p <> 0 AND p = LENGTH object name - pattern length + CASE 2 : p = 1 + CASE 3 : p <> 0 + OTHERWISE FALSE + ENDSELECT . + +into bulletin : + object names into bulletin (BOOL PROC not end of chain) +ENDPROC help ; + +BOOL PROC not end of chain : + permanent pointer <> 0 +ENDPROC not end of chain ; + +PROC write packet name : + indentation := 0 ; + write line ; + write bulletin line ("PACKET ") ; + indentation := 7 ; + object name := packet name ; + write bulletin line (object name) ; + write bulletin line (":") ; + writeline (2) +ENDPROC write packet name ; + +PROC put specifications (TEXT CONST proc name) : + put obj name (proc name) ; + to first param ; + IF NOT end of params THEN put param list FI ; + put result ; + writeline . + +to first param : + param link := permanent pointer + word length ; + set end marker if end of list . + +put result : + INT VAR type; + get type and mode (type) ; + IF type <> void THEN type and mode := " --> " ; + name of type (type) ; + write bulletin line (type and mode) + FI +ENDPROC put specifications ; + +PROC put param list : + write bulletin line (" (") ; + REP + INT VAR type; + get type and mode (type) ; + put type and mode ; + maybe param proc ; + next pt param ; + IF end of params THEN write bulletin line (")") ; + LEAVE put param list + FI ; + write bulletin line (", ") ; + PER . + +put type and mode : + type and mode := "" ; + name of type (type) ; + type and mode CAT name of mode ; + write bulletin line (type and mode) . + +name of mode : + IF mode = const THEN " CONST" + ELIF mode = var THEN " VAR" + ELSE " PROC" + FI . + +maybe param proc : + IF mode = permanent param proc THEN put virtual params FI . + +put virtual params : + skip over result type if complex type ; + IF NOT end of virtual params THEN put param list FI. + +skip over result type if complex type : + next pt param . + +end of virtual params : + end of params +ENDPROC put param list ; + +PROC next packet : + REP + packet link INCR wordlength ; + word := cdb int (packet link) ; + IF word = permanent packet THEN true return + ELIF end of permanents THEN false return + FI ; + ENDREP . + +true return : + found := TRUE ; + LEAVE next packet . + +false return : + found := FALSE ; + LEAVE next packet . + +end of permanents : + word = permanent end OR packet link > end of permanent table +ENDPROC next packet ; + +PROC prep bulletin : + forget (bulletin ds) ; + bulletin ds := nilspace ; + bulletin file := sequential file (output, bulletin ds) ; + line number := 0 ; + buffer := "" +ENDPROC prep bulletin ; + +PROC show bulletin file : + IF within editor THEN ueberschrift neu FI ; + DATASPACE VAR local ds :: bulletin ds ; + FILE VAR local file :: sequential file (modify, local ds) ; + edit (local file) ; + forget (local ds) +ENDPROC show bulletin file ; + +PROC write bulletin line (TEXT CONST line) : + IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ; + buffer CAT line +ENDPROC write bulletin line ; + +PROC writeline : + write (bulletin file, buffer) ; + line (bulletin file) ; + line number INCR 1 ; + cout (line number) ; + buffer := indentation * " " +ENDPROC writeline ; + +PROC writeline (INT CONST times) : + IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ; + writeline + ELSE index := times + FI ; + line (bulletin file, index) ; + line number INCR index; + indentation := 0 ; + cout (line number) +ENDPROC writeline ; + +PROC bulletin (TEXT CONST packet name) : + prep bulletin ; + scan (packet name) ; + next symbol (pattern) ; + to packet ; + IF found THEN list packet ; + show bulletin file + ELSE error stop (packet name + " ist kein Paketname") + FI . + +to packet : + last packet entry := 0 ; + get nametab link of packet name ; + packet link := before first pt entry ; + REP + packet link INCR wordlength ; + word := cdb int (packet link) ; + IF word < 0 THEN IF word = permanent packet THEN packet found + ELIF word = permanent end THEN return + FI + FI + ENDREP . + +get nametab link of packet name : + to object (pattern) ; + IF NOT found THEN error stop ("unbekanntes Paket :" + packet name) ; + LEAVE to packet + FI . + +packet found : + IF cdb int (packet link + wordlength) = nt link + THEN last packet entry := packet link FI . + +return : + IF last packet entry <> 0 THEN found := TRUE ; + packet link := last packet entry + ELSE found := FALSE + FI ; + LEAVE to packet +ENDPROC bulletin ; + +PROC list packet : + begin of packet := packet link + word length ; + write packet name ; + find end of packet ; + run through nametab and list all packet objects . + +find end of packet : + last packet entry := begin of packet ; + REP + last packet entry INCR wordlength ; + word := cdb int (last packet entry) ; + UNTIL end of packet entries PER . + +end of packet entries : + word = permanent packet OR word = permanent end . + +run through nametab and list all packet objects : + hashtable pointer := begin of hashtable ; + REP + nt link := hashtable pointer ; + list objects of current packet in this chain ; + next hash entry + UNTIL end of hashtable reached ENDREP . + +list objects of current packet in this chain : + WHILE yet another nt entry REP + permanent pointer := cdb int (nt link + wordlength) ; + put objects of this name + PER . + +put objects of this name : + IF there is at least one object of this name in the current packet + THEN into bulletin FI . + +there is at least one object of this name in the current packet : + REP + IF permanent pointer >= begin of packet AND + permanent pointer < last packet entry + THEN LEAVE there is at least one object of this name + in the current packet WITH TRUE FI ; + next procedure + UNTIL permanent pointer = 0 PER ; + FALSE . + +into bulletin : + object name := cdb text (nt link + two word length) ; + object names into bulletin (BOOL PROC within packet) +ENDPROC list packet ; + +BOOL PROC within packet : + permanent pointer >= begin of packet AND + permanent pointer < last packet entry +ENDPROC within packet ; + +PROC object names into bulletin (BOOL PROC link ok) : + scan (object name) ; + next symbol (object name, mode) ; + IF type definition THEN put type definition + ELSE put object definitions + FI . + +type definition : + mode = bold AND no params . + +no params : + cdb int (permanent pointer + word length) >= permanent type . + +put type definition : + put obj name (object name) ; + write bulletin line ("TYPE ") ; + writeline (1) . + +put object definitions : + WHILE link ok REP + put specifications (object name) ; + next procedure + ENDREP +ENDPROC object names into bulletin ; + +PROC bulletin : + prep bulletin ; + packet link := first permanent entry ; + REP + list packet ; + write line (4) ; + next packet + UNTIL NOT found PER ; + show bulletin file +ENDPROC bulletin ; + +PROC put obj name (TEXT CONST name) : + buffer := " " ; + bulletin name := point line ; + change (bulletin name, 1, end of line or name, name) ; + buffer CAT bulletin name ; + indentation := LENGTH buffer + 1 . + +end of line or name : + min (LENGTH name, LENGTH bulletin name) +ENDPROC put obj name ; + +PROC packets : + prep bulletin ; + packet link := first permanent entry ; + REP + object name := packet name ; + put obj name (object name) ; + write line ; + next packet + UNTIL NOT found PER ; + show bulletin file +ENDPROC packets ; + +#page# +(**************************************************************************) +(* *) +(* 11. ELAN Run-Interface 09.01.1986 *) +(* *) +(* Uebersetzen von ELAN-Programmen *) +(* Bereitstellen der Ausgabeprozeduren fuer den ELAN-Compiler *) +(* *) +(**************************************************************************) + + + +BOOL VAR list option := FALSE , + check option := TRUE , + listing enabled := FALSE ; + +FILE VAR listing file ; + +TEXT VAR listing file name := "" ; + + +PROC run (TEXT CONST file name) : + enable stop ; + IF NOT exists (file name) + THEN errorstop ("""" + file name + """ gibt es nicht") + FI ; + last param (file name) ; + run elan (file name, no ins) +END PROC run; + +PROC run : + run (last param) +ENDPROC run ; + +PROC run again : + IF run again mod nr <> 0 + THEN elan (run again mode, bulletin file, "", run again mod nr, + no ins, no lst, check option, no sermon) + ELSE errorstop ("'run again' nicht moeglich") + FI +ENDPROC run again ; + +PROC insert (TEXT CONST file name) : + enable stop ; + IF NOT exists (file name) + THEN errorstop ("""" + file name + """ gibt es nicht") + FI ; + last param (file name) ; + run elan (file name, ins) +ENDPROC insert ; + +PROC insert : + insert (last param) +ENDPROC insert ; + +PROC run elan (TEXT CONST file name, BOOL CONST insert option) : + FILE VAR source := sequential file (modify, file name) ; + IF listing enabled + THEN open listing file + FI ; + + disable stop ; + no do again ; + elan (compile file mode, source, "" , run again mod nr, + insert option, list option, check option, sermon) ; + + IF anything noted AND command dialogue + THEN ignore halt during compiling ; + note edit (source) ; + errorstop ("") + FI . + +ignore halt during compiling : + IF is error + THEN put error ; + clear error ; + pause (5) + FI . + +open listing file : + listing file := sequential file (output, listing file name) ; + max line length (listing file, 130) + +ENDPROC run elan ; +(* +PROC out text (TEXT CONST text, INT CONST out type) : + INTERNAL 257 ; + IF online + THEN out (text) + FI ; + IF out type = error message + THEN note (text) ; + number of errors INCR 1 + ELIF out type = warning message + THEN note (text) + FI ; + IF listing enabled + THEN write (listing file, text) + FI +ENDPROC out text ; + +PROC out line (INT CONST out type) : + INTERNAL 258 ; + IF online + THEN out (""13""10"") + FI ; + IF out type = error message OR out type = warning message + THEN note line + ELIF listing enabled + THEN line (listing file) + FI +ENDPROC out line ; +*) +PROC prot (TEXT CONST file name) : + list option := TRUE ; + listing file name := file name ; + listing enabled := TRUE +ENDPROC prot ; + +PROC prot off : + list option := FALSE ; + listing enabled := FALSE +ENDPROC prot off ; + +BOOL PROC prot : + list option +ENDPROC prot ; + +PROC check on : + check option := TRUE +ENDPROC check on ; + +PROC check off : + check option := FALSE +ENDPROC check off ; + +BOOL PROC check : + check option +ENDPROC check ; + +ENDPACKET eumel coder ; diff --git a/system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod new file mode 100644 index 0000000..6914548 --- /dev/null +++ b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod @@ -0,0 +1,2043 @@ +PACKET eumel coder (* Autor: U. Bartling *) + DEFINES coder on, coder off, (* 1.8.0-Korr. M.St. *) + declare, define, apply, identify, (* 21.11.86 *) + :=, =, (* EXTERNAL 10...Nummern*) + dump, (* und coderon-flags *) + (* inspector/coder1 weg *) + LABEL, + gosub, goret, + complement condition code, + + ADDRESS , + GLOB, LOC, REF, DEREF, + ref length, + +, + adjust, + is global, is local, is ref, + + DTYPE, + type class, type name, + void type, int type, real type, text type, bool type, + dataspace type, undefined type, + row type, struct type, proc type, end type, + + OPN, + set length of local storage, + begin module, end module, + is proc, is eumel 0 instruction, + address, operation, + nop, + init op codes, + mnemonic, + + parameter, + next param, + NEXTPARAM, + access , + dtype , + param address, + same type , + + reserve storage, + allocate denoter , + allocate variable, + data allocation by coder , + data allocation by user : + +(**************************************************************************) +(* *) +(* E U M E L - C O D E R *) +(* *) +(* *) +(* Zur Beschreibung des Coders siehe *) +(* U.Bartling, J. Liedtke: EUMEL-Coder-Interface *) +(* *) +(* Stand der Dokumentation : 13.02.1986 *) +(* Stand der Implementation : 21.03.1986 *) +(* *) +(* *) +(**************************************************************************) + + + (***** Globale Variable *****) + +TEXT VAR object name; + +FILE VAR bulletin file; + +INT VAR memory management mode, global address offset, + nt link, permanent pointer, param link, index, mode, field pointer; + +BOOL VAR found, end of params; + +#page# +(**************************************************************************) +(* *) +(* 1. Interface zum ELAN-Compiler 12.03.1986 *) +(* 1.7.5.4 *) +(* *) +(* Beschreibung der Tabellen (-groessen), *) +(* internen Vercodung von Typen *) +(* und Kennungen . *) +(* Initialisieren und Beenden des Compilers, *) +(* Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle *) +(* *) +(**************************************************************************) + + +LET begin of hash table = 0 , + end of hash table = 1023 , + + begin of permanent table = 22784 , +(* before first pt entry = 22784 , *) +(* first permanent entry = 22785 , *) +(* end of permanent table = 32767 , *) + + wordlength = 1 , (* compile u n d run time *) + two word length = 2 , + three word length = 3 , + four word length = 4 , + + permanent param const = 10000 , + permanent param var = 20000 , + permanent proc op = 30000 , + permanent type = 30000 , + permanent row = 10 , + permanent struct = 11 , + permanent param proc = 12 , +(* permanent param proc end marker = 0 , *) + permanent type field = 0 , + + ptt limit = 10000 , + begin of pt minus ptt limit = 12784 , + offset to row size = 12785 , + + void = 0 , + int = 1 , + real = 2 , + string = 3 , + bool = 5 , + bool result = 6 , + dataspace = 7 , + undefined = 9 , + row = 10 , + struct = 11 , + end = 0 , + + const = 1 , + var = 2 , +(* proc = 3 , *) +(* denoter = 5 , *) +(* bold = 2 , *) + + ins = TRUE , + no ins = FALSE , + no lst = FALSE , + sermon = TRUE , + no sermon = FALSE , + +(* run again mode = 0 , *) +(* compile file mode = 1 , *) + prep coder mode = 5 , + +(* warning message = 2 , *) +(* error message = 4 , *) + + point line = "..............." ; +(* +INT CONST permanent packet := -2 , + permanent end := -3 ; +*) +BOOL VAR coder active := FALSE ; + +INT VAR run again mod nr := 0 ; + + + (***** Start/Ende *****) + +LET invalid coder off = "CODER not active" ; + +PROC coder on (INT CONST data allocation mode) : + mark coder on ; + init memory management ; + init opn section ; + init compiler . + +mark coder on : + coder active := TRUE . + +init memory management : + memory management mode := data allocation mode ; + prep pbase (global address offset) . + +init compiler : + no do again ; + elan (prep coder mode, bulletin file, "", run again mod nr, + no ins, prot, check, no sermon) (* prot, check f.test, M.St. *) + +ENDPROC coder on; + +PROC coder off (BOOL CONST insert, sermon, OPN CONST start proc) : + IF coder active + THEN mark coder off ; + end coder (insert, sermon, start mod nr if no insert) + ELSE errorstop (invalid coder off) + FI . + +start mod nr if no insert : + IF insert THEN run again mod nr := 0 + ELSE run again mod nr := start proc.mod nr + FI ; + run again mod nr . + +mark coder off : + reset memory management mode ; + init opn section ; + coder active := FALSE +ENDPROC coder off ; + +PROC end coder (BOOL CONST insert wanted, sermon wanted, INT CONST mod) : + EXTERNAL 10021 +ENDPROC end coder ; + +PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, + INT VAR start module number, BOOL CONST ins, lst, rtc, ser) : + EXTERNAL 256 +ENDPROC elan ; + + (***** Hash/Namenstabelle *****) + +. yet another nt entry : + nt link := cdb int (nt link) ; + nt link <> 0 . ; + +PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : + EXTERNAL 10031 +ENDPROC declare object ; + +PROC to object (TEXT CONST searched object) : + hash ; + search nt entry . + +hash : + hash code := 0 ; + FOR index FROM 1 UPTO LENGTH searched object REP + addmult cyclic + ENDREP . + +addmult cyclic : + hash code INCR hash code ; + IF hash code > end of hash table THEN wrap around FI ; + hash code := (hash code + code (searched object SUB index)) MOD 1024 . + +wrap around : + hash code DECR end of hash table . + +hash code : nt link . + +search nt entry : + found := FALSE ; + WHILE yet another nt entry REP + read current entry ; + IF object name = searched object + THEN found := TRUE ; + LEAVE to object + FI + PER . + +read current entry : + permanent pointer := cdb int (nt link + wordlength) ; + object name := cdb text (nt link + two word length) +ENDPROC to object ; + + + (***** Permanent Tabelle *****) +. +next procedure : + permanent pointer := cdb int (permanent pointer) . ; + +PROC next pt param : + mode := cdb int (param link) MOD ptt limit ; + param link INCR wordlength ; + IF mode = permanent row THEN skip over permanent row + ELIF mode = permanent struct THEN skip over permanent struct + FI ; + set end marker if end of list . + +skip over permanent row : + param link INCR wordlength ; + next pt param . + +skip over permanent struct : + REP + next pt param ; + mode := cdb int (param link) + UNTIL mode = permanent type field PER ; + param link INCR wordlength +ENDPROC next pt param ; + +PROC set end marker if end of list : + mode := cdb int (param link) ; + end of params := mode >= permanent proc op OR mode <= 0 +ENDPROC set end marker if end of list ; + +PROC get type and mode (INT VAR type) : + mode := cdb int (param link) ; + IF mode = permanent param proc THEN type of param proc + ELSE type of object + FI . + +type of param proc : + param link INCR wordlength ; + get type and mode (type) ; + mode := permanent param proc . + +type of object : + IF mode < 0 THEN type := 2769 + (32767 + mode) ; + mode := 0 + ELSE type := mode MOD ptt limit ; + mode DECR type ; + translate type if necessary ; + translate mode if necessary + FI . + +translate type if necessary : + IF permanent row or struct THEN translate type FI . + +translate type : + type := param link - begin of pt minus ptt limit . + +translate mode if necessary : + IF mode = permanent param const THEN mode := const + ELIF mode = permanent param var THEN mode := var + FI . + +permanent row or struct : + type = permanent row OR type = permanent struct +ENDPROC get type and mode ; + + + (***** Allgemeine Zugriffsprozeduren *****) + +INT PROC cdb int (INT CONST index) : + EXTERNAL 116 +ENDPROC cdb int ; + +TEXT PROC cdb text (INT CONST index) : + EXTERNAL 117 +ENDPROC cdb text ; + + +#page# +(**************************************************************************) +(* *) +(* 2. Spruenge und Marken 07.03.1986 *) +(* *) +(* Definition des Datentyps LABEL *) +(* *) +(* Deklaration, Definition und Applikation von Marken *) +(* *) +(**************************************************************************) + + +TYPE LABEL = INT ; + +BOOL VAR invers :: FALSE ; + +PROC declare (LABEL VAR label) : + CONCR (label) := 0 +ENDPROC declare ; + +PROC define (LABEL VAR label) : + EXTERNAL 10083 +ENDPROC define ; + +PROC complement condition code : + invers := TRUE +ENDPROC complement condition code ; + +PROC apply (LABEL VAR label) : + EXTERNAL 10148 +ENDPROC apply ; + +PROC apply (LABEL VAR label, BOOL CONST condition) : + IF condition xor invers THEN branch true (label) + ELSE branch false (label) + FI ; + invers := FALSE . + +condition xor invers : + IF condition THEN NOT invers + ELSE invers + FI +ENDPROC apply ; + +OP := (LABEL VAR global label, local label) : (* EQUATE ! *) + EXTERNAL 10014 +ENDOP := ; + +TEXT PROC dump (LABEL CONST label) : + "LAB " + text (CONCR (label)) +ENDPROC dump ; + +PROC gosub (LABEL VAR label) : + EXTERNAL 10015 +ENDPROC gosub ; + +PROC goret : + s0 (q goret code) +ENDPROC goret ; + +PROC branch true (LABEL VAR label) : + EXTERNAL 10028 +ENDPROC branch true ; + +PROC branch false (LABEL VAR label) : + EXTERNAL 10029 +ENDPROC branch false ; + + +#page# +(**************************************************************************) +(* *) +(* 3. Datenaddressen 21.03.1986 *) +(* *) +(* Definition des Datentyps ADDRESS *) +(* *) +(* Aufbau von Datenaddressen (Vercodung) *) +(* Fortschalten und Ausrichten von Adressen *) +(* Bereitstellen der Fehlermeldung "address overflow" (Coder-intern) *) +(* *) +(**************************************************************************) + + + +TYPE ADDRESS = STRUCT (INT kind, value) ; + +LET global = 0 , + local = 1 , + ref mask = 2 , + global ref = 2 , + local ref = 3 , + module nr = 4 , + immediate value = 5 , + + eumel0 stack offset = 4 , + local address limit = 16 384 , + + illegal ref operation = "REF not allowed" , + deref on non ref = "DEREF on non-ref address" , + global ref not allowed = "GLOBAL REF not allowed" , + unknown kind = "Unknown address kind" , + address overflow = "Address Overflow" , + illegal plus operation = "+ not allowed" ; + +ADDRESS VAR result addr; + +INT CONST ref length :: 2 ; + +OP := (ADDRESS VAR l, ADDRESS CONST r) : + CONCR (l) := CONCR (r) +ENDOP := ; + +ADDRESS OP GLOB (INT CONST address level) : + result addr.kind := global ; + result addr.value := address level ; + IF memory management mode = data allocation by user + THEN result addr.value INCR global address offset + FI ; + result addr +ENDOP GLOB ; + +ADDRESS OP LOC (INT CONST address level) : + result addr.kind := local ; + result addr.value := address level + eumel0 stack offset ; + result addr +ENDOP LOC ; + +ADDRESS OP REF (ADDRESS CONST addr) : + CONCR (result addr) := CONCR (addr) ; + IF result addr.kind = local THEN result addr.kind INCR ref mask + ELIF result addr.kind = global THEN errorstop (global ref not allowed) + ELSE errorstop (illegal ref operation) + FI ; + result addr +ENDOP REF ; + +ADDRESS OP DEREF (ADDRESS CONST ref address) : + CONCR (result addr) := CONCR (ref address) ; + IF is not local ref THEN errorstop (deref on non ref) FI ; + result addr.kind DECR ref mask ; + result addr . + +is not local ref : + result addr.kind <> local ref +ENDOP DEREF ; + +INT OP REPR (ADDRESS CONST addr) : + CONCR (result addr) := CONCR (addr) ; + SELECT result addr.kind OF + CASE global : + CASE local : set bit (result addr.value, 15) + CASE global ref : errorstop (global ref not allowed) + CASE local ref : prep local ref + OTHERWISE errorstop (unknown kind) + ENDSELECT ; + result addr.value . + +prep local ref : + IF address limit exceeded THEN errorstop (address overflow) FI ; + set bit (result addr.value, 14) ; + set bit (result addr.value, 15) . + +address limit exceeded : + result addr.value < eumel0 stack offset OR + result addr.value > local address limit +ENDOP REPR ; + +BOOL PROC is ref (ADDRESS CONST addr) : + addr.kind = local ref +ENDPROC is ref ; + +BOOL PROC is global (ADDRESS CONST addr) : + addr.kind = global +ENDPROC is global ; + +BOOL PROC is local (ADDRESS CONST addr) : + addr.kind = local +ENDPROC is local ; + +ADDRESS OP + (ADDRESS CONST addr, INT CONST offset) : + CONCR (result addr) := CONCR (addr) ; + SELECT result addr.kind OF + CASE global : inc global + CASE local : inc local + OTHERWISE errorstop (illegal plus operation) + ENDSELECT ; + result addr . + +inc global : + result addr.value INCR offset ; + IF result addr.value < 0 THEN errorstop (address overflow) FI . + +inc local : + result addr.value INCR offset ; + IF result addr.value < eumel 0 stack offset OR + result addr.value > local address limit + THEN errorstop (address overflow) + FI +ENDOP + ; + +PROC adjust (ADDRESS VAR addr, INT CONST adjust length) : + IF is local or global THEN adjust to length FI . + +is local or global : + addr.kind <= local . + +adjust to length : + mode := addr.value MOD adjust length ; + IF mode <> 0 THEN addr.value INCR (adjust length-mode) FI +ENDPROC adjust ; + +TEXT PROC dump (ADDRESS CONST addr) : + kind + text (addr.value) . + +kind : + SELECT addr.kind OF + CASE global : "GLOBAL " + CASE local : "LOCAL " + CASE immediate value : "IMMEDIATE " + CASE module nr : "PARAM PROC " + CASE global ref : "GLOBAL REF " + CASE local ref : "LOCAL REF " + OTHERWISE "undef. Addr:" + ENDSELECT +ENDPROC dump; + + +#page# +(**************************************************************************) +(* *) +(* 4. Datentypen Teil I 03.12.1985 *) +(* *) +(* Definition des Datentyps DTYPE *) +(* *) +(* Interne Repraesentation der primitiven Datentypen *) +(* Identifikation von DTYPEs *) +(* *) +(**************************************************************************) + + + +TYPE DTYPE = INT ; + +OP := (DTYPE VAR l, DTYPE CONST r) : + CONCR (l) := CONCR (r) +ENDOP := ; + +BOOL OP = (DTYPE CONST l, r) : + CONCR (l) = CONCR (r) +ENDOP = ; + +DTYPE PROC void type : DTYPE :(void) ENDPROC void type ; + +DTYPE PROC int type : DTYPE :(int ) ENDPROC int type ; + +DTYPE PROC real type : DTYPE :(real) ENDPROC real type ; + +DTYPE PROC text type : DTYPE :(string) ENDPROC text type ; + +DTYPE PROC bool type : DTYPE :(bool) ENDPROC bool type ; + +DTYPE PROC dataspace type : DTYPE :(dataspace) ENDPROC dataspace type ; + +DTYPE PROC undefined type : DTYPE :(undefined) ENDPROC undefined type ; + +DTYPE PROC row type : DTYPE :(row) ENDPROC row type ; + +DTYPE PROC struct type : DTYPE :(struct) ENDPROC struct type ; + +DTYPE PROC proc type : DTYPE :(permanent param proc) ENDPROC proc type ; + +DTYPE PROC end type : DTYPE :(end) ENDPROC end type ; + +INT PROC type class (DTYPE CONST type) : + SELECT type id OF + CASE int, real, bool, string, dataspace, undefined : 1 + CASE void : 0 + CASE row : 3 + CASE struct : 4 + CASE permanent param proc : 5 + OTHERWISE pt type + ENDSELECT . + +pt type : + IF type id > ptt limit THEN permanent row or struct + ELSE abstract type + FI . + +abstract type : 2 . + +permanent row or struct : + mode := cdbint (type link into pt) MOD ptt limit ; + IF mode = struct THEN 4 + ELIF mode = row THEN 3 + ELSE 2 + FI . + +type link into pt : + type id + begin of pt minus ptt limit . + +type id : CONCR (type) +ENDPROC type class ; + +PROC identify (TEXT CONST name,INT VAR size, align, DTYPE VAR type) : + SELECT type pos OF + CASE 1 : size := 0; align := 0; type id := void + CASE 6 : size := 1; align := 1; type id := int + CASE 10 : size := 4; align := 4; type id := real + CASE 15 : size := 8; align := 4; type id := string + CASE 20 : size := 1; align := 1; type id := bool + CASE 25 : size := 1; align := 1; type id := dataspace + OTHERWISE search for type in permanent table + ENDSELECT . + +type pos : + enclose in delimiters ; + pos (".VOID.INT.REAL.TEXT.BOOL.DATASPACE.", object name) . + +enclose in delimiters : + object name := "." ; + object name CAT name ; + object name CAT "." . + +search for type in permanent table : + to object (name) ; + IF NOT found THEN size := 0; align := 0; type id := undefined + ELSE size := cdbint (permanent pointer + two wordlength) ; + type id := permanent pointer - begin of permanent table ; + IF size < two wordlength THEN align := 1 + ELIF size < four wordlength THEN align := 2 + ELSE align := 4 + FI + FI . + +type id : CONCR (type) +ENDPROC identify ; + + +#page# +(**************************************************************************) +(* *) +(* 5. Operationen Teil I 21.03.1986 *) +(* *) +(* Definition des Datentyps OPN *) +(* Primitive Operationen (:= etc.) *) +(* Bereitstellen dee Fehlermeldung 'proc op expected' (coder-intern) *) +(* *) +(**************************************************************************) + + +TYPE OPN = STRUCT (INT kind, mod nr, top of stack) ; + +LET proc op = 0 , + param proc = 1 , + eumel 0 = 2 , + nil = 3 , + + param proc at non ref = "PARAM PROC at non-ref address" , + proc op expected = "PROC expected" ; + +OPN VAR eumel0 opn; +eumel0 opn.kind := eumel0 ; +eumel0 opn.top of stack := 0 ; + +eumel0 opn.mod nr := q pp ; +OPN CONST pp :: eumel0 opn , + nop code :: OPN :(nil, 0, 0) ; + +THESAURUS VAR eumel 0 opcodes :: empty thesaurus ; + +PROC init op codes (FILE VAR eumelcodes) : + eumel 0 opcodes := empty thesaurus ; + WHILE NOT eof (eumelcodes) REP + getline (eumelcodes, object name) ; + delete trailing blanks ; + IF object name <> "" CAND NOT (eumel 0 opcodes CONTAINS object name) + THEN insert (eumel 0 opcodes, object name) + FI + PER . + +delete trailing blanks : + WHILE (object name SUB LENGTH object name) = " " REP + object name := subtext (object name, 1, LENGTH object name - 1) + PER +ENDPROC init op codes ; + +ADDRESS PROC address (OPN CONST opn) : + IF opn.kind <> proc op THEN errorstop (proc op expected) FI ; + result addr.kind := module nr ; + result addr.value := opn.mod nr ; + result addr +ENDPROC address ; + +OPN PROC operation (ADDRESS CONST addr) : + IF addr.kind <> local ref THEN errorstop (param proc at non ref) FI ; + OPN VAR opn ; + opn.kind := param proc ; + opn.mod nr :=addr.value ; + opn.top of stack := 0 ; + opn +ENDPROC operation ; + +TEXT PROC mnemonic (OPN CONST op code) : + name (eumel 0 opcodes, op code.mod nr) +ENDPROC mnemonic ; + +OPN PROC nop : + nop code +ENDPROC nop ; + +OP := (OPN VAR r, OPN CONST l) : + CONCR (r) := CONCR (l) +ENDOP := ; + +BOOL PROC is proc (OPN CONST operation) : + operation.kind = proc op +ENDPROC is proc ; + +BOOL PROC is eumel 0 instruction (TEXT CONST op code name) : + link (eumel 0 opcodes, op code name) <> 0 +ENDPROC is eumel 0 instruction ; + + +#page# +(**************************************************************************) +(* *) +(* 6. Parameterfeld 10.01.1986 *) +(* *) +(* Bereitstellen des Parameterfeldes *) +(* Schreiben und Lesen von Eintraegen im Parameterfeld *) +(* Fortschalten von Zeigern in das Parameterfeld *) +(* Bereitstellen der Konstanten 'size of param field' (Coder-intern) *) +(* *) +(**************************************************************************) + + + +LET PARAMDESCRIPTOR = STRUCT (DTYPE type, INT access, + ADDRESS addr, OPN push opn) , + + size of param field = 100 , + param field exceeded = "Param Field Overflow", + param nr out of range = "Illegal Param Number" ; + +ROW size of param field PARAMDESCRIPTOR VAR param field ; + + + (***** Schreiben *****) + +PROC test param pos (INT CONST param nr) : + IF param nr < 1 OR param nr > size of param field + THEN errorstop (param nr out of range) + FI +ENDPROC test param pos ; + +PROC declare (INT CONST param nr, DTYPE CONST type) : + test param pos (param nr) ; + enter type . + +enter type : + CONCR (param field [param nr].type) := CONCR (type) +ENDPROC declare ; + +PROC declare (INT CONST param nr, access) : + test param pos (param nr) ; + enter access . + +enter access : + param field [param nr].access := access +ENDPROC declare ; + +PROC define (INT CONST param nr, ADDRESS CONST addr) : + test param pos (param nr) ; + enter address . + +enter address : + CONCR (param field [param nr].addr) := CONCR (addr) +ENDPROC define ; + +PROC define (INT CONST param nr, value) : + result addr.kind := immediate value ; + result addr.value := value ; + define (param nr, result addr) +ENDPROC define ; + +PROC apply (INT CONST param nr, OPN CONST opn) : + test param pos (param nr) ; + enter push opn . + +enter push opn : + CONCR (param field [param nr].push opn) := CONCR (opn) +ENDPROC apply ; + +PROC parameter (INT CONST param nr, DTYPE CONST type, + INT CONST access, ADDRESS CONST addr) : + test param pos (param nr) ; + enter type ; + enter access ; + enter address ; + enter pp as default . + +enter type : + CONCR (param field [param nr].type) := CONCR (type) . + +enter access : + param field [param nr].access := access . + +enter address : + CONCR (param field [param nr].addr) := CONCR (addr) . + +enter pp as default : + CONCR (param field [param nr].push opn) := CONCR (pp) +ENDPROC parameter ; + + + (***** Lesen *****) + +ADDRESS PROC param address (INT CONST param nr) : + test param pos (param nr) ; + param field [param nr].addr +ENDPROC param address ; + +DTYPE PROC dtype (INT CONST param nr) : + test param pos (param nr) ; + param field [param nr].type +ENDPROC dtype ; + +INT PROC access (INT CONST param nr) : + test param pos (param nr) ; + param field [param nr].access +ENDPROC access ; + + + (***** Fortschalten *****) + +OP NEXTPARAM (INT VAR param nr) : + test param pos (param nr) ; + IF long entry THEN read until end FI ; + param nr INCR 1 . + +long entry : + type class (param field [param nr].type) > 2 . + +read until end : + REP + param nr INCR 1 ; + NEXTPARAM param nr + UNTIL end marker read or end of field PER . + +end marker read or end of field : + param nr > size of param field OR + CONCR (param field [param nr].type) = end +ENDOP NEXTPARAM ; + +INT PROC next param (INT CONST p) : + index := p ; + NEXTPARAM index ; + index +ENDPROC next param ; + +TEXT PROC dump (INT CONST p) : + IF p > 0 AND p <= 100 THEN dump entry (param field (p)) + ELSE param nr out of range + FI +ENDPROC dump ; + +TEXT PROC dump entry (PARAMDESCRIPTOR CONST id) : + object name := dump (id.type) ; + object name CAT text (id.access) ; + object name CAT dump (id.addr) ; + object name CAT dump (id.push opn) ; + object name +ENDPROC dump entry ; + + +#page# +(**************************************************************************) +(* *) +(* 7. Datentypen Teil II 20.01.1986 *) +(* *) +(* Deklaration neuer Datentypen *) +(* Vergleich von DTYPEs im Parameterfeld und in der Permanent-Tabelle *) +(* *) +(**************************************************************************) + + + +DTYPE VAR pt type ; + +PROC declare (TEXT CONST name, INT CONST size, align, DTYPE VAR type) : + entry into name table ; + put next permanent (permanent type) ; + put next permanent (size) ; + put next permanent (nt link) ; + mark no offsets of text elements . + +entry into name table : + declare object (name, nt link, CONCR (type)) . + +mark no offsets of text elements : + put next permanent (0) +ENDPROC declare ; + +BOOL PROC same type (INT CONST param 1, param 2) : + INT CONST left type :: CONCR (param field [param 1].type) ; + IF left type = right type + THEN same fine structure if there is one + ELSE left type = undefined OR right type = undefined + FI . + +right type : CONCR (param field [param 2].type) . + +same fine structure if there is one : + IF left type = row THEN compare row + ELIF left type = struct THEN compare struct + ELSE TRUE + FI . + +compare row : + equal sizes AND same type (param1 + 1, param2 + 1) . + +equal sizes : + param field [param1+1].access = param field [param2+1].access . + +compare struct : + INT VAR p1 :: param1+1, p2 :: param2+1 ; + REP + IF NOT same type (p1, p2) THEN LEAVE same type WITH FALSE + ELIF end type found THEN LEAVE same type WITH TRUE + FI ; + NEXTPARAM p1 ; + NEXTPARAM p2 + UNTIL end of field PER ; + FALSE . + +end type found : + CONCR (param field [p1].type) = end . + +end of field : + p1 > size of param field OR p2 > size of param field +ENDPROC same type ; + +BOOL PROC same type (INT CONST param nr, DTYPE CONST type) : + field pointer := param nr ; + CONCR (pt type) := CONCR (type) ; + equal types +ENDPROC same type ; + +BOOL PROC equal types : + identical types OR one type is undefined . + +one type is undefined : + type of actual field = undefined OR CONCR(pt type) = undefined . + +identical types : + SELECT type class (pt type) OF + CASE 0, 1, 2 : type of actual field = CONCR (pt type) + CASE 3 : perhaps equal rows + CASE 4 : perhaps equal structs + OTHERWISE FALSE + ENDSELECT . + +perhaps equal rows : + is row AND equal row sizes AND equal row types . + +is row : + type of actual field = row . + +perhaps equal structs : + is struct AND same type fields . + +is struct : + type of actual field = struct . + +equal row sizes : + pt row size = row size within param field . + +equal row types : + same type (field pointer + 1, pt row type) . + +pt row size : + cdb int (CONCR(pt type) + offset to row size) . + +pt row type : + CONCR (pt type) INCR 2 ; + pt type . + +row size within param field : + param field [field pointer].access . + +same type fields : + field pointer INCR 1 ; + CONCR (pt type) INCR 1 ; + REP + IF NOT equal types THEN LEAVE same type fields WITH FALSE FI ; + IF type of actual field = end + THEN LEAVE same type fields WITH TRUE + FI ; + NEXTPARAM field pointer + UNTIL end of field PER ; + FALSE . + +end of field : + field pointer > size of param field . + +type of actual field : + CONCR (param field [field pointer].type) . +ENDPROC equal types ; + +BOOL PROC is not void bool or undefined (DTYPE CONST dtype) : + type <> void AND type <> bool AND type <> undefined . + +type : CONCR (dtype) +ENDPROC is not void bool or undefined ; + + +#page# +(**************************************************************************) +(* *) +(* 8. Operationen Teil II 07.03.1986 *) +(* *) +(* Definition der Opcodes *) +(* Deklaration, Definition, Identifikation und Applikation *) +(* Eroeffnen und Schliessen eines Moduls *) +(* *) +(**************************************************************************) + + + +LET module not opened = "Module not opened" , + define missing = "DEFINE missing" , + wrong nr of params = "Wrong Nr. of Params:" , + illegal kind = "Opcode expected" , + nested module = "Nested Modules" , + no mod nr = "Param Proc expected" , + no immediate value = "Value expected" , + type error = "Type Error" , + + q ln = 1 , + q move = 2 , q move code = 2 048 , + q inc1 = 3 , q inc1 code = 3 072 , + q dec1 = 4 , q dec1 code = 4 096 , + q inc = 5 , q inc code = 5 120 , + q dec = 6 , q dec code = 6 144 , + q add = 7 , q add code = 7 168 , + q sub = 8 , q sub code = 8 192 , + q clear = 9 , q clear code = 9 216 , + q test = 10 , + q equ = 11 , q equ code = 11 264 , + q lsequ = 12 , q lsequ code = 12 288 , + q fmove = 13 , q fmove code = 13 312 , + q fadd = 14 , q fadd code = 14 336 , + q fsub = 15 , q fsub code = 15 360 , + q fmult = 16 , q fmult code = 16 384 , + q fdiv = 17 , q fdiv code = 17 408 , + q flsequ = 18 , q flsequ code = 18 432 , + q tmove = 19 , q tmove code = 19 456 , + q tequ = 20 , q tequ code = 20 480 , + q accds = 21 , q access ds code = 22 528 , + q ref = 22 , q ref code = 23 552 , + q subscript = 23 , q subscript code = 24 576 , + q select = 24 , q select code = 25 600 , + q ppv = 25 , + q pp = 26 , + q make false = 27 , (* q make false code = 65 513 *) + q movex = 28 , +(* q longa subs q longa subs code = 65 376 *) + q return = 29 , q return code = 32 512 , + q true return = 30 , q true return code = 32 513 , + q false return = 31 , q false return code = 32 514 , + q goret code = 32 519 , + q esc mult = 32 , q esc mult code = 32 553 , + q esc div = 33 , q esc div code = 32 554 , + q esc mod = 34 , q esc mod code = 32 555 , + q pproc = 35 , + q compl int = 36 , q compl int code = 32 551 , + q compl real = 37 , q compl real code = 32 550 , +(* q alias ds = 38 , *) + q movim = 39 , q esc movim code = 32 547 , + q fequ = 40 , q fequ code = 32 548 , + q tlsequ = 41 , q tlsequ code = 32 549 , +(* q case = 42 , *) + q plus = 43 , + q minus = 44 , + q mult = 45 , + q int div = 46 , + q real div = 47 , + q equal = 48 , + q lessequal = 49 ; + +INT CONST q make false code :: - 1 022 , + q longa subs code :: - 159 ; + + + (***** Deklaration *****) + +PROC declare (OPN VAR operation) : + operation.kind := proc op ; + get module nr (operation.mod nr) ; + operation.top of stack := 0 +ENDPROC declare ; + +PROC declare (TEXT CONST name, INT CONST first, params, OPN VAR operation) : + declare (operation) ; + entry into name and pt table if necessary ; + enter params ; + enter result ; + enter module number . + +entry into name and pt table if necessary : + declare object (name, nt link, permanent pointer) . + +enter params : + field pointer := first ; + FOR index FROM 1 UPTO params REP + enter param (param field [field pointer]) ; + NEXTPARAM field pointer + PER . + +enter result : + enter param (param field[field pointer].type, permanent proc op) . + +enter module number : + put next permanent (operation.mod nr) +ENDPROC declare ; + +PROC enter param (PARAMDESCRIPTOR CONST param) : + IF param.access = const + THEN enter param (param.type, permanent param const) + ELIF param.access = var + THEN enter param (param.type, permanent param var) + ELSE errorstop ("Unknown Access") + FI +ENDPROC enter param ; + +PROC enter param (DTYPE CONST type, INT CONST permanent mode) : + SELECT type class (type) OF + CASE 0, 1, 2 : put next permanent (CONCR(type) + permanent mode) + OTHERWISE errorstop ("Illegal Type") + ENDSELECT +ENDPROC enter param ; + + + (***** Definition *****) + +PROC define (OPN VAR opn) : + IF NOT module open THEN errorstop (module not opened) + ELSE proc head (opn.mod nr, opn.top of stack) + FI +ENDPROC define ; + +PROC set length of local storage (OPN VAR opn, INT CONST size) : + IF size < 0 OR size > local address limit + THEN errorstop (address overflow) + ELIF opn.top of stack = 0 + THEN errorstop (define missing) + ELIF opn.kind <> proc op + THEN errorstop (proc op expected) + FI ; + set length (opn.top of stack, size + eumel0 stack offset) +ENDPROC set length of local storage ; + +PROC define (OPN VAR operation, INT CONST size) : + define (operation) ; + set length of local storage (operation, size) +ENDPROC define ; + + + (***** Identifikation *****) + +INT VAR counter, result index, result type repr; + +PROC identify (TEXT CONST name, INT CONST first, params, OPN VAR operation, + BOOL VAR object exists) : + find result entry ; + to object (name) ; + IF found THEN first fit and leave if found FI ; + IF eumel0 THEN identify eumel0 instruction + ELSE yield undefined operation + FI . + +find result entry : + result index := first; + counter := 0 ; + WHILE counter < params REP + NEXTPARAM result index ; + counter INCR 1 + PER ; + check on param field exceeded . + +check on param field exceeded : + IF result index > size of param field + THEN errorstop (param field exceeded) + FI . + +yield undefined operation : + declare (result index, undefined type) ; + apply (result index, nop) ; + object exists := FALSE . + +first fit and leave if found : + WHILE yet another procedure exists REP + check one procedure and leave if match ; + next procedure + PER . + +yet another procedure exists : + permanent pointer <> 0 . + +check one procedure and leave if match: + param link := permanent pointer + wordlength ; + set end marker if end of list ; + counter := params ; + field pointer := 1 ; + REP + IF end of params AND counter = 0 + THEN procedure found + ELIF end of params OR counter = 0 + THEN LEAVE check one procedure and leave if match + ELSE check next param + FI + PER . + +check next param : + get type and mode (CONCR(pt type)) ; + IF same types THEN set param mode ; + counter DECR 1 ; + field pointer INCR 1 ; + next pt param + ELSE LEAVE check one procedure and leave if match + FI . + +same types : (* inline version ! *) + equal types . + +set param mode : + param field [field pointer].access := mode . + +procedure found : + get result ; + operation.kind := proc op ; + operation.mod nr := module number ; + operation.top of stack := 0 ; + object exists := TRUE ; + LEAVE identify . + +get result : + get type and mode (result type) ; + declare (result index, mode) . + +module number : + cdbint (param link + 1) . + +result type : + CONCR (param field [result index].type) . + +eumel0 : + eumel0 opn.mod nr := link (eumel 0 opcodes, name) ; + eumel0 opn.mod nr <> 0 . + +identify eumel 0 instruction : + init result type with void ; + CONCR (operation) := CONCR (eumel0 opn) ; + object exists := check params and set result ; + declare (result index, DTYPE:(result type repr)) ; + declare (result index, const) . + +init result type with void : + result type repr := void . + +check params and set result : + SELECT operation.mod nr OF + CASE q return, q false return, q true return : no params + CASE q inc1, q dec1 : one int param yielding void + CASE q pproc, q pp, q ln : one param yielding void + CASE q test : one param yielding bool + CASE q clear, q ppv : one int or bool param yielding void + CASE q make false : one bool param yielding void + CASE q move : two int or bool params yielding void + CASE q compl int, q inc, q dec : two int params yielding void + CASE q compl real, q fmove : two real params yielding void + CASE q equ, q lsequ : two int params yielding bool + CASE q fequ, q flsequ : two real params yielding bool + CASE q tequ, q tlsequ : two text params yielding bool + CASE q tmove : two text params yielding void + CASE q accds, q ref : two params yielding void + CASE q add, q sub, q esc mult, + q esc div, q esc mod : three int params yielding void + CASE q fadd, q fsub, q fmult, q fdiv : three real params yielding void + CASE q select, q movex : three params + CASE q subscript : five params + CASE q plus, q minus, q mult : two intreals yielding intreal + CASE q int div : two int params yielding int + CASE q real div : two real params yielding real + CASE q equal, q lessequal : two intrealtexts yielding bool + OTHERWISE FALSE + ENDSELECT . + +no params : + params = 0 . + +one int param yielding void : + p1 void (int type, first, params) . + +one param yielding void : + params = 1 . + +one param yielding bool : + IF params = 1 THEN result type repr := bool ; + TRUE + ELSE FALSE + FI . + +one int or bool param yielding void : + p1 void (int type, first, params) OR p1 void (bool type, first, params) . + +one bool param yielding void : + p1 void (bool type, first, params) . + +two int or bool params yielding void : + p2 (int type, first, params, void) OR + p2 (bool type, first, params, void) . + +two int params yielding void : + p2 (int type, first, params, void) . + +two real params yielding void : + p2 (real type, first, params, void) . + +two text params yielding void : + p2 (text type, first, params, void) . + +two int params yielding bool : + p2 (int type, first, params, bool) . + +two real params yielding bool : + p2 (real type, first, params, bool) . + +two text params yielding bool : + p2 (text type, first, params, bool) . + +two params yielding void : + params = 2 . + +three int params yielding void : + p3 void (int type, first, params) . + +three real params yielding void : + p3 void (real type, first, params) . + +three params : + params = 3 . + +five params : + params = 5 . + +two intreals yielding intreal : + two int params yielding int OR two real params yielding real . + +two intrealtexts yielding bool : + two int params yielding bool OR two real params yielding bool OR + two text params yielding bool . + +two int params yielding int : + p2 (int type, first, params, int) . + +two real params yielding real : + p2 (real type, first, params, real) +ENDPROC identify ; + +BOOL PROC p1 void (DTYPE CONST requested type, INT CONST first, param nr) : + param nr = 1 AND param type is requested plain type . + +param type is requested plain type : + CONCR (param field [first].type) = CONCR (requested type) + +ENDPROC p1 void ; + +BOOL PROC p2 (DTYPE CONST requested type, INT CONST first, param nr, + INT CONST result type) : + IF param nr = 2 AND param types equal requested plain type + THEN result type repr := result type ; + TRUE + ELSE FALSE + FI . + +param types equal requested plain type : + CONCR (param field [first] .type) = CONCR (requested type) AND + CONCR (param field [first+1].type) = CONCR (requested type) + +ENDPROC p2 ; + +BOOL PROC p3 void (DTYPE CONST requested type, INT CONST first, param nr) : + param nr = 3 AND param types ok . + +param types ok : + FOR index FROM first UPTO first+2 REP + IF different param types THEN LEAVE p3 void WITH FALSE FI + PER ; + TRUE . + +different param types : + CONCR (param field [index].type) <> CONCR (requested type) +ENDPROC p3 void; + + + (***** Applikation *****) + +INT VAR address representation, left repr, right repr, result repr; + +PROC apply (INT CONST first, nr of params, OPN CONST opn) : + IF NOT module open THEN errorstop (module not opened) FI ; + SELECT opn.kind OF + CASE eumel 0 : generate eumel0 instruction + CASE proc op : call operation + CASE param proc : call param proc + CASE nil : + OTHERWISE errorstop (illegal kind) + ENDSELECT . + +call operation : + push params if necessary (first, nr of params, opn.mod nr) ; + call (opn.mod nr) . + +call param proc : + result addr.kind := local ref ; + result addr.value := opn.mod nr ; + address representation := REPR result addr ; + push params if necessary (first, nr of params, address representation) ; + call param (address representation) . + +generate eumel0 instruction : + SELECT real nr of params OF + CASE 0 : p0 instruction + CASE 1 : apply p1 (opn, first addr) + CASE 2 : apply p2 (opn, first addr, second addr) + CASE 3 : apply p3 (opn, left type, first addr, second addr, third addr) + CASE 5 : subscript operation + OTHERWISE errorstop (wrong nr of params + text (nr of params)) + ENDSELECT . + +real nr of params : + IF operator denotation THEN nr of params + 1 + ELSE nr of params + FI . + +operator denotation : + opn.mod nr >= q plus . + +p0 instruction : + IF opn.mod nr = q return THEN s0 (q return code) + ELIF opn.mod nr = q true return THEN s0 (q true return code) + ELIF opn.mod nr = q false return THEN s0 (q false return code) + ELSE errorstop (wrong nr of params + + mnemonic (opn)) + FI . + +subscript operation : + IF opn.mod nr = q subscript + THEN subscription + ELSE errorstop (wrong nr of params + text (nr of params)) + FI . + +subscription : + ADDRESS CONST element length :: param field [first+2].addr , + limit :: param field [first+3].addr ; + check on immediates ; + IF element length.value < 1024 + THEN s0 (q subscript code + element length.value) + ELSE s0 (q longa subs code) ; + s0 (element length.value) + FI ; + s3 (limit.value - 1, subs index, base addr, subs result) . + +check on immediates : + IF element length.kind <> immediate value OR + limit.kind <> immediate value + THEN errorstop (no immediate value) + FI . + +subs index : REPR param field [first+1].addr . + +base addr : REPR param field [first].addr . + +subs result : REPR param field [first+4].addr . + +first addr : + param field [first].addr . + +left type : + param field [first].type . + +second addr : + param field [nextparam (first)].addr . + +third addr : + param field [nextparam(nextparam(first))].addr +ENDPROC apply ; + +PROC push params if necessary (INT CONST first, nr of params, mod nr) : + init param push (mod nr) ; + IF nr of params > 0 THEN push params ; + push result if there is one + FI . + +push params : + field pointer := first ; + FOR index FROM 1 UPTO nr of params REP + apply p1 (push code, param addr) ; + NEXTPARAM field pointer + PER . + +push code : + param field [field pointer].push opn . + +param addr : + param field [field pointer].addr . + +push result if there is one : + IF push result necessary + THEN push result address (REPR param field [field pointer].addr) + FI . + +push result necessary : + param field [field pointer].push opn.kind <> nil AND + is not void bool or undefined (param field [field pointer].type) +ENDPROC push params if necessary ; + +PROC apply p1 (OPN CONST opn, ADDRESS CONST addr) : + IF opn.mod nr = q ln THEN generate line number + ELIF opn.mod nr = q pproc THEN push module nr + ELSE gen p1 instruction + FI . + +gen p1 instruction : + address representation := REPR addr ; + SELECT opn.mod nr OF + CASE q inc1 : t1 (q inc1 code, address representation) + CASE q dec1 : t1 (q dec1 code, address representation) + CASE q clear : t1 (q clear code,address representation) + CASE q test : test bool object (address representation) + CASE q pp : push param (address representation) + CASE q make false : s1 (q make false code, address representation) + OTHERWISE errorstop (wrong nr of params + mnemonic (opn)) + ENDSELECT . + +generate line number : + IF addr.kind = immediate value THEN mark line (addr.value) + ELSE errorstop (no immediate value) + FI . + +push module nr : + IF addr.kind = module nr THEN push param proc (addr.value) + ELSE errorstop (no mod nr) + FI +ENDPROC apply p1; + +PROC apply p2 (OPN CONST opn, ADDRESS CONST left addr, right addr): + left repr := REPR left addr ; + IF opn.mod nr = q movim THEN move immediate + ELSE gen p2 instruction + FI . + +gen p2 instruction : + right repr := REPR right addr ; + SELECT opn.mod nr OF + CASE q move : t2 (q move code, right repr, left repr) + CASE q inc : t2 (q inc code, right repr, left repr) + CASE q dec : t2 (q dec code, right repr, left repr) + CASE q equ : compare (q equ code, left repr, right repr) + CASE q lsequ : compare (q lsequ code, left repr, right repr) + CASE q fmove : t2 (q fmove code, right repr, left repr) + CASE q flsequ : compare (q flsequ code, left repr, right repr) + CASE q tmove : t2 (q tmove code, right repr, left repr) + CASE q tequ : compare (q tequ code, left repr, right repr) + CASE q compl int : s2 (q compl int code, left repr, right repr) + CASE q compl real : s2 (q compl real code, left repr, right repr) + CASE q fequ : compare (q fequ code, left repr, right repr) + CASE q tlsequ : compare (q tlsequ code, left repr, right repr) + CASE q accds : t2 (q access ds code, left repr, right repr) + CASE q ref : t2 (q ref code, left repr, right repr) + OTHERWISE errorstop (wrong nr of params + mnemonic (opn)) + ENDSELECT . + +move immediate : + IF right addr.kind = immediate value + THEN s0 (q esc movim code) ; + s1 (left repr, right addr.value) + ELSE errorstop (no immediate value) + FI +ENDPROC apply p2; + +PROC apply p3 (OPN CONST opn, DTYPE CONST left dtype, + ADDRESS CONST left addr, right addr, result addr ): + left repr := REPR left addr ; + result repr := REPR result addr ; + IF opn.mod nr = q select THEN gen select instruction + ELIF opn.mod nr = q movex THEN gen long move + ELSE gen p3 instruction + FI . + +gen p3 instruction : + right repr := REPR right addr ; + SELECT opn.mod nr OF + CASE q add : int add + CASE q sub : int sub + CASE q fadd : real add + CASE q fsub : real sub + CASE q fmult : real mult + CASE q fdiv, q real div : real div + CASE q esc mult : int mult + CASE q esc div, q int div : int div + CASE q esc mod : int mod + CASE q plus : int real add + CASE q minus : int real sub + CASE q mult : int real mult + CASE q equal, q lessequal : compare (comp code, left repr, right repr) + OTHERWISE errorstop (wrong nr of params + mnemonic (opn)) + ENDSELECT . + +gen select instruction : + IF right addr.kind = immediate value + THEN t1 (q select code, left repr) ; + s1 (right addr.value, result repr) + ELSE errorstop (no immediate value) + FI . + +gen long move : + IF right addr.kind = immediate value + THEN long move (left repr, result repr, right addr.value) + ELSE errorstop (no immediate value) + FI . + +int add : compute (q add code, left repr, right repr, result repr) . + +int sub : compute (q sub code, left repr, right repr, result repr) . + +real add : compute (q fadd code, left repr, right repr, result repr) . + +real sub : compute (q fsub code, left repr, right repr, result repr) . + +real mult : compute (q fmult code, left repr, right repr, result repr) . + +real div : compute (q fdiv code, left repr, right repr, result repr) . + +int mult : s3 (q esc mult code, left repr, right repr, result repr) . + +int div : s3 (q esc div code, left repr, right repr, result repr) . + +int mod : s3 (q esc mod code, left repr, right repr, result repr) . + +int real add : + IF left type = int THEN int add + ELSE real add + FI . + +int real sub : + IF left type = int THEN int sub + ELSE real sub + FI . + +int real mult : + IF left type = int THEN int mult + ELSE real mult + FI . + +comp code : + SELECT left type OF + CASE int : IF opn.mod nr = q equal THEN q equ ELSE q lsequ FI + CASE real : IF opn.mod nr = q equal THEN q fequ ELSE q flsequ FI + CASE string : IF opn.mod nr = q equal THEN q tequ ELSE q tlsequ FI + OTHERWISE errorstop (type error); q equ + ENDSELECT . + +left type : CONCR (left dtype) + +ENDPROC apply p3; + + + (***** Modul *****) + +BOOL VAR module open ; + +.init opn section : + module open := FALSE .; + +PROC begin module : + IF module open THEN errorstop (nested module) + ELSE begin modul ; + module open := TRUE + FI +ENDPROC begin module ; + +PROC end module : + IF NOT module open + THEN errorstop (module not opened) + ELSE end modul ; + module open := FALSE + FI +ENDPROC end module ; + +TEXT PROC dump (OPN CONST operation) : + IF operation.kind = proc op THEN " PROC" + text (operation.mod nr, 5) + ELIF operation.kind = eumel 0 THEN " EUMEL0: " + mnemonic (operation) + ELSE " undef. Opn" + FI +ENDPROC dump ; + +PROC begin modul : + EXTERNAL 10071 +ENDPROC begin modul ; + +PROC end modul : + EXTERNAL 10011 +ENDPROC end modul ; + +PROC proc head (INT VAR mod nr, top of stack) : + EXTERNAL 10012 +ENDPROC proc head ; + +PROC set length (INT CONST top of stack, size) : + EXTERNAL 10013 +ENDPROC set length ; + +PROC get module nr (INT VAR module nr) : + EXTERNAL 10016 +ENDPROC get module nr ; + +PROC compute (INT CONST op code, l addr, r addr, result address) : + EXTERNAL 10017 +ENDPROC compute ; + +PROC compare (INT CONST op code, l addr, r addr) : + EXTERNAL 10018 +ENDPROC compare ; + +PROC long move (INT CONST to, from, length) : + EXTERNAL 10019 +ENDPROC long move ; + +PROC put next permanent (INT CONST permanent value) : + EXTERNAL 10020 +ENDPROC put next permanent ; + +PROC call (INT CONST mod nr) : + EXTERNAL 10022 +ENDPROC call ; + +PROC call param (INT CONST mod nr) : + EXTERNAL 10023 +ENDPROC call param ; + +PROC push param (INT CONST addr) : + EXTERNAL 10024 +ENDPROC push param ; + +PROC push param proc (INT CONST mod nr) : + EXTERNAL 10025 +ENDPROC push param proc ; + +PROC init param push (INT CONST mod nr) : + EXTERNAL 10026 +ENDPROC init param push ; + +PROC push result address (INT CONST addr) : + EXTERNAL 10027 +ENDPROC push result address ; + +PROC test bool object (INT CONST addr) : + EXTERNAL 10186 +ENDPROC test bool object ; + +PROC mark line (INT CONST line number) : + EXTERNAL 10030 +ENDPROC mark line ; + +PROC s0 (INT CONST op code) : + EXTERNAL 10038 +ENDPROC s0 ; + +PROC s1 (INT CONST op code, addr) : + EXTERNAL 10039 +ENDPROC s1 ; + +PROC s2 (INT CONST op code , addr1, addr2) : + EXTERNAL 10040 +ENDPROC s2 ; + +PROC s3 (INT CONST op code, addr1, addr2, addr3) : + EXTERNAL 10041 +ENDPROC s3 ; + +PROC t1 (INT CONST op code, addr) : + EXTERNAL 10042 +ENDPROC t1 ; + +PROC t2 (INT CONST op code, addr1, addr2) : + EXTERNAL 10043 +ENDPROC t2 ; + +#page# +(**************************************************************************) +(* *) +(* 9. Speicherverwaltung 21.03.1986 *) +(* *) +(* Ablage der Paketdaten *) +(* *) +(**************************************************************************) + + + +INT VAR address value; + +INT CONST data allocation by coder := 1 , + data allocation by user := 2 ; + +LET not initialized = 0 , + wrong mm mode = "Wrong MM Mode" , + define on non global = "Define for GLOB only" , + text too long = "TEXT too long" ; + +TEXT VAR const buffer :: point line ; + +.reset memory management mode : + memory management mode := not initialized . ; + +PROC reserve storage (INT CONST size) : + IF memory management mode <> data allocation by user + THEN errorstop (wrong mm mode) + FI ; + allocate var (address value, size) ; + memory management mode := not initialized +ENDPROC reserve storage ; + +PROC allocate variable (ADDRESS VAR addr, INT CONST size) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate var (addr.value, size) ; + addr.kind := global +ENDPROC allocate variable ; + +PROC allocate denoter (ADDRESS VAR addr, INT CONST value) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate int denoter (addr.value) ; + put data word (value, addr.value) ; + addr.kind := global +ENDPROC allocate denoter ; + +PROC allocate denoter (ADDRESS VAR addr, REAL CONST value) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate real denoter (addr.value) ; + addr.kind := global ; + define (addr, value) +ENDPROC allocate denoter ; + +PROC allocate denoter (ADDRESS VAR addr, TEXT CONST value) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate text denoter (addr.value, (LENGTH value+1) DIV 2 + 2) ; + addr.kind := global ; + skip heaplink; + define (addr, value) ; + reset heaplink . + +skip heaplink : + addr.value INCR 1 . + +reset heaplink : + addr.value DECR 1 +ENDPROC allocate denoter ; + +PROC define (ADDRESS CONST addr, INT CONST value) : + IF addr.kind <> global + THEN errorstop (define on non global) + FI ; + put data word (value, addr.value) +ENDPROC define ; + +PROC define (ADDRESS CONST addr, REAL CONST value) : + IF addr.kind <> global + THEN errorstop (define on non global) + FI ; + replace (const buffer, 1, value) ; + address value := addr.value ; + FOR index FROM 1 UPTO 4 REP + put data word (const buffer ISUB index, address value) ; + address value INCR 1 + PER +ENDPROC define ; + +PROC define (ADDRESS CONST addr, TEXT CONST value) : + IF addr.kind <> global THEN errorstop (define on non global) + ELIF LENGTH value > 255 THEN errorstop (text too long) + FI ; + address value := addr.value ; + const buffer := code (LENGTH value) ; + const buffer CAT value ; + const buffer CAT " " ; + FOR index FROM 1 UPTO LENGTH const buffer DIV 2 REP + put data word (const buffer ISUB index, address value) ; + address value INCR 1 + PER ; + const buffer := point line +ENDPROC define ; + +PROC prep pbase (INT VAR offset) : + EXTERNAL 10032 +ENDPROC prep pbase; + +PROC allocate var (INT VAR addr, INT CONST length) : + EXTERNAL 10033 +ENDPROC allocate var ; + +PROC allocate int denoter (INT VAR addr) : + EXTERNAL 10034 +ENDPROC allocate int denoter ; + +PROC allocate real denoter (INT VAR addr) : + EXTERNAL 10035 +ENDPROC allocate real denoter ; + +PROC allocate text denoter (INT VAR addr, INT CONST length) : + EXTERNAL 10036 +ENDPROC allocate text denoter ; + +PROC put data word (INT CONST value, INT CONST addr) : + EXTERNAL 10037 +ENDPROC put data word ; + + +#page# +(**************************************************************************) +(* *) +(* 10. Inspector 08.01.1986 *) +(* *) +(**************************************************************************) + +TEXT VAR type and mode ; + +TEXT PROC type name (DTYPE CONST type) : + type and mode := "" ; + name of type (CONCR (type)) ; + type and mode +ENDPROC type name ; + +TEXT PROC dump (DTYPE CONST type) : + type and mode := "TYPE " ; + name of type (CONCR (type)) ; + type and mode +ENDPROC dump ; + +PROC name of type (INT CONST type) : + SELECT type OF + CASE void : + CASE int : type and mode CAT "INT" + CASE real : type and mode CAT "REAL" + CASE string : type and mode CAT "TEXT" + CASE bool, bool result : type and mode CAT "BOOL" + CASE dataspace : type and mode CAT "DATASPACE" + OTHERWISE : complex type + ENDSELECT . + +complex type : + IF type > ptt limit THEN perhaps permanent struct or row + ELSE get complex type + FI . + +perhaps permanent struct or row : + index := type + begin of pt minus ptt limit ; + mode := cdb int (index) MOD ptt limit ; + IF mode = permanent row THEN get permanent row + ELIF mode = permanent struct THEN get permanent struct + ELSE type and mode CAT "-" + FI . + +get complex type : + index := type + begin of permanent table ; + IF is complex type THEN get name + ELSE type and mode CAT "-" + FI . + +is complex type : + permanent type definition mode = permanent type . + +get name : + type and mode CAT cdb text (link to type name + two word length) . + +link to type name : + cdb int (index + three word length) . + +permanent type definition mode : + cdb int (index + wordlength) . + +get permanent row : + INT VAR t; + type and mode CAT "ROW " ; + type and mode CAT text (cdb int (index + wordlength)) ; + type and mode CAT " " ; + param link := index + two wordlength ; + get type and mode (t) ; + name of type (t) . + +get permanent struct : + type and mode CAT "STRUCT ( ... )" +ENDPROC name of type ; + +ENDPACKET eumel coder ; diff --git a/system/eumel-coder/1.8.0/src/eumel0 codes b/system/eumel-coder/1.8.0/src/eumel0 codes new file mode 100644 index 0000000..428f71e --- /dev/null +++ b/system/eumel-coder/1.8.0/src/eumel0 codes @@ -0,0 +1,50 @@ +LN +MOVE +INC1 +DEC1 +INC +DEC +ADD +SUB +CLEAR +TEST +EQU +LSEQU +FMOVE +FADD +FSUB +FMULT +FDIV +FLSEQU +TMOVE +TEQU +ACCDS +REF +SUBSCRIPT +SELECT +PPV +PP +MAKE_FALSE +MOVEX +RETURN +TRUE_RETURN +FALSE_RETURN +ESC_MULT +ESC_DIV +ESC_MOD +PPROC +COMPL_INT +COMPL_REAL +ALIAS_DS +MOVIM +FEQU +TLSEQU +CASE ++ +- +* +DIV +/ += +<= + diff --git a/system/eumel-coder/1.8.1/source-disk b/system/eumel-coder/1.8.1/source-disk new file mode 100644 index 0000000..972580b --- /dev/null +++ b/system/eumel-coder/1.8.1/source-disk @@ -0,0 +1 @@ +debug/eumel-coder-1.8.1.img diff --git a/system/eumel-coder/1.8.1/src/eumel coder 1.8.1 b/system/eumel-coder/1.8.1/src/eumel coder 1.8.1 new file mode 100644 index 0000000..0047067 --- /dev/null +++ b/system/eumel-coder/1.8.1/src/eumel coder 1.8.1 @@ -0,0 +1,3086 @@ +PACKET eumel coder (* Autor: U. Bartling *) + DEFINES coder on, coder off, + declare, define, apply, identify, + :=, =, + dump, + + LIB, + + LABEL, + gosub, goret, + computed branch, + complement condition code, + + ADDRESS , + GLOB, LOC, REF, DEREF, + ref length, + +, + adjust, + get base, + is global, is local, is ref, + + DTYPE, + type class, type name, + void type, int type, real type, text type, bool type, + bool result type, dataspace type, undefined type, + row type, struct type, proc type, end type, + + OPN, + set length of local storage, + begin module, end module, + is proc, is eumel 0 instruction, + address, operation, + nop, + mnemonic, + + parameter, + next param, + NEXTPARAM, + access , + dtype , + param address, + same type , + + reserve storage, + allocate denoter , + allocate variable, + data allocation by coder , + data allocation by user, + + run, run again, + insert, + prot, prot off, + check, check on, check off, + + help, bulletin, packets, + +(**************************************************************************) +(* *) +(* E U M E L - C O D E R *) +(* *) +(* *) +(* Zur Beschreibung des Coders siehe *) +(* U.Bartling, J. Liedtke: EUMEL-Coder-Interface *) +(* *) +(* Stand der Dokumentation : 29.10.1986 *) +(* Stand der Implementation : 03.09.1986 *) +(* *) +(* *) +(**************************************************************************) + +#page# +(**************************************************************************) +(* *) +(* 0. Datentyp DINT 03.09.1987 *) +(* *) +(* Definition des Datentyps *) +(* arithmetischer Operationen *) +(* und Konvertierungsprozeduren *) +(* *) +(**************************************************************************) + + + DINT, + -, *, DIV, MOD, <, <=, + AND, OR, XOR, + dput, dget, dmov, + ddec1, dinc1, dinc, ddec, + dadd, dsub, + dequ, dlseq, + INCR, DECR, + put, get, cout, + text, real, int, dint, + replace, DSUB : + + +TYPE DINT = STRUCT (INT low, high) ; + + +REAL VAR real value ; (* auch fuer Ausrichtung ! *) +TEXT VAR convertion buffer ; + +DINT CONST dint0 :: dint(0) ; +DINT VAR result :: dint 0 ; + + +DINT PROC dint (INT CONST number) : + EXTERNAL 144 +ENDPROC dint ; + +INT PROC int (DINT CONST i) : + EXTERNAL 143 +ENDPROC int; + +REAL PROC real (DINT CONST number) : + real value := 65536.0 * real (number.high) ; + + IF number.low >= 0 + THEN real value INCR real (number.low) + ELSE real value INCR (real (number.low AND maxint) + 32768.0) + FI ; + real value +ENDPROC real ; + +DINT PROC dint (REAL CONST number) : + real value := abs (number) ; + REAL CONST low := real value MOD 65536.0 ; + + result.high := int(real value / 65536.0) ; + IF low < 32768.0 + THEN result.low := int (low) + ELSE result.low := int (low-32768.0) OR minint + FI ; + IF number < 0.0 THEN dsub (dint0, result, result) FI ; + result +ENDPROC dint ; + +TEXT PROC text (DINT CONST number) : + IF number.high = 0 THEN convert low part only + ELSE convert number + FI ; + convertion buffer . + +convert low part only : + IF number.low >= 0 THEN convertion buffer := text (number.low) + ELSE convertion buffer := text (real of low) ; + erase decimal point + FI . + +real of low : + real (number.low AND maxint) + 32768.0 . + +convert number : + convertion buffer := text (real(number)) ; + erase decimal point . + +erase decimal point : + convertion buffer := subtext (convertion buffer, 1, LENGTH convertion buffer-2) +ENDPROC text; + +DINT PROC dint (TEXT CONST dint txt) : + convertion buffer := dint txt ; + INT CONST dot pos :: pos (convertion buffer, ".") ; + IF dot pos = 0 THEN convertion buffer CAT ".0" FI ; + dint (real(convertion buffer)) +ENDPROC dint ; + +PROC get (DINT VAR dest) : + REAL VAR number ; + get (number) ; + dest := dint (number) +ENDPROC get ; + +PROC put (DINT CONST number) : + put (text (number)); +ENDPROC put ; + +PROC cout (DINT CONST number) : + EXTERNAL 61 +ENDPROC cout; + +OP := (DINT VAR a, DINT CONST b) : +# INLINE ; # + dmov (b, a); +ENDOP :=; + +OP INCR (DINT VAR a, DINT CONST b) : +# INLINE ; # + dinc (b, a); +ENDOP INCR; + +OP DECR (DINT VAR a, DINT CONST b) : +# INLINE ; # + ddec (b, a); +ENDOP DECR; + +BOOL OP = (DINT CONST a, b) : + EXTERNAL 137 +ENDOP =; + +BOOL OP <= (DINT CONST a, b) : + EXTERNAL 138 +ENDOP <=; + +BOOL OP < (DINT CONST a, b) : +# INLINE ; # + NOT (b <= a) +ENDOP <; + +BOOL PROC dequ (DINT CONST a, b) : + EXTERNAL 137 +ENDPROC dequ ; + +BOOL PROC dlseq (DINT CONST a, b) : + EXTERNAL 138 +ENDPROC dlseq ; + +PROC replace (TEXT VAR text, INT CONST index of dint, DINT CONST value) : + INT VAR subscript := index of dint * 2 ; + replace (text, subscript - 1,value.low); + replace (text, subscript, value.high); +ENDPROC replace; + +DINT OP DSUB (TEXT CONST text, INT CONST index of dint) : + INT VAR subscript := index of dint * 2 ; + result.low := text ISUB subscript - 1; + result.high := text ISUB subscript; + result +ENDOP DSUB; + +DINT OP + (DINT CONST a, b) : + EXTERNAL 135 +ENDOP + ; + +DINT OP - (DINT CONST a, b) : + EXTERNAL 136 +ENDOP - ; + +PROC dadd (DINT CONST a, b, DINT VAR res) : + EXTERNAL 135 +ENDPROC dadd ; + +PROC dsub (DINT CONST a, b, DINT VAR res) : + EXTERNAL 136 +ENDPROC dsub ; + +PROC dinc (DINT CONST source, DINT VAR dest) : + EXTERNAL 133 +ENDPROC dinc ; + +PROC ddec (DINT CONST source, DINT VAR dest) : + EXTERNAL 134 +ENDPROC ddec ; + +PROC dmov (DINT CONST source, DINT VAR dest) : + EXTERNAL 130 +ENDPROC dmov; + +DINT OP DIV (DINT CONST a,b) : + EXTERNAL 152 +ENDOP DIV ; + +DINT OP MOD (DINT CONST a,b) : + EXTERNAL 153 +ENDOP MOD ; + +DINT OP AND (DINT CONST a,b) : + result.low := a.low AND b.low ; + result.high := a.high AND b.high ; + result +ENDOP AND ; + +DINT OP OR (DINT CONST a,b) : + result.low := a.low OR b.low ; + result.high := a.high OR b.high ; + result +ENDOP OR ; + +DINT OP XOR (DINT CONST a,b) : + result.low := a.low XOR b.low ; + result.high := a.high XOR b.high ; + result +ENDOP XOR ; + +PROC dput (ROW 32000 DINT VAR array, DINT CONST index, value) : + EXTERNAL 139 +ENDPROC dput ; + +PROC dget (ROW 32000 DINT VAR array, DINT CONST index, DINT VAR dest) : + EXTERNAL 140 +ENDPROC dget ; + +PROC dinc1 (DINT VAR dest) : + EXTERNAL 131 +ENDPROC dinc1 ; + +PROC ddec1 (DINT VAR dest) : + EXTERNAL 132 +ENDPROC ddec1 ; + +DINT OP * (DINT CONST a,b) : + EXTERNAL 151 +ENDOP * ; + +#page# + (***** Globale Variable *****) + +TEXT VAR object name; + +FILE VAR bulletin file; + +INT VAR memory management mode, global address offset, packet base, + hash table pointer, nt link, permanent pointer, param link, + packet link, index, mode, field pointer, word, + number of errors := 0 ; + +BOOL VAR found, end of params; + +#page# +(**************************************************************************) +(* *) +(* 1. Interface zum ELAN-Compiler 13.11.1986 *) +(* 1.8.1 *) +(* *) +(* Beschreibung der Tabellen (-groessen), *) +(* internen Vercodung von Typen *) +(* und Kennungen . *) +(* Initialisieren und Beenden des Compilers, *) +(* Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle *) +(* *) +(**************************************************************************) + + +TYPE LIB = STRUCT (TEXT name, INT nt link, pt link, ADDRESS base) ; + +LET begin of hash table = 0 , + end of hash table = 1023 , + + begin of permanent table = 22784 , + before first pt entry = 22784 , + first permanent entry = 22785 , + end of permanent table = 32767 , + + wordlength = 1 , (* compile u n d run time *) + two word length = 2 , + three word length = 3 , + four word length = 4 , + + permanent param const = 10000 , + permanent param var = 20000 , + permanent proc op = 30000 , + permanent type = 30000 , + permanent row = 10 , + permanent struct = 11 , + permanent param proc = 12 , + permanent param proc end marker = 0 , + permanent type field = 0 , + + ptt limit = 10000 , + begin of pt minus ptt limit = 12784 , + begin of pt minus ptt limit 1 = 12785 , (* plus wordlength *) + + void id = 0 , + int id = 1 , + real id = 2 , + string id = 3 , + bool id = 5 , + bool result id = 6 , + dataspace id = 7 , + undefined id = 9 , + row id = 10 , + struct id = 11 , + end id = 0 , + + const = 1 , + var = 2 , + proc id = 3 , +(* denoter = 5 , *) + bold = 2 , + + ins = TRUE , + no ins = FALSE , + no lst = FALSE , + sermon = TRUE , + no sermon = FALSE , + + run again mode = 0 , + compile file mode = 1 , + prep coder mode = 5 , + + warning message = 2 , + error message = 4 , + + point line = "..............." ; + +INT CONST permanent packet := -2 , + permanent end := -3 ; + +BOOL VAR coder active := FALSE ; + +INT VAR run again mod nr := 0 ; + + + (***** Start/Ende *****) + +LET coder not active = "CODER not active" , + illegal define packet = "illegal define packet" ; + +PROC coder on (INT CONST data allocation mode) : + mark coder on ; + init opn section ; + init compiler ; + init memory management . + +mark coder on : + coder active := TRUE . + +init memory management : + memory management mode := data allocation mode . + +init compiler : + no do again ; + elan (prep coder mode, bulletin file, "", run again mod nr, + no ins, no lst, check option, no sermon) + +ENDPROC coder on; + +PROC coder off (BOOL CONST insert, sermon, OPN CONST start proc) : + IF coder active + THEN mark coder off ; + end coder (insert, sermon, start mod nr if no insert) + ELSE errorstop (coder not active) + FI . + +start mod nr if no insert : + IF insert THEN run again mod nr := 0 + ELSE run again mod nr := start proc.mod nr + FI ; + run again mod nr . + +mark coder off : + reset memory management mode ; + init opn section ; + coder active := FALSE +ENDPROC coder off ; + +PROC end coder (BOOL CONST insert wanted, sermon wanted, INT CONST mod) : + EXTERNAL 10021 +ENDPROC end coder ; + +PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, + INT VAR start module number, BOOL CONST ins, lst, rtc, ser) : + EXTERNAL 256 +ENDPROC elan ; + +PROC unsigned arithmetic : + EXTERNAL 92 +ENDPROC unsigned arithmetic ; + + + (***** Paket-Rahmen *****) + +PROC declare (TEXT CONST name, LIB VAR packet) : + packet.name := name +ENDPROC declare ; + +PROC define (LIB VAR packet) : + check if definition possible ; + declare object (packet.name, packet.nt link, packet.pt link) ; + open packet (packet.nt link, global address offset, packet base) ; + set to actual base (packet) . + +check if definition possible : + IF NOT coder active THEN errorstop (coder not active) FI ; + IF module open THEN errorstop (illegal define packet) FI +ENDPROC define ; + +PROC open packet (INT CONST nt link of packet name, INT VAR offset, base) : + EXTERNAL 10032 +ENDPROC open packet ; + +PROC identify (TEXT CONST name, LIB VAR packet, BOOL VAR packet exists) : + to packet (name) ; + packet exists := found ; + IF found THEN packet.name := name ; + packet.nt link := nt link ; + packet.pt link := packet link ; + get pbas (packet.base) + FI +ENDPROC identify ; + + + (***** Hash/Namenstabelle *****) +. +next hash entry : + hash table pointer INCR wordlength . + +end of hash table reached : + hash table pointer > end of hash table . + +yet another nt entry : + nt link := cdb int (nt link) ; + nt link <> 0 . ; + +PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : + EXTERNAL 10031 +ENDPROC declare object ; + +PROC to object (TEXT CONST searched object) : + hash ; + search nt entry . + +hash : + hash code := 0 ; + FOR index FROM 1 UPTO LENGTH searched object REP + addmult cyclic + ENDREP . + +addmult cyclic : + hash code INCR hash code ; + IF hash code > end of hash table THEN wrap around FI ; + hash code := (hash code + code (searched object SUB index)) MOD 1024 . + +wrap around : + hash code DECR end of hash table . + +hash code : nt link . + +search nt entry : + found := FALSE ; + WHILE yet another nt entry REP + read current entry ; + IF object name = searched object + THEN found := TRUE ; + LEAVE to object + FI + PER . + +read current entry : + permanent pointer := cdb int (nt link + wordlength) ; + object name := cdb text (nt link + two word length) +ENDPROC to object ; + + + (***** Permanent Tabelle *****) +. +next procedure : + permanent pointer := cdb int (permanent pointer) . ; + +PROC next pt param : + mode := cdb int (param link) MOD ptt limit ; + param link INCR wordlength ; + IF mode = permanent row THEN skip over permanent row + ELIF mode = permanent struct THEN skip over permanent struct + FI ; + set end marker if end of list . + +skip over permanent row : + param link INCR wordlength ; + next pt param . + +skip over permanent struct : + REP + mode := cdb int (param link) ; + IF mode = permanent type field + THEN param link INCR wordlength ; + LEAVE skip over permanent struct + FI ; + next pt param + PER +ENDPROC next pt param ; + +PROC set end marker if end of list : + mode := cdb int (param link) ; + end of params := mode >= permanent proc op OR mode <= 0 +ENDPROC set end marker if end of list ; + +PROC get type and mode (INT VAR type) : + mode := cdb int (param link) ; + IF mode < 0 THEN type := 2769 + (32767 + mode) ; + mode := 0 + ELIF mode = permanent param proc THEN translate type + ELSE type := mode MOD ptt limit ; + mode DECR type ; + translate type if necessary ; + translate mode if necessary + FI . + +translate type if necessary : + IF permanent row or struct THEN translate type FI . + +translate type : + type := param link - begin of pt minus ptt limit . + +translate mode if necessary : + IF mode = permanent param const THEN mode := const + ELIF mode = permanent param var THEN mode := var + FI . + +permanent row or struct : + type = permanent row OR type = permanent struct +ENDPROC get type and mode ; + +PROC put next permanent (INT CONST permanent value) : + EXTERNAL 10020 +ENDPROC put next permanent ; + + + (***** Allgemeine Zugriffsprozeduren *****) + +INT PROC cdb int (INT CONST index) : + EXTERNAL 116 +ENDPROC cdb int ; + +TEXT PROC cdb text (INT CONST index) : + EXTERNAL 117 +ENDPROC cdb text ; + + +#page# +(**************************************************************************) +(* *) +(* 2. Spruenge und Marken 07.10.1986 *) +(* *) +(* Definition des Datentyps LABEL *) +(* *) +(* Deklaration, Definition und Applikation von Marken *) +(* *) +(**************************************************************************) + + + +TYPE LABEL = INT ; + +BOOL VAR invers :: FALSE ; + +PROC declare (LABEL VAR label) : + CONCR (label) := 0 +ENDPROC declare ; + +PROC define (LABEL VAR label) : + EXTERNAL 10085 +ENDPROC define ; + +PROC complement condition code : + invers := NOT invers +ENDPROC complement condition code ; + +PROC apply (LABEL VAR label) : + EXTERNAL 10151 +ENDPROC apply ; + +PROC apply (LABEL VAR label, BOOL CONST condition) : + IF condition xor invers THEN branch true (label) + ELSE branch false (label) + FI ; + invers := FALSE . + +condition xor invers : + IF condition THEN NOT invers + ELSE invers + FI +ENDPROC apply ; + +OP := (LABEL VAR global label, local label) : (* EQUATE ! *) + EXTERNAL 10014 +ENDOP := ; + +TEXT PROC dump (LABEL CONST label) : + "LAB " + text (CONCR (label)) +ENDPROC dump ; + +PROC gosub (LABEL VAR label) : + EXTERNAL 10015 +ENDPROC gosub ; + +PROC goret : + s0 (q goret code) +ENDPROC goret ; + +PROC branch true (LABEL VAR label) : + EXTERNAL 10028 +ENDPROC branch true ; + +PROC branch false (LABEL VAR label) : + EXTERNAL 10029 +ENDPROC branch false ; + +PROC computed branch (ADDRESS CONST switch, INT CONST limit, LABEL VAR out) : + s1 (q esc case, REPR switch) ; + s0 (limit) ; + branch false (out) +ENDPROC computed branch ; + + +#page# +(**************************************************************************) +(* *) +(* 3. Datenaddressen 13.11.1986 *) +(* *) +(* Definition des Datentyps ADDRESS *) +(* *) +(* Aufbau von Datenaddressen (Vercodung) *) +(* Fortschalten und Ausrichten von Adressen *) +(* Behandlung von Paketbasis-Adressen *) +(* Bereitstellen der Fehlermeldung "address overflow" (Coder-intern) *) +(* *) +(**************************************************************************) + + + +TYPE ADDRESS = STRUCT (INT kind, value) ; + +LET global = 0 , + local = 1 , + ref mask = 2 , + global ref = 2 , + local ref = 3 , + module nr = 4 , + immediate value = 5 , + p base = 6 , + + eumel0 stack offset = 4 , + local address limit = 16 384 , + global address zero = 0 , + + illegal ref operation = "REF not allowed" , + deref on non ref = "DEREF on non-ref address" , + global ref not allowed = "GLOBAL REF not allowed" , + unknown kind = "Unknown address kind" , + address overflow = "Address Overflow" , + illegal plus operation = "+ not allowed" ; + +ADDRESS VAR result addr; + +INT CONST ref length :: 2 ; + +OP := (ADDRESS VAR l, ADDRESS CONST r) : + CONCR (l) := CONCR (r) +ENDOP := ; + +ADDRESS OP GLOB (INT CONST address level) : + result addr.kind := global ; + result addr.value := address level ; + IF memory management mode = data allocation by user + THEN result addr.value INCR global address offset + FI ; + result addr +ENDOP GLOB ; + +ADDRESS OP LOC (INT CONST address level) : + result addr.kind := local ; + result addr.value := address level + eumel0 stack offset ; + result addr +ENDOP LOC ; + +ADDRESS OP REF (ADDRESS CONST addr) : + CONCR (result addr) := CONCR (addr) ; + IF result addr.kind = local THEN result addr.kind INCR ref mask + ELIF result addr.kind = global THEN errorstop (global ref not allowed) + ELSE errorstop (illegal ref operation) + FI ; + result addr +ENDOP REF ; + +ADDRESS OP DEREF (ADDRESS CONST ref address) : + CONCR (result addr) := CONCR (ref address) ; + IF is not local ref THEN errorstop (deref on non ref) FI ; + result addr.kind DECR ref mask ; + result addr . + +is not local ref : + result addr.kind <> local ref +ENDOP DEREF ; + +INT OP REPR (ADDRESS CONST addr) : + CONCR (result addr) := CONCR (addr) ; + SELECT result addr.kind OF + CASE global : + CASE local : set bit (result addr.value, 15) + CASE global ref : errorstop (global ref not allowed) + CASE local ref : prep local ref + OTHERWISE errorstop (unknown kind) + ENDSELECT ; + result addr.value . + +prep local ref : + IF address limit exceeded THEN errorstop (address overflow) FI ; + set bit (result addr.value, 14) ; + set bit (result addr.value, 15) . + +address limit exceeded : + result addr.value < eumel0 stack offset OR + result addr.value > local address limit +ENDOP REPR ; + +PROC get base (LIB CONST packet, ADDRESS VAR base) : + CONCR (base) := CONCR (packet.base) +ENDPROC get base ; + +PROC set to actual base (LIB VAR packet) : + packet.base.kind := p base ; + packet.base.value := packet base +ENDPROC set to actual base ; + +PROC get pbas (ADDRESS VAR base) : + base.kind := p base ; + base.value := cdbint (packet link + 2) +ENDPROC get pbas ; + +BOOL OP = (ADDRESS CONST l,r) : + l.kind = r.kind AND l.value = r.value +ENDOP = ; + +BOOL PROC is ref (ADDRESS CONST addr) : + addr.kind = local ref +ENDPROC is ref ; + +BOOL PROC is global (ADDRESS CONST addr) : + addr.kind = global +ENDPROC is global ; + +BOOL PROC is local (ADDRESS CONST addr) : + addr.kind = local +ENDPROC is local ; + +ADDRESS OP + (ADDRESS CONST addr, INT CONST offset) : + CONCR (result addr) := CONCR (addr) ; + SELECT result addr.kind OF + CASE global : inc global + CASE local : inc local + OTHERWISE errorstop (illegal plus operation) + ENDSELECT ; + result addr . + +inc global : + result addr.value INCR offset ; + IF result addr.value < 0 THEN errorstop (address overflow) FI . + +inc local : + result addr.value INCR offset ; + IF result addr.value < eumel 0 stack offset OR + result addr.value > local address limit + THEN errorstop (address overflow) + FI +ENDOP + ; + +PROC adjust (ADDRESS VAR addr, INT CONST adjust length) : + IF is local or global THEN adjust to length FI . + +is local or global : + addr.kind <= local . + +adjust to length : + mode := addr.value MOD adjust length ; + IF mode <> 0 THEN addr.value INCR (adjust length-mode) FI +ENDPROC adjust ; + +TEXT PROC dump (ADDRESS CONST addr) : + kind + text (addr.value) . + +kind : + SELECT addr.kind OF + CASE global : "GLOBAL " + CASE local : "LOCAL " + CASE immediate value : "IMMEDIATE " + CASE module nr : "PARAM PROC " + CASE global ref : "GLOBAL REF " + CASE local ref : "LOCAL REF " + CASE p base : "PBAS " + OTHERWISE "undef. Addr: " + ENDSELECT +ENDPROC dump; + + +#page# +(**************************************************************************) +(* *) +(* 4. Datentypen Teil I 08.09.1986 *) +(* *) +(* Definition des Datentyps DTYPE *) +(* *) +(* Interne Repraesentation der primitiven Datentypen *) +(* Identifikation von DTYPEs *) +(* *) +(**************************************************************************) + + + +TYPE DTYPE = INT ; + +OP := (DTYPE VAR l, DTYPE CONST r) : + CONCR (l) := CONCR (r) +ENDOP := ; + +BOOL OP = (DTYPE CONST l, r) : + CONCR (l) = CONCR (r) +ENDOP = ; + +DTYPE PROC void type : DTYPE :(void id) ENDPROC void type ; + +DTYPE PROC int type : DTYPE :(int id) ENDPROC int type ; + +DTYPE PROC real type : DTYPE :(real id) ENDPROC real type ; + +DTYPE PROC text type : DTYPE :(string id) ENDPROC text type ; + +DTYPE PROC bool type : DTYPE :(bool id) ENDPROC bool type ; + +DTYPE PROC bool result type : DTYPE :(bool result id) ENDPROC bool result type; + +DTYPE PROC dataspace type : DTYPE :(dataspace id) ENDPROC dataspace type ; + +DTYPE PROC undefined type : DTYPE :(undefined id) ENDPROC undefined type ; + +DTYPE PROC row type : DTYPE :(row id) ENDPROC row type ; + +DTYPE PROC struct type : DTYPE :(struct id) ENDPROC struct type ; + +DTYPE PROC proc type : DTYPE :(permanent param proc) ENDPROC proc type ; + +DTYPE PROC end type : DTYPE :(end id) ENDPROC end type ; + +INT PROC type class (DTYPE CONST type) : + SELECT type id OF + CASE int id, real id, bool id, bool result id, string id, + dataspace id, undefined id : 1 + CASE void id : 0 + CASE row id : 3 + CASE struct id : 4 + CASE permanent param proc : 5 + OTHERWISE pt type + ENDSELECT . + +pt type : + IF type id > ptt limit THEN permanent row or struct + ELSE abstract type + FI . + +abstract type : 2 . + +permanent row or struct : + unsigned arithmetic ; + mode := cdbint (type link into pt) MOD ptt limit ; + IF mode = struct id THEN 4 + ELIF mode = row id THEN 3 + ELIF mode = permanent param proc THEN 5 + ELSE 2 + FI . + +type link into pt : + type id + begin of pt minus ptt limit . + +type id : CONCR (type) +ENDPROC type class ; + +PROC identify (TEXT CONST name,INT VAR size, align, DTYPE VAR type) : + SELECT type pos OF + CASE 1 : size := 0; align := 0; type id := void id + CASE 6 : size := 1; align := 1; type id := int id + CASE 10 : size := 4; align := 4; type id := real id + CASE 15 : size := 8; align := 4; type id := string id + CASE 20 : size := 1; align := 1; type id := bool id + CASE 25 : size := 1; align := 1; type id := dataspace id + OTHERWISE search for type in permanent table + ENDSELECT . + +type pos : + enclose in delimiters ; + pos (".VOID.INT.REAL.TEXT.BOOL.DATASPACE.", object name) . + +enclose in delimiters : + object name := "." ; + object name CAT name ; + object name CAT "." . + +search for type in permanent table : + to object (name) ; + IF not found THEN size := 0; align := 0; type id := undefined id + ELSE size := cdbint (permanent pointer + two wordlength) ; + type id := permanent pointer - begin of permanent table ; + IF size < two wordlength THEN align := 1 + ELIF size < four wordlength THEN align := 2 + ELSE align := 4 + FI + FI . + +not found : + NOT found OR invalid entry . + +invalid entry : + permanent pointer = 0 OR + cdb int (permanent pointer + wordlength) <> permanent type . + +type id : CONCR (type) +ENDPROC identify ; + + +#page# +(**************************************************************************) +(* *) +(* 5. Operationen Teil I 30.09.1986 *) +(* *) +(* Definition des Datentyps OPN *) +(* Primitive Operationen (:= etc.) *) +(* Initialisieren mit den externen Namen der EUMEL-0-Codes *) +(* Bereitstellen dee Fehlermeldung 'proc op expected' (coder-intern) *) +(* *) +(**************************************************************************) + + +TYPE OPN = STRUCT (INT kind, mod nr, top of stack) ; + +LET proc op = 0 , + param proc = 1 , + eumel 0 = 2 , + nil = 3 , + + param proc at non ref = "PARAM PROC at non-ref address" , + proc op expected = "PROC expected" ; + +OPN VAR eumel0 opn; +eumel0 opn.kind := eumel0 ; +eumel0 opn.top of stack := 0 ; + +eumel0 opn.mod nr := q pp ; +OPN CONST pp :: eumel0 opn , + nop code :: OPN :(nil, 0, 0) ; + +IF NOT exists ("eumel0 codes") + THEN IF yes ("Archive 'eumel coder' eingelegt") + THEN archive ("eumel coder") ; + fetch ("eumel0 codes", archive) ; + release (archive) + ELSE errorstop ("""eumel0 codes"" gibt es nicht") + FI +FI ; +BOUND THESAURUS VAR initial opcodes :: old ("eumel0 codes") ; +THESAURUS VAR eumel 0 opcodes :: initial opcodes ; +forget ("eumel0 codes") ; + +ADDRESS PROC address (OPN CONST opn) : + IF opn.kind <> proc op THEN errorstop (proc op expected) FI ; + result addr.kind := module nr ; + result addr.value := opn.mod nr ; + result addr +ENDPROC address ; + +OPN PROC operation (ADDRESS CONST addr) : + IF addr.kind <> local ref THEN errorstop (param proc at non ref) FI ; + OPN VAR opn ; + opn.kind := param proc ; + opn.mod nr :=addr.value ; + opn.top of stack := 0 ; + opn +ENDPROC operation ; + +TEXT PROC mnemonic (OPN CONST op code) : + name (eumel 0 opcodes, op code.mod nr) +ENDPROC mnemonic ; + +OPN PROC nop : + nop code +ENDPROC nop ; + +OP := (OPN VAR r, OPN CONST l) : + CONCR (r) := CONCR (l) +ENDOP := ; + +BOOL PROC is proc (OPN CONST operation) : + operation.kind = proc op +ENDPROC is proc ; + +BOOL PROC is eumel 0 instruction (TEXT CONST op code name) : + link (eumel 0 opcodes, op code name) <> 0 +ENDPROC is eumel 0 instruction ; + +BOOL PROC is eumel 0 instruction (OPN CONST operation) : + operation.kind = eumel0 +ENDPROC is eumel 0 instruction ; + + +#page# +(**************************************************************************) +(* *) +(* 6. Parameterfeld 10.04.1986 *) +(* *) +(* Bereitstellen des Parameterfeldes *) +(* Schreiben und Lesen von Eintraegen im Parameterfeld *) +(* Fortschalten von Zeigern in das Parameterfeld *) +(* Bereitstellen der Konstanten 'size of param field' (Coder-intern) *) +(* *) +(**************************************************************************) + + + +LET PARAMDESCRIPTOR = STRUCT (DTYPE type, INT access, + ADDRESS addr, OPN push opn) , + + size of param field = 100 , + param field exceeded = "Param Field Overflow", + param nr out of range = "Illegal Param Number" ; + +ROW size of param field PARAMDESCRIPTOR VAR param field ; + + + (***** Schreiben *****) + +PROC test param pos (INT CONST param nr) : + IF param nr < 1 OR param nr > size of param field + THEN errorstop (param nr out of range) + FI +ENDPROC test param pos ; + +PROC declare (INT CONST param nr, DTYPE CONST type) : + test param pos (param nr) ; + enter type . + +enter type : + CONCR (param field [param nr].type) := CONCR (type) +ENDPROC declare ; + +PROC declare (INT CONST param nr, access) : + test param pos (param nr) ; + enter access . + +enter access : + param field [param nr].access := access +ENDPROC declare ; + +PROC define (INT CONST param nr, ADDRESS CONST addr) : + test param pos (param nr) ; + enter address . + +enter address : + CONCR (param field [param nr].addr) := CONCR (addr) +ENDPROC define ; + +PROC define (INT CONST param nr, value) : + result addr.kind := immediate value ; + result addr.value := value ; + define (param nr, result addr) +ENDPROC define ; + +PROC apply (INT CONST param nr, OPN CONST opn) : + test param pos (param nr) ; + enter push opn . + +enter push opn : + CONCR (param field [param nr].push opn) := CONCR (opn) +ENDPROC apply ; + +PROC parameter (INT CONST param nr, DTYPE CONST type, + INT CONST access, ADDRESS CONST addr) : + test param pos (param nr) ; + enter type ; + enter access ; + enter address ; + enter pp as default . + +enter type : + CONCR (param field [param nr].type) := CONCR (type) . + +enter access : + param field [param nr].access := access . + +enter address : + CONCR (param field [param nr].addr) := CONCR (addr) . + +enter pp as default : + CONCR (param field [param nr].push opn) := CONCR (pp) +ENDPROC parameter ; + + + (***** Lesen *****) + +ADDRESS PROC param address (INT CONST param nr) : + test param pos (param nr) ; + param field [param nr].addr +ENDPROC param address ; + +DTYPE PROC dtype (INT CONST param nr) : + test param pos (param nr) ; + param field [param nr].type +ENDPROC dtype ; + +INT PROC access (INT CONST param nr) : + test param pos (param nr) ; + param field [param nr].access +ENDPROC access ; + + + (***** Fortschalten *****) + +OP NEXTPARAM (INT VAR param nr) : + test param pos (param nr) ; + INT CONST class :: type class (param field [param nr].type) ; + param nr INCR 1 ; + SELECT class OF + CASE 3 : NEXTPARAM param nr + CASE 4,5 : read until end + ENDSELECT . + +read until end : + WHILE NOT end marker read or end of field REP + NEXTPARAM param nr + PER ; + param nr INCR 1 . + +end marker read or end of field : + param nr > size of param field OR + CONCR (param field [param nr].type) = end id +ENDOP NEXTPARAM ; + +INT PROC next param (INT CONST p) : + INT VAR index := p ; + NEXTPARAM index ; + index +ENDPROC next param ; + +TEXT PROC dump (INT CONST p) : + IF p > 0 AND p <= 100 THEN dump entry (param field (p)) + ELSE param nr out of range + FI +ENDPROC dump ; + +TEXT PROC dump entry (PARAMDESCRIPTOR CONST id) : +(* object name := dump (id.type) ; *) + object name := "TYPE " ; (* siehe *) + object name CAT dump (id.type) ; (* TEXT PROC dump (DTYPE d) *) + object name CAT text (id.access) ; + object name CAT dump (id.addr) ; + object name CAT dump (id.push opn) ; + object name +ENDPROC dump entry ; + + +#page# +(**************************************************************************) +(* *) +(* 7. Datentypen Teil II 08.09.1986 *) +(* *) +(* Deklaration neuer Datentypen *) +(* Vergleich von DTYPEs im Parameterfeld und in der Permanent-Tabelle *) +(* *) +(**************************************************************************) + + + +DTYPE VAR pt type ; + +PROC declare (TEXT CONST name, INT CONST size, align, DTYPE VAR type) : + entry into name table ; + put next permanent (permanent type) ; + put next permanent (size) ; + put next permanent (nt link) ; + mark no offsets of text elements . + +entry into name table : + declare object (name, nt link, CONCR (type)) ; + CONCR (type) DECR begin of permanent table . + +mark no offsets of text elements : + put next permanent (0) +ENDPROC declare ; + +BOOL PROC same type (INT CONST param 1, param 2) : + INT CONST left type :: CONCR (param field [param 1].type) ; + IF left type = right type + THEN same fine structure if there is one + ELSE left type = undefined id OR right type = undefined id + FI . + +right type : CONCR (param field [param 2].type) . + +same fine structure if there is one : + IF left type = row id THEN compare row + ELIF left is struct or proc THEN compare struct + ELSE TRUE + FI . + +left is struct or proc : + left type = struct id OR left type = proc id . + +compare row : + equal sizes AND same type (param1 + 1, param2 + 1) . + +equal sizes : + param field [param1+1].access = param field [param2+1].access . + +compare struct : + INT VAR p1 :: param1+1, p2 :: param2+1 ; + WHILE same type (p1, p2) AND NOT end type found REP + NEXTPARAM p1 ; + NEXTPARAM p2 + UNTIL end of field PER ; + FALSE . + +end type found : + CONCR (param field [p1].type) = end id . + +end of field : + p1 > size of param field OR p2 > size of param field +ENDPROC same type ; + +BOOL PROC same type (INT CONST param nr, DTYPE CONST type) : + field pointer := param nr ; + CONCR (pt type) := CONCR (type) ; + equal types +ENDPROC same type ; + +BOOL PROC equal types : + identical types OR one type is undefined . + +one type is undefined : + type of actual field = undefined id OR CONCR(pt type) = undefined id . + +identical types : + SELECT type class (pt type) OF + CASE 0, 1, 2 : type of actual field = CONCR (pt type) + CASE 3 : perhaps equal rows + CASE 4 : perhaps equal structs + CASE 5 : perhaps equal param procs + OTHERWISE FALSE + ENDSELECT . + +perhaps equal rows : + param link := CONCR (pt type) + begin of pt minus ptt limit ; + is row AND equal row sizes AND equal row types . + +is row : + type of actual field = row id . + +perhaps equal structs : + param link := CONCR (pt type) + begin of pt minus ptt limit ; + is struct AND same type fields . + +is struct : + type of actual field = struct id . + +equal row sizes : + pt row size = row size within param field . + +equal row types : + field pointer INCR 1 ; + param link INCR 2 ; + get type and mode (CONCR(pt type)) ; + equal types . + +pt row size : + cdb int (param link + 1) . + +row size within param field : + param field [field pointer + 1].access . + +same type fields : + REP + field pointer INCR 1 ; + param link INCR 1 ; + IF type of actual field = end id + THEN LEAVE same type fields WITH pt struct end reached + FI ; + get type and mode (CONCR(pt type)) ; + IF NOT equal types THEN LEAVE same type fields WITH FALSE FI + UNTIL end of field PER ; + FALSE . + +pt struct end reached : + cdbint (param link) = permanent type field . + +end of field : + field pointer > size of param field . + +type of actual field : + CONCR (param field [field pointer].type) . + +perhaps equal param procs : + param link := CONCR (pt type) + begin of pt minus ptt limit ; + is proc AND same param list . + +is proc : cdbint (param link) = permanent param proc . + +same param list : + param link INCR wordlength ; + DTYPE VAR proc result type ; + get type and mode (CONCR (proc result type)) ; + compare param list ; + check results . + +compare param list : + INT VAR last param := field pointer + 1 ; + REP + field pointer INCR 1 ; + param link INCR wordlength ; + IF pt param list exhausted THEN LEAVE compare param list FI ; + IF type of actual field = end id + THEN LEAVE equal types WITH FALSE + FI ; + get type and mode (CONCR(pt type)) ; + last param := field pointer ; + UNTIL NOT equal types OR end of field PER . + +check results : + pt param list exhausted AND equal result types . + +equal result types : + save param link ; + IF same type (last param, proc result type) + THEN restore ; + TRUE + ELSE FALSE + FI . + +pt param list exhausted : + cdbint (param link) = permanent param proc end marker . + +save param link : + INT CONST p :: param link . + +restore : + field pointer INCR 1 ; + param link := p + +ENDPROC equal types ; + +BOOL PROC is not void bool or undefined (DTYPE CONST dtype) : + type <> void id AND type <> bool result id AND type <> undefined id . + +type : CONCR (dtype) +ENDPROC is not void bool or undefined ; + + +#page# +(**************************************************************************) +(* *) +(* 8. Operationen Teil II 08.09.1986 *) +(* *) +(* Definition der Opcodes *) +(* Deklaration, Definition, Identifikation und Applikation *) +(* Eroeffnen und Schliessen eines Moduls *) +(* *) +(**************************************************************************) + + + +LET module not opened = "Module not opened" , + define missing = "DEFINE missing" , + wrong nr of params = "Wrong Nr. of Params:" , + illegal kind = "Opcode expected" , + nested module = "Nested Modules" , + no mod nr = "Param Proc expected" , + no immediate value = "Value expected" , + type error = "Type Error" , + + q ln = 1 , + q move = 2 , q move code = 2 048 , + q inc1 = 3 , q inc1 code = 3 072 , + q dec1 = 4 , q dec1 code = 4 096 , + q inc = 5 , q inc code = 5 120 , + q dec = 6 , q dec code = 6 144 , + q add = 7 , q add code = 7 168 , + q sub = 8 , q sub code = 8 192 , + q clear = 9 , q clear code = 9 216 , + q test = 10 , + q equ = 11 , q equ code = 11 264 , + q lsequ = 12 , q lsequ code = 12 288 , + q fmove = 13 , q fmove code = 13 312 , + q fadd = 14 , q fadd code = 14 336 , + q fsub = 15 , q fsub code = 15 360 , + q fmult = 16 , q fmult code = 16 384 , + q fdiv = 17 , q fdiv code = 17 408 , + q flsequ = 18 , q flsequ code = 18 432 , + q tmove = 19 , q tmove code = 19 456 , + q tequ = 20 , q tequ code = 20 480 , + q accds = 21 , q access ds code = 22 528 , + q ref = 22 , q ref code = 23 552 , + q subscript = 23 , q subscript code = 24 576 , + q select = 24 , q select code = 25 600 , + q ppv = 25 , q ppv code = 26 624 , + q pp = 26 , + q make false = 27 , (* q make false code = 65 513 *) + q movex = 28 , +(* q longa subs q longa subs code = 65 376 *) + q return = 29 , q return code = 32 512 , + q true return = 30 , q true return code = 32 513 , + q false return = 31 , q false return code = 32 514 , + q goret code = 32 519 , + q esc mult = 32 , q esc mult code = 32 553 , + q esc div = 33 , q esc div code = 32 554 , + q esc mod = 34 , q esc mod code = 32 555 , + q pproc = 35 , + q compl int = 36 , q compl int code = 32 551 , + q compl real = 37 , q compl real code = 32 550 , + q alias ds = 38 , q alias ds code = 32 546 , + q movim = 39 , q esc movim code = 32 547 , + q fequ = 40 , q fequ code = 32 548 , + q tlsequ = 41 , q tlsequ code = 32 549 , +(* q case = 42 , *) q esc case = 32 544 , + q plus = 43 , + q minus = 44 , + q mult = 45 , + q int div = 46 , + q real div = 47 , + q equal = 48 , + q lessequal = 49 , + q ulseq = 50 , q ulseq code = 21 504 , + q pdadd = 51 , q pdadd code = 32 653 , + q ppsub = 52 , q ppsub code = 32 654 , + q dimov = 53 , q dimov code = 32 655 , + q idmov = 54 , q idmov code = 32 656 ; + +INT CONST q make false code :: - 1 022 , + q longa subs code :: - 159 , + q penter code :: - 511 ; + + + (***** Deklaration *****) + +PROC declare (OPN VAR operation) : + operation.kind := proc op ; + get module nr (operation.mod nr) ; + operation.top of stack := 0 +ENDPROC declare ; + +PROC declare (TEXT CONST name, INT CONST first, params, OPN VAR operation) : + declare (operation) ; + entry into name and pt table if necessary ; + enter params ; + enter result ; + enter module number . + +entry into name and pt table if necessary : + declare object (name, nt link, permanent pointer) . + +enter params : + field pointer := first ; + FOR index FROM 1 UPTO params REP + enter param (param field [field pointer]) ; + NEXTPARAM field pointer + PER . + +enter result : + enter param (param field[field pointer].type, permanent proc op) . + +enter module number : + put next permanent (operation.mod nr) +ENDPROC declare ; + +PROC enter param (PARAMDESCRIPTOR CONST param) : + IF param.access = const + THEN enter param (param.type, permanent param const) + ELIF param.access = var + THEN enter param (param.type, permanent param var) + ELSE errorstop ("Unknown Access") + FI +ENDPROC enter param ; + +PROC enter param (DTYPE CONST type, INT CONST permanent mode) : + unsigned arithmetic ; + SELECT type class (type) OF + CASE 0, 1, 2 : put next permanent (CONCR(type) + permanent mode) + OTHERWISE errorstop ("Illegal Type") + ENDSELECT +ENDPROC enter param ; + + + (***** Definition *****) + +PROC define (OPN VAR opn) : + IF NOT module open THEN errorstop (module not opened) + ELSE proc head (opn.mod nr, opn.top of stack) + FI +ENDPROC define ; + +PROC set length of local storage (OPN VAR opn, INT CONST size) : + IF size < 0 OR size > local address limit + THEN errorstop (address overflow) + ELIF opn.top of stack = 0 + THEN errorstop (define missing) + ELIF opn.kind <> proc op + THEN errorstop (proc op expected) + FI ; + set length (opn.top of stack, size + eumel0 stack offset) +ENDPROC set length of local storage ; + +PROC define (OPN VAR operation, INT CONST size) : + define (operation) ; + set length of local storage (operation, size) +ENDPROC define ; + + + (***** Identifikation *****) + +INT VAR counter, result index, result type repr; + +PROC identify (TEXT CONST name, INT CONST first, params, OPN VAR operation, + BOOL VAR object exists) : + find result entry ; + to object (name) ; + IF found THEN first fit and leave if found FI ; + IF eumel0 THEN identify eumel0 instruction + ELSE yield undefined operation + FI . + +find result entry : + result index := first; + counter := 0 ; + WHILE counter < params REP + NEXTPARAM result index ; + counter INCR 1 + PER ; + check on param field exceeded . + +check on param field exceeded : + IF result index > size of param field + THEN errorstop (param field exceeded) + FI . + +yield undefined operation : + declare (result index, undefined type) ; + apply (result index, nop) ; + object exists := FALSE . + +first fit and leave if found : + WHILE yet another procedure exists REP + check one procedure and leave if match ; + next procedure + PER . + +yet another procedure exists : + permanent pointer <> 0 . + +check one procedure and leave if match: + param link := permanent pointer + wordlength ; + set end marker if end of list ; + counter := params ; + field pointer := first ; + REP + IF end of params AND counter = 0 + THEN procedure found + ELIF end of params OR counter = 0 + THEN LEAVE check one procedure and leave if match + ELSE check next param + FI + PER . + +check next param : + get type and mode (CONCR(pt type)) ; + IF same types THEN set param mode ; + field pointer INCR 1 ; + param link INCR 1 ; + set end marker if end of list ; + counter DECR 1 ; + ELSE LEAVE check one procedure and leave if match + FI . + +same types : (* inline version ! *) + equal types . + +set param mode : + param field [field pointer].access := mode . + +procedure found : + get result ; + operation.kind := proc op ; + operation.mod nr := module number ; + operation.top of stack := 0 ; + object exists := TRUE ; + LEAVE identify . + +get result : + get type and mode (result type) ; + declare (result index, mode) . + +module number : + cdbint (param link + 1) . + +result type : + CONCR (param field [result index].type) . + +eumel0 : + eumel0 opn.mod nr := link (eumel 0 opcodes, name) ; + eumel0 opn.mod nr <> 0 . + +identify eumel 0 instruction : + init result type with void ; + CONCR (operation) := CONCR (eumel0 opn) ; + object exists := check params and set result ; + declare (result index, DTYPE:(result type repr)) ; + declare (result index, const) . + +init result type with void : + result type repr := void id . + +check params and set result : + SELECT operation.mod nr OF + CASE q return, q false return, q true return : no params + CASE q inc1, q dec1 : one int param yielding void + CASE q pproc, q pp, q ln : one param yielding void + CASE q test : one param yielding bool + CASE q clear, q ppv : one int or bool param yielding void + CASE q make false : one bool param yielding void + CASE q move : two int or bool params yielding void + CASE q compl int, q inc, q dec : two int params yielding void + CASE q compl real, q fmove : two real params yielding void + CASE q equ, q lsequ, q ulseq : two int params yielding bool + CASE q fequ, q flsequ : two real params yielding bool + CASE q tequ, q tlsequ : two text params yielding bool + CASE q tmove : two text params yielding void + CASE q accds, q ref, q movim, + q dimov, q idmov : two params yielding void + CASE q add, q sub, q esc mult, + q esc div, q esc mod : three int params yielding void + CASE q fadd, q fsub, q fmult, q fdiv : three real params yielding void + CASE q select, q movex, q alias ds, + q pdadd, q ppsub : three params + CASE q subscript : five params + CASE q plus, q mult : two intreals yielding intreal + CASE q minus : monadic or dyadic minus + CASE q int div : two int params yielding int + CASE q real div : two real params yielding real + CASE q equal, q lessequal : two intrealtexts yielding bool + OTHERWISE FALSE + ENDSELECT . + +no params : + params = 0 . + +one int param yielding void : + p1 void (int type, first, params) . + +one param yielding void : + params = 1 . + +one param yielding bool : + IF params = 1 THEN result type repr := bool id ; + TRUE + ELSE FALSE + FI . + +one int or bool param yielding void : + p1 void (int type, first, params) OR p1 void (bool type, first, params) . + +one bool param yielding void : + p1 void (bool type, first, params) . + +two int or bool params yielding void : + p2 (int type, first, params, void id) OR + p2 (bool type, first, params, void id) . + +two int params yielding void : + p2 (int type, first, params, void id) . + +two real params yielding void : + p2 (real type, first, params, void id) . + +two text params yielding void : + p2 (text type, first, params, void id) . + +two int params yielding bool : + p2 (int type, first, params, bool id) . + +two real params yielding bool : + p2 (real type, first, params, bool id) . + +two text params yielding bool : + p2 (text type, first, params, bool id) . + +two params yielding void : + params = 2 . + +three int params yielding void : + p3 void (int type, first, params) . + +three real params yielding void : + p3 void (real type, first, params) . + +three params : + params = 3 . + +five params : + params = 5 . + +two intreals yielding intreal : + two int params yielding int OR two real params yielding real . + +monadic or dyadic minus : + IF params = 2 THEN two intreals yielding intreal + ELIF params = 1 THEN monadic minus + ELSE FALSE + FI . + +monadic minus : + result type repr := CONCR (param field[first].type) ; + result type repr = int id OR result type repr = real id . + +two intrealtexts yielding bool : + two int params yielding bool OR two real params yielding bool OR + two text params yielding bool . + +two int params yielding int : + p2 (int type, first, params, int id) . + +two real params yielding real : + p2 (real type, first, params, real id) +ENDPROC identify ; + +BOOL PROC p1 void (DTYPE CONST requested type, INT CONST first, param nr) : + param nr = 1 AND param type is requested plain type . + +param type is requested plain type : + CONCR (param field [first].type) = CONCR (requested type) + +ENDPROC p1 void ; + +BOOL PROC p2 (DTYPE CONST requested type, INT CONST first, param nr, + INT CONST result type) : + IF param nr = 2 AND param types equal requested plain type + THEN result type repr := result type ; + TRUE + ELSE FALSE + FI . + +param types equal requested plain type : + CONCR (param field [first] .type) = CONCR (requested type) AND + CONCR (param field [first+1].type) = CONCR (requested type) + +ENDPROC p2 ; + +BOOL PROC p3 void (DTYPE CONST requested type, INT CONST first, param nr) : + param nr = 3 AND param types ok . + +param types ok : + FOR index FROM first UPTO first+2 REP + IF different param types THEN LEAVE p3 void WITH FALSE FI + PER ; + TRUE . + +different param types : + CONCR (param field [index].type) <> CONCR (requested type) +ENDPROC p3 void; + + + (***** Applikation *****) + +INT VAR address representation, left repr, right repr, result repr; + +PROC apply (INT CONST first, nr of params, OPN CONST opn) : + IF NOT module open THEN errorstop (module not opened) FI ; + SELECT opn.kind OF + CASE eumel 0 : generate eumel0 instruction + CASE proc op : call operation + CASE param proc : call param proc + CASE nil : + OTHERWISE errorstop (illegal kind) + ENDSELECT . + +call operation : + push params if necessary (first, nr of params, opn.mod nr) ; + call (opn.mod nr) . + +call param proc : + result addr.kind := local ref ; + result addr.value := opn.mod nr ; + INT CONST module nr := REPR result addr ; + push params if necessary (first, nr of params, module nr) ; + call param (module nr) . + +generate eumel0 instruction : + SELECT real nr of params OF + CASE 0 : p0 instruction + CASE 1 : apply p1 (opn, first addr) + CASE 2 : apply p2 (opn, first addr, second addr) + CASE 3 : apply p3 (opn, left type, first addr, second addr, third addr) + CASE 5 : subscript operation + OTHERWISE errorstop (wrong nr of params + text (nr of params)) + ENDSELECT . + +real nr of params : + IF operator denotation THEN nr of params + 1 + ELSE nr of params + FI . + +operator denotation : + opn.mod nr >= q plus AND opn.mod nr < q ulseq . + +p0 instruction : + IF opn.mod nr = q return THEN s0 (q return code) + ELIF opn.mod nr = q true return THEN s0 (q true return code) + ELIF opn.mod nr = q false return THEN s0 (q false return code) + ELSE errorstop (wrong nr of params + + mnemonic (opn)) + FI . + +subscript operation : + IF opn.mod nr = q subscript + THEN subscription + ELSE errorstop (wrong nr of params + text (nr of params)) + FI . + +subscription : + ADDRESS CONST element length :: param field [first+2].addr , + limit :: param field [first+3].addr ; + check on immediates ; + IF element length.value < 1024 + THEN s0 (q subscript code + element length.value) + ELSE s0 (q longa subs code) ; + s0 (element length.value) + FI ; + s3 (limit.value - 1, subs index, base addr, subs result) . + +check on immediates : + IF element length.kind <> immediate value OR + limit.kind <> immediate value + THEN errorstop (no immediate value) + FI . + +subs index : REPR param field [first+1].addr . + +base addr : REPR param field [first].addr . + +subs result : REPR param field [first+4].addr . + +first addr : + param field [first].addr . + +left type : + param field [first].type . + +second addr : + param field [nextparam (first)].addr . + +third addr : + param field [nextparam(nextparam(first))].addr +ENDPROC apply ; + +PROC push params if necessary (INT CONST first, nr of params, mod nr) : + init param push (mod nr) ; + field pointer := first ; + IF nr of params > 0 THEN push params FI ; + push result if there is one . + +push params : + FOR index FROM 1 UPTO nr of params REP + apply p1 (push code, param addr) ; + NEXTPARAM field pointer + PER . + +push code : + param field [field pointer].push opn . + +param addr : + param field [field pointer].addr . + +push result if there is one : + IF push result necessary + THEN push result address (REPR param field [field pointer].addr) + FI . + +push result necessary : + param field [field pointer].push opn.kind <> nil AND + is not void bool or undefined (param field [field pointer].type) +ENDPROC push params if necessary ; + +PROC apply p1 (OPN CONST opn, ADDRESS CONST addr) : + IF opn.mod nr = q ln THEN generate line number + ELIF opn.mod nr = q pproc THEN push module nr + ELSE gen p1 instruction + FI . + +gen p1 instruction : + address representation := REPR addr ; + SELECT opn.mod nr OF + CASE q inc1 : t1 (q inc1 code, address representation) + CASE q dec1 : t1 (q dec1 code, address representation) + CASE q clear : t1 (q clear code,address representation) + CASE q test : test bool object (address representation) + CASE q pp : push param (address representation) + CASE q ppv : s1 (q ppv code, address representation) + CASE q make false : s1 (q make false code, address representation) + OTHERWISE errorstop (wrong nr of params + mnemonic (opn)) + ENDSELECT . + +generate line number : + IF addr.kind = immediate value THEN mark line (addr.value) + ELSE errorstop (no immediate value) + FI . + +push module nr : + IF addr.kind = module nr THEN push param proc (addr.value) + ELSE errorstop (no mod nr) + FI +ENDPROC apply p1; + +PROC apply p2 (OPN CONST opn, ADDRESS CONST left addr, right addr): + left repr := REPR left addr ; + IF opn.mod nr = q movim THEN move immediate + ELSE gen p2 instruction + FI . + +gen p2 instruction : + right repr := REPR right addr ; + SELECT opn.mod nr OF + CASE q move : t2 (q move code, right repr, left repr) + CASE q inc : t2 (q inc code, right repr, left repr) + CASE q dec : t2 (q dec code, right repr, left repr) + CASE q equ : compare (q equ code, left repr, right repr) + CASE q lsequ : compare (q lsequ code, left repr, right repr) + CASE q ulseq : compare (q ulseq code, left repr, right repr) + CASE q fmove : t2 (q fmove code, right repr, left repr) + CASE q flsequ : compare (q flsequ code, left repr, right repr) + CASE q tmove : t2 (q tmove code, right repr, left repr) + CASE q tequ : compare (q tequ code, left repr, right repr) + CASE q compl int : s2 (q compl int code, left repr, right repr) + CASE q compl real : s2 (q compl real code, left repr, right repr) + CASE q fequ : compare (q fequ code, left repr, right repr) + CASE q tlsequ : compare (q tlsequ code, left repr, right repr) + CASE q accds : t2 (q access ds code, left repr, right repr) + CASE q ref : t2 (q ref code, left repr, right repr) + CASE q dimov : s2 (q dimov code, left repr, right repr) + CASE q idmov : s2 (q idmov code, left repr, right repr) + OTHERWISE errorstop (wrong nr of params + mnemonic (opn)) + ENDSELECT . + +move immediate : + IF right addr.kind = immediate value + THEN s0 (q esc movim code) ; + s1 (right addr.value, left repr) + ELSE errorstop (no immediate value) + FI +ENDPROC apply p2; + +PROC apply p3 (OPN CONST opn, DTYPE CONST left dtype, + ADDRESS CONST left addr, right addr, result addr ): + result repr := REPR result addr ; + IF opn.mod nr = q pdadd THEN select with dint; LEAVE apply p3 + ELIF opn.mod nr = q select THEN gen select instruction; LEAVE apply p3 FI ; + left repr := REPR left addr ; + IF opn.mod nr = q movex THEN gen long move + ELIF opn.mod nr = q alias ds THEN alias dataspace + ELSE gen p3 instruction + FI . + +gen long move : + IF right addr.kind = immediate value + THEN long move (left repr, result repr, right addr.value) + ELSE errorstop (no immediate value) + FI . + +alias dataspace : + IF right addr.value = immediate value + THEN s0 (q alias ds code) ; + s2 (right addr.value, result repr, left repr) + ELSE errorstop (no immediate value) + FI . + +gen select instruction : + IF right addr.kind = immediate value + THEN IF different bases + THEN access external (left addr.value, right addr.value) + ELSE t1 (q select code, REPR left addr) ; + s1 (right addr.value, result repr) + FI + ELSE errorstop (no immediate value) + FI . + +select with dint : + right repr := REPR right addr ; + IF different bases THEN access external packet + ELSE simple access + FI . + +different bases : + left addr.kind = p base AND left addr.value <> packet base . + +simple access : + s3 (q pdadd code, REPR left addr, right repr, result repr) . + +access external packet : + access external (left addr.value, global address zero) ; + s3 (q pdadd code, REPR REF result addr, right repr, result repr) . + +gen p3 instruction : + right repr := REPR right addr ; + SELECT opn.mod nr OF + CASE q add : int add + CASE q sub : int sub + CASE q fadd : real add + CASE q fsub : real sub + CASE q fmult : real mult + CASE q fdiv, q real div : real div + CASE q esc mult : int mult + CASE q esc div, q int div : int div + CASE q esc mod : int mod + CASE q plus : int real add + CASE q minus : int real sub + CASE q mult : int real mult + CASE q equal, q lessequal : compare (comp code, left repr, right repr) + CASE q ppsub : distance between two objects + OTHERWISE errorstop (wrong nr of params + mnemonic (opn)) + ENDSELECT . + +int add : compute (q add code, left repr, right repr, result repr) . + +int sub : compute (q sub code, left repr, right repr, result repr) . + +real add : compute (q fadd code, left repr, right repr, result repr) . + +real sub : compute (q fsub code, left repr, right repr, result repr) . + +real mult : compute (q fmult code, left repr, right repr, result repr) . + +real div : compute (q fdiv code, left repr, right repr, result repr) . + +int mult : s3 (q esc mult code, left repr, right repr, result repr) . + +int div : s3 (q esc div code, left repr, right repr, result repr) . + +int mod : s3 (q esc mod code, left repr, right repr, result repr) . + +int real add : + IF left type = int id THEN int add + ELSE real add + FI . + +int real sub : + IF left type = int id THEN int sub + ELSE real sub + FI . + +int real mult : + IF left type = int id THEN int mult + ELSE real mult + FI . + +comp code : + SELECT left type OF + CASE int id : IF opn.mod nr = q equal THEN q equ ELSE q lsequ FI + CASE real id : IF opn.mod nr = q equal THEN q fequ ELSE q flsequ FI + CASE string id : IF opn.mod nr = q equal THEN q tequ ELSE q tlsequ FI + OTHERWISE errorstop (type error); q equ + ENDSELECT . + +left type : CONCR (left dtype) . + +distance between two objects : + s3 (q ppsub code, left repr, right repr, result repr) + +ENDPROC apply p3; + +PROC access external (INT CONST old base, offset) : + s0 (q penter code + old base) ; + t2 (q ref code, offset, result repr) ; + s0 (q penter code + packet base) +ENDPROC access external ; + + + (***** Modul *****) + +BOOL VAR module open ; + +.init opn section : + module open := FALSE .; + +PROC begin module : + IF module open THEN errorstop (nested module) + ELSE begin modul ; + module open := TRUE + FI +ENDPROC begin module ; + +PROC end module : + IF NOT module open + THEN errorstop (module not opened) + ELSE end modul ; + module open := FALSE + FI +ENDPROC end module ; + +TEXT PROC dump (OPN CONST operation) : + IF operation.kind = proc op THEN " PROC" + text (operation.mod nr, 5) + ELIF operation.kind = eumel 0 THEN " EUMEL0: " + mnemonic (operation) + ELSE " undef. Opn" + FI +ENDPROC dump ; + +PROC begin modul : + EXTERNAL 10073 +ENDPROC begin modul ; + +PROC end modul : + EXTERNAL 10011 +ENDPROC end modul ; + +PROC proc head (INT VAR mod nr, top of stack) : + EXTERNAL 10012 +ENDPROC proc head ; + +PROC set length (INT CONST top of stack, size) : + EXTERNAL 10013 +ENDPROC set length ; + +PROC get module nr (INT VAR module nr) : + EXTERNAL 10016 +ENDPROC get module nr ; + +PROC compute (INT CONST op code, l addr, r addr, result address) : + EXTERNAL 10017 +ENDPROC compute ; + +PROC compare (INT CONST op code, l addr, r addr) : + EXTERNAL 10018 +ENDPROC compare ; + +PROC long move (INT CONST to, from, length) : + EXTERNAL 10019 +ENDPROC long move ; + +PROC call (INT CONST mod nr) : + EXTERNAL 10022 +ENDPROC call ; + +PROC call param (INT CONST mod nr) : + EXTERNAL 10023 +ENDPROC call param ; + +PROC push param (INT CONST addr) : + EXTERNAL 10024 +ENDPROC push param ; + +PROC push param proc (INT CONST mod nr) : + EXTERNAL 10025 +ENDPROC push param proc ; + +PROC init param push (INT CONST mod nr) : + EXTERNAL 10026 +ENDPROC init param push ; + +PROC push result address (INT CONST addr) : + EXTERNAL 10027 +ENDPROC push result address ; + +PROC test bool object (INT CONST addr) : + EXTERNAL 10192 +ENDPROC test bool object ; + +PROC mark line (INT CONST line number) : + EXTERNAL 10030 +ENDPROC mark line ; + +PROC s0 (INT CONST op code) : + EXTERNAL 10038 +ENDPROC s0 ; + +PROC s1 (INT CONST op code, addr) : + EXTERNAL 10039 +ENDPROC s1 ; + +PROC s2 (INT CONST op code , addr1, addr2) : + EXTERNAL 10040 +ENDPROC s2 ; + +PROC s3 (INT CONST op code, addr1, addr2, addr3) : + EXTERNAL 10041 +ENDPROC s3 ; + +PROC t1 (INT CONST op code, addr) : + EXTERNAL 10042 +ENDPROC t1 ; + +PROC t2 (INT CONST op code, addr1, addr2) : + EXTERNAL 10043 +ENDPROC t2 ; + +#page# +(**************************************************************************) +(* *) +(* 9. Speicherverwaltung 03.06.1986 *) +(* *) +(* Ablage der Paketdaten *) +(* *) +(**************************************************************************) + + + +INT VAR address value; + +INT CONST data allocation by coder := 1 , + data allocation by user := 2 ; + +LET not initialized = 0 , + wrong mm mode = "Wrong MM Mode" , + define on non global = "Define for GLOB only" , + text too long = "TEXT too long" ; + +TEXT VAR const buffer :: point line ; + +.reset memory management mode : + memory management mode := not initialized . ; + +PROC reserve storage (INT CONST size) : + IF memory management mode <> data allocation by user + THEN errorstop (wrong mm mode) + FI ; + allocate var (address value, size) ; + memory management mode := not initialized +ENDPROC reserve storage ; + +PROC allocate variable (ADDRESS VAR addr, INT CONST size) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate var (addr.value, size) ; + addr.kind := global +ENDPROC allocate variable ; + +PROC allocate denoter (ADDRESS VAR addr, INT CONST value) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate int denoter (addr.value) ; + put data word (value, addr.value) ; + addr.kind := global +ENDPROC allocate denoter ; + +PROC allocate denoter (ADDRESS VAR addr, REAL CONST value) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate real denoter (addr.value) ; + addr.kind := global ; + define (addr, value) +ENDPROC allocate denoter ; + +PROC allocate denoter (ADDRESS VAR addr, TEXT CONST value) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate text denoter (addr.value, (LENGTH value+1) DIV 2 + 2) ; + addr.kind := global ; + skip heaplink; + define (addr, value) ; + reset heaplink . + +skip heaplink : + addr.value INCR 1 . + +reset heaplink : + addr.value DECR 1 +ENDPROC allocate denoter ; + +PROC allocate denoter (ADDRESS VAR addr, DINT CONST value) : + IF memory management mode <> data allocation by coder + THEN errorstop (wrong mm mode) + FI ; + allocate dint denoter (addr.value, value) ; + addr.kind := global +ENDPROC allocate denoter ; + +PROC allocate dint denoter (INT VAR addr offset, DINT CONST value) : + adjust to an even address if necessary ; + put data word (value.low, addr offset) ; + allocate int denoter (address value) ; + put data word (value.high, address value) . + +adjust to an even address if necessary : + allocate int denoter (addr offset) ; + IF (addr offset AND 1) <> 0 THEN allocate int denoter (addr offset) FI +ENDPROC allocate dint denoter ; + +PROC define (ADDRESS CONST addr, INT CONST value) : + IF addr.kind <> global + THEN errorstop (define on non global) + FI ; + put data word (value, addr.value) +ENDPROC define ; + +PROC define (ADDRESS CONST addr, DINT CONST value) : + IF addr.kind <> global + THEN errorstop (define on non global) + FI ; + put data word (value.low , addr.value); + put data word (value.high, addr.value + 1) +ENDPROC define ; + +PROC define (ADDRESS CONST addr, REAL CONST value) : + IF addr.kind <> global + THEN errorstop (define on non global) + FI ; + replace (const buffer, 1, value) ; + address value := addr.value ; + FOR index FROM 1 UPTO 4 REP + put data word (const buffer ISUB index, address value) ; + address value INCR 1 + PER +ENDPROC define ; + +PROC define (ADDRESS CONST addr, TEXT CONST value) : + IF addr.kind <> global THEN errorstop (define on non global) + ELIF LENGTH value > 255 THEN errorstop (text too long) + FI ; + address value := addr.value ; + const buffer := code (LENGTH value) ; + const buffer CAT value ; + const buffer CAT ""0"" ; + FOR index FROM 1 UPTO LENGTH const buffer DIV 2 REP + put data word (const buffer ISUB index, address value) ; + address value INCR 1 + PER ; + const buffer := point line +ENDPROC define ; + +PROC allocate var (INT VAR addr, INT CONST length) : + EXTERNAL 10033 +ENDPROC allocate var ; + +PROC allocate int denoter (INT VAR addr) : + EXTERNAL 10034 +ENDPROC allocate int denoter ; + +PROC allocate real denoter (INT VAR addr) : + EXTERNAL 10035 +ENDPROC allocate real denoter ; + +PROC allocate text denoter (INT VAR addr, INT CONST length) : + EXTERNAL 10036 +ENDPROC allocate text denoter ; + +PROC put data word (INT CONST value, INT CONST addr) : + EXTERNAL 10037 +ENDPROC put data word ; + + +#page# +(**************************************************************************) +(* *) +(* 10. Inspector 28.10.1987 *) +(* *) +(**************************************************************************) + + + +INT VAR line number, pattern length, begin of packet, + last packet entry, indentation; + +TEXT VAR bulletin name, type and mode, pattern, buffer, dummy name; + +DATASPACE VAR bulletin ds :: nilspace ; + +.packet name : + cdb text (cdb int(packet link + wordlength) + two word length) . + +.packet entry : + permanent pointer = 0 OR + cdbint (permanent pointer) = permanent packet OR + cdbint (permanent pointer + wordlength) = permanent packet . + +.within editor : + aktueller editor > 0 . ; + +TEXT PROC type name (DTYPE CONST type) : + type and mode := "" ; + IF CONCR (type) = void id THEN type and mode CAT "VOID" + ELSE name of type (CONCR (type)) + FI ; + type and mode +ENDPROC type name ; + +TEXT PROC dump (DTYPE CONST type) : +(* type and mode := "TYPE " ; + name of type (CONCR (type)) ; + type and mode +*) + type name (type) (* aus Kompatibilitätsgründen zum 1.9.2 Coder / rr *) +ENDPROC dump ; + +PROC name of type (INT CONST type) : + SELECT type OF + CASE void id : + CASE int id : type and mode CAT "INT" + CASE real id : type and mode CAT "REAL" + CASE string id : type and mode CAT "TEXT" + CASE bool id, bool result id : type and mode CAT "BOOL" + CASE dataspace id : type and mode CAT "DATASPACE" + CASE row id : type and mode CAT "ROW " + CASE struct id : type and mode CAT "STRUCT" + OTHERWISE : complex type + ENDSELECT . + +complex type : + unsigned arithmetic ; + IF type > ptt limit THEN perhaps permanent struct or row + ELSE get complex type + FI . + +perhaps permanent struct or row : + index := type + begin of pt minus ptt limit ; + mode := cdb int (index) MOD ptt limit ; + IF mode = permanent row THEN get permanent row + ELIF mode = permanent struct THEN get permanent struct + ELSE type and mode CAT "-" + FI . + +get complex type : + index := type + begin of permanent table ; + IF is complex type THEN get name + ELSE type and mode CAT "-" + FI . + +is complex type : + permanent type definition mode = permanent type . + +get name : + type and mode CAT cdb text (link to type name + two word length) . + +link to type name : + cdb int (index + three word length) . + +permanent type definition mode : + cdb int (index + wordlength) . + +get permanent row : + INT VAR t; + type and mode CAT "ROW " ; + type and mode CAT text (cdb int (index + wordlength)) ; + type and mode CAT " " ; + param link := index + two wordlength ; + get type and mode (t) ; + name of type (t) . + +get permanent struct : + type and mode CAT "STRUCT ( ... )" +ENDPROC name of type ; + +PROC help (TEXT CONST proc name) : + prep bulletin ; + prep help ; + scan (object name) ; + next symbol (pattern) ; + packet link := end of permanent table ; + IF function = 0 THEN standard help + ELSE asterisk help + FI . + +prep help : + object name := compress (proc name) ; + INT VAR function :: 0 ; + INT CONST l :: LENGTH object name ; + IF l > 1 AND object name <> "**" + THEN IF (object name SUB l) = "*" + THEN function INCR 2 ; + delete char (object name, l) + FI ; + IF (object name SUB 1) = "*" + THEN function INCR 1 ; + delete char (object name, 1) + FI ; + IF another asterisk THEN wrong function FI + FI. + +another asterisk : + pos (object name, "*") <> 0 . + +wrong function : + errorstop ("unzulaessige Sternfunktion") . + +standard help : + to object (pattern) ; + IF found THEN display + ELSE error stop ("unbekannt: " + proc name) + FI . + +display : + IF NOT packet entry + THEN WHILE permanent pointer <> 0 REP + put name of packet if necessary ; + put specifications (pattern) ; + next procedure + ENDREP ; + show bulletin file + FI . + +put name of packet if necessary : + IF new packet THEN packet link := permanent pointer ; + find begin of packet ; + writeline (2) ; + write packet name + FI . + +find begin of packet : + REP + packet link DECR wordlength + UNTIL begin of packet found PER . + +begin of packet found : + cdb int (packet link) = permanent packet . + +new packet : + permanent pointer < packet link . + +asterisk help : + hash table pointer := begin of hash table ; + pattern length := LENGTH pattern - 1 ; + REP + list all objects in current hash table chain ; + next hash entry + UNTIL end of hash table reached ENDREP ; + show bulletin file . + +list all objects in current hash table chain : + nt link := hash table pointer ; + WHILE yet another nt entry REP + permanent pointer := cdb int (nt link + wordlength) ; + object name := cdb text (nt link + two word length) ; + IF matching THEN into bulletin FI + PER . + +matching : + INT CONST p :: pos (object name, pattern) ; + SELECT function OF + CASE 1 : p <> 0 AND p = LENGTH object name - pattern length + CASE 2 : p = 1 + CASE 3 : p <> 0 + OTHERWISE FALSE + ENDSELECT . + +into bulletin : + object names into bulletin (BOOL PROC not end of chain) +ENDPROC help ; + +BOOL PROC not end of chain : + permanent pointer <> 0 +ENDPROC not end of chain ; + +PROC write packet name : + indentation := 0 ; + write line ; + write bulletin line ("PACKET ") ; + indentation := 7 ; + object name := packet name ; + write bulletin line (object name) ; + write bulletin line (":") ; + writeline (2) +ENDPROC write packet name ; + +PROC put specifications (TEXT CONST proc name) : + put obj name (proc name) ; + to first param ; + IF NOT end of params THEN put param list FI ; + put result ; + writeline . + +to first param : + param link := permanent pointer + word length ; + set end marker if end of list . + +put result : + INT VAR type; + get type and mode (type) ; + IF type <> void id THEN type and mode := " --> " ; + name of type (type) ; + write bulletin line (type and mode) + FI +ENDPROC put specifications ; + +PROC put param list : + write bulletin line (" (") ; + REP + INT VAR type, param mode; + get type and mode (type) ; + param mode := mode ; + put type and mode ; + maybe param proc ; + next pt param ; + IF end of params THEN write bulletin line (")") ; + LEAVE put param list + FI ; + write bulletin line (", ") ; + PER . + +put type and mode : + type and mode := "" ; + name of type (type) ; + type and mode CAT name of mode ; + write bulletin line (type and mode) . + +name of mode : + IF param mode = const THEN " CONST" + ELIF param mode = var THEN " VAR" + ELSE " PROC" + FI . + +maybe param proc : + IF mode = permanent param proc THEN put virtual params FI . + +put virtual params : + skip over result type if complex type ; + IF NOT end of virtual params THEN put param list FI. + +skip over result type if complex type : + next pt param . + +end of virtual params : + end of params +ENDPROC put param list ; + +PROC to packet (TEXT CONST packet name) : + to object ( packet name) ; + IF found THEN find start of packet objects FI . + +find start of packet objects : + last packet entry := 0 ; + packet link := before first pt entry ; + REP + packet link INCR wordlength ; + word := cdb int (packet link) ; + IF word < 0 THEN IF word = permanent packet THEN packet found + ELIF word = permanent end THEN return + FI + FI + ENDREP . + +packet found : + IF cdb int (packet link + wordlength) = nt link + THEN last packet entry := packet link FI . + +return : + IF last packet entry <> 0 THEN found := TRUE ; + packet link := last packet entry + ELSE found := FALSE + FI ; + LEAVE to packet +ENDPROC to packet ; + +PROC next packet : + REP + packet link INCR wordlength ; + word := cdb int (packet link) ; + IF word = permanent packet THEN true return + ELIF end of permanents THEN false return + FI ; + ENDREP . + +true return : + found := TRUE ; + LEAVE next packet . + +false return : + found := FALSE ; + LEAVE next packet . + +end of permanents : + word = permanent end OR packet link > end of permanent table +ENDPROC next packet ; + +PROC prep bulletin : + forget (bulletin ds) ; + bulletin ds := nilspace ; + bulletin file := sequential file (output, bulletin ds) ; + line number := 0 ; + buffer := "" +ENDPROC prep bulletin ; + +PROC show bulletin file : + IF within editor THEN ueberschrift neu FI ; + DATASPACE VAR local ds :: bulletin ds ; + FILE VAR local file :: sequential file (modify, local ds) ; + show (local file) ; + forget (local ds) +ENDPROC show bulletin file ; + +PROC write bulletin line (TEXT CONST line) : + IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ; + buffer CAT line +ENDPROC write bulletin line ; + +PROC writeline : + write (bulletin file, buffer) ; + line (bulletin file) ; + line number INCR 1 ; + cout (line number) ; + buffer := indentation * " " +ENDPROC writeline ; + +PROC writeline (INT CONST times) : + IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ; + writeline + ELSE index := times + FI ; + line (bulletin file, index) ; + line number INCR index; + indentation := 0 ; + cout (line number) +ENDPROC writeline ; + +PROC bulletin (TEXT CONST packet name) : + prep bulletin ; + scan (packet name) ; + next symbol (pattern) ; + to packet (pattern) ; + IF found THEN list packet ; + show bulletin file + ELSE error stop (packet name + " ist kein Paketname") + FI . + +ENDPROC bulletin ; + +PROC list packet : + begin of packet := packet link + word length ; + write packet name ; + find end of packet ; + run through nametab and list all packet objects . + +find end of packet : + last packet entry := begin of packet ; + REP + last packet entry INCR wordlength ; + word := cdb int (last packet entry) ; + UNTIL end of packet entries PER . + +end of packet entries : + word = permanent packet OR word = permanent end . + +run through nametab and list all packet objects : + hashtable pointer := begin of hashtable ; + REP + nt link := hashtable pointer ; + list objects of current packet in this chain ; + next hash entry + UNTIL end of hashtable reached ENDREP . + +list objects of current packet in this chain : + WHILE yet another nt entry REP + permanent pointer := cdb int (nt link + wordlength) ; + put objects of this name + PER . + +put objects of this name : + IF there is an entry THEN into bulletin FI . + +there is an entry : + NOT packet entry AND + there is at least one object of this name in the current packet . + +there is at least one object of this name in the current packet : + REP + IF permanent pointer >= begin of packet AND + permanent pointer < last packet entry + THEN LEAVE there is at least one object of this name + in the current packet WITH TRUE FI ; + next procedure + UNTIL permanent pointer = 0 PER ; + FALSE . + +into bulletin : + object name := cdb text (nt link + two word length) ; + object names into bulletin (BOOL PROC within packet) +ENDPROC list packet ; + +BOOL PROC within packet : + permanent pointer >= begin of packet AND + permanent pointer < last packet entry +ENDPROC within packet ; + +PROC object names into bulletin (BOOL PROC link ok) : + scan (object name) ; + next symbol (dummy name, mode) ; + IF type definition THEN put type definition + ELSE put object definitions + FI . + +type definition : + mode = bold AND no params . + +no params : + cdb int (permanent pointer + word length) >= permanent type . + +put type definition : + put obj name (object name) ; + write bulletin line ("TYPE ") ; + writeline (1) . + +put object definitions : + WHILE link ok REP + put specifications (object name) ; + next procedure + ENDREP +ENDPROC object names into bulletin ; + +PROC bulletin : + prep bulletin ; + packet link := first permanent entry ; + REP + list packet ; + write line (4) ; + next packet + UNTIL NOT found PER ; + show bulletin file +ENDPROC bulletin ; + +PROC put obj name (TEXT CONST name) : + buffer := " " ; + bulletin name := point line ; + change (bulletin name, 1, end of line or name, name) ; + buffer CAT bulletin name ; + indentation := LENGTH buffer + 1 . + +end of line or name : + min (LENGTH name, LENGTH bulletin name) +ENDPROC put obj name ; + +PROC packets : + prep bulletin ; + packet link := first permanent entry ; + REP + object name := packet name ; + put obj name (object name) ; + write line ; + next packet + UNTIL NOT found PER ; + show bulletin file +ENDPROC packets ; + +#page# +(**************************************************************************) +(* *) +(* 11. ELAN Run-Interface 04.08.1986 *) +(* *) +(* Uebersetzen von ELAN-Programmen *) +(* Bereitstellen der Ausgabeprozeduren fuer den ELAN-Compiler *) +(* *) +(**************************************************************************) + + + +BOOL VAR list option := FALSE , + check option := TRUE , + warning option := FALSE , + listing enabled := FALSE ; + +FILE VAR listing file ; + +TEXT VAR listing file name := "" ; + + +PROC run (TEXT CONST file name) : + enable stop ; + IF NOT exists (file name) + THEN errorstop ("""" + file name + """ gibt es nicht") + FI ; + last param (file name) ; + run elan (file name, no ins) +END PROC run; + +PROC run : + run (last param) +ENDPROC run ; + +PROC run again : + IF run again mod nr <> 0 + THEN elan (run again mode, bulletin file, "", run again mod nr, + no ins, no lst, check option, no sermon) + ELSE errorstop ("'run again' nicht moeglich") + FI +ENDPROC run again ; + +PROC insert (TEXT CONST file name) : + enable stop ; + IF NOT exists (file name) + THEN errorstop ("""" + file name + """ gibt es nicht") + FI ; + last param (file name) ; + run elan (file name, ins) +ENDPROC insert ; + +PROC insert : + insert (last param) +ENDPROC insert ; + +PROC run elan (TEXT CONST file name, BOOL CONST insert option) : + FILE VAR source := sequential file (modify, file name) ; + IF listing enabled + THEN open listing file + FI ; + + disable stop ; + no do again ; + elan (compile file mode, source, "" , run again mod nr, + insert option, list option, check option, sermon) ; + + IF anything noted AND command dialogue + THEN ignore halt during compiling ; + note edit (source) ; + last param (file name) ; + errorstop ("") + FI . + +ignore halt during compiling : + IF is error + THEN put error ; + clear error ; + pause (5) + FI . + +open listing file : + listing file := sequential file (output, listing file name) ; + max line length (listing file, 130) + +ENDPROC run elan ; +(* +PROC out text (TEXT CONST text, INT CONST out type) : + INTERNAL 257 ; + IF online + THEN out (text) + FI ; + IF out type = error message OR (warning option AND out type = warning message) + THEN note (text) ; + FI ; + IF listing enabled + THEN write (listing file, text) + FI +ENDPROC out text ; + +PROC out line (INT CONST out type) : + INTERNAL 258 ; + IF online + THEN out (""13""10"") + FI ; + IF out type = error message + OR (warning option AND out type = warning message) + THEN note line + ELIF listing enabled + THEN line (listing file) + FI +ENDPROC out line ; +*) +PROC prot (TEXT CONST file name) : + list option := TRUE ; + listing file name := file name ; + listing enabled := TRUE +ENDPROC prot ; + +PROC prot off : + list option := FALSE ; + listing enabled := FALSE +ENDPROC prot off ; + +BOOL PROC prot : + list option +ENDPROC prot ; + +PROC check on : + check option := TRUE +ENDPROC check on ; + +PROC check off : + check option := FALSE +ENDPROC check off ; + +BOOL PROC check : + check option +ENDPROC check ; + +PROC warnings on : + warning option := TRUE +ENDPROC warnings on ; + +PROC warnings off : + warning option := FALSE +ENDPROC warnings off ; + +BOOL PROC warnings : + warning option +ENDPROC warnings ; + +ENDPACKET eumel coder ; + +PACKET dint2 DEFINES dint type : + +INT VAR dummy ; +DTYPE VAR d ; +identify ("DINT", dummy, dummy, d) ; + +DTYPE CONST dint type := d + +ENDPACKET dint2 ; + diff --git a/system/multiuser/1.7.5/source-disk b/system/multiuser/1.7.5/source-disk new file mode 100644 index 0000000..e24344a --- /dev/null +++ b/system/multiuser/1.7.5/source-disk @@ -0,0 +1,2 @@ +175_src/source-code-1.7.5m_0.img +175_src/source-code-1.7.5m_1.img diff --git a/system/multiuser/1.7.5/src/archive b/system/multiuser/1.7.5/src/archive new file mode 100644 index 0000000..8027b29 --- /dev/null +++ b/system/multiuser/1.7.5/src/archive @@ -0,0 +1,92 @@ +(* ------------------- VERSION 14 06.03.86 ------------------- *) +PACKET archive DEFINES + + archive , + clear , + release , + format , + check , + reserve : + + +LET clear code = 18 , + reserve code = 19 , + free code = 20 , + check read code = 22 , + format code = 23 ; + + +TASK PROC archive : + + task ("ARCHIVE") + +ENDPROC archive ; + +PROC archive (TEXT CONST archive name, TASK CONST task) : + + call (reserve code, archive name, task) + +ENDPROC archive ; + +PROC reserve (TEXT CONST message, TASK CONST task) : + + call (reserve code, message, task) + +END PROC reserve; + +PROC reserve (TASK CONST task) : + + call(reserve code, "", task) + +END PROC reserve; + +PROC archive (TEXT CONST archive name, INT CONST station) : + + call (reserve code, archive name, station/ "ARCHIVE") + +ENDPROC archive ; + +PROC archive (TEXT CONST archive name): + + call (reserve code, archive name, archive) + +ENDPROC archive ; + +PROC release (TASK CONST task) : + + call (free code, "", task) + +ENDPROC release ; + +PROC clear (TASK CONST task) : + + call (clear code, "", task) + +ENDPROC clear ; + +PROC format (TASK CONST task) : + + format (0, task) + +ENDPROC format ; + +PROC format (INT CONST code, TASK CONST task) : + + call (format code , text (code), task) + +ENDPROC format ; + +PROC check (TEXT CONST file name, TASK CONST task) : + + call (check read code, file name, task) + +ENDPROC check ; + +PROC check (THESAURUS CONST nameset, TASK CONST task) : + + do (PROC (TEXT CONST, TASK CONST) check, nameset, task) + +ENDPROC check ; + +ENDPACKET archive ; + diff --git a/system/multiuser/1.7.5/src/archive manager b/system/multiuser/1.7.5/src/archive manager new file mode 100644 index 0000000..c37d2e2 --- /dev/null +++ b/system/multiuser/1.7.5/src/archive manager @@ -0,0 +1,670 @@ +(* ------------------- VERSION 10 vom 17.04.86 ------------------- *) +PACKET archive manager DEFINES (* Autor: J.Liedtke*) + + archive manager , + provide channel : + + + +LET std archive channel = 31 , + + ack = 0 , + nak = 1 , + error nak = 2 , + second phase ack = 5 , + false code = 6 , + + fetch code = 11 , + save code = 12 , + exists code = 13 , + erase code = 14 , + list code = 15 , + all code = 17 , + clear code = 18 , + reserve code = 19 , + free code = 20 , + check read code = 22 , + format code = 23 , + + read error = 92 , + + max files = 200 , + + start of volume = 1000 , + end of volume = 1 , + file header = 3 , + + number of header blocks = 2 , + + quote = """" , + dummy name = "-" , + dummy date = " " , + + + HEADER = STRUCT (TEXT name, date, INT type, TEXT password) ; + + +BOUND STRUCT (TEXT name, pass) VAR msg ; + +INT VAR archive channel := std archive channel ; + +TASK VAR archive owner := niltask , + order task ; +TEXT VAR archive name := "" , write stamp ; + +REAL VAR last access time := 0.0 ; + +BOOL VAR was already write access ; + + +DATASPACE VAR header space := nilspace ; +BOUND HEADER VAR header ; + +TEXT VAR file name := "" ; + +LET invalid = 0 , + read only = 1 , + valid = 2 ; + +LET accept read errors = TRUE , + ignore read errors = FALSE ; + + +INT VAR directory state := invalid ; + +THESAURUS VAR directory ; +INT VAR dir index ; + +INT VAR archive size ; + +INT VAR end of volume block ; +ROW max files INT VAR header block ; +ROW max files TEXT VAR header date ; + + + +PROC provide channel (INT CONST channel) : + + archive channel := channel + +ENDPROC provide channel ; + +PROC archive manager : + + archive manager (archive channel) + +ENDPROC archive manager ; + +PROC archive manager (INT CONST channel) : + + archive channel := channel ; + task password ("-") ; + global manager + (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) archive manager) + +ENDPROC archive manager ; + +PROC archive manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST task) : + + + enable stop ; + order task := task ; + msg := ds ; + SELECT order OF + CASE fetch code : fetch file + CASE save code : save file + CASE exists code : exists file + CASE erase code : erase file + CASE list code : list (ds); manager ok (ds) + CASE all code : deliver directory + CASE clear code, + format code : clear or format + CASE reserve code : reserve + CASE free code : free + CASE check read code : check + OTHERWISE errorstop (name (myself) + ": unbekannter Auftrag") + ENDSELECT . + +deliver directory : + access archive ; + BOUND THESAURUS VAR all names := ds ; + all names := directory ; + WHILE all names CONTAINS dummy name REP + delete (all names, dummy name, dir index) + PER ; + manager ok (ds) . + +clear or format : + IF NOT (order task = archive owner) + THEN errorstop ("Archiv nicht angemeldet") + ELIF phase = 1 + THEN ask for erase all + ELSE directory state := invalid ; + IF order <> clear code + THEN format archive (specification) ; + archive size := archive blocks + FI ; + rewind ; + write header (archive name, text (clock(1),13,1), start of volume); + write end of volume ; + manager ok (ds) + FI . + +ask for erase all : + IF order = format code AND specification > 3 + THEN errorstop ("ungueltiger Format-Code") + FI ; + look at volume header ; + IF header.name <> "" + THEN IF order = clear code + THEN manager question ("Archiv """+header.name+""" loeschen", order task) + ELSE manager question ("Archiv """+header.name+""" formatieren", order task) + FI + ELSE IF order = clear code + THEN manager question ("Archiv initialisieren", order task) + ELSE manager question ("Archiv formatieren", order task) + FI + FI . + +specification : + int (msg.name) . + +reserve : + IF reserve or free permitted + THEN continue archive channel; + disable stop ; + directory state := invalid ; + archive owner := order task ; + archive name := msg.name ; + manager ok (ds) + ELSE errorstop ("Archiv wird von Task """+name(archive owner)+""" benutzt") + FI . + +continue archive channel : + continue channel (archive channel) . + +free : + IF reserve or free permitted + THEN archive owner := niltask ; + break (quiet) ; + manager ok (ds) + ELSE manager message ("Archiv nicht angemeldet", order task) + FI. + +reserve or free permitted : + order task = archive owner OR last access more than five minutes ago + OR archive owner = niltask OR NOT + (exists (archive owner) OR station (archive owner) <> station (myself)) . + +last access more than five minutes ago : + abs (last access time - clock (1)) > 300.0 . + +fetch file : + access archive ; + access file (msg.name) ; + IF no read error remarked + THEN disable stop ; + fetch (ds, accept read errors) ; + IF read error occurred + THEN remark read error + FI ; + enable stop + ELSE fetch (ds, ignore read errors) + FI ; + manager ok (ds) . + +no read error remarked : + pos (file name, " mit Lesefehler") = 0 . + +read error occurred : + is error AND error code = read error . + +remark read error : + dir index := link (directory, file name) ; + REP + file name CAT " mit Lesefehler" ; + UNTIL NOT (directory CONTAINS file name) PER ; + IF LENGTH file name < 100 + THEN rename (directory, dir index, file name) + FI . + +save file : + IF phase = 1 + THEN access archive ; + access file (msg.name) ; + IF file in directory + THEN manager question (""""+file name +""" ueberschreiben", order task) + ELSE send (order task, second phase ack, ds) + FI + ELSE access archive ; + access file (file name) ; + erase ; + save (ds) ; + forget (ds) ; + ds := nilspace ; + manager ok (ds) + FI . + +exists file : + access archive ; + access file (msg.name) ; + IF file in directory + THEN manager ok (ds) + ELSE send (order task, false code, ds) + FI . + +erase file : + access archive ; + access file (msg.name) ; + IF file in directory + THEN IF phase = 1 + THEN manager question (""""+file name+""" loeschen", order task) + ELSE erase ; manager ok (ds) + FI + ELSE manager message ("gibt es nicht", order task) + FI . + +check : + access archive ; + access file (msg.name) ; + IF file in directory + THEN position to file ; + disable stop ; + check read ; + IF is error + THEN clear error; error ("fehlerhaft") + ELSE last access time := clock (1) ; + manager message ("""" + file name + """ ohne Fehler gelesen", order task) + FI + ELSE error ("gibt es nicht") + FI . + +file in directory : dir index > 0 . + +position to file : + seek (header block (dir index) + number of header blocks) . + +ENDPROC archive manager ; + +PROC manager ok (DATASPACE VAR ds) : + + send (order task, ack, ds) ; + last access time := clock (1) . + +ENDPROC manager ok ; + +PROC access archive : + + IF NOT (order task = archive owner) + THEN errorstop ("Archiv nicht angemeldet") + ELIF directory state = invalid + THEN open archive + ELIF last access more than two seconds ago + THEN check volume name ; + new open if somebody changed medium + FI . + +last access more than two seconds ago : + abs (clock (1) - last access time) > 2.0 . + +new open if somebody changed medium : + IF header.date <> write stamp + THEN directory state := invalid ; + access archive + FI . + +open archive : + directory state := invalid ; + check volume name ; + write stamp := header.date ; + was already write access := FALSE ; + read directory ; + make directory valid if no read errors occurred . + +read directory : + directory := empty thesaurus ; + rewind ; + get next header ; + WHILE header.type = file header REP + IF directory CONTAINS header.name + THEN rename (directory, header.name, dummy name) + FI ; + insert (directory, header.name, dir index) ; + header block (dir index) := end of volume block ; + header date (dir index) := header.date ; + get next header ; + PER . + +make directory valid if no read errors occurred : + IF directory state = invalid + THEN directory state := valid + FI . + +ENDPROC access archive ; + +PROC access file (TEXT CONST name) : + + file name := name ; + dir index := link (directory, file name) . + +ENDPROC access file ; + + +PROC check volume name : + + disable stop ; + archive size := archive blocks ; + read volume header ; + IF header.type <> start of volume + THEN simulate header (start of volume, "?????") + ELIF header.name <> archive name + THEN errorstop ("Archiv heisst """ + header.name + """") + FI . + +read volume header : + rewind ; + read header ; + IF is error AND error code = read error + THEN clear error ; + simulate header (start of volume, "?????") + FI . + +ENDPROC check volume name ; + +PROC get next header : + + disable stop ; + skip dataspace ; + IF NOT is error + THEN read header + FI ; + IF is error + THEN clear error ; + directory state := read only ; + search header + FI ; + end of volume block := block number - number of header blocks . + +search header : + INT VAR ds pages ; + search dataspace (ds pages) ; + IF ds pages < 0 + THEN simulate header (end of volume, "") + ELIF NOT is header space + THEN simulate header (file header, "????? " + text (block number)) + FI . + +is header space : + IF ds pages <> 1 + THEN FALSE + ELSE remember position ; + read header ; + IF read error occurred + THEN clear error; back to old position; FALSE + ELIF header format looks ok + THEN TRUE + ELSE back to old position ; FALSE + FI + FI . + +read error occurred : + is error CAND error code = read error . + +header format looks ok : + header.type = file header OR header.type = end of volume . + +remember position : + INT CONST old block nr := block number . + +back to old position : + seek (old block nr) . + +ENDPROC get next header ; + +PROC fetch (DATASPACE VAR ds, BOOL CONST error accept): + + enable stop ; + IF file name <> dummy name + THEN fetch from archive + ELSE error ("Name unzulaessig") + FI . + +fetch from archive : + IF file in directory + THEN position to file ; + read (ds, 30000, error accept) + ELIF directory state = read only + THEN error ("gibt es nicht (oder Lesefehler)") + ELSE error ("gibt es nicht") + FI . + +position to file : + seek (header block (dir index) + number of header blocks) . + +file in directory : dir index > 0 . + +ENDPROC fetch ; + +PROC erase : + + IF directory state = read only + THEN errorstop ("'save'/'erase' wegen Lesefehler verboten") + ELSE update write stamp if first write access ; + erase archive + FI . + +update write stamp if first write access : + IF NOT was already write access + THEN rewind ; + write stamp := text (clock (1), 13, 1) ; + write header (archive name, write stamp, start of volume) ; + was already write access := TRUE + FI . + +erase archive : + IF file in directory + THEN IF is last file of archive + THEN cut off all erased files + ELSE rename to dummy + FI + FI . + +file in directory : dir index > 0 . + +is last file of archive : dir index = highest entry (directory) . + +cut off all erased files : + directory state := invalid ; + REP + delete (directory, dir index) ; + dir index DECR 1 + UNTIL dir index = 0 COR name (directory, dir index) <> dummy name PER ; + behind last valid file ; + write end of volume ; + directory state := valid . + +behind last valid file : + seek (header block (dir index + 1)) ; + end of volume block := block number . + +rename to dummy : + directory state := invalid ; + to file header ; + read header ; + to file header ; + header.name := dummy name ; + header.date := dummy date ; + write (header space) ; + rename (directory, file name, dummy name) ; + header date (dir index) := dummy date ; + directory state := valid . + +to file header : + seek (header block (dir index)) . + +ENDPROC erase ; + +PROC save (DATASPACE VAR ds) : + + IF file name <> dummy name + THEN save to archive + ELSE error ("Name unzulaessig") + FI . + +save to archive : + IF file too large OR highest entry (directory) >= max files + THEN error ( "kann nicht geschrieben werden (Archiv voll)") + ELSE write new file + FI . + +file too large : + end of volume block + ds pages (ds) + 5 > archive size . + +write new file : + seek (end of volume block) ; + disable stop ; + write file (ds) ; + IF is error + THEN seek (end of volume block) + ELSE insert (directory, file name, dir index) ; + remember begin of header block ; + remember date + FI ; + write end of volume . + +remember begin of header block : + header block (dir index) := end of volume block . + +remember date : + header date (dir index) := date . + +ENDPROC save ; + +PROC write file (DATASPACE CONST ds) : + + enable stop ; + write header (file name, date, file header) ; + write (ds) + +ENDPROC write file ; + +PROC write end of volume : + + disable stop ; + end of volume block := block number ; + write header ("", "", end of volume) + +ENDPROC write end of volume ; + +PROC write header (TEXT CONST name, date, INT CONST header type) : + + forget (header space) ; + header space := nilspace ; + header := header space ; + + header.name := subtext (name,1,100) ; + header.date := date ; + header.type := header type ; + + write (header space) + +ENDPROC write header ; + +PROC read header : + + IF archive size > 0 + THEN forget (header space) ; + header space := nilspace ; + read (header space, 1, accept read errors) ; + header := header space + ELSE errorstop ("Lesen unmoeglich (Archiv)") + FI . + +ENDPROC read header ; + +PROC simulate header (INT CONST type, TEXT CONST name) : + + forget (header space) ; + header space := nilspace ; + header := header space ; + header.name := name ; + header.date := "??.??.??" ; + header.type := type ; + header.password := "" + +ENDPROC simulate header ; + +PROC look at volume header : + + rewind ; + archive size := archive blocks ; + forget (header space) ; + header space := nilspace ; + INT VAR return code ; + read block (header space, 1, 1, return code) ; + header := header space ; + disable stop ; + IF return code <> 0 OR + LENGTH header.name < 0 OR LENGTH header.name > 100 OR is error + THEN header.name := "" ; + clear error + FI + +ENDPROC look at volume header ; + +PROC list (DATASPACE VAR ds) : + + access archive ; + open list file ; + INT VAR file number := 0 ; + get (directory, file name, file number) ; + WHILE file number > 0 REP + generate list line ; + get (directory, file name, file number) + PER ; + IF directory state = read only + THEN putline (list file, "Lesefehler: Evtl. fehlen Eintraege") + FI ; + write list head . + +open list file : + forget (ds) ; + ds := nilspace ; + FILE VAR list file := sequential file (output, ds) ; + putline (list file, "") . + +generate list line : + write (list file, header date (file number)) ; + write (list file, text (file blocks DIV 2, 5)) ; + write (list file, " K ") ; + IF file name = dummy name + THEN write (list file, dummy name) + ELSE write (list file, quote) ; + write (list file, file name) ; + write (list file, quote) + FI ; + line (list file) . + +file blocks : + IF file number < highest entry (directory) + THEN header block (file number+1) - header block (file number) + ELSE end of volume block - header block (file number) + FI . + +write list head : (* wk 22.08.85 *) + headline (list file, archive name + + " (" + used + " K belegt von " + text (archive size DIV 2) + " K)") . + +used : text ((end of volume block + 3) DIV 2) . + +ENDPROC list ; + +PROC error (TEXT CONST error msg) : + + errorstop ("""" + file name + """ " + error msg) + +ENDPROC error ; + +ENDPACKET archive manager ; + diff --git a/system/multiuser/1.7.5/src/basic archive b/system/multiuser/1.7.5/src/basic archive new file mode 100644 index 0000000..8235607 --- /dev/null +++ b/system/multiuser/1.7.5/src/basic archive @@ -0,0 +1,401 @@ +(* ------------------- VERSION 11 06.03.86 ------------------- *) +PACKET basic archive DEFINES + + archive blocks , + block number , + check read , + format archive , + read block , + read , + rewind , + search dataspace , + seek , + size , + skip dataspace , + write block , + write : + +INT VAR blocknr := 0 , + rerun := 0 , + page := -1 , + bit word := 1 , + unreadable sequence length := 0 ; +INT CONST all ones :=-1 ; + + +DATASPACE VAR label ds ; + +LET write normal = 0 , + archive version = 1 , + first page stored = 2 , + dr size = 3 , + first bit word = 4 , +(* write deleted data mark = 64 , *) + inconsistent = 90 , + read error = 92 , + label size = 131 ; + +BOUND STRUCT (ALIGN dummy for page1, + (* Page 2 begins: *) + ROW label size INT lab) VAR label; + + +INT PROC block number : + block nr +ENDPROC block number ; + +PROC seek (INT CONST block) : + block nr := block +ENDPROC seek ; + +PROC rewind : + forget (label ds); + label ds := nilspace; + label := label ds; + block nr := 0; + rerun := session +END PROC rewind; + +PROC skip dataspace: + check rerun; + get label; + IF is error + THEN + ELIF olivetti + THEN block nr INCR label.lab (dr size+1) + ELSE block nr INCR label.lab (dr size) + FI +END PROC skip dataspace; + +PROC read (DATASPACE VAR ds): + read (ds, 30000, FALSE) +ENDPROC read ; + +PROC read (DATASPACE VAR ds, INT CONST max pages, BOOL CONST error accept) : + enable stop ; + check rerun; + get label; + init next page; + INT VAR i ; + FOR i FROM 1 UPTO max pages REP + next page; + IF no further page THEN LEAVE read FI; + check storage ; + check rerun ; + read block ; + block nr INCR 1; + PER . + +read block : + disable stop ; + get external block (ds, page, block nr) ; + ignore read error if no errors accepted ; + enable stop . + +ignore read error if no errors accepted : + IF is error CAND error code = read error CAND NOT error accept + THEN clear error + FI . + +check storage : + INT VAR size, used ; + storage (size, used) ; + IF used > size + THEN forget (ds) ; + ds := nilspace ; + errorstop ("Speicherengpass") ; + LEAVE read + FI . + +check rerun : + IF rerun <> session + THEN errorstop ("RERUN beim Archiv-Zugriff") ; + LEAVE read + FI . + +END PROC read; + +PROC check read : + + enable stop ; + get label ; + INT VAR pages, i; + IF olivetti + THEN pages := label.lab (dr size+1) + ELSE pages := label.lab (dr size) + FI ; + FOR i FROM 1 UPTO pages REP + get external block (label ds, 2, block nr) ; + block nr INCR 1 + PER . + +ENDPROC check read ; + +PROC write (DATASPACE CONST ds): + enable stop ; + check rerun; + INT VAR label block nr := block nr; + block nr INCR 1;init label; + INT VAR page := -1,i; + FOR i FROM 1 UPTO ds pages (ds) REP + check rerun ; + page := next ds page(ds,page); + put external block (ds, page, block nr) ; + reset archive bit; + label.lab(dr size) INCR 1; + block nr INCR 1 + PER; + put label. + + + init label: + label.lab(archive version) := 0 ; + label.lab(first page stored) := 0 ; + label.lab(dr size) := 0; + INT VAR j; + FOR j FROM first bit word UPTO label size REP + label.lab (j) := all ones + PER. + + put label: + put external block (label ds, 2, label block nr). + + reset archive bit: + reset bit (label.lab (page DIV 16+first bit word), page MOD 16). + +END PROC write; + +PROC get label: + + enable stop ; + get external block (label ds, 2, block nr) ; + block nr INCR 1; + check label. + +check label: + IF may be z80 format label OR may be old olivetti format label + THEN + ELSE errorstop (inconsistent, "Archiv inkonsistent") + FI. + +may be z80 format label : + z80 archive AND label.lab(dr size) > 0 . + +may be old olivetti format label : + olivetti AND label.lab(first page stored)=0 AND label.lab(dr size+1) > 0 . + +END PROC get label; + +PROC next page: + IF z80 archive + THEN + WHILE labelbits = all ones REP + bitword INCR 1; + IF bitword >= label size THEN + no further page := true; LEAVE next page FI + PER; + INT VAR p := lowest reset (labelbits); + set bit (labelbits, p); + page := 16*(bitword-first bit word)+p + ELSE + WHILE oli bits = 0 REP + bitword INCR 1; + IF bitword >= labelsize-64 THEN + no further page := true; LEAVE next page FI + PER; + p := lowest set (oli bits); + reset bit (olibits, p); + page := 16*(bitword-firstbitword)+p; + FI. + + label bits : label.lab (bitword). + oli bits : label.lab (bitword+1). + +END PROC next page; +. +olivetti : label.lab (archive version) = -1. + +z80 archive : label.lab (archive version) = 0. + +init next page: + BOOL VAR no further page := false; + bitword := first bit word. + +check rerun : + IF rerun <> session + THEN errorstop ("RERUN beim Archiv-Zugriff") + FI . + +PROC get external block (DATASPACE VAR ds, INT CONST page, + INT CONST block nr): + + INT VAR error ; + read block (ds, page, block nr, error) ; + SELECT error OF + CASE 0: read succeeded + CASE 1: error stop ("Lesen unmoeglich (Archiv)") + CASE 2: read failed + CASE 3: error stop ("Archiv-Ueberlauf") + OTHERWISE error stop ("??? (Archiv)") + END SELECT . + +read succeeded : + unreadable sequence length := 0 . + +read failed : + unreadable sequence length INCR 1 ; + IF unreadable sequence length >= 30 + THEN errorstop ("30 unlesbare Bloecke hintereinander") + ELSE error stop (read error, "Lesefehler (Archiv)") + FI . + +END PROC get external block; + +PROC put external block (DATASPACE CONST ds, INT CONST page, + INT CONST block nr): + INT VAR error; + write block (ds, page, write normal, block nr, error) ; + SELECT error OF + CASE 0: + CASE 1: error stop ("Schreiben unmoeglich (Archiv)") + CASE 2: error stop ("Schreibfehler (Archiv)") + CASE 3: error stop ("Archiv-Ueberlauf") + OTHERWISE error stop ("??? (Archiv)") + END SELECT . + +END PROC put external block; + +PROC read block (DATASPACE VAR ds, + INT CONST ds page no, + INT CONST block no, + INT VAR return code) : + read block; + retry if read error. + +read block: + block in (ds, ds page no, 0, block no, return code). + +retry if read error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + read block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN block in (ds, ds page no, 0, 0, return code) + FI. + +END PROC read block; + +PROC write block (DATASPACE CONST ds, + INT CONST ds page no, + INT CONST mode, + INT CONST block no, + INT VAR return code): + write block; + retry if write error. + +write block: + block out (ds, ds page no, mode * 256, block no, return code) . + +retry if write error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + write block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN disable stop; + DATASPACE VAR dummy ds := nilspace; + block in (dummy ds, 2, 0, 0, return code); + forget (dummy ds); + enable stop + FI. + +END PROC write block; + +INT PROC size (INT CONST key) : + + INT VAR return code ; + control (5, key, 0, return code) ; + return code . + +ENDPROC size ; + +INT PROC archive blocks : + size (0) +ENDPROC archive blocks ; + +PROC search dataspace (INT VAR ds pages) : + + disable stop ; + ds pages := -1 ; + INT CONST last block := archive blocks ; + + WHILE block nr < last block REP + IF block is dataspace label + THEN ds pages := pages counted ; + LEAVE search dataspace + FI ; + block nr INCR 1 + UNTIL is error PER . + +block is dataspace label : + look at label block ; + IF is error + THEN IF error code = read error OR error code = inconsistent + THEN clear error + FI ; + FALSE + ELSE count pages ; + pages counted = number of pages as label says + FI . + +look at label block : + INT CONST + old block nr := block nr ; + get label ; + block nr := old block nr. + +count pages : + INT VAR + pages counted := 0 ; + init next page ; + next page ; + WHILE NOT no further page REP + pages counted INCR 1 ; + next page + PER . + +number of pages as label says : label.lab (dr size) . + +ENDPROC search dataspace ; + +PROC format archive (INT CONST format code) : + + IF format is possible + THEN format + ELSE errorstop ("'format' ist hier nicht implementiert") + FI . + +format is possible : + INT VAR return code ; + control (1,0,0, return code) ; + bit (return code, 4) . + +format : + control (7, format code, 0, return code) ; + IF return code = 1 + THEN errorstop ("Formatieren unmoeglich") + ELIF return code > 1 + THEN errorstop ("Schreibfehler (Archiv)") + FI . + +ENDPROC format archive ; + +END PACKET basic archive; + diff --git a/system/multiuser/1.7.5/src/canal b/system/multiuser/1.7.5/src/canal new file mode 100644 index 0000000..ad0baa8 --- /dev/null +++ b/system/multiuser/1.7.5/src/canal @@ -0,0 +1,227 @@ +(* ------------------- VERSION 6 20.05.86 ------------------- *) +PACKET canal DEFINES (* Autor: J.Liedtke *) + + analyze supervisor command : + + + +LET command list = + +"begin:1.12end:3.0break:4.0continue:5.01halt:7.0 +taskinfo:8.0storageinfo:9.0help:10.0 ", + + supervisor command text = + +""6""20""1"ESC ? --> help +"6""21""1"ESC b --> begin ("""") +"6""22""1"ESC c --> continue ("""") +"6""23""1"ESC q --> break +"6""21""50"ESC h --> halt +"6""22""50"ESC s --> storage info +"6""23""50"ESC t --> task info +"6""8""6"gib supervisor kommando :" , + + text type = 4 , + ack = 0 , + error nak = 2 , + begin code = 4 , + end code = 5 , + break code = 6 , + halt code = 8 , + password code = 9 , + continue code = 100 , + + home = ""1"" ; + + +TASK VAR sv ; + +DATASPACE VAR ds ; + +BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg ; +BOUND TEXT VAR error msg ; + +INT VAR command index , number of params , reply ; +TEXT VAR param 1, param 2 , task password ; + + + lernsequenz auf taste legen ("b", ""1""8""1""12"begin ("""")"8""8""11"") ; + lernsequenz auf taste legen ("c", ""1""8""1""12"continue ("""")"8""8""11"") ; + lernsequenz auf taste legen ("q", ""1""8""1""12"break"13"") ; + lernsequenz auf taste legen ("h", ""1""8""1""12"halt"13"") ; + lernsequenz auf taste legen ("s", ""1""8""1""12"storage info"13"") ; + lernsequenz auf taste legen ("t", ""1""8""1""12"task info"13"") ; + lernsequenz auf taste legen ("?", ""1""8""1""12"help"13"") ; + +PROC analyze supervisor command : + + disable stop ; + sv := supervisor ; + ds := nilspace ; + REP + command dialogue (TRUE) ; + command pre ; + cry if not enough storage ; + get command (supervisor command text) ; + analyze command (command list, text type, + command index, number of params, + param1, param2) ; + execute command ; + PER . + +command pre : + IF NOT is error + THEN wait for terminal; eumel must advertise + ELSE forget (ds) ; ds := nilspace + FI . + +wait for terminal : + out (home) . + +cry if not enough storage : + INT VAR size, used ; + storage (size, used) ; + IF used > size + THEN out (""7"Speicher Engpass!"13""10"") ; + FI . + +ENDPROC analyze supervisor command ; + +PROC execute command : + + enable stop ; + SELECT command index OF + CASE 1 : begin ("PUBLIC") + CASE 2 : begin (param2) + CASE 3 : end via canal + CASE 4 : break + CASE 5 : quiet + CASE 6 : continue (param1) + CASE 7 : halt + CASE 8 : task info (0); eumel must advertise; quiet + CASE 9 : storage info; quiet + CASE 10 : help; eumel must advertise; quiet + OTHERWISE analyze command error + ENDSELECT ; + IF reply = error nak + THEN error msg := ds ; + errorstop (CONCR (error msg)) + FI . + +end via canal : + IF yes ("Task """ + name (task (channel (myself))) + """ loeschen") + THEN eumel must advertise ; + call (sv, end code, ds, reply) + FI . + +break : + eumel must advertise ; + call (sv, break code, ds, reply) . + +halt : + call (sv, halt code, ds, reply) . + +quiet : + call (sv, ack, ds, reply) . + +analyze command error : + command error ; + IF command index = 0 + THEN errorstop ("kein supervisor kommando") + ELIF number of params = 0 + THEN errorstop ("Taskname fehlt") + ELSE errorstop ("Parameter ueberfluessig") + FI . + +ENDPROC execute command ; + +PROC begin (TEXT CONST father name) : + + IF param1 = "-" + THEN errorstop ("Name ungueltig") + FI ; + sv msg := ds ; + CONCR (sv msg).tname := param1 ; + CONCR (sv msg).tpass := "" ; + call (task (father name), begin code, ds, reply) ; + IF reply = password code + THEN get password ; + sv msg := ds ; + CONCR (sv msg).tpass := task password ; + call (task (father name), begin code, ds, reply) + FI ; + IF reply = ack + THEN continue (param1) + FI . + +get password : + put (" Passwort:") ; + get secret line (task password) . + +ENDPROC begin ; + +PROC continue (TEXT CONST task name) : + + sv msg := ds ; + CONCR (sv msg).tname := task name ; + CONCR (sv msg).tpass := "" ; + call (sv, continue code + channel, ds, reply) ; + IF reply = password code + THEN get password ; + sv msg := ds ; + CONCR (sv msg).tpass := task password ; + call (sv, continue code + channel, ds, reply) + FI . + +get password : + put (" Passwort:") ; + get secret line (task password) . + +ENDPROC continue ; + +PROC help: + + LET page = ""1""4"" + ,bell = ""7"" + ,cr = ""13"" + ,end mark = ""14"" + ,begin mark = ""15"" + ,esc = ""27"" + ; + + REP + out (page) ; + show page ; + UNTIL is quit command PER . + + show page : + putline(begin mark + (31 * ".") + " supervisor help " + (31 * ".") + end mark) ; + putline("Hier finden Sie einige Kommandos, die Ihnen den Einstieg ins System er -") ; + putline("leichtern sollen:") ; + out(""6""05""07"1. Informations-Kommandos") ; + out(""6""07""11"storage info physisch belegten Hintergrundplatz melden") ; + out(""6""08""11"task info Taskbaum zeigen") ; + out(""6""14""07"2. Verbindung zum Supervisor") ; + out(""6""16""11"break Task vom Terminal abkoppeln") ; + out(""6""17""11"begin(""task"") neue Task `task` einrichten") ; + out(""6""18""11"continue(""task"") Task `task` an ein Terminal ankoppeln") ; + out(""6""21""01"Näheres: Benutzerhandbuch, Teil 2, Kap. 2") ; + out(""6""23""05"Wenn Sie den Hilfe-Modus beenden wollen, tippen Sie die Taste `q`. ") ; + out(cr) . + + is quit command : + TEXT VAR char ; + get char (char) ; + IF char = esc + THEN get char (char) + FI; + IF char = "q" COR char = "Q" + THEN true + ELSE out (bell); + FALSE + FI. + +END PROC help ; + +ENDPACKET canal ; + diff --git a/system/multiuser/1.7.5/src/configuration manager b/system/multiuser/1.7.5/src/configuration manager new file mode 100644 index 0000000..5eaea52 --- /dev/null +++ b/system/multiuser/1.7.5/src/configuration manager @@ -0,0 +1,553 @@ +(* ------------------- VERSION 11 02.06.86 ------------------- *) +PACKET configuration manager DEFINES + + configurate , + exec configuration , + setup , + define collector , + configuration manager : + + +LET baudrates = ""1"50"2"75"3"110"4"134.5"5"150"6"300"7"600 +"8"1200"9"1800"10"2400"11"3600"12"4800"13"7200 +"14"9600"15"19200"16"38400"17"", + parities = ""0"no"1"odd"2"even"3"" , + bits per char = ""0"1"1"2"2"3"3"4"4"5"5"6"6"7"7"8"8"" , + stopbits = ""0"1"1"1.5"2"2"3"" , + flow modes = ""0"ohne Protokoll"1"XON/XOFF"2"RTS/CTS +"3""4""5"XON/XOFF - ausgabeseitig"6"RTS/CTS - ausgabeseitig"7""8" +"9"XON/XOFF - eingabeseitig"10"RTS/CTS - eingabeseitig"11"" , + + ok = "j" , + esc = ""27"" , + cr = ""13"" , + right = ""2"" , + + psi = "psi" , + transparent = "transparent" , + + std rate = 14 , + std bits = 22 , + std flow = 0 , + std inbuffer size = 16 , + + device table = 32000 , + + max edit terminal = 15 , + configuration channel = 32 , + + fetch code = 11 , + save code = 12 , + erase code = 14 , + system start interrupt = 100 , + + CONF = STRUCT (TEXT dev type, + INT baud, bits par stop, flow control, inbuffer size) ; + + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ; + +BOUND ROW max edit terminal CONF VAR conf ; + +INT VAR channel no ; + +TEXT VAR prelude , last feature , answer , collector := "" ; + + + +BOOL PROC shard permits (INT CONST code, key) : + + INT VAR reply ; + IF key > -128 + THEN control (code, channel no, key, reply) + ELSE control (code, channel no, -maxint-1, reply) + FI ; + reply = 0 . + +ENDPROC shard permits ; + +PROC ask user (TEXT CONST feature, question) : + + last feature := feature ; + put question ; + skip pretyped chars ; + get valid answer . + +put question : + clear line ; + out (prelude) ; + out (feature) ; + out (question) ; + out (" (j/n) ") . + +clear line : + out (cr) ; + 79 TIMESOUT " " ; + out (cr) . + +skip pretyped chars : + REP UNTIL incharety = "" PER . + +get valid answer : + REP + inchar (answer) + UNTIL pos ("jJyYnN"27"", answer) > 0 PER ; + IF answer > ""31"" + THEN out (answer) + FI ; + out (cr) ; + normalize answer . + +normalize answer : + IF pos ("jJyY", answer) > 0 + THEN answer := ok + FI . + +ENDPROC ask user ; + +BOOL PROC yes (TEXT CONST question) : + + ask user ("", question) ; + answer = ok + +ENDPROC yes ; + +PROC chose key (INT VAR old key, INT CONST max key, TEXT CONST key string, + key entity, BOOL PROC (INT CONST) shard permits): + + IF shard permits at least one standard key + THEN try all keys + FI . + +shard permits at least one standard key : + INT VAR key ; + FOR key FROM 0 UPTO max key REP + IF shard permits (key) + THEN LEAVE shard permits at least one standard key WITH TRUE + FI + PER ; + FALSE . + +try all keys : + key := old key ; + REP + examine this key ; + next key + PER . + +examine this key : + IF shard permits (key) CAND key value <> "" + THEN ask user (key value, key entity) ; + IF answer = ok + THEN chose this key + ELIF answer = esc + THEN key := -129 + FI + FI . + +key value : + IF key >= 0 + THEN subtext (key string, key pos + 1, next key pos - 1) + ELSE text (key) + FI . + +key pos : pos (key string, code (key)) . +next key pos : pos (key string, code (key+1)) . + +chose this key : + remember calibration ; + old key := key ; + LEAVE chose key . + +next key : + IF key < max key + THEN key INCR 1 + ELSE key := 0 + FI . + +remember calibration : + prelude CAT last feature ; + prelude CAT ", " . + +ENDPROC chose key ; + +BOOL PROC rate ok (INT CONST key) : + + shard permits (8, key) + +ENDPROC rate ok ; + +BOOL PROC bits ok (INT CONST key) : + + IF key < 0 + THEN shard permits (9, key) + ELSE some standard combination ok + FI . + +some standard combination ok : + INT VAR combined := key ; + REP + IF shard permits (9, combined) + THEN LEAVE bits ok WITH TRUE + FI ; + combined INCR 8 + UNTIL combined > 127 PER ; + FALSE + +ENDPROC bits ok ; + +BOOL PROC parity ok (INT CONST key) : + + INT VAR combined := 8 * key + data bits ; + key >= 0 AND (shard permits (9, combined) OR + shard permits (9, combined + 32) OR + shard permits (9, combined + 64) ) + +ENDPROC parity ok ; + +BOOL PROC stopbits ok (INT CONST key) : + + key >= 0 AND shard permits (9, 32 * key + 8 * parity + data bits) + +ENDPROC stopbits ok ; + +BOOL PROC flow mode ok (INT CONST key) : + + shard permits (6, key) + +ENDPROC flow mode ok ; + + + +INT VAR data bits , + parity , + stop ; + +INT VAR old session := 0 ; + + +TEXT VAR table name, dummy ; + + +PROC configurate : + + new configuration ; + access configuration table ; + show all device types ; + channel no := 1 ; + REP + IF channel hardware exists + THEN try this channel ; + setup this channel + FI ; + channel no INCR 1 + UNTIL channel no > 15 PER ; + prelude := "" ; + IF yes ("Koennen unbenutzte Geraetetypen geloescht werden") + THEN forget unused device tables + FI . + +access configuration table : + IF exists ("configuration") + THEN conf := old ("configuration") + ELSE conf := new ("configuration") ; + initialize configuration + FI . + +initialize configuration : + FOR channel no FROM 1 UPTO max edit terminal REP + conf (channel no) := + CONF:(transparent, std rate, std bits, std flow, std inbuffer size) + PER ; + conf (1).dev type := psi . + +show all device types : + show prelude ; + begin list ; + get list entry (table name, dummy) ; + WHILE table name <> "" REP + IF dataspace is device table + THEN show table name + FI ; + get list entry (table name, dummy) + PER ; + line (2) . + +show prelude : + line (30) ; + outtext (psi, 1, 20) ; + outtext (transparent, 1, 20) . + +dataspace is device table : + type (old (table name)) = device table . + +show table name : + outtext (table name, 1, 20) . + +try this channel : + prelude := "Kanal " ; + ask user ("", text (channel no)) ; + IF answer = ok + THEN prelude CAT text (channel no) + ": " ; + get configuration from user (conf (channel no)) ; + line + FI . + +channel hardware exists : + INT VAR + operators channel := channel ; + INT VAR channel type ; + disable stop ; + continue (channel no) ; + IF is error + THEN IF error message = "kein Kanal" + THEN channel type := 0 + ELSE channel type := inout mask + FI + ELSE get channel type from shard + FI ; + clear error ; + disable stop ; + continue operators channel ; + (channel type AND inout mask) <> 0 . + +get channel type from shard : + control (1, 0, 0, channel type) . + +inout mask : 3 . + +forget unused device tables : + begin list ; + get list entry (table name, dummy) ; + WHILE table name <> "" REP + IF type (old (table name)) = device table + THEN forget if unused + FI ; + get list entry (table name, dummy) + PER . + +forget if unused : + FOR channel no FROM 1 UPTO max edit terminal REP + IF conf (channel no).dev type = table name + THEN LEAVE forget if unused + FI + PER ; + forget (table name, quiet) . + +setup this channel : + operators channel := channel ; + disable stop ; + continue (configuration channel) ; + set up channel (channel no, conf (channel no)) ; + continue operators channel . + +continue operators channel : + continue (operators channel) ; + IF is error + THEN clear error ; + break (quiet) ; + LEAVE configurate + FI ; + enable stop . + +ENDPROC configurate ; + +PROC get configuration from user (CONF VAR conf) : + + get device type ; + get baud rate ; + get bits and parity and stopbits ; + get protocol ; + get buffer size . + + +get device type : + begin list ; + table name := conf.dev type ; + IF NOT is valid device type + THEN next device type + FI ; + REP + IF NOT (table name = transparent AND channel no = 1) + THEN ask user ("", table name) ; + IF answer = ok COR was esc followed by type table name + THEN IF is valid device type + THEN remember device type ; + LEAVE get device type + ELSE out (""7" unbekannter Typ"); pause (20) + FI + FI + FI ; + next device type + PER . + +was esc followed by type table name : + IF answer = esc + THEN 9 TIMESOUT right ; + put ("Typ:") ; + editget (table name) ; + TRUE + ELSE FALSE + FI . + +is valid device type : + table name = psi OR table name = transparent OR + (exists (table name) CAND type (old (table name)) = device table) . + +remember device type : + prelude CAT table name ; + conf.dev type := table name ; + prelude CAT ", " . + +next device type : + IF table name = psi + THEN table name := transparent + ELSE IF table name = transparent + THEN begin list + FI ; + search next device type space + FI . + +search next device type space : + REP + get list entry (table name, dummy) + UNTIL table name = "" COR type (old (table name)) = device table PER; + IF table name = "" + THEN table name := psi + FI . + +get baud rate : + chose key (conf.baud, 16, baudrates, " Baud", PROC rate ok) . + +get bits and parity and stopbits : + data bits := conf.bits par stop MOD 8 ; + parity := (conf.bits par stop DIV 8) MOD 4 ; + stop := (conf.bits par stop DIV 32) MOD 4 ; + chose key (data bits, 7, bits per char, " Bits", PROC bits ok) ; + IF data bits >= 0 + THEN chose key (parity, 2, parities, " parity", PROC parity ok) ; + chose key (stop, 2, stopbits, " Stopbits", PROC stopbits ok); + conf.bits par stop := data bits + 8 * parity + 32 * stop + ELSE conf.bits par stop := data bits + FI . + +get protocol : + chose key (conf.flow control, 10, flow modes, + "", PROC flow mode ok) . + +get buffer size : + IF dev type is transparent + THEN chose buffer size + ELSE conf.inbuffer size := std inbuffer size + FI . + +dev type is transparent : + conf.dev type = "transparent" . + +chose buffer size : + REP + IF conf.inbuffer size = 16 CAND yes ("normaler Puffer") + THEN LEAVE chose buffer size + FI ; + conf.inbuffer size := 512 ; + IF yes ("grosser Puffer") + THEN LEAVE chose buffer size + FI ; + conf.inbuffer size := 16 + PER . + +ENDPROC get configuration from user ; + +PROC exec configuration : + + setup + +ENDPROC exec configuration ; + +PROC setup : + + conf := old ("configuration") ; + continue (configuration channel) ; + FOR channel no FROM 1 UPTO max edit terminal REP + set up channel (channel no, conf (channel no)) + PER ; + set up collector task ; + break but do not forget error message if any . + +set up collector task : + IF collector <> "" CAND collector <> "-" CAND exists task (collector) + THEN define collector (task (collector)) + FI . + +break but do not forget error message if any : + IF is error + THEN dummy := error message ; + clear error ; + break (quiet) ; + errorstop (dummy) + ELSE break (quiet) + FI . + +ENDPROC set up ; + +PROC set up channel (INT CONST channel no, CONF CONST conf) : + + link (channel no, conf.dev type) ; + baudrate (channel no, conf.baud) ; + bits (channel no, conf.bits par stop) ; + flow (channel no, conf.flow control) ; + input buffer size (channel no, conf.inbuffer size) . + +ENDPROC setup channel ; + +PROC configuration manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task) : + + enable stop ; + IF order <> system start interrupt + THEN font manager + FI ; + IF session <> old session + THEN disable stop ; + set up ; + clear error ; + old session := session ; + set autonom + FI . + + font manager : + IF (order <> save code AND order <> erase code ) OR order task < supervisor + THEN delete password if there is one; + free manager (ds, order, phase, order task) + ELSE errorstop ("kein Zugriffsrecht auf Task """ + name (myself) + """") + FI . + + delete password if there is one : + IF order >= fetch code AND order <= erase code AND phase = 1 + THEN msg := ds; + msg. write pass := ""; + msg. read pass := ""; + FI . + +ENDPROC configuration manager ; + +PROC configuration manager : + + configurate ; + break ; + global manager + (PROC (DATASPACE VAR,INT CONST,INT CONST,TASK CONST) configuration manager) + +ENDPROC configuration manager ; + +PROC define collector (TEXT CONST task table name) : + + collector := task table name ; + IF exists task (collector) + THEN define collector (task (collector)) + FI + +ENDPROC define collector ; + +ENDPACKET configuration manager ; + diff --git a/system/multiuser/1.7.5/src/eumel printer b/system/multiuser/1.7.5/src/eumel printer new file mode 100644 index 0000000..94858b5 --- /dev/null +++ b/system/multiuser/1.7.5/src/eumel printer @@ -0,0 +1,3066 @@ +PACKET eumel printer (* Autor : Rudolf Ruland *) + (* Version : 4 *) + (* Stand : 05.05.86 *) + DEFINES print, + with elan listings, + is elan source, + bottom label for elan listings, + x pos, + y pos, + y offset index, + line type, + material, + pages printed : + + +LET std x wanted = 2.54, + std y wanted = 2.35, + std limit = 16.0, + std pagelength = 25.0, + std linefeed faktor = 1.0, + std material = ""; + +LET blank = " ", + blank code 1 = 33, + geschuetztes blank = ""223"", + keine blankanalyse = 0, + einfach blank = 1, + doppel blank = 2, + + anweisungszeichen = "#", + anweisungszeichen code 1 = 36, + geschuetztes anweisungszeichen = ""222"", + druckerkommando zeichen = "/", + quote = """", + + erweiterungs ausgang = 32767, + blank ausgang = 32766, + anweisungs ausgang = 32765, + d code ausgang = 32764, + max breite = 32763, + + punkt = ".", + + leer = 0, + + kommando token = 0, + text token = 1, + + underline linetype = 1, + underline bit = 0, + bold bit = 1, + italics bit = 2, + modifikations liste = "ubir", + anzahl modifikationen = 4, + + document = 1, + page = 2, + + write text = 1, + write cmd = 2, + carriage return = 3, + move = 4, + draw = 5, + on = 6, + off = 7, + type = 8, + + tag type = 1, + bold type = 2, + number type = 3, + text type = 4, + delimiter type = 6, + eof type = 7; + + +INT CONST null ausgang := -32767-1; + +ROW anzahl modifikationen INT CONST modifikations werte := + ROW anzahl modifikationen INT : (1, 2, 4, 8); + +TEXT CONST anweisungsliste := + "type:1.1on:2.1off:3.1center:4.0right:5.0u:6.0d:7.0e:8.0b:9.0" + + "fillchar:10.1mark:11.2markend:12.0" + + "ub:13.0ue:14.0fb:15.0fe:16.0" + + "block:20.0columns:21.2columnsend:22.0free:23.1limit:24.1linefeed:25.1" + + "material:26.1page:27.01pagelength:29.1start:30.2" + + "table:31.0tableend:32.0clearpos:33.01" + + "lpos:35.1rpos:36.1cpos:37.1dpos:38.2bpos:39.2" + + "textbegin:40.02textend:42.0" + + "indentation:43.1ytab:44.1"; + +LET a type = 1, a block = 20, + a on = 2, a columns = 21, + a off = 3, a columnsend = 22, + a center = 4, a free = 23, + a right = 5, a limit = 24, + a up = 6, a linefeed = 25, + a down = 7, a material = 26, + a end up or down = 8, a page0 = 27, + a bsp = 9, a page1 = 28, + a fill char = 10, a pagelength = 29, + a mark = 11, a start = 30, + a markend = 12, a table = 31, + a ub = 13, a tableend = 32, + a ue = 14, a clearpos0 = 33, + a fb = 15, a clearpos1 = 34, + a fe = 16, a lpos = 35, + a rpos = 36, + a cpos = 37, + a dpos = 38, + a bpos = 39, + a textbegin0 = 40, + a textbegin2 = 41, + a textend = 42, + a indentation = 43, + a y tab = 44; + +INT VAR a xpos, a breite, a font, a modifikationen, + a modifikationen fuer x move, a ypos, aktuelle ypos, + letzter font, letzte modifikationen, + d ypos, d xpos, d font, d modifikationen, + + zeilenpos, alte zeilenpos, zeilen laenge, anzahl zeichen, ausgang, + anzahl einrueck blanks, blankbreite, + einrueckbreite, aktuelle einrueckbreite, alte einrueckbreite, + font durchschuss, fonthoehe, font tiefe, + groesste fonthoehe, aktuelle zeilenhoehe, letzte zeilenhoehe, + blankmodus, alter blankmodus, + token zeiger, erstes token der zeile, + + erstes tab token, tab anfang, anzahl blanks, + d code 1, d pitch, fuell zeichen breite, erstes fuell token, + letztes fuell token, + + x size, y size, x wanted, y wanted, x start, y start, + pagelength, limit, indentation, + left margin, top margin, seitenlaenge, + papierlaenge, papierbreite, + luecke, anzahl spalten, aktuelle spalte, + + verschiebung, rest, neue modifikationen, modifikations modus, pass, + + int param, anweisungs index, anzahl params, index, + + gedruckte seiten; + +BOOL VAR zeile ist absatzzeile, letzte zeile war absatzzeile, + zeile muss geblockt werden, rechts, a block token, offsets, + tabellen modus, block modus, center modus, right modus, + seite ist offen, vor erster seite; + +REAL VAR linefeed faktor, real param; + +TEXT VAR zeile, anweisung, par1, par2, material wert, replacements, + fuell zeichen, d string, font offsets; + +ROW 256 INT VAR zeichenbreiten, replacement tabelle, zeichen zaehler; + +INITFLAG VAR in dieser task := FALSE; + +. zeile ist zu ende : zeilenpos > zeilen laenge + +. zeilen breite : a xpos - left margin + +. neue zeilenhoehe : int (linefeed faktor * real (fonthoehe) + 0.5) + +. naechstes zeichen ist blank : pos (zeile, blank, zeilenpos + 1, zeilenpos + 1) <> 0 + +. naechstes nicht blankes zeichen : pos (zeile, ""33"", ""255"", zeilenpos) + +. in letzter spalte : aktuelle spalte >= anzahl spalten + +. anfangs blankmodus : + INT VAR dummy; + IF center modus OR right modus + THEN dummy + ELIF index zaehler = 0 + THEN blankmodus + ELSE alter blankmodus + FI + +. initialisiere tab variablen : + erstes tab token := token index f + 1; + tab anfang := zeilen breite; + anzahl blanks := 0; +.; + +(******************************************************************) + +LET zeilen nr laenge = 4, + teil einrueckung = 5, + + headline pre = "Zeile **** E L A N EUMEL 1.7.5 **** ", + headline post = " **** "; + +INT VAR zeilen nr, rest auf seite, + max zeichen zeile, max zeichen fuss, layout laenge, layout laenge name, + symbol type, naechster symbol type; + +BOOL VAR vor erstem packet, innerhalb der define liste; + +TEXT VAR bottom label, dateiname, layout blanks, refinement layout zeile; + + +. symbol : fuell zeichen +. naechstes symbol : d string +. elan text : d token. text +.; + +(******************************************************************) +(*** tokenspeicher ***) + +LET max token = 3000, + max ypos = 1000, + + TOKEN = STRUCT (TEXT text, + INT xpos, breite, font, modifikationen, + modifikationen fuer x move, + offset index, naechster token index, + BOOL block token ), + + YPOS = STRUCT (INT ypos, vorheriger ypos index, naechster ypos index, + erster token index, letzter token index ), + + TOKENLISTE = STRUCT (ROW max token TOKEN token liste, + ROW max ypos YPOS ypos liste ); + +DATASPACE VAR ds; + +BOUND TOKENLISTE VAR tokenspeicher; + +TOKEN VAR d token, offset token; + +INT VAR erster ypos index a, letzter ypos index a, + erster ypos index d, letzter ypos index d, + ypos index, ypos index f, ypos index a, ypos index d, + token index, token index f; + +. t : tokenspeicher. token liste (token index) +. tf : tokenspeicher. token liste (token index f) + +. y : tokenspeicher. ypos liste (ypos index) +. yf : tokenspeicher. ypos liste (ypos index f) +. ya : tokenspeicher. ypos liste (ypos index a) +. yd : tokenspeicher. ypos liste (ypos index d) + +. loesche druckspeicher : + erster ypos index d := 0; + ypos index f := 0; + token index f := 0; + +. druckspeicher ist nicht leer : + erster ypos index d <> 0 + +. loesche analysespeicher : + erster ypos index a := 0; + +. analysespeicher ist nicht leer : + erster ypos index a <> 0 +.; + +(******************************************************************) +(*** anweisungsspeicher ***) + +INT VAR anweisungszaehler; +TEXT VAR anweisungs indizes, params1 zeiger, params2 zeiger; +THESAURUS VAR params1, params2; + +PROC loesche anweisungsspeicher : + + anweisungs zaehler := 0; + anweisungs indizes := ""; + params1 zeiger := ""; + params2 zeiger := ""; + params1 := empty thesaurus; + params2 := empty thesaurus; + +END PROC loesche anweisungsspeicher; + +(******************************************************************) +(*** indexspeicher ***) + +INT VAR index zaehler; +TEXT VAR grosse fonts, verschiebungen; + +PROC loesche indexspeicher : + + index zaehler := 0; + grosse fonts := ""; + verschiebungen := ""; + +END PROC loesche indexspeicher; + + +(******************************************************************) +(*** tabellenspeicher ***) + +LET max tabs = 30, + TABELLENEINTRAG = STRUCT (INT tab typ, tab position, tab param); + +TEXT VAR tab liste, fill char; +THESAURUS VAR d strings; +ROW max tabs TABELLENEINTRAG VAR tabspeicher; + +INT VAR tab index; + +. tab typ : tab speicher (tab liste ISUB tab index). tab typ +. tab position : tab speicher (tab liste ISUB tab index). tab position +. tab param : tab speicher (tab liste ISUB tab index). tab param +. anzahl tabs : LENGTH tab liste DIV 2 +.; + +PROC loesche tabellenspeicher : + + fill char := " "; + tabliste := ""; + d strings := empty thesaurus; + FOR tab index FROM 1 UPTO max tabs + REP tab speicher (tab index). tab typ := leer PER; + +END PROC loesche tabellenspeicher; + +(******************************************************************) +(*** markierungsspeicher ***) + +INT VAR mark index l, mark index r, alter mark index l, alter mark index r; + +ROW 4 TOKEN VAR mark token; + +. markierung links : mark index l > 0 +. markierung rechts : mark index r > 0 +.; + +PROC loesche markierung : + + mark index l := 0; + mark index r := 0; + +END PROC loesche markierung; + + +PROC loesche alte markierung : + + alter mark index l := 0; + alter mark index r := 0; + +END PROC loesche alte markierung; + + +PROC initialisiere markierung : + + FOR mark index l FROM 1 UPTO 4 + REP mark token (mark index l). modifikationen fuer x move := 0; + mark token (mark index l). offset index := text token; + mark token (mark index l). block token := FALSE; + mark token (mark index l). naechster token index := 0; + PER; + +END PROC initialisiere markierung; + +(******************************************************************) +(*** durchschuss ***) + +INT VAR durchschuss 1, durchschuss 2, anzahl durchschuss 1, + anzahl durchschuss, zeilen zaehler; + +BOOL VAR wechsel := TRUE; + +INT PROC durchschuss : + + zeilen zaehler INCR 1; + IF zeilen zaehler <= anzahl durchschuss 1 + THEN durchschuss 1 + ELIF zeilen zaehler <= anzahl durchschuss + THEN durchschuss 2 + ELSE 0 + FI + +END PROC durchschuss; + + +PROC neuer durchschuss (INT CONST anzahl, rest) : + + zeilen zaehler := 0; + anzahl durchschuss := anzahl; + IF anzahl > 0 + THEN IF wechsel + THEN durchschuss 1 := rest DIV anzahl durchschuss; + durchschuss 2 := durchschuss 1 + sign (rest); + anzahl durchschuss 1 := anzahl durchschuss - + abs (rest) MOD anzahl durchschuss; + wechsel := FALSE; + ELSE durchschuss 2 := rest DIV anzahl durchschuss; + durchschuss 1 := durchschuss 2 + sign (rest); + anzahl durchschuss 1 := abs (rest) MOD anzahl durchschuss; + wechsel := TRUE; + FI; + ELSE loesche durchschuss + FI; + +END PROC neuer durchschuss; + + +PROC loesche durchschuss : + + durchschuss 1 := 0; + durchschuss 2 := 0; + anzahl durchschuss 1 := 0; + anzahl durchschuss := 0; + zeilen zaehler := 0; + +END PROC loesche durchschuss; + +(****************************************************************) + +PROC initialisierung : + + forget (ds); + ds := nilspace; tokenspeicher := ds; + loesche druckspeicher; + loesche anweisungsspeicher; + loesche indexspeicher; + initialisiere markierung; + right modus := FALSE; + center modus := FALSE; + seite ist offen := FALSE; + pass := 0; + a breite := 0; + a block token := FALSE; + a modifikationen fuer x move := 0; + d code 1 := leer; + erstes fuell token := leer; + IF two bytes + THEN FOR index FROM 1 UPTO 129 REP zeichen zaehler (index) := 1 PER; + FOR index FROM 130 UPTO 160 REP zeichen zaehler (index) := - maxint PER; + FOR index FROM 161 UPTO 224 REP zeichen zaehler (index) := 1 PER; + FOR index FROM 225 UPTO 240 REP zeichen zaehler (index) := - maxint PER; + FOR index FROM 241 UPTO 256 REP zeichen zaehler (index) := 1 PER; + ELSE FOR index FROM 1 UPTO 256 REP zeichen zaehler (index) := 1 PER; + FI; + +END PROC initialisierung; + +(****************************************************************) +(*** print - Kommando ***) + +BOOL VAR elan listings erlaubt; +FILE VAR eingabe; + +with elan listings (TRUE); + +PROC with elan listings (BOOL CONST flag) : + elan listings erlaubt := flag; +END PROC with elan listings; + +BOOL PROC with elan listings : elan listings erlaubt END PROC with elan listings; + + +PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ): + + print (PROC (TEXT VAR) lese zeile, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + FALSE, ""); + +END PROC print; + + +PROC print (FILE VAR file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + eingabe := file; + input (eingabe); + print (PROC (TEXT VAR) lese zeile, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + elan listings erlaubt CAND is elan source (eingabe), + headline (eingabe) ); + +END PROC print; + +PROC lese zeile (TEXT VAR zeile) : getline (eingabe, zeile) END PROC lese zeile; + +BOOL PROC eof : eof (eingabe) END PROC eof; + +BOOL PROC is elan source (FILE VAR eingabe) : + +hole erstes symbol; +elan programm tag COR elan programm bold COR kommentar + +. elan programm tag : + symbol type = tag type CAND pos (zeile, ";") > 0 + +. elan programm bold : + symbol type = bold type CAND is elan bold + + . is elan bold : + symbol = "PACKET" COR symbol = "LET" + COR proc oder op (symbol) COR deklaration + + . deklaration : + next symbol (symbol); + symbol = "VAR" OR symbol = "CONST" + +. kommentar : + pos (zeile, "(*") > 0 OR pos (zeile, "{") > 0 + +. + hole erstes symbol : + hole erstes nicht blankes symbol; + scan (zeile); + next symbol (symbol, symbol type); + + . hole erstes nicht blankes symbol : + IF eof (eingabe) THEN LEAVE is elan source WITH FALSE FI; + REP getline (eingabe, zeile); + UNTIL pos (zeile, ""33"",""254"", 1) > 0 OR eof (eingabe) PER; + reset (eingabe); + +END PROC is elan source; + +(****************************************************************) + +bottom label for elan listings (""); + +PROC bottom label for elan listings (TEXT CONST label) : + bottom label := label; +END PROC bottom label for elan listings; + +TEXT PROC bottom label for elan listings : bottom label END PROC bottom label for elan listings; + + +PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + BOOL CONST elan listing, TEXT CONST file name) : + +disable stop; +gedruckte seiten := 0; +drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + elan listing, file name ); +IF is error THEN behandle fehlermeldung FI; + +. behandle fehlermeldung : + par1 := error message; + int param := error line; + clear error; + IF NOT vor erster seite + THEN IF seite ist offen + THEN schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ) + FI; + clear error; + close (document, 0); + clear error; + FI; + initialisierung; + errorstop (par1 (* + " -> " + text (int param) *) ); + +END PROC print; + +INT PROC x pos : d xpos END PROC x pos; +INT PROC y pos : d ypos END PROC y pos; +INT PROC y offset index : d token. offset index END PROC y offset index; +INT PROC linetype : underline linetype END PROC linetype; +TEXT PROC material : material wert END PROC material; +INT PROC pages printed : gedruckte seiten END PROC pages printed; + +(****************************************************************) + +PROC drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + BOOL CONST elan listing, TEXT CONST file name ) : + + +enable stop; +IF elan listing + THEN dateiname := file name; + drucke elan listing; + ELSE drucke text datei; +FI; + +. + drucke text datei : + initialisiere druck; + WHILE NOT eof + REP next line (zeile); + analysiere zeile; + drucke token soweit wie moeglich; + werte anweisungsspeicher aus; + PER; + schliesse druck ab; + +. + initialisiere druck : + IF NOT initialized (in dieser task) + THEN ds := nilspace; + initialisierung + FI; + vor erster seite := TRUE; + tabellen modus := FALSE; + block modus := FALSE; + zeile ist absatzzeile := TRUE; + x wanted := x step conversion (std x wanted); + y wanted := y step conversion (std y wanted); + limit := x step conversion (std limit); + pagelength := y step conversion (std pagelength); + linefeed faktor := std linefeed faktor; + material wert := std material; + indentation := 0; + modifikations modus := maxint; + seitenlaenge := maxint; + papierlaenge := maxint; + left margin := 0; + top margin := 0; + a ypos := top margin; + a font := -1; + a modifikationen := 0; + aktuelle spalte := 1; + anzahl spalten := 1; + stelle neuen font ein (1); + loesche tabellenspeicher; + loesche markierung; + loesche alte markierung; + loesche durchschuss; + +. + schliesse druck ab : + IF NOT vor erster seite + THEN IF seite ist offen + THEN schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ) + FI; + close (document, 0); + FI; + +. + drucke token soweit wie moeglich : + IF analysespeicher ist nicht leer + THEN letztes token bei gleicher ypos; + IF NOT seite ist offen + THEN eroeffne seite (x wanted, y wanted, + PROC (INT CONST, INT VAR, INT VAR) open); + FI; + gehe zur letzten neuen ypos; + IF seitenlaenge ueberschritten OR papierlaenge ueberschritten + THEN neue seite oder spalte; + analysiere zeile nochmal; + ELSE sortiere neue token ein; + IF in letzter spalte + THEN drucke tokenspeicher (a ypos, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + FI; + FI; + + . gehe zur letzten neuen ypos : + ypos index a := letzter ypos index a + + . seitenlaenge ueberschritten : + ya. ypos > seitenlaenge + + . papierlaenge ueberschritten : + ya. ypos > papierlaenge + + . neue seite oder spalte : + IF in letzter spalte + THEN schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + eroeffne seite (x wanted, aktuelles y wanted, + PROC (INT CONST, INT VAR, INT VAR) open); + ELSE neue spalte; + FI; + + . aktuelles y wanted : + IF seitenlaenge ueberschritten + THEN y wanted + ELSE 0 + FI + + . analysiere zeile nochmal : + setze auf alte werte zurueck; + loesche anweisungsspeicher; + analysiere zeile; + letztes token bei gleicher ypos; + sortiere neue token ein; + + . setze auf alte werte zurueck : + zeile ist absatzzeile := letzte zeile war absatzzeile; + a modifikationen := letzte modifikationen; + stelle neuen font ein (letzter font); + +. + werte anweisungsspeicher aus : + INT VAR index; + FOR index FROM 1 UPTO anweisungszaehler + REP + SELECT anweisungs indizes ISUB index OF + CASE a block : block anweisung + CASE a columns : columns anweisung + CASE a columnsend : columnsend anweisung + CASE a free : free anweisung + CASE a limit : limit anweisung + CASE a linefeed : linefeed anweisung + CASE a material : material anweisung + CASE a page0, a page1 : page anweisung + CASE a pagelength : pagelength anweisung + CASE a start : start anweisung + CASE a table : table anweisung + CASE a tableend : tableend anweisung + CASE a clearpos0 : clearpos0 anweisung + CASE a clearpos1 : clearpos1 anweisung + CASE a lpos, a rpos, a cpos, a dpos + : lpos rpos cpos dpos anweisung + CASE a bpos : bpos anweisung + CASE a fillchar : fillchar anweisung + CASE a textbegin0 : textbegin0 anweisung + CASE a textbegin2 : textbegin2 anweisung + CASE a textend : textend anweisung + CASE a indentation : indentation anweisung + CASE a y tab : y tab anweisung + END SELECT + PER; + loesche anweisungsspeicher; + + . block anweisung : + blockmodus := TRUE; + + . columns anweisung : + IF anzahl spalten = 1 AND int conversion ok (param1) + AND real conversion ok (param2) + THEN anzahl spalten := max (1, int param); + luecke := x step conversion (real param); + FI; + + . columnsend anweisung : + anzahl spalten := 1; + aktuelle spalte := 1; + left margin := x wanted - x start + indentation; + + . free anweisung : + IF real conversion ok (param1) THEN a ypos INCR y step conversion (real param) FI; + + . limit anweisung : + IF real conversion ok (param1) THEN limit := x step conversion (real param) FI; + + . linefeed anweisung : + IF real conversion ok (param1) + THEN linefeed faktor := real param; + letzte zeilenhoehe := neue zeilenhoehe; + FI; + + . material anweisung : + material wert := param1; + + . page anweisung : + IF seite ist offen + THEN IF NOT in letzter spalte + THEN neue spalte + ELSE schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + papier laenge := maxint; + FI; + ELSE a ypos := top margin; + papier laenge := maxint; + FI; + + . pagelength anweisung : + IF real conversion ok (param1) + THEN pagelength := y step conversion (real param); + FI; + + . start anweisung : + IF real conversion ok (param1) THEN x wanted := x step conversion (real param) FI; + IF real conversion ok (param2) THEN y wanted := y step conversion (real param) FI; + + . table anweisung : + tabellenmodus := TRUE; + + . tableend anweisung : + tabellenmodus := FALSE; + + . clearpos0 anweisung : + loesche tabellenspeicher; + + . clearpos1 anweisung : + IF real conversion ok (param1) + THEN int param := x step conversion (real param); + FOR tab index FROM 1 UPTO anzahl tabs + REP IF tab position = int param + THEN tab typ := leer; + delete int (tab liste, tab index); + LEAVE clearpos1 anweisung; + FI; + PER; + FI; + + . lpos rpos cpos dpos anweisung : + IF real conversion ok (param1) + THEN neuer tab eintrag (anweisungs indizes ISUB index, param2) FI; + + . bpos anweisung : + IF real conversion ok (param2) CAND real conversion ok (param1) + CAND real (param2) > real param + THEN neuer tab eintrag (a bpos, param2) FI; + + . fillchar anweisung : + fill char := param1; + + . textbegin0 anweisung : + aktuelle einrueckbreite := alte einrueckbreite; + mark index l := alter mark index l; + mark index r := alter mark index r; + loesche alte markierung; + + . textbegin2 anweisung : + aktuelle einrueckbreite := alte einrueckbreite; + mark index l := alter mark index l; + mark index r := alter mark index r; + loesche alte markierung; + neuer durchschuss (int (param1), y step conversion (real (param 2))); + + . textend anweisung : + alte einrueckbreite := aktuelle einrueckbreite; + alter mark index l := mark index l; + alter mark index r := mark index r; + loesche markierung; + loesche durchschuss; + + . indentation anweisung : +(* IF real conversion ok (param1) + THEN int param := x step conversion (real param); + left margin INCR (int param - indentation); + indentation := int param; + FI; + *) + . y tab anweisung : +(* IF real conversion ok (param1) + THEN int param := y step conversion (real param); + IF int param <= seitenlaenge THEN a ypos := int param FI; + FI; + *) + . param1 : + IF (params1 zeiger ISUB index) <> 0 + THEN name (params1, params1 zeiger ISUB index) + ELSE "" + FI + + . param2 : + IF (params2 zeiger ISUB index) <> 0 + THEN name (params2, params2 zeiger ISUB index) + ELSE "" + FI + + +. + drucke elan listing : + initialisiere elan listing; + WHILE NOT eof + REP next line (zeile); + zeilen nr INCR 1; + drucke elan zeile; + PER; + schliesse elan listing ab; + +. + initialisiere elan listing : + open document cmd; + hole elan list font; + initialisiere variablen; + elan fuss und kopf (1, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + + . open document cmd : + material wert := ""; + d token. offset index := 1; + erster ypos index d := 0; + vor erster seite := FALSE; + seite ist offen := FALSE; + open (document, x size, y size); + vor erster seite := TRUE; + + . hole elan list font : + d font := max (1, font ("elanlist")); + get replacements (d font, replacements, replacement tabelle); + einrueckbreite := indentation pitch (d font) ; + font hoehe := font lead (d font) + font height (d font) + font depth (d font); + + . initialisiere variablen : + innerhalb der define liste := FALSE; + vor erstem packet := TRUE; + zeilen nr := 0; + y wanted := y size DIV 23; + pagelength := y size - y wanted - y wanted; + x wanted := (min (x size DIV 10, x step conversion (2.54)) + DIV einrueckbreite) * einrueckbreite; + max zeichen zeile := (x size - x wanted - (x wanted DIV 3)) DIV einrueckbreite; + max zeichen fuss := fusszeilenbreite; + layout laenge := min (38, max zeichen zeile DIV 3); + layout laenge name := layout laenge - zeilen nr laenge - 8; + layout blanks := (layout laenge - zeilen nr laenge - 1) * " "; + refinement layout zeile := (layout laenge - 1) * " " ; + refinement layout zeile CAT "|" ; + IF pagelength DIV fonthoehe - 6 < 35 OR max zeichen zeile < 65 + THEN errorstop ("Schreibfeld fuer 'elan listing' zu klein") FI; + + . fusszeilenbreite : + INT CONST dina 4 breite := x step conversion (21.0); + IF x size <= dina 4 breite + THEN (x size - 2 * x wanted) DIV einrueckbreite + ELIF 120 * einrueckbreite <= dina 4 breite - 2 * x wanted + THEN (dina 4 breite - 2 * x wanted) DIV einrueckbreite + ELSE min (120, (x size - 2 * x wanted) DIV einrueckbreite) + FI + +. + schliesse elan listing ab : + elan fuss und kopf (-1, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + close (document, 0); + +. + drucke elan zeile : + IF pos (zeile, "#page#") = 1 + THEN IF nicht am seiten anfang THEN seiten wechsel FI; + ELSE bestimme elan layout; + bestimme elan zeile; + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + seitenwechsel wenn noetig; + FI; + + . nicht am seitenanfang : + rest auf seite < pagelength - 3 * font hoehe + + . seiten wechsel : + elan fuss und kopf (0, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +. + bestimme elan layout : + IF pos (zeile, "P") = 0 AND pos (zeile, ":") = 0 + THEN leeres layout + ELSE analysiere elan zeile + FI; + elan text CAT "|"; + + . leeres layout : + elan text := text (zeilen nr, zeilen nr laenge); + elan text CAT layout blanks; + + . analysiere elan zeile : + scan (zeile); + next symbol (symbol, symbol type); + next symbol (naechstes symbol, naechster symbol type) ; + IF packet anfang THEN packet layout + ELIF innerhalb der define liste THEN leeres layout; pruefe ende der define liste + ELIF proc op anfang THEN proc op layout + ELIF refinement anfang THEN refinement layout + ELSE leeres layout + FI; + + . packet anfang : + symbol = "PACKET" + + . proc op anfang : + IF proc oder op (symbol) + THEN naechster symbol type <> delimiter type + ELIF (symbol <> "END") AND proc oder op (naechstes symbol) + THEN symbol := naechstes symbol; + next symbol (naechstes symbol, naechster symbol type) ; + naechster symbol type <> delimiter type + ELSE FALSE + FI + + . refinement anfang : + symbol type = tag type AND naechstes symbol = ":" + AND NOT innerhalb der define liste + + . packet layout : + IF nicht am seiten anfang AND + (NOT vor erstem packet OR gedruckte seiten > 0) + THEN seiten wechsel FI; + layout (" ", naechstes symbol, "*") ; + vor erstem packet := FALSE ; + innerhalb der define liste := TRUE; + pruefe ende der define liste; + + . pruefe ende der define liste : + IF pos (zeile, ":") <> 0 + THEN scan (zeile); + WHILE innerhalb der define liste + REP next symbol (symbol); + IF symbol = ":" THEN innerhalb der define liste := FALSE FI; + UNTIL symbol = "" PER; + FI; + + . proc op layout : + IF keine vier zeilen mehr + THEN seiten wechsel + ELIF nicht am seitenanfang + THEN cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI ; + layout (" ", naechstes symbol, "."); + + . keine vier zeilen mehr : + rest auf seite <= 8 * font hoehe + + . refinement layout : + IF keine drei zeilen mehr + THEN seiten wechsel + ELIF nicht am seitenanfang + THEN elan text := refinement layout zeile; + gib elan text aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI ; + layout (" ", symbol, " "); + + . keine drei zeilen mehr : + rest auf seite <= 7 * font hoehe + +. + bestimme elan zeile : + IF zeile ist nicht zu lang + THEN elan text CAT zeile; + ELSE drucke zeile in teilen + FI; + + . zeile ist nicht zu lang : + zeilen laenge := LENGTH zeile; + zeilen laenge <= rest auf zeile + + . rest auf zeile : + max zeichen zeile - LENGTH elan text + + . drucke zeile in teilen : + zeilen pos := 1; + bestimme einrueckung; + WHILE zeile noch nicht ganz gedruckt REP teil layout PER; + + . bestimme einrueckung : + anzahl einrueck blanks := naechstes nicht blankes zeichen - 1; + IF anzahl einrueck blanks > rest auf zeile - 20 + THEN anzahl einrueck blanks := 0 FI; + + . zeile noch nicht ganz gedruckt : + bestimme zeilenteil; + NOT zeile ist zu ende + + . bestimme zeilenteil : + bestimme laenge; + zeilen teil := subtext (zeile, zeilen pos, zeilen pos + laenge - 1); + elan text CAT zeilen teil; + zeilen pos INCR laenge; + + . zeilen teil : par1 + + . bestimme laenge : + INT VAR laenge := zeilen laenge - zeilen pos + 1; + IF laenge > rest auf zeile + THEN laenge := rest auf zeile; + WHILE (zeile SUB (zeilen pos + laenge - 1)) <> " " + REP laenge DECR 1 UNTIL laenge = 0 PER; + IF laenge = 0 THEN laenge := rest auf zeile FI; + FI; + + . teil layout : + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + elan text := (zeilen nr laenge - 1) * " "; + elan text CAT "+"; + elan text CAT layout blanks; + elan text CAT "|"; + elan text cat blanks (anzahl einrueck blanks + teil einrueckung); + +. + seiten wechsel wenn noetig : + IF keine zeilen mehr AND NOT eof THEN seiten wechsel FI; + + . keine zeilen mehr : + rest auf seite <= 4 * font hoehe + +END PROC drucke datei; + + +BOOL PROC real conversion ok (TEXT CONST param) : + real param := real (param); + last conversion ok AND real param >= 0.0 +END PROC real conversion ok; + + +BOOL PROC int conversion ok (TEXT CONST param) : + int param := int (param); + last conversion ok AND int param >= 0 +END PROC int conversion ok; + + +PROC neuer tab eintrag (INT CONST typ, TEXT CONST param) : + + suche neuen eintrag; + sortiere neue tab position ein; + tab typ := typ; + tab position := neue tab position; + tab param := eventueller parameter; + + . suche neuen eintrag : + INT VAR index := 0; + REP index INCR 1; + IF tab speicher (index). tab typ = leer + THEN LEAVE suche neuen eintrag FI; + UNTIL index = max tabs PER; + LEAVE neuer tab eintrag; + + . sortiere neue tab position ein : + INT VAR neue tab position := x step conversion (real param); + FOR tab index FROM 1 UPTO anzahl tabs + REP IF tab position = neue tab position + THEN LEAVE neuer tab eintrag + ELIF tab position > neue tab position + THEN insert int (tab liste, tab index, index); + LEAVE sortiere neue tab position ein; + FI; + PER; + tab liste CAT index; + tab index := anzahl tabs; + + . eventueller parameter : + INT VAR link; + SELECT typ OF + CASE a dpos : insert (d strings, param, link); link + CASE a bpos : x step conversion (real(param)) + OTHERWISE : 0 + END SELECT + +END PROC neuer tab eintrag; + + +PROC neue spalte : + a ypos := top margin; + left margin INCR (limit + luecke); + aktuelle spalte INCR 1; +END PROC neue spalte ; + + +BOOL PROC proc oder op (TEXT CONST symbol) : + + symbol = "PROC" OR symbol = "PROCEDURE" + OR symbol = "OP" OR symbol = "OPERATOR" + +ENDPROC proc oder op ; + + +PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) : + +name := subtext (name, 1, layout laenge name) ; +elan text := text (zeilen nr, zeilen nr laenge); +elan text CAT pre; +elan text CAT name; +elan text CAT " "; +generiere strukturiertes layout; + +. generiere strukturiertes layout : + INT VAR index; + FOR index FROM 1 UPTO layout laenge - LENGTH elan text - 1 + REP elan text CAT post PER; + +ENDPROC layout ; + + +PROC elan text cat blanks (INT CONST anzahl) : + + par2 := anzahl * " "; + elan text CAT par2; + +END PROC elan text cat blanks; + + +(***********************************************************************) + +PROC analysiere zeile : + +loesche analysespeicher; +behandle fuehrende blanks; +pruefe ob anweisungszeile; +pruefe ob markierung links; + +IF tabellen modus + THEN analysiere tabellenzeile +ELIF letzte zeile war absatzzeile + THEN analysiere zeile nach absatzzeile + ELSE analysiere zeile nach blockzeile +FI; + +pruefe center und right modus; +pruefe ob tabulation vorliegt; +werte indexspeicher aus; +berechne zeilenhoehe; +pruefe ob markierung rechts; + +. + analysiere zeile nach absatzzeile : + test auf aufzaehlung; + IF zeile muss geblockt werden + THEN analysiere blockzeile nach absatzzeile + ELSE analysiere absatzzeile nach absatzzeile + FI; +. + analysiere zeile nach blockzeile : + IF zeile muss geblockt werden + THEN analysiere blockzeile nach blockzeile + ELSE analysiere absatzzeile nach blockzeile + FI; + + +. + behandle fuehrende blanks : + zeilenpos := 1; + zeilenpos := naechstes nicht blankes zeichen; + IF zeilenpos = 0 + THEN behandle leerzeile; + LEAVE analysiere zeile; + ELSE letzte zeile war absatzzeile := zeile ist absatzzeile; + IF letzte zeile war absatzzeile THEN neue einrueckung FI; + initialisiere analyse; + FI; + + . behandle leerzeile : + a ypos INCR (letzte zeilenhoehe + durchschuss); + zeile ist absatzzeile := LENGTH zeile > 0; + pruefe ob markierung links; + pruefe ob markierung rechts; + + . neue einrueckung : + aktuelle einrueckbreite := einrueckbreite; + + . initialisiere analyse : + zeile ist absatzzeile := (zeile SUB LENGTH zeile) = blank; + zeile muss geblockt werden := block modus AND NOT zeile ist absatzzeile; + erstes token der zeile := token index f + 1; + groesste fonthoehe := fonthoehe; + aktuelle zeilenhoehe := letzte zeilenhoehe; + zeilen laenge := laenge der zeile; + anzahl einrueck blanks := zeilen pos - 1; + anzahl zeichen := anzahl einrueck blanks; + a xpos := left margin + anzahl zeichen * aktuelle einrueckbreite; + a modifikationen fuer x move := 0; + letzter font := a font; + letzte modifikationen := a modifikationen; + IF zeile muss geblockt werden THEN initialisiere tab variablen FI; + + . laenge der zeile : + IF zeile ist absatzzeile + THEN LENGTH zeile - 1 + ELSE LENGTH zeile + FI +. + pruefe ob anweisungszeile : + IF erstes zeichen ist anweisungszeichen + THEN REP analysiere anweisung; + IF zeile ist zu ende THEN LEAVE analysiere zeile FI; + UNTIL zeichen ist kein anweisungs zeichen PER; + FI; + + . erstes zeichen ist anweisungszeichen : + pos (zeile, anweisungszeichen, 1, 1) <> 0 + + . zeichen ist kein anweisungszeichen : + pos (zeile, anweisungszeichen, zeilen pos, zeilen pos) = 0 + +. + pruefe ob markierung links : + IF markierung links + THEN mark token (mark index l). xpos := + left margin - mark token (mark index l). breite; + lege markierungs token an (mark index l); + erstes token der zeile := token index f + 1; + initialisiere tab variablen; + FI; + +. + analysiere tabellenzeile : + anfangs blankmodus := doppel blank; + alte zeilenpos := zeilen pos; + FOR tab index FROM 1 UPTO anzahl tabs + REP lege fuell token an wenn noetig; + initialisiere tab variablen; + SELECT tab typ OF + CASE a lpos : linksbuendige spalte + CASE a rpos : rechtsbuendige spalte + CASE a cpos : zentrierte spalte + CASE a dpos : dezimale spalte + CASE a bpos : geblockte spalte + END SELECT; + berechne fuell token wenn noetig; + tabulation; + PER; + analysiere rest der zeile; + + . lege fuell token an wenn noetig : + IF fill char <> blank + THEN fuellzeichen := fill char; + fuellzeichen breite := string breite (fuellzeichen); + token zeiger := zeilen pos; + erstes fuell token := token index f + 1; + lege text token an; + letztes fuell token := token index f; + a modifikationen fuer x move := a modifikationen + FI; + + . berechne fuell token wenn noetig : + IF erstes fuell token <> leer + THEN IF letztes fuell token <> token index f + THEN berechne fuell token; + ELSE loesche letzte token; + FI; + erstes fuell token := leer + FI; + + . berechne fuell token : + INT VAR anzahl fuellzeichen, fuell breite; + token index := erstes fuell token; + anzahl fuellzeichen := (tab anfang - t. xpos + left margin) + DIV fuellzeichen breite; + rest := (tab anfang - t. xpos + left margin) + MOD fuellzeichen breite; + IF anzahl fuell zeichen > 0 + THEN fuell text := anzahl fuellzeichen * fuellzeichen; + fuell breite := anzahl fuellzeichen * fuellzeichen breite; + FOR token index FROM erstes fuell token UPTO letztes fuell token + REP t. text := fuell text; + t. breite := fuell breite; + IF erstes fuell token <> erstes token der zeile + THEN t. xpos INCR rest DIV 2; + t. modifikationen fuer x move := t. modifikationen; + FI; + PER; + FI; + + . fuell text : par1 + + . loesche letzte token : + FOR token index FROM letztes fuell token DOWNTO erstes fuell token + REP loesche letztes token PER; + + . tabulation : + alte zeilenpos := zeilenpos; + zeilenpos := naechstes nicht blankes zeichen; + IF zeilenpos = 0 + THEN zeilenpos := zeilenlaenge + 1; + LEAVE analysiere tabellenzeile; + FI; + anzahl zeichen INCR zeilenpos - alte zeilenpos; + + . linksbuendige spalte : + a xpos := left margin + tab position; + tab anfang := tab position; + bestimme token bis terminator oder zeilenende; + + . rechtsbuendige spalte : + bestimme token bis terminator oder zeilenende; + schreibe zeile rechtsbuendig (tab position); + + . zentrierte spalte : + bestimme token bis terminator oder zeilenende; + zentriere zeile (tab position); + + . dezimale spalte : + d string := name (d strings, tab param); + d code 1 := code (d string SUB 1) + 1; + d pitch := zeichenbreiten (d code 1); + zeichenbreiten (d code 1) := d code ausgang; + bestimme token bis terminator oder zeilenende; + zeichenbreiten (d code 1) := d pitch; + d code 1 := leer; + schreibe zeile rechtsbuendig (tab position); + IF zeichen ist dezimal zeichen + THEN IF tab position <> zeilen breite + THEN a xpos := left margin + tab position; + tab anfang := tab position; + FI; + bestimme token bis terminator oder zeilenende + FI; + + . zeichen ist dezimal zeichen : + pos (zeile, d string, zeilen pos) = zeilen pos + + . geblockte spalte : + blankmodus := einfach blank; + a xpos := left margin + tab position; + tab anfang := tab position; + REP bestimme token bis terminator oder zeilenende; + IF zeile ist zu ende OR naechstes zeichen ist blank + THEN blocke spalte wenn noetig; + LEAVE geblockte spalte; + ELSE dehnbares blank gefunden; + FI; + PER; + + . blocke spalte wenn noetig : + IF letztes zeichen ist kein geschuetztes blank + THEN blocke zeile (tab param) FI; + blank modus := doppel blank; + + . letztes zeichen ist kein geschuetztes blank : + pos (zeile, geschuetztes blank, zeilen pos - 1, zeilen pos - 1) = 0 + AND NOT within kanji (zeile, zeilen pos - 2) + + . analysiere rest der zeile : + blankmodus := keine blankanalyse; + zeilen pos := alte zeilenpos; + bestimme token bis terminator oder zeilenende; + +. + test auf aufzaehlung : + anfangs blankmodus := einfach blank; + bestimme token bis terminator oder zeilenende; + IF zeile ist zu ende + THEN LEAVE analysiere zeile nach absatzzeile + ELSE aufzaehlung moeglich + FI; + + . aufzaehlung moeglich : + bestimme letztes zeichen; + IF (anzahl zeichen bei aufzaehlung < 2 AND letztes zeichen = "-") + OR (anzahl zeichen bei aufzaehlung < 20 AND letztes zeichen = ":") + OR (anzahl zeichen bei aufzaehlung < 7 + AND pos (".)", letztes zeichen) <> 0) + OR naechstes zeichen ist blank + THEN tabulator position gefunden; + ELIF zeile muss geblockt werden + THEN dehnbares blank gefunden; + FI; + + . bestimme letztes zeichen : + token index := token index f; + WHILE token index >= erstes token der zeile + REP IF token ist text token + THEN letztes zeichen := t. text SUB LENGTH t. text; + LEAVE bestimme letztes zeichen; + FI; + token index DECR 1; + PER; + letztes zeichen := ""; + + . letztes zeichen : par1 + + . anzahl zeichen bei aufzaehlung : + anzahl zeichen - anzahl einrueck blanks + + . token ist text token : + t. offset index >= text token +. + analysiere blockzeile nach absatzzeile : + REP bestimme token bis terminator oder zeilenende; + IF zeile ist zu ende + THEN blocke zeile (limit); + LEAVE analysiere blockzeile nach absatzzeile + ELSE analysiere blank in blockzeile nach absatzzeile + FI; + PER; + + . analysiere blank in blockzeile nach absatzzeile : + IF naechstes zeichen ist blank + THEN tabulator position gefunden; + ELSE dehnbares blank gefunden; + FI; + +. + analysiere absatzzeile nach absatzzeile : + blankmodus := doppel blank; + REP bestimme token bis terminator oder zeilenende; + IF zeile ist zu ende + THEN LEAVE analysiere absatzzeile nach absatzzeile + ELSE tabulator position gefunden + FI; + PER; + +. + analysiere blockzeile nach blockzeile : + anfangs blankmodus := einfach blank; + REP bestimme token bis terminator oder zeilenende; + IF zeile ist zu ende + THEN blocke zeile (limit); + LEAVE analysiere blockzeile nach blockzeile + ELSE dehnbares blank gefunden + FI; + PER; + +. + analysiere absatzzeile nach blockzeile : + anfangs blankmodus := keine blankanalyse; + bestimme token bis terminator oder zeilenende; + +. + dehnbares blank gefunden : + anzahl zeichen INCR 1; + zeilenpos INCR 1; + a xpos INCR blankbreite; + a modifikationen fuer x move := a modifikationen; + IF NOT a block token + THEN anzahl blanks INCR 1; + a block token := TRUE; + FI; +. + tabulator position gefunden : + alte zeilenpos := zeilenpos; + zeilenpos := naechstes nicht blankes zeichen; + IF zeilenpos = 0 + THEN zeilenpos := zeilen laenge + 1; + ELSE IF erstes token der zeile > token index f + THEN token zeiger := zeilen pos; + lege text token an; + FI; + anzahl zeichen INCR (zeilenpos - alte zeilenpos); + a xpos := left margin + anzahl zeichen * aktuelle einrueckbreite; + a modifikationen fuer x move := a modifikationen; + IF zeile muss geblockt werden THEN initialisiere tab variablen FI; + FI; + +. + pruefe center und right modus : + IF center modus THEN zentriere zeile (limit DIV 2) FI; + IF right modus THEN schreibe zeile rechtsbuendig (limit) FI; +. + pruefe ob tabulation vorliegt: + IF analyse speicher ist nicht leer CAND a xpos > tf. xpos + tf. breite + THEN a modifikationen fuer x move := a modifikationen; + token zeiger := zeilen pos; + lege text token an; + FI; +. + werte indexspeicher aus : + INT VAR index; + IF index zaehler > 0 + THEN FOR index FROM index zaehler DOWNTO 1 + REP a ypos DECR (verschiebungen ISUB index) PER; + stelle neuen font ein (grosse fonts ISUB 1); + loesche index speicher; + FI; +. + berechne zeilenhoehe : + verschiebung := aktuelle zeilenhoehe + durchschuss; + a ypos INCR verschiebung; + verschiebe token ypos (verschiebung); + +. + pruefe ob markierung rechts : + IF markierung rechts + THEN mark token (mark index r). xpos := left margin + limit; + lege markierungs token an (mark index r); + FI; + +END PROC analysiere zeile; + + +PROC blocke zeile (INT CONST rechter rand) : + +rest := rechter rand - zeilen breite; +IF rest > 0 AND anzahl blanks > 0 + THEN INT CONST schmaler schritt := rest DIV anzahl blanks, + breiter schritt := schmaler schritt + 1, + anzahl breite schritte := rest MOD anzahl blanks; + IF rechts + THEN blocke token xpos (breiter schritt, schmaler schritt, + anzahl breite schritte); + rechts := FALSE; + ELSE blocke token xpos (schmaler schritt, breiter schritt, + anzahl blanks - anzahl breite schritte); + rechts := TRUE; + FI; + a xpos INCR ( breiter schritt * anzahl breite schritte + + schmaler schritt * (anzahl blanks - anzahl breite schritte) ); +FI; + +END PROC blocke zeile; + + +PROC zentriere zeile (INT CONST zentrier pos) : + +IF erstes tab token <= token index f + THEN verschiebung := zentrier pos - tab anfang - + (zeilen breite - tab anfang) DIV 2; + verschiebe token xpos (verschiebung); + a xpos INCR verschiebung; + tab anfang INCR verschiebung; +FI; +center modus := FALSE; + +END PROC zentriere zeile; + + +PROC schreibe zeile rechtsbuendig (INT CONST rechte pos) : + +IF erstes tab token <= token index f + THEN verschiebung := rechte pos - zeilen breite; + verschiebe token xpos (verschiebung); + a xpos INCR verschiebung; + tab anfang INCR verschiebung; +FI; +right modus := FALSE; + + +END PROC schreibe zeile rechtsbuendig; + + +PROC bestimme token bis terminator oder zeilenende : + +token zeiger := zeilen pos; +REP stranalyze (zeichenbreiten, a breite, max breite, + zeile, zeilen pos, zeilen laenge, + ausgang); + zeilen pos INCR 1; + IF ausgang = blank ausgang + THEN analysiere blank + ELIF ausgang = anweisungs ausgang + THEN anweisung gefunden + ELIF ausgang = d code ausgang + THEN analysiere d string + ELIF ausgang = erweiterungs ausgang + THEN erweiterung gefunden + ELSE terminator oder zeilenende gefunden + FI; +PER; + +. analysiere blank : + IF blankmodus = einfach blank OR + (blankmodus = doppel blank AND naechstes zeichen ist blank) + THEN terminator oder zeilenende gefunden + ELSE a breite INCR blankbreite; + zeilenpos INCR 1; + FI; + +. analysiere d string : + IF pos (zeile, d string, zeilen pos) = zeilen pos + THEN terminator oder zeilenende gefunden + ELSE IF d pitch = maxint + THEN erweiterung gefunden + ELIF d pitch < 0 + THEN a breite INCR (d pitch XOR - maxint - 1); + zeilen pos INCR 2; + ELSE a breite INCR d pitch; + zeilenpos INCR 1; + FI; + FI; + +. erweiterung gefunden : + a breite INCR extended char pitch (a font, zeile SUB zeilen pos, + zeile SUB zeilen pos + 1); + zeilen pos INCR 2; + +. anweisung gefunden : + gegebenfalls neues token gefunden; + analysiere anweisung; + IF zeile ist zu ende + THEN LEAVE bestimme token bis terminator oder zeilenende FI; + token zeiger := zeilenpos; + +. terminator oder zeilenende gefunden : + IF ausgang = null ausgang THEN zeilen laenge DECR 1 FI; + gegebenfalls neues token gefunden; + LEAVE bestimme token bis terminator oder zeilenende; + + . gegebenfalls neues token gefunden : + IF token zeiger < zeilenpos THEN lege text token an FI; + +END PROC bestimme token bis terminator oder zeilen ende; + + +PROC analysiere anweisung : + + bestimme anweisung; + IF anweisung ist kommando + THEN lege kommando token an; + ELSE werte anweisung aus; + FI; + + . anweisungsanfang : token zeiger + + . anweisungsende : zeilen pos - 2 + + . erstes zeichen : par1 + +. bestimme anweisung : + anweisungsanfang := zeilenpos + 1; + zeilen pos := pos (zeile, anweisungszeichen, anweisungsanfang, zeilenlaenge); + IF zeilenpos = 0 + THEN zeilenpos := anweisungsanfang - 1; + replace (zeile, zeilenpos, geschuetztes anweisungszeichen); + LEAVE analysiere anweisung; + FI; + zeilen pos INCR 1; + anweisung := subtext (zeile, anweisungsanfang, anweisungsende); + erstes zeichen := anweisung SUB 1; + +. anweisung ist kommando : + IF erstes zeichen = quote + THEN scan (anweisung); + next symbol (anweisung, symbol type); + next symbol (par2, naechster symbol type); + IF symbol type <> text type OR naechster symbol type <> eof type + THEN LEAVE analysiere anweisung FI; + TRUE + ELIF erstes zeichen = druckerkommando zeichen + THEN delete char (anweisung, 1); + TRUE + ELSE FALSE + FI + +. + werte anweisung aus : + analyze command (anweisungs liste, anweisung, number type, + anweisungs index, anzahl params, par1, par2); + SELECT anweisungs index OF + CASE a type : type anweisung + CASE a on : on anweisung + CASE a off : off anweisung + CASE a ub, a fb : ub fb anweisung + CASE a ue, a fe : ue fe anweisung + CASE a center : center anweisung + CASE a right : right anweisung + CASE a up, a down : index anweisung + CASE a end up or down : end index anweisung + CASE a bsp : bsp anweisung + CASE a fillchar : fillchar anweisung + CASE a mark : mark anweisung + CASE a markend : markend anweisung + OTHERWISE : IF anweisungs index > 0 THEN speichere anweisung FI; + END SELECT; + + . type anweisung : + change all (par1, " ", ""); + stelle neuen font ein (font (par1)); + groesste fonthoehe := max (groesste fonthoehe, fonthoehe); + a modifikationen := 0; + IF nicht innerhalb eines indexes THEN berechne aktuelle zeilenhoehe FI; + + . nicht innerhalb eines indexes : + index zaehler = 0 + + . berechne aktuelle zeilenhoehe : + IF linefeed faktor >= 1.0 + THEN aktuelle zeilenhoehe := max (groesste fonthoehe, + letzte zeilenhoehe); + ELSE aktuelle zeilenhoehe := max (aktuelle zeilenhoehe, + letzte zeilenhoehe); + FI; + + . on anweisung : + par1 := par1 SUB 1; + IF pos (modifikations liste, par1) > 0 + THEN set bit (a modifikationen, pos (modifikations liste, par1) - 1 ); + FI; + + . off anweisung : + par1 := par1 SUB 1; + IF pos (modifikations liste, par1) > 0 + THEN reset bit (a modifikationen, pos (modifikations liste, par1) - 1 ); + FI; + + . ub fb anweisung : + IF anweisungs index = a ub + THEN par1 := "u" + ELSE par1 := "b" + FI; + on anweisung; + + . ue fe anweisung : + IF anweisungs index = a ue + THEN par1 := "u" + ELSE par1 := "b" + FI; + off anweisung; + + . center anweisung : + IF NOT zeile muss geblockt werden AND NOT tabellen modus + AND NOT right modus + THEN center modus := TRUE; + blankmodus := keine blankanalyse; + initialisiere tab variablen; + FI; + + . right anweisung : + IF NOT zeile muss geblockt werden AND NOT tabellen modus + THEN IF center modus THEN zentriere zeile (limit DIV 2) FI; + right modus := TRUE; + blankmodus := keine blankanalyse; + initialisiere tab variablen; + FI; + + . index anweisung : + INT CONST grosser font := a font, grosse fonthoehe := fonthoehe; + INT VAR kleiner font; + IF next smaller font exists (grosser font, kleiner font) + THEN stelle neuen font ein (kleiner font) FI; + IF font hoehe < grosse fonthoehe + THEN berechne verschiebung fuer kleinen font + ELSE berechne verschiebung fuer grossen font + FI; + a ypos INCR verschiebung; + merke grossen font und verschiebung; + + . berechne verschiebung fuer kleinen font : + IF anweisungs index = a down + THEN verschiebung := 15 PROZENT grosse fonthoehe; + ELSE verschiebung := - ( 9 PROZENT grosse fonthoehe ) + - (grosse fonthoehe - fonthoehe); + FI; + + . berechne verschiebung fuer grossen font : + IF anweisungs index = a down + THEN verschiebung := 25 PROZENT fonthoehe; + ELSE verschiebung := - (50 PROZENT fonthoehe); + FI; + + . merke grossen font und verschiebung : + index zaehler INCR 1; + grosse fonts CAT grosser font; + verschiebungen CAT verschiebung; + IF index zaehler = 1 + THEN alter blankmodus := blankmodus; + blankmodus := keine blankanalyse; + FI; + + . end index anweisung : + IF index zaehler > 0 + THEN schalte auf groesseren font zurueck; + FI; + + . schalte auf groesseren font zurueck : + a ypos DECR (verschiebungen ISUB index zaehler); + stelle neuen font ein (grosse fonts ISUB index zaehler); + IF index zaehler = 1 + THEN blankmodus := alter blankmodus; + FI; + index zaehler DECR 1; + verschiebungen := subtext (verschiebungen, 1, 2 * index zaehler); + grosse fonts := subtext (grosse fonts, 1, 2 * index zaehler); + + . bsp anweisung : + INT VAR breite davor, breite dahinter; + IF anweisungs anfang - 2 >= 1 AND anweisungs ende + 2 <= zeilen laenge + THEN IF is kanji esc (zeile SUB anweisungs anfang - 3) + THEN zeichen davor := subtext (zeile, anweisungs anfang - 3, + anweisungs anfang - 2); + ELSE zeichen davor := zeile SUB anweisungs anfang - 2; + FI; + IF is kanji esc (zeile SUB anweisungs ende + 2) + THEN zeichen dahinter := subtext (zeile, anweisungs ende + 2, + anweisungs ende + 3 ); + ELSE zeichen dahinter := zeile SUB anweisungs ende + 2; + FI; + IF pos (" #", zeichen davor) = 0 AND pos (" #", zeichen dahinter) = 0 + THEN breite davor := char pitch (a font, zeichen davor); + breite dahinter := char pitch (a font, zeichen dahinter); + IF breite davor < breite dahinter THEN vertausche zeichen FI; + lege token fuer zeichen dahinter an; + a xpos INCR (breite davor - breite dahinter) DIV 2; + FI; + FI; + + . zeichen davor : par1 + . zeichen dahinter : par2 + + . vertausche zeichen : + change (zeile, anweisungs anfang - 2 - LENGTH zeichen davor + 1, + anweisungs anfang - 2, zeichen dahinter); + change (zeile, anweisungs ende + 2, + anweisungs ende + 2 + LENGTH zeichen dahinter - 1, zeichen davor); + change (tf. text, LENGTH tf. text - LENGTH zeichen davor + 1, + LENGTH tf. text, zeichen dahinter); + tf. breite INCR (breite dahinter - breite davor); + a xpos INCR (breite dahinter - breite davor); + int param := breite davor; + breite davor := breite dahinter; + breite dahinter := int param; + + . lege token fuer zeichen dahinter an : + token zeiger := zeilen pos; + a breite := breite dahinter; + zeilen pos INCR LENGTH zeichen dahinter; + a xpos DECR (breite davor + breite dahinter) DIV 2; + lege text token an; + anzahl zeichen DECR 1; + + . fillchar anweisung : + IF par1 = "" THEN par1 := " " FI; + fill char := par1; + speichere anweisung; + + . mark anweisung : + IF par1 <> "" + THEN mark index l := (alter mark index l MOD 2) + 1; + neue markierung (par1, mark index l); + ELSE mark index l := 0; + FI; + IF par2 <> "" + THEN mark index r := (alter mark index r MOD 2) + 3; + neue markierung (par2, mark index r); + ELSE mark index r := 0; + FI; + + . markend anweisung : + loesche markierung; + + . speichere anweisung : + anweisungs zaehler INCR 1; + anweisungs indizes CAT anweisungs index; + IF par1 <> "" + THEN insert (params1, par1); + params1 zeiger CAT highest entry (params1); + ELSE params1 zeiger CAT 0; + FI; + IF par2 <> "" + THEN insert (params2, par2); + params2 zeiger CAT highest entry (params2); + ELSE params2 zeiger CAT 0; + FI; + +END PROC analysiere anweisung; + + +PROC stelle neuen font ein (INT CONST font nr ) : + + IF font nr <> a font THEN neuer font FI; + + . neuer font : + a font := max (1, font nr); + get font (a font, einrueckbreite, font durchschuss, font hoehe, font tiefe, + zeichenbreiten); + font hoehe INCR (font durchschuss + font tiefe); + letzte zeilenhoehe := neue zeilenhoehe; + blankbreite := zeichenbreiten (blank code 1); + zeichenbreiten (blank code 1) := blank ausgang; + zeichenbreiten (anweisungs zeichen code 1) := anweisungs ausgang; + font offsets := y offsets (a font); + offsets := LENGTH font offsets > 2; + IF d code 1 <> leer + THEN d pitch := zeichenbreiten (d code 1); + zeichenbreiten (d code 1) := d code ausgang; + FI; + +END PROC stelle neuen font ein; + + +INT OP PROZENT (INT CONST prozent, wert) : + + (wert * prozent + 99) DIV 100 + +END OP PROZENT; + + +PROC neue markierung (TEXT CONST text, INT CONST mark index) : + + mark token (mark index). text := text; + mark token (mark index). breite := string breite (text); + mark token (mark index). font := a font; + mark token (mark index). modifikationen := a modifikationen; + +END PROC neue markierung; + + +INT PROC string breite (TEXT CONST string) : + + INT VAR summe := 0, pos := 1; + REP stranalyze (zeichenbreiten, summe, max breite, string, pos, maxint, ausgang); + IF ausgang = erweiterungs ausgang + THEN summe INCR extended char pitch (a font, + string SUB pos+1, string SUB pos+2); + pos INCR 3; + ELIF ausgang = blank ausgang + THEN summe INCR blankbreite; + pos INCR 2; + ELIF ausgang = anweisungs ausgang + THEN summe INCR char pitch (a font, anweisungszeichen); + pos INCR 2; + ELSE LEAVE string breite WITH summe + FI; + PER; + 0 + +END PROC string breite; + +(*******************************************************************) + +PROC lege text token an : + + aktuelle ypos := a ypos + (font offsets ISUB 1); + neuer token index; + uebertrage text token (tf); + IF offsets THEN lege offsets an (font offsets) FI; + stranalyze (zeichen zaehler, anzahl zeichen, max int, + zeile, token zeiger, zeilen pos - 1, ausgang); + a xpos INCR a breite; + a breite := 0; + a modifikationen fuer x move := 0; + a block token := FALSE; + +END PROC lege text token an; + + +PROC uebertrage text token (TOKEN VAR tf) : + + tf. text := subtext (zeile, token zeiger, zeilenpos - 1); + tf. xpos := a xpos; + tf. breite := a breite; + tf. font := a font; + tf. modifikationen := a modifikationen; + tf. modifikationen fuer x move := a modifikationen fuer x move; + tf. offset index := text token; + tf. block token := a block token; + +END PROC uebertrage text token; + + +PROC lege kommando token an : + + aktuelle ypos := a ypos + (font offsets ISUB 1); + neuer token index; + uebertrage kommando token (tf); + a modifikationen fuer x move := 0; + a block token := FALSE; + +END PROC lege kommando token an; + + +PROC uebertrage kommando token (TOKEN VAR tf) : + + tf. text := anweisung; + tf. breite := 0; + tf. xpos := a xpos; + tf. font := a font; + tf. modifikationen := a modifikationen; + tf. modifikationen fuer x move := a modifikationen fuer x move; + tf. offset index := kommando token; + tf. block token := a block token; + +END PROC uebertrage kommando token; + + +PROC lege markierungs token an (INT CONST mark index) : + + aktuelle ypos := a ypos + (mark font offsets ISUB 1); + neuer token index; + tf := mark token (mark index); + IF mark offsets THEN lege offsets an (mark font offsets) FI; + + . mark font offsets : y offsets (mark token (mark index). font) + + . mark offsets : LENGTH mark font offsets > 2 + +END PROC lege markierungs token an; + + +PROC lege offsets an (TEXT CONST offsets) : + + INT CONST anzahl offsets := LENGTH offsets DIV 2; + offset token := tf; + offset token. block token := FALSE; + reset bit (offset token. modifikationen, underline bit); + FOR index FROM 2 UPTO anzahl offsets + REP aktuelle ypos := a ypos + (offsets ISUB index); + neuer token index; + tf := offset token; + tf. offset index := index; + PER; + +END PROC lege offsets an; + + +PROC neuer token index : + +IF erster ypos index a = 0 + THEN erste ypos +ELIF ya. ypos = aktuelle ypos + THEN neues token bei gleicher ypos + ELSE fuege neue ypos ein +FI; + + . erste ypos : + ypos index f INCR 1; + erster ypos index a := ypos index f; + letzter ypos index a := ypos index f; + yf. vorheriger ypos index := 0; + yf. naechster ypos index := 0; + erstes token bei neuer ypos; + + . fuege neue ypos ein : + letztes token bei gleicher ypos; + IF ya. ypos > aktuelle ypos + THEN richtige ypos ist oberhalb + ELSE richtige ypos ist unterhalb + FI; + + . richtige ypos ist oberhalb : + REP ypos index a := ya. vorheriger ypos index; + IF ypos index a = 0 + THEN fuege ypos vor erstem ypos index ein; + LEAVE richtige ypos ist oberhalb; + ELIF ya. ypos = aktuelle ypos + THEN neues token bei neuer ypos; + LEAVE richtige ypos ist oberhalb; + ELIF ya. ypos < aktuelle ypos + THEN fuege ypos nach ypos index ein; + LEAVE richtige ypos ist oberhalb; + FI; + PER; + + . richtige ypos ist unterhalb : + REP ypos index a := ya. naechster ypos index; + IF ypos index a = 0 + THEN fuege ypos nach letztem ypos index ein; + LEAVE richtige ypos ist unterhalb; + ELIF ya. ypos = aktuelle ypos + THEN neues token bei neuer ypos; + LEAVE richtige ypos ist unterhalb; + ELIF ya. ypos > aktuelle ypos + THEN fuege ypos vor ypos index ein; + LEAVE richtige ypos ist unterhalb; + FI; + PER; + + . fuege ypos vor erstem ypos index ein : + ypos index f INCR 1; + yf. vorheriger ypos index := 0; + yf. naechster ypos index := erster ypos index a; + erster ypos index a := ypos index f; + ypos index a := yf. naechster ypos index; + ya. vorheriger ypos index := ypos index f; + erstes token bei neuer ypos; + + . fuege ypos nach ypos index ein : + ypos index f INCR 1; + yf. vorheriger ypos index := ypos index a; + yf. naechster ypos index := ya. naechster ypos index; + ya. naechster ypos index := ypos index f; + ypos index a := yf. naechster ypos index; + ya. vorheriger ypos index := ypos index f; + erstes token bei neuer ypos; + + . fuege ypos vor ypos index ein : + ypos index f INCR 1; + yf. naechster ypos index := ypos index a; + yf. vorheriger ypos index := ya. vorheriger ypos index; + ya. vorheriger ypos index := ypos index f; + ypos index a := yf. vorheriger ypos index; + ya. naechster ypos index := ypos index f; + erstes token bei neuer ypos; + + . fuege ypos nach letztem ypos index ein : + ypos index f INCR 1; + yf. naechster ypos index := 0; + yf. vorheriger ypos index := letzter ypos index a; + letzter ypos index a := ypos index f; + ypos index a := yf. vorheriger ypos index; + ya. naechster ypos index := ypos index f; + erstes token bei neuer ypos; + +END PROC neuer token index; + + +PROC erstes token bei neuer ypos : + token index f INCR 1; + ypos index a := ypos index f; + ya. erster token index := token index f; + ya. ypos := aktuelle ypos; +END PROC erstes token bei neuer ypos; + + +PROC neues token bei neuer ypos : + token index f INCR 1; + ya. ypos := aktuelle ypos; + token index := ya. letzter token index; + t. naechster token index := token index f; +END PROC neues token bei neuer ypos; + + +PROC neues token bei gleicher ypos : + tf. naechster token index := token index f + 1; + token index f INCR 1; +END PROC neues token bei gleicher ypos; + + +PROC letztes token bei gleicher ypos : + tf. naechster token index := 0; + ya. letzter token index := token index f; +END PROC letztes token bei gleicher ypos; + + +PROC loesche letztes token : + + IF token index f = ya. erster token index + THEN loesche ypos + ELSE token index f DECR 1; + FI; + + . loesche ypos : + kette vorgaenger um; + kette nachfolger um; + bestimme letzten ypos index; + + . kette vorgaenger um : + ypos index := ya. vorheriger ypos index; + IF ypos index = 0 + THEN erster ypos index a := ya. naechster ypos index; + ELSE y. naechster ypos index := ya. naechster ypos index; + FI; + + . kette nachfolger um : + ypos index := ya. naechster ypos index; + IF ypos index = 0 + THEN letzter ypos index a := ya. vorheriger ypos index; + ELSE y. vorheriger ypos index := ya. vorheriger ypos index; + FI; + + . bestimme letzten ypos index : + IF ypos index a = ypos index f THEN ypos index f DECR 1 FI; + token index f DECR 1; + ypos index a := letzter ypos index a; + WHILE ypos index a <> 0 + CAND ya. letzter token index <> token index f + REP ypos index a := ya. vorheriger ypos index PER; + +END PROC loesche letztes token; + + +PROC blocke token xpos (INT CONST dehnung 1, dehnung 2, + anzahl dehnungen fuer dehnung 1 ) : + + INT VAR dehnung := 0, anzahl dehnungen := 0; + token index := erstes tab token; + WHILE token index <= token index f + REP erhoehe token xpos bei block token; + t. xpos INCR dehnung; + token index INCR 1; + PER; + + . erhoehe token xpos bei block token : + IF t. block token + THEN IF anzahl dehnungen < anzahl dehnungen fuer dehnung 1 + THEN anzahl dehnungen INCR 1; + dehnung INCR dehnung 1; + ELSE dehnung INCR dehnung 2; + FI; + FI; + +END PROC blocke token xpos; + + +PROC verschiebe token xpos (INT CONST verschiebung) : + + token index := erstes tab token; + WHILE token index <= token index f + REP t. xpos INCR verschiebung; + token index INCR 1; + PER; + +END PROC verschiebe token xpos; + + +PROC verschiebe token ypos (INT CONST verschiebung) : + + ypos index := erster ypos index a; + WHILE ypos index <> 0 + REP y. ypos INCR verschiebung; + ypos index := y. naechster ypos index; + PER; + +END PROC verschiebe token ypos; + + +PROC sortiere neue token ein : + +IF analysespeicher ist nicht leer + THEN IF druckspeicher ist nicht leer + THEN sortiere neue token in sortierte liste ein + ELSE sortierte liste ist leer + FI; +FI; + +. sortierte liste ist leer : + IF erster ypos index a <> 0 + THEN erster ypos index d := erster ypos index a; + letzter ypos index d := letzter ypos index a; + ypos index d := letzter ypos index a; + FI; + +. sortiere neue token in sortierte liste ein : + gehe zum ersten neuen token; + bestimme erste einsortierposition; + WHILE es gibt noch neue token + REP IF ypos index d = 0 + THEN haenge neue token ans ende der sortierten liste + ELIF ya. ypos > yd. ypos + THEN naechste ypos der sortierten liste + ELIF ya. ypos = yd. ypos + THEN neues token auf gleicher ypos + ELSE neue token vor ypos + FI; + PER; + + . gehe zum ersten neuen token : + ypos index a := erster ypos index a; + + . bestimme erste einsortierposition : + WHILE ypos index d <> 0 CAND ya. ypos < yd. ypos + REP ypos index d := yd. vorheriger ypos index PER; + IF ypos index d = 0 THEN erste neue token vor listen anfang FI; + + . erste neue token vor listen anfang : + ypos index d := erster ypos index d; + erster ypos index d := erster ypos index a; + REP ypos index a := ya. naechster ypos index; + IF ypos index a = 0 + THEN verkette letztes ya mit yd; + LEAVE sortiere neue token in sortierte liste ein + ELIF ya. ypos = yd. ypos + THEN verkette ya mit yd; + LEAVE erste neue token vor listen anfang + ELIF ya. ypos > yd. ypos + THEN verkette vorheriges ya mit yd; + ypos index d := yd. naechster ypos index; + LEAVE erste neue token vor listen anfang + FI; + PER; + + . es gibt noch neue token : + ypos index a <> 0 + + . haenge neue token ans ende der sortierten liste : + ypos index d := letzter ypos index d; + yd. naechster ypos index := ypos index a; + ya. vorheriger ypos index := ypos index d; + letzter ypos index d := letzter ypos index a; + ypos index d := letzter ypos index a; + ypos index a := 0; + + . naechste ypos der sortierten liste : + ypos index d := yd. naechster ypos index; + + . neues token auf gleicher ypos : + token index := yd. letzter token index; + t . naechster token index := ya. erster token index; + yd. letzter token index := ya. letzter token index; + ypos index a := ya. naechster ypos index; + ypos index d := yd. naechster ypos index; + IF ypos index d = 0 THEN ypos index d := letzter ypos index d FI; + + . neue token vor ypos : + verkette ya mit vorherigem yd; + REP ypos index a := ya. naechster ypos index; + IF ypos index a = 0 + THEN verkette letztes ya mit yd; + LEAVE sortiere neue token in sortierte liste ein + ELIF ya. ypos = yd. ypos + THEN verkette ya mit yd; + LEAVE neue token vor ypos + ELIF ya. ypos > yd. ypos + THEN verkette vorheriges ya mit yd; + ypos index d := yd. naechster ypos index; + LEAVE neue token vor ypos + FI; + PER; + + +. verkette ya mit vorherigem yd : + index := ypos index d; + ypos index d := yd. vorheriger ypos index; + yd. naechster ypos index := ypos index a; + ya. vorheriger ypos index := ypos index d; + ypos index d := index; + +. verkette letztes ya mit yd : + ypos index a := letzter ypos index a; + yd. vorheriger ypos index := ypos index a; + ya. naechster ypos index := ypos index d; + ypos index a := 0; + +. verkette vorheriges ya mit yd : + index := ypos index a; + ypos index a := ya. vorheriger ypos index; + yd. vorheriger ypos index := ypos index a; + ya. naechster ypos index := ypos index d; + ypos index a := index; + +. verkette ya mit yd : + verkette vorheriges ya mit yd; + neues token auf gleicher ypos; + +END PROC sortiere neue token ein; + +(***************************************************************) + +PROC drucke tokenspeicher + (INT CONST max ypos, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +IF druckspeicher ist nicht leer + THEN gehe zur ersten ypos; + WHILE yd. ypos <= max ypos + REP drucke token bei ypos; + gehe zur naechsten ypos; + PER; + loesche gedruckte token; +FI; + +. gehe zur ersten ypos : + ypos index d := erster ypos index d; + +. drucke token bei ypos : + IF yd. ypos >= - y start + THEN druck durchgang; + IF bold pass THEN fett durchgang FI; + IF underline pass THEN unterstreich durchgang FI; + FI; + + . bold pass : bit (pass, bold bit) + + . underline pass : bit (pass, underline bit) + +. gehe zur naechsten ypos : + IF ypos index d = letzter ypos index d + THEN loesche druckspeicher; + LEAVE drucke tokenspeicher; + FI; + ypos index d := yd. naechster ypos index; + +. loesche gedruckte token : + erster ypos index d := ypos index d; + yd. vorheriger ypos index := 0; + +. + druck durchgang : + verschiebung := yd. ypos - d ypos; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + gehe zum ersten token dieser ypos; + REP drucke token UNTIL kein token mehr vorhanden PER; + gib cr aus; + + . drucke token : + IF NOT token passt in zeile THEN berechne token teil FI; + font wechsel wenn noetig; + x move mit modifikations ueberpruefung; + IF token ist text token + THEN gib text token aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + ELSE gib kommando token aus + FI; + + . gib kommando token aus : + execute (write cmd, d token. text, 1, LENGTH d token. text) + + . berechne token teil : + INT CONST fuenf punkte := 5 * char pitch (d token. font, punkt); + INT VAR token pos, token breite, anzahl punkte, zeichen laenge, zeichen breite; + IF d token. xpos < - x start + AND d token. xpos + d token. breite > - x start + THEN berechne token teil von links + ELIF d token. xpos < papierbreite + AND d token. xpos + d token. breite > papierbreite + THEN berechne token teil nach rechts + ELSE LEAVE drucke token + FI; + + . berechne token teil von links : + rest := min (x size, d token. xpos + d token. breite + x start); + d token. xpos := - x start; + IF rest <= fuenf punkte + THEN anzahl punkte := rest DIV char pitch (d token. font, punkt); + d token. text := anzahl punkte * punkt; + d token. breite := anzahl punkte * char pitch (d token. font, punkt); + ELSE token pos := LENGTH d token. text + 1; + token breite := fuenf punkte; + berechne token teil breite von hinten; + change (d token. text, 1, token pos - 1, 5 * punkt); + d token. breite := token breite; + FI; + + . berechne token teil breite von hinten : + WHILE naechstes zeichen passt noch davor + REP token breite INCR zeichen breite; + token pos DECR zeichen laenge; + PER; + + . naechstes zeichen passt noch davor : + IF within kanji (d token. text, token pos - 1) + THEN zeichen laenge := 2 + ELSE zeichen laenge := 1 + FI; + zeichen breite := char pitch (d token. font, + subtext (d token. text, token pos - zeichen laenge, token pos - 1)); + token breite + zeichen breite < rest + + . berechne token teil nach rechts : + rest := papier breite - d token. xpos; + IF rest <= fuenf punkte + THEN anzahl punkte := rest DIV char pitch (d token. font, punkt); + d token. text := anzahl punkte * punkt; + d token. breite := anzahl punkte * char pitch (d token. font, punkt); + ELSE token pos := 0; + token breite := fuenf punkte; + berechne token teil breite von vorne; + change (d token. text, token pos + 1, LENGTH d token. text, 5 * punkt); + d token. breite := token breite; + FI; + + . berechne token teil breite von vorne : + WHILE naechstes zeichen passt noch dahinter + REP token breite INCR zeichen breite; + token pos INCR zeichen laenge; + PER; + + . naechstes zeichen passt noch dahinter : + IF is kanji esc (d token. text SUB token pos + 1) + THEN zeichen laenge := 2 + ELSE zeichen laenge := 1 + FI; + zeichen breite := char pitch (d token. font, + subtext (d token. text, token pos + 1, token pos + zeichen laenge)); + token breite + zeichen breite < rest + +. + fett durchgang : + reset bit (pass, bold bit); + gehe zum ersten token dieser ypos; + REP gib token nochmal aus UNTIL kein token mehr vorhanden PER; + schalte modifikationen aus wenn noetig; + gib cr aus; + + . gib token nochmal aus : + INT CONST min verschiebung := bold offset (d token. font); + d token. xpos INCR min verschiebung; + IF bit (d token. modifikationen, bold bit) AND + token passt in zeile AND token ist text token + THEN verschiebung := d token. xpos - d xpos; + font wechsel wenn noetig; + schalte italics ein wenn noetig; + x move wenn noetig; + gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + d token. xpos DECR min verschiebung; + + . schalte italics ein wenn noetig : + IF bit (d token. modifikationen, italics bit) + THEN neue modifikationen := modifikations werte (italics bit + 1); + schalte modifikationen ein wenn noetig; + ELSE schalte modifikationen aus wenn noetig; + FI; + +. + unterstreich durchgang : + INT VAR l xpos := 0; + reset bit (pass, underline bit); + schalte modifikationen aus wenn noetig; + gehe zum ersten token dieser ypos; + REP unterstreiche token UNTIL kein token mehr vorhanden PER; + gib cr aus; + + . unterstreiche token : + IF token muss unterstrichen werden AND + token passt in zeile AND token ist text token + THEN font wechsel wenn noetig; + berechne x move laenge; + x move wenn noetig; + berechne unterstreich laenge; + unterstreiche; + FI; + l xpos := d token. xpos + d token. breite; + + . token muss unterstrichen werden : + bit (d token. modifikationen, underline bit) OR + bit (d token. modifikationen fuer x move, underline bit) + + . berechne x move laenge : + IF bit (d token. modifikationen fuer x move, underline bit) + THEN verschiebung := l xpos - d xpos + ELSE verschiebung := d token. xpos - d xpos + FI; + + . berechne unterstreich laenge : + INT VAR unterstreich verschiebung; + IF bit (d token. modifikationen, underline bit) + THEN unterstreich verschiebung := d token. xpos + + d token. breite - d xpos + ELSE unterstreich verschiebung := d token. xpos - d xpos + FI; + + +. gehe zum ersten token dieser ypos : + token index := yd. erster token index; + d token := t; + +. kein token mehr vorhanden : + token index := d token. naechster token index; + IF token index = 0 + THEN TRUE + ELSE d token := t; + FALSE + FI + +. token ist text token : + d token. offset index >= text token + +. token passt in zeile : + d token. xpos >= - x start AND + d token. xpos + d token. breite <= papier breite + +. font wechsel wenn noetig : + IF d token. font <> d font + THEN font wechsel (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. schalte modifikationen ein wenn noetig : + IF d modifikationen <> neue modifikationen + THEN schalte modifikationen ein (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. schalte modifikationen aus wenn noetig : + IF d modifikationen <> 0 + THEN schalte modifikationen aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. x move wenn noetig : + IF verschiebung <> 0 + THEN x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. gib cr aus : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + +. + x move mit modifikations ueberpruefung : + verschiebung := d token. xpos - d xpos; + IF verschiebung <> 0 + THEN neue modifikationen := d token. modifikationen fuer x move; + schalte modifikationen ein wenn noetig; + x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + neue modifikationen := d token. modifikationen; + schalte modifikationen ein wenn noetig; + +. + unterstreiche : + IF unterstreich verschiebung > 0 + THEN disable stop; + d xpos INCR unterstreich verschiebung; + execute (draw, "", unterstreich verschiebung, 0); + IF is error + THEN unterstreiche nach cr; + FI; + enable stop; + FI; + + . unterstreiche nach cr : + clear error; + d xpos DECR unterstreich verschiebung; + verschiebung := d xpos; + gib cr aus; + x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + d xpos INCR unterstreich verschiebung; + execute (draw, "", unterstreich verschiebung, 0); + IF is error + THEN clear error; + d xpos DECR unterstreich verschiebung; + gib cr aus; + LEAVE unterstreich durchgang; + FI; + +END PROC drucke tokenspeicher; + +PROC y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + IF verschiebung <> 0 + THEN disable stop; + d ypos INCR verschiebung; + execute (move, "", 0, verschiebung); + IF is error + THEN clear error; + d ypos DECR verschiebung; + verschiebung := 0; + FI; + enable stop; + FI; + +END PROC y move; + + +PROC x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + d xpos INCR verschiebung; + execute (move, "", verschiebung, 0); + IF is error + THEN fuehre x move nach cr aus + FI; + + . fuehre x move nach cr aus : + clear error; + schalte modifikationen aus wenn noetig; + gib cr aus; + IF d xpos <> 0 + THEN execute (move, "", d xpos, 0); + IF is error + THEN clear error; + d xpos := 0; + FI + FI; + schalte modifikationen ein wenn noetig; + + . gib cr aus : + execute (carriage return, "", d xpos - verschiebung, 0); + + . schalte modifikationen aus wenn noetig : + neue modifikationen := d modifikationen; + IF d modifikationen <> 0 + THEN schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + + . schalte modifikationen ein wenn noetig : + IF d modifikationen <> neue modifikationen + THEN schalte modifikationen ein + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + +END PROC x move; + + +PROC schalte modifikationen ein + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + INT VAR index; + IF d modifikationen <> 0 + THEN schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + d modifikationen := neue modifikationen; + FOR index FROM 1 UPTO anzahl modifikationen + REP IF bit (d modifikationen, modifikations bit) + THEN modifikation muss eingeschaltet werden + FI; + PER; + + . modifikations bit : index - 1 + + . modifikation muss eingeschaltet werden : + IF bit (modifikations modus, modifikations bit) + THEN execute (on, "", modifikations werte (index), 0); + IF is error + THEN clear error; + reset bit (modifikations modus, modifikations bit); + set bit (pass, modifikations bit); + FI; + ELSE set bit (pass, modifikations bit); + FI; + +END PROC schalte modifikationen ein; + + +PROC schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + INT VAR index; + FOR index FROM 1 UPTO anzahl modifikationen + REP IF bit (d modifikationen, modifikations bit) + THEN modifikation muss ausgeschaltet werden + FI; + PER; + d modifikationen := 0; + + . modifikations bit : index - 1 + + . modifikation muss ausgeschaltet werden : + IF bit (modifikations modus, modifikations bit) + THEN execute (off, "", modifikations werte (index), 0); + IF is error THEN clear error FI; + FI; + +END PROC schalte modifikationen aus; + + +PROC font wechsel + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + d font := d token. font; + get replacements (d font, replacements, replacement tabelle); + execute (type, "", d font, 0); + IF is error THEN font wechsel nach cr FI; + enable stop; + + . font wechsel nach cr : + clear error; + verschiebung := d xpos; + gib cr aus; + execute (type, "", d font, 0); + IF NOT is error + THEN schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + x move + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + + . gib cr aus : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + +END PROC font wechsel; + + +PROC gib text token aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + INT CONST token laenge := LENGTH d token. text; + INT VAR token pos := 1, alte token pos, summe := 0; + IF token laenge > 0 + THEN REP alte token pos := token pos; + stranalyze (replacement tabelle, summe, 0, + d token. text, token pos, token laenge, + ausgang); + IF ausgang = 0 + THEN gib token rest aus; + ELSE gib token teil aus; + gib ersatzdarstellung aus; + FI; + PER; + FI; + + . gib token rest aus : + IF token laenge >= alte token pos + THEN execute (write text, d token. text, alte token pos, token laenge) FI; + d xpos INCR d token. breite; + LEAVE gib text token aus; + + . gib token teil aus : + IF token pos >= alte token pos + THEN execute (write text, d token. text, alte token pos, token pos) FI; + + . gib ersatzdarstellung aus : + IF ausgang = maxint + THEN ersatzdarstellung := extended replacement (d token. font, + d token. text SUB token pos + 1, d token. text SUB token pos + 2); + execute (write text, ersatzdarstellung, 1, LENGTH ersatzdarstellung); + tokenpos INCR 3; + ELSE IF ausgang < 0 + THEN ausgang := ausgang XOR (-32767-1); + token pos INCR 1; + FI; + execute (write text, replacements, ausgang + 1, ausgang + code (replacements SUB ausgang)); + token pos INCR 2; + FI; + + . ersatzdarstellung : par1 + +END PROC gib text token aus; + + +PROC schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +enable stop; +gebe restliche token aus; +seiten ende kommando; + +. gebe restliche token aus : + IF erster ypos index d <> 0 + THEN drucke tokenspeicher (maxint, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + rest := papier laenge - d ypos; + +. seiten ende kommando : + seite ist offen := FALSE; + a ypos := top margin; + aktuelle spalte := 1; + close (page, rest); + +END PROC schliesse seite ab; + + +PROC eroeffne seite (INT CONST x wanted, y wanted, + PROC (INT CONST, INT VAR, INT VAR) open ) : + +IF vor erster seite THEN eroeffne druck FI; +seiten anfang kommando; +initialisiere neue seite; + +. eroeffne druck : + open (document, x size, y size); + vor erster seite := FALSE; + d font := -1; + d modifikationen := 0; + +. seiten anfang kommando : + x start := x wanted; + y start := y wanted; + open (page, x start, y start); + gedruckte seiten INCR 1; + seite ist offen := TRUE; + +. initialisiere neue seite : + INT CONST dif left margin := x wanted - x start - left margin + indentation, + dif top margin := y wanted - y start - top margin; + IF dif left margin <> 0 + THEN erstes tab token := 1; + verschiebe token xpos (dif left margin); + a xpos INCR dif left margin; + left margin INCR dif left margin; + FI; + IF dif top margin <> 0 + THEN verschiebe token ypos (dif top margin); + a ypos INCR dif top margin; + top margin INCR dif top margin; + FI; + d xpos := 0; + d ypos := 0; + IF seitenlaenge <= papierlaenge + THEN seitenlaenge := top margin + pagelength; + ELSE seitenlaenge DECR papierlaenge; + FI; + papierlaenge := y size - y start; + papierbreite := x size - x start; + +END PROC eroeffne seite; + +(****************************************************************) + +PROC elan fuss und kopf (INT CONST fuss oder kopf, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +IF fuss oder kopf <= 0 THEN elan fuss FI; +IF fuss oder kopf >= 0 THEN elan kopf FI; + +. + elan fuss : + y move zur fusszeile; + drucke elan fuss; + close page cmd; + +. y move zur fusszeile : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + verschiebung := rest auf seite - font hoehe; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +. drucke elan fuss : + IF bottom label = "" + THEN seiten nr := "" + ELSE seiten nr := bottom label; + seiten nr CAT "/"; + FI; + seiten nr CAT text (gedruckte seiten); + elan text := seiten nr; + elan text CAT " "; + elan text cat blanks ((max zeichen fuss - LENGTH dateiname) DIV 2 - LENGTH elan text); + elan text CAT dateiname; + elan text cat blanks (max zeichen fuss - LENGTH seiten nr - LENGTH elan text - 3); + elan text CAT " "; + elan text CAT seiten nr; + IF LENGTH elan text > max zeichen zeile + THEN elan text := subtext (elan text, 1, max zeichen zeile) FI; + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + + . seiten nr : par1 + +. close page cmd : + close (page, papierlaenge - d ypos); + seite ist offen := FALSE; + +. + elan kopf : + open page cmd ; + y move zur kopfzeile; + drucke elan kopf; + +. open page cmd : + x start := x wanted; + y start := y wanted; + open (page, x start, y start); + IF fuss oder kopf = 1 THEN execute (type, "", d font, 0) FI; + gedruckte seiten INCR 1; + seite ist offen := TRUE; + top margin := y wanted - y start; + left margin := x wanted - x start; + rest auf seite := pagelength; + papierlaenge := y size - y start; + d ypos := 0; + d xpos := 0; + +. y move zur kopf zeile : + verschiebung := top margin; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + IF verschiebung = 0 THEN rest auf seite INCR top margin FI; + +. drucke elan kopf : + elan text := headline pre; + elan text CAT date; + elan text CAT headline post; + elan text CAT datei name; + IF LENGTH elan text > max zeichen zeile + THEN elan text := subtext (elan text, 1, max zeichen zeile) FI; + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC elan fuss und kopf; + + +PROC gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +cr plus lf (1, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); +linker rand wenn noetig; +d token. breite := LENGTH elan text * einrueckbreite; +gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +. linker rand wenn noetig : + IF left margin > 0 + THEN disable stop; + d xpos := left margin; + execute (move, "", left margin, 0); + IF is error + THEN clear error; + d xpos := 0; + FI; + enable stop; + FI; + +END PROC gib elan text aus; + + +PROC cr plus lf (INT CONST anzahl, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +gib cr aus; +gib lf aus; +rest auf seite DECR verschiebung; + +. gib cr aus : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + +. gib lf aus : + verschiebung := anzahl * font hoehe; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +END PROC cr plus lf ; + + +END PACKET eumel printer; + diff --git a/system/multiuser/1.7.5/src/font store b/system/multiuser/1.7.5/src/font store new file mode 100644 index 0000000..ebb6a62 --- /dev/null +++ b/system/multiuser/1.7.5/src/font store @@ -0,0 +1,695 @@ +PACKET font store (* Autor : Rudolf Ruland *) + (* Stand : 18.02.86 *) + DEFINES font table, + list font tables, + list fonts, + + x step conversion, + y step conversion, + on string, + off string, + + font, + font exists, + next larger font exists, + next smaller font exists, + font lead, + font height, + font depth, + indentation pitch, + char pitch, + extended char pitch, + replacement, + extended replacement, + font string, + y offsets, + bold offset, + get font, + get replacements : + + +LET font task = "configurator"; + +LET ack = 0, + fetch code = 11, + all code = 17, + + underline = 1, + bold = 2, + italics = 4, + reverse = 8, + + first font = 1, + max fonts = 50, + max extensions = 120, + font table type = 3009, + + FONTTABLE = STRUCT ( + + THESAURUS font names, + + TEXT replacements, font name links, + extension chars, extension indexes, + + ROW 4 TEXT on strings, off strings, + + REAL x unit, y unit, + + ROW 256 INT replacements table, + + INT last font, last extension + + ROW max fonts STRUCT ( + TEXT font string, font name indexes, replacements, + extension chars, extension indexes, y offsets, + ROW 256 INT pitch table, replacements table, + INT indentation pitch, font lead, font height, font depth, + next larger font, next smaller font, bold offset ) fonts , + + ROW max extensions STRUCT ( + TEXT replacements, + ROW 256 INT pitch table, replacements table, + INT std pitch ) extensions , + + ); + +INT VAR font nr, help, reply, list index, last font, + index, char code 1, link nr, font store replacements length; + +TEXT VAR fo table := "", old font table, font name links, buffer; + +THESAURUS VAR font tables, font names; + +INITFLAG VAR in this task := FALSE, + init font ds := FALSE, + init ds := FALSE; + +BOUND FONTTABLE VAR font store; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg; + +BOUND THESAURUS VAR all msg; + +BOUND TEXT VAR error msg; + +DATASPACE VAR font ds, ds; + +(*****************************************************************) + +PROC font table (TEXT CONST new font table) : + + disable stop; + get font table (new font table); + in this task := NOT (font table = "" OR type (font ds) <> font table type); + +END PROC font table; + + +PROC get font table (TEXT CONST new font table) : + + enable stop; + buffer := new font table; + change all (buffer, " ", ""); + IF exists (buffer) CAND type (old (buffer)) = font table type + THEN get font table from own task + ELIF exists task (font task) + THEN get font table from font task + ELSE errorstop ("Fonttabelle """ + buffer + """ gibt es nicht") + FI; + + . get font table from own task : + IF NOT initialized (init ds) THEN ds := nilspace FI; + forget (ds); ds := old (buffer); + new font store; + + . get font table from font task : + fetch font table (buffer); + IF type (ds) <> font table type + THEN forget (ds); + errorstop ("Fonttabelle """ + buffer + """ gibt es nicht") + FI; + new font store; + + . new font store : + disable stop; + IF NOT initialized (init font ds) THEN font ds := nilspace FI; + forget (font ds); + font ds := ds; + forget (ds); + font store := font ds; + fo table := buffer; + font names := font store. font names; + font name links := font store. font name links; + last font := font store. last font; + font store replacements length := LENGTH font store. replacements; + +END PROC get font table; + + +TEXT PROC font table : + + fo table + +END PROC font table; + + +PROC list font tables : + + enable stop; + font tables := empty thesaurus; + font tables in own task; + font tables in font task; + note font tables; + note edit; + + . font tables in own task : + list index := 0; + REP get (all, buffer, list index); + IF buffer = "" THEN LEAVE font tables in own task FI; + IF type (old (buffer)) = font table type + AND NOT (font tables CONTAINS buffer) + THEN insert (font tables, buffer) FI; + PER; + + . font tables in font task : + all file names from font task; + THESAURUS CONST names := all msg; + list index := 0; + REP get (names, buffer, list index); + IF buffer = "" + THEN forget (ds); + LEAVE font tables in font task + FI; + fetch font table (buffer); + IF type (ds) = font table type + AND NOT (font tables CONTAINS buffer) + THEN insert (font tables, buffer) FI; + PER; + + . note font tables : + list index := 0; + REP get (font tables, buffer, list index); + IF buffer = "" + THEN LEAVE note font tables; + ELSE note (buffer); note line; + FI; + PER; + +END PROC list font tables; + + +PROC list fonts (TEXT CONST name): + + initialize if necessary; + disable stop; + old font table := font table; + font table (name); + list fonts; + font table (old font table); + +END PROC list fonts; + + +PROC list fonts : + + enable stop; + initialize if necessary; + note font table; + FOR font nr FROM first font UPTO last font REP note font PER; + note edit; + +. note font table : + note ("FONTTABELLE : """); note (font table); note (""";"); noteline; + note (" x einheit = "); note (text (font store. x unit)); note (";"); noteline; + note (" y einheit = "); note (text (font store. y unit)); note (";"); noteline; + +. note font : + cout (font nr); + noteline; + note (" FONT : "); note font names; note (";"); noteline; + note (" einrueckbreite = "); note (text(font. indentation pitch)); note (";"); noteline; + note (" durchschuss = "); note (text(font. font lead)); note (";"); noteline; + note (" fonthoehe = "); note (text(font. font height)); note (";"); noteline; + note (" fonttiefe = "); note (text(font. font depth)); note (";"); noteline; + note (" groesserer font = """); note (next larger); note (""";"); noteline; + note (" kleinerer font = """); note (next smaller); note (""";"); noteline; + + . font : font store. fonts (font nr) + . next larger : name (font store. font names, font. next larger font) + . next smaller : name (font store. font names, font. next smaller font) + + . note font names : + INT VAR index; + note (""""); + note (name (font names, font. font name indexes ISUB 1)); + note (""""); + FOR index FROM 2 UPTO LENGTH font. font name indexes DIV 2 + REP note (", """); + note (name (font names, font. font name indexes ISUB index)); + note (""""); + PER; + +END PROC list fonts; + + +INT PROC x step conversion (REAL CONST cm) : + + initialize if necessary; + IF cm >= 0.0 + THEN int (cm * font store. x unit + 0.5 ) + ELSE int (cm * font store. x unit - 0.5 ) + FI + +END PROC x step conversion; + + +REAL PROC x step conversion (INT CONST steps) : + + initialize if necessary; + real (steps) / font store. x unit + +END PROC x step conversion; + + +INT PROC y step conversion (REAL CONST cm) : + + initialize if necessary; + IF cm >= 0.0 + THEN int (cm * font store. y unit + 0.5 ) + ELSE int (cm * font store. y unit - 0.5 ) + FI + +END PROC y step conversion; + + +REAL PROC y step conversion (INT CONST steps) : + + initialize if necessary; + real (steps) / font store. y unit + +END PROC y step conversion; + + +TEXT PROC on string (INT CONST modification) : + + initialize if necessary; + SELECT modification OF + CASE underline : font store. on strings (1) + CASE bold : font store. on strings (2) + CASE italics : font store. on strings (3) + CASE reverse : font store. on strings (4) + OTHERWISE : errorstop ("unzulaessige Modifikation"); "" + END SELECT + +END PROC on string; + + +TEXT PROC off string (INT CONST modification) : + + initialize if necessary; + SELECT modification OF + CASE underline : font store. off strings (1) + CASE bold : font store. off strings (2) + CASE italics : font store. off strings (3) + CASE reverse : font store. off strings (4) + OTHERWISE : errorstop ("unzulaessige Modifikation"); "" + END SELECT + +END PROC off string; + + +INT PROC font (TEXT CONST font name) : + + initialize if necessary; + buffer := font name; + change all (buffer, " ", ""); + INT CONST link nr := link (font names, buffer) + IF link nr <> 0 + THEN font name links ISUB link nr + ELSE 0 + FI + +END PROC font; + + +TEXT PROC font (INT CONST font number) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN name (font names, fonts. font name indexes ISUB 1) + ELSE "" + FI + + . fonts : font store. fonts (font number) + +END PROC font; + + +BOOL PROC font exists (TEXT CONST font name) : + + font (font name) <> 0 + +END PROC font exists; + + +BOOL PROC next larger font exists(INT CONST font number, + INT VAR next larger font) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN next larger font := fonts. next larger font; + IF next larger font <> 0 + THEN next larger font := font name links ISUB next larger font; + next larger font <> 0 + ELSE FALSE + FI + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); + FALSE + FI + + . fonts : font store. fonts (font number) + +END PROC next larger font exists; + + +BOOL PROC next smaller font exists (INT CONST font number, + INT VAR next smaller font) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN next smaller font := fonts. next smaller font; + IF next smaller font <> 0 + THEN next smaller font := font name links ISUB next smaller font; + next smaller font <> 0 + ELSE FALSE + FI + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); + FALSE + FI + + . fonts : font store. fonts (font number) + +END PROC next smaller font exists; + + +INT PROC font lead (INT CONST font number) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN fonts. font lead + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0 + FI + + . fonts : font store. fonts (font number) + +END PROC font lead; + + +INT PROC font height (INT CONST font number) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN fonts. font height + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0 + FI + + . fonts : font store. fonts (font number) + +END PROC font height; + + +INT PROC font depth (INT CONST font number) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN fonts. font depth + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0 + FI + + . fonts : font store. fonts (font number) + +END PROC font depth; + + +INT PROC indentation pitch (INT CONST font number) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN fonts. indentation pitch + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0 + FI + + . fonts : font store. fonts (font number) + +END PROC indentation pitch; + + +INT PROC char pitch (INT CONST font number, + TEXT CONST char ) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN INT CONST pitch := font. pitch table (code (char SUB 1) + 1); + IF pitch = maxint + THEN extended char pitch (font number, char SUB 1, char SUB 2) + ELIF pitch < 0 + THEN pitch XOR (-maxint-1) + ELSE pitch + FI + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0 + FI + + . font : font store. fonts (font number) + +END PROC char pitch; + + +INT PROC extended char pitch (INT CONST font number, + TEXT CONST esc char, char) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN extension. pitch table (code (char) + 1) + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0 + FI + + . font : font store. fonts (font number) + + . extension : font store. extensions (extension number) + + . extension number : + INT CONST index := pos (font. extension chars, esc char); + IF index = 0 + THEN errorstop ("""" + esc char + char + """ hat keine Erweiterung") FI; + font. extension indexes ISUB index + +END PROC extended char pitch; + + +TEXT PROC replacement (INT CONST font number, + TEXT CONST char ) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN link nr := font. replacements table (code (char SUB 1) + 1); + IF link nr = maxint + THEN extended replacement (font number, char SUB 1, char SUB 2) + ELSE process font replacement + FI + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); "" + FI + + . font : font store. fonts (font number) + + . process font replacement : + IF link nr < 0 THEN link nr := link nr XOR (-maxint-1) FI; + IF link nr = 0 + THEN char + ELIF link nr > font store replacements length + THEN link nr DECR font store replacements length; + replacement text (font. replacements) + ELSE replacement text (font store. replacements) + FI + +END PROC replacement; + + +TEXT PROC extended replacement (INT CONST font number, + TEXT CONST esc char, char ) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN process extension replacement + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); "" + FI + + . process extension replacement : + determine extension link nr; + IF link nr = 0 + THEN char + ELIF link nr > font store extension replacements length + THEN link nr DECR font store extension replacements length; + replacement text (font extension. replacements) + ELSE replacement text (font store extension. replacements) + FI + + . determine extension link nr : + INT CONST index 1 := pos (font. extension chars, esc char); + INT CONST index 2 := pos (font store. extension chars, esc char); + IF index 1 <> 0 + THEN link nr := font extension. replacements table (code (char) + 1); + ELIF index 2 <> 0 + THEN link nr := font store extension. replacements table (code (char) + 1); + ELSE errorstop ("""" + esc char + char + """ hat keine Erweiterung") + FI; + + . font extension : font store. extensions (font extension number) + + . font extension number : font. extension indexes ISUB index 1 + + . font : font store. fonts (font number) + + . font store extension : font store. extensions (font store extension number) + + . font store extension number : font store. extension indexes ISUB index 2 + + . font store extension replacements length : + IF index 2 = 0 + THEN 0 + ELSE LENGTH font store extension. replacements + FI + +END PROC extended replacement; + + +TEXT PROC replacement text (TEXT CONST replacements) : + + buffer := subtext (replacements, link nr + 1, + link nr + code (replacements SUB link nr)); + buffer + +END PROC replacement text; + + +TEXT PROC font string (INT CONST font number) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN fonts. font string + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); "" + FI + + . fonts : font store. fonts (font number) + +END PROC font string; + + +TEXT PROC y offsets (INT CONST font number) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN fonts. y offsets + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); "" + FI + + . fonts : font store. fonts (font number) + +END PROC y offsets; + + +INT PROC bold offset (INT CONST font number) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN fonts. bold offset + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0 + FI + + . fonts : font store. fonts (font number) + +END PROC bold offset; + + +PROC get font (INT CONST font number, + INT VAR indentation pitch, font lead, font height, font depth, + ROW 256 INT VAR pitch table ) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN indentation pitch := fonts. indentation pitch; + pitch table := fonts. pitch table; + font lead := fonts. font lead; + font height := fonts. font height; + font depth := fonts. font depth; + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); + FI; + + . fonts : font store. fonts (font number) + +END PROC get font; + + +PROC get replacements (INT CONST font number, + TEXT VAR replacements, + ROW 256 INT VAR replacements table) : + + initialize if necessary; + IF font number >= first font AND font number <= last font + THEN replacements := font store. replacements; + replacements CAT fonts. replacements; + replacements table := fonts. replacements table; + ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); + FI; + + . fonts : font store. fonts (font number) + +END PROC get replacements; + + +PROC initialize if necessary : + + IF NOT initialized (in this task) + THEN IF font table = "" + THEN in this task := FALSE; + errorstop ("Fonttabelle noch nicht eingestellt"); + ELSE font table (font table); + FI; + FI; + +END PROC initialize if necessary; + + +PROC fetch font table (TEXT CONST font table name) : + + enable stop; + IF NOT initialized (init ds) THEN ds := nilspace FI; + forget (ds); ds := nilspace; + msg := ds; + msg. name := font table name; + msg. write pass := ""; + msg. read pass := ""; + call (task (font task), fetch code, ds, reply); + IF reply <> ack + THEN errorstop ("Fonttabelle """ + font table name + """ gibt es nicht") + FI; + +END PROC fetch font table; + + +PROC all file names from font task : + + enable stop; + IF NOT initialized (init ds) THEN ds := nilspace FI; + forget (ds); ds := nilspace; + call (task (font task), all code, ds, reply); + IF reply <> ack + THEN error msg := ds; + errorstop (error msg); + ELSE all msg := ds + FI; + +END PROC all file names from font task; + + +END PACKET font store; + diff --git a/system/multiuser/1.7.5/src/global manager b/system/multiuser/1.7.5/src/global manager new file mode 100644 index 0000000..b3d64cc --- /dev/null +++ b/system/multiuser/1.7.5/src/global manager @@ -0,0 +1,683 @@ +(* ------------------- VERSION 19 16.05.86 ------------------- *) +PACKET global manager DEFINES (* Autor: J.Liedtke *) + + ALL , + begin password , + call , + continue channel , + erase , + exists , + fetch , + free global manager , + free manager , + global manager , + list , + manager message , + manager question , + save , + std 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 , + free code = 20 , + continue code = 100, + + + error pre = ""7""13""10""5"FEHLER : " , + cr lf = ""13""10"" ; + +INT VAR reply , order , last order, phase number ; + +DATASPACE VAR ds := nilspace ; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ; +BOUND TEXT VAR reply msg ; +BOUND THESAURUS VAR thesaurus msg ; + +TASK VAR order task, last order task ; + +FILE VAR list file ; + +TEXT VAR error message buffer := "" + ,record + ,received name + ,create son password := "" + ,save file name + ,save write password + ,save read password + ; + + +PROC fetch (TEXT CONST file name) : + + fetch (file name, father) + +ENDPROC fetch ; + +PROC fetch (TEXT CONST file name, TASK CONST manager) : + + enable stop ; + last param (file name) ; + IF NOT exists (file name) + THEN call (fetch code, file name, manager) + ELIF overwrite permitted + THEN call (fetch code, file name, manager) ; + forget (file name, quiet) + ELSE LEAVE fetch + FI ; + IF reply = ack + THEN disable stop ; + copy (ds, file name) ; + forget (ds) + ELSE forget (ds) ; + errorstop ("Task """ + name (manager) + """antwortet nicht mit ack") + FI . + +overwrite permitted : + say ("eigene Datei """) ; + say (file name) ; + yes (""" ueberschreiben") . + +ENDPROC fetch ; + +PROC fetch (DATASPACE VAR dest, TEXT CONST file name, TASK CONST manager) : + + disable stop ; + call (fetch code, file name, manager) ; + dest := ds ; + forget (ds) + +ENDPROC fetch ; + + +PROC save : + + save (last param) + +ENDPROC save ; + +PROC save (TEXT CONST file name) : + + save (file name, father) + +ENDPROC save ; + +PROC save (TEXT CONST file name, TASK CONST manager) : + + last param (file name) ; + call (save code, file name, old (file name), manager) ; + forget (ds) + +ENDPROC save ; + +PROC save (DATASPACE CONST source, TEXT CONST file name, TASK CONST manager): + + call (save code, file name, source, manager) ; + forget (ds) + +ENDPROC save ; + + +BOOL PROC exists (TEXT CONST file name, TASK CONST manager) : + + call (exists code, file name, manager) ; + forget (ds) ; + reply = ack . + +ENDPROC exists ; + + +PROC erase : + + erase (last param) + +ENDPROC erase ; + +PROC erase (TEXT CONST file name) : + + erase (file name, father) + +ENDPROC erase ; + +PROC erase (TEXT CONST file name, TASK CONST manager) : + + call (erase code, file name, manager) ; + forget (ds) + +ENDPROC erase ; + + +PROC list (TASK CONST manager) : + + IF manager = myself + THEN list + ELSE list from manager + FI . + +list from manager : + call (list code, "", manager) ; + IF reply = ack + THEN DATASPACE VAR save ds := ds ; + forget (ds) ; + list file := sequential file (modify, save ds) ; + insert station and name of task in headline if possible ; + show (list file) ; + forget (save ds) + ELSE forget (ds) + FI . + +insert station and name of task in headline if possible : + IF headline (list file) = "" + THEN headline (list file, station number if there is one + + " Task : " + name (manager)) + FI . + +station number if there is one : + IF station (manager) > 0 + THEN "Station : " + text (station (manager)) + ELSE "" + FI . + +ENDPROC list ; + +PROC list (FILE VAR f, TASK CONST manager) : + + IF manager = myself + THEN list (f) + ELSE list from manager + FI . + +list from manager : + call (list code, "", manager) ; + IF reply = ack + THEN DATASPACE VAR save ds := ds ; + forget (ds) ; + list file := sequential file (input, save ds) ; + copy attributes (list file, f) ; + insert station and name of task in headline if possible ; + REP + getline (list file, record) ; + putline (f, record) + UNTIL eof (list file) PER ; + forget (save ds) + ELSE forget (ds) + FI . + +insert station and name of task in headline if possible : + IF headline (list file) = "" + THEN headline (list file, station number if there is one + + " Task : " + name (manager)) + FI . + +station number if there is one : + IF station (manager) > 0 + THEN "Station : " + text (station (manager)) + ELSE "" + FI . + +ENDPROC list ; + +THESAURUS OP ALL (TASK CONST manager) : + + THESAURUS VAR result ; + IF manager = myself + THEN result := all + ELSE get all from manager + FI ; + result . + +get all from manager : + call (all code, "", manager) ; + IF reply = ack + THEN get result thesaurus + ELSE result := empty thesaurus + FI . + +get result thesaurus : + thesaurus msg := ds ; + result := CONCR (thesaurus msg) ; + forget (ds) . + +ENDOP ALL ; + + +PROC call (INT CONST op code, TEXT CONST file name, TASK CONST manager) : + + DATASPACE VAR dummy space ; + call (op code, file name, dummy space, manager) + +ENDPROC call ; + +PROC call (INT CONST op code, TEXT CONST file name, + DATASPACE CONST save space, TASK CONST manager) : + + enable stop ; + send first order first time ; + send second order if required first time ; + WHILE order restart required REP + pause (10) ; + send first order (op code, file name, manager) ; + send second order if required + PER ; + error or message if required . + +send first order first time : + send first order (op code, file name, manager) ; + WHILE order restart required REP + pause (10) ; + send first order (op code, file name, manager) + PER . + +send second order if required first time : + IF reply = question ack + THEN reply msg := ds ; + IF NOT yes (reply msg) + THEN LEAVE call + ELSE send second order (op code, file name, save space, manager) + FI + ELIF reply = second phase ack + THEN send second order (op code, file name, save space, manager) + FI . + +send second order if required : + IF reply = second phase ack OR reply = question ack + THEN send second order (op code, file name, save space, manager) + FI . + +error or message if required : + IF reply = message ack + THEN reply msg := ds ; + say (reply msg) ; + say (cr lf) + ELIF reply = error nak + THEN reply msg := ds ; + errorstop (reply msg) + FI . + +order restart required : reply = nak . + +ENDPROC call ; + +PROC send first order (INT CONST op code, TEXT CONST file name, + TASK CONST manager) : + + forget (ds) ; + ds := nilspace ; + msg := ds ; + msg.name := file name ; + msg.write pass := write password ; + msg.read pass := read password ; + call (manager, op code, ds, reply) ; + IF reply < 0 + THEN errorstop ("Task nicht vorhanden") + FI . + +ENDPROC send first order ; + +PROC send second order (INT CONST op code, TEXT CONST file name, + DATASPACE CONST save space, TASK CONST manager) : + + IF op code = save code + THEN send save space + ELSE send first order (second phase ack, file name, manager) + FI . + +send save space : + forget (ds) ; + ds := save space ; + call (manager, second phase ack, ds, reply) . + +ENDPROC send second order ; + + +PROC global manager : + + global manager + (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) std manager) + +ENDPROC global manager ; + +PROC free global manager : + + global manager + (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) free manager) + +ENDPROC free global manager ; + + +PROC global manager (PROC (DATASPACE VAR, + INT CONST, INT CONST, TASK CONST) manager) : + + DATASPACE VAR local ds := nilspace ; + break ; + set autonom ; + disable stop ; + command dialogue (FALSE) ; + remember heap size ; + last order task := niltask ; + REP + forget (local ds) ; + wait (local ds, order, order task) ; + IF order <> second phase ack + THEN prepare first phase ; + manager (local ds, order, phase number, order task) + ELIF order task = last order task + THEN prepare second phase ; + manager (local ds, order, phase number, order task) + ELSE send nak + FI ; + send error if necessary ; + collect heap garbage if necessary + PER . + +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 msg := local ds ; + CONCR (reply msg) := error message ; + clear error ; + send (order task, error nak, local ds) + FI . + +remember heap size : + INT VAR old heap size := heap size . + +collect heap garbage if necessary : + IF heap size > old heap size + 8 + THEN collect heap garbage ; + old heap size := heap size + FI . + +ENDPROC global manager ; + +PROC std manager (DATASPACE VAR ds, + INT CONST order, phase, TASK CONST order task) : + + IF order task < myself OR order = begin code OR order task = supervisor + THEN free manager (ds, order, phase, order task) + ELSE errorstop ("kein Zugriffsrecht auf Task """ + name (myself) + """") + FI . + +ENDPROC 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 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 + 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 + THEN msg := ds ; + received name := msg.name + 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 (received name, msg.read pass) + THEN forget (ds) ; + ds := old (received name) ; + send (order task, ack, ds) + ELSE errorstop ("Passwort falsch") + FI . + +y erase : + msg := ds ; + received name := msg.name ; + IF NOT exists (received name) + THEN manager message ("""" + received name + """ existiert nicht", order task) + ELIF phase = 1 + THEN manager question ("""" + received name + """ loeschen", order task) + ELIF write permission (received name, msg.write pass) + THEN forget (received name, quiet) ; + send (order task, ack, ds) + ELSE errorstop ("Passwort falsch") + FI . + +y save : + IF phase = 1 + THEN y save pre + ELSE y save post + FI . + +y save pre : + IF write permission (received name, msg.write pass) + THEN save file name := received name ; + save write password := msg.write pass ; + save read password := msg.read pass ; + IF exists (received name) + THEN manager question + ("""" + received name + """ ueberschreiben", order task) + ELSE send (order task, second phase ack, ds) + FI + ELSE errorstop ("Passwort falsch") + FI . + +y save post : + forget (save file name, quiet) ; + copy (ds, save file name) ; + enter password (save file name, 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 (received name) + 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 names := ds ; + all names := all ; + send (order task, ack, ds) . + +y maintenance : + disable stop ; + call (supervisor, order, ds, reply) ; + forget (ds) ; + IF reply = ack + THEN put error message if there is one ; + REP + command dialogue (TRUE) ; + get command ("maintenance :") ; + reset editor ; + do command + UNTIL NOT on line PER ; + command dialogue (FALSE) ; + 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 . + +reset editor : + WHILE aktueller editor > 0 REP + quit + PER ; + clear error . + +save error message if there is one : + IF is error + THEN error message buffer := error message ; + clear error + FI . + +ENDPROC free manager ; + +PROC manager message (TEXT CONST message) : + + forget (ds) ; + ds := nilspace ; + reply msg := ds ; + reply msg := message ; + send (order task, message ack, ds) + +ENDPROC manager message ; + +PROC manager question (TEXT CONST question) : + + forget (ds) ; + ds := nilspace ; + reply msg := ds ; + reply msg := question ; + send (order task, question ack, ds) + +ENDPROC manager question ; + +PROC manager message (TEXT CONST message, TASK CONST receiver) : + + forget (ds) ; + ds := nilspace ; + reply msg := ds ; + reply msg := message ; + send (receiver, message ack, ds) + +ENDPROC manager message ; + +PROC manager question (TEXT CONST question, TASK CONST receiver) : + + forget (ds) ; + ds := nilspace ; + reply msg := ds ; + reply msg := question ; + send (receiver, question ack, ds) + +ENDPROC manager question ; + +PROC std begin : + + do ("monitor") + +ENDPROC std begin ; + +PROC begin password (TEXT CONST password) : + + cover tracks of old create son password ; + create son password := password ; + say (""3""13""5"") ; + cover tracks . + +cover tracks of old create son password : + replace (create son password, 1, LENGTH create son password * " ") . + +ENDPROC begin password ; + + +PROC continue channel (INT CONST channel number) : + + TASK CONST channel owner := task (channel number) ; + IF i am not channel owner + THEN IF NOT is niltask (channel owner) + THEN ask channel owner to release the channel ; + IF channel owner does not release channel + THEN errorstop ("Task """ + name (channel owner) + + """ gibt Kanal " + + text (channel number) + + " nicht frei") + FI + FI ; + continue (channel number) + FI . + +i am not channel owner : + channel <> channel number . + +ask channel owner to release the channel : + forget (ds) ; + ds := nilspace ; + pingpong (channel owner, free code, ds, reply) . + +channel owner does not release channel : + (reply <> ack) AND task exists . + +task exists : + reply <> -1 . + +ENDPROC continue channel ; + + +END PACKET global manager ; + diff --git a/system/multiuser/1.7.5/src/indexer b/system/multiuser/1.7.5/src/indexer new file mode 100644 index 0000000..e60110a --- /dev/null +++ b/system/multiuser/1.7.5/src/indexer @@ -0,0 +1,1142 @@ +(* ------------------- VERSION 59 vom 21.02.86 -------------------- *) +PACKET index program DEFINES outline, + index, + index merge: + +(* Programm zur Behandlung von Indizes aus Druckdateien + Autor: Rainer Hahn + Stand: 1.7.1 (Febr. 1984) + 1.7.4 (Maerz 1985) 'outline' +*) + +LET escape = ""27"", + blank = " ", + trenn k = ""220"", + trennzeichen = ""221"", + minuszeichen = ""45"", + kommando zeichen = "#", + trenner = " ...", + ziffernanfang = "... ", + ziffern = "1234567890", + ib0 = 1, + ib1 = 2, + ib2 = 3, + ie0 = 4, + ie1 = 5, + ie2 = 6, + max indizes = 10, (* !!Anzahl möglichetr Indizes *) + punkt grenze = 50, + leer = 0, + fuellend = 1, + nicht angekoppelt = 2; + +INT VAR seiten nr, + zeilen nr, + erste fehler zeilennr, + zeilen seit index begin, + von, + komm anf, + komm ende, + kommando index, + index nr, + inhalt nr, + anz params, + anz zwischenspeicher, + y richtung; + +BOOL VAR outline modus, + inhaltsverzeichnis offen; + +TEXT VAR dummy, + dummy2, + fehlerdummy, + einrueckung, + akt zeile, + zweite zeile, + akt index, + zweiter index, + zeile, + kommando, + datei name, + kommando liste :: "ib:1.012ie:4.012", + par1, + par2; + +FILE VAR eingabe file, + ausgabe file; + +ROW max indizes FILE VAR f; + +ROW max indizes TEXT VAR zwischenspeicher; + +LET SAMMLER = STRUCT (TEXT index text, + TEXT seitennummer zusatz, + INT zustand); + +ROW max indizes SAMMLER VAR sammler; + +(******************************* outline-Routine **********************) + +PROC outline: + outline (last param) +END PROC outline; + +PROC outline (TEXT CONST eingabe datei): + outline modus := TRUE; + disable stop; + do outline (eingabe datei); + IF is error + THEN put error; + clear error + FI; + enable stop; + IF anything noted + THEN to line (eingabe file, erste fehler zeilennr); + note edit (eingabe file) + ELSE to line (eingabe file, 1); + last param (eingabe datei + ".outline") + FI; + line +END PROC outline; + +PROC do outline (TEXT CONST eingabe datei): + enable stop; + IF exists (eingabe datei) + THEN initialisiere bildschirm; + deaktiviere sammler; + anfrage auf inhaltsverzeichnis; + einrichten fuer zeilennummer ausgabe; + richte dateien ein; + verarbeite datei; + ELSE errorstop ("Datei nicht vorhanden") + FI; + cursor (1, y richtung + 1). + +initialisiere bildschirm: + eingabe file := sequential file (modify, eingabe datei); + page; + put ("OUTLINE"); put ("( für"); put (lines (eingabe file)); put ("Zeilen):"); + put (eingabe datei); + put ("->"); out (eingabe datei); out (".outline"); + cursor (1, 3). + +anfrage auf inhaltsverzeichnis: + put ("Bitte Index-Nr. für Inhaltsverzeichnis:"); + dummy := "9"; + REP + editget (dummy); + inhalt nr := int (dummy); + IF last conversion ok AND inhalt nr > 0 AND inhalt nr < 10 + THEN LEAVE anfrage auf inhaltsverzeichnis + ELSE line; put ("Nr. zwischen 0 und 9, bitte nochmal:") + FI + END REP. + +einrichten fuer zeilennummer ausgabe: + line (2); + INT VAR x; + get cursor (x, y richtung). + +richte dateien ein: + inhaltsverzeichnis offen := FALSE; + anz zwischenspeicher := 0; + einrueckung := ""; + erste fehler zeilennr := 0; + ggf ueberschreibe anfrage (eingabe datei + ".outline"); + ausgabe file := sequential file (output, eingabe datei + ".outline"); + to line (eingabe file, 1); + col (eingabe file, 1). + +verarbeite datei: + REP + suche naechste zeile mit kommandozeichen; + IF pattern found + THEN verarbeite ggf index kommandos + FI; + IF line no (eingabe file) = lines (eingabe file) + THEN LEAVE verarbeite datei + ELSE down (eingabe file); + col (eingabe file, 1) + FI + END REP. + +verarbeite ggf index kommandos: + komm anf := col (eingabe file); + von := komm anf; + REP + WHILE komm anf <> 0 REP + komplettiere alle fuellenden sammler (von, komm anf - 1); + entschluessele kommando; + von := komm ende + 1; + setze kommando um + END REP; + IF alle sammler leer + THEN LEAVE verarbeite ggf index kommandos + ELSE fuelle sammler mit restzeile und lese naechste zeile + FI + UNTIL line no (eingabe file) = lines (eingabe file) END REP. + +setze kommando um: + SELECT kommando index OF + CASE ib0, ib1, ib2: + zeilen seit index begin := 0; + IF anz params = 0 + THEN index nr := 1 + ELSE index nr := int (par1) + FI; + index anfang; + CASE ie0, ie1, ie2: + IF anz params = 0 + THEN index nr := 1 + ELSE index nr := int (par1) + FI; + index ende; + OTHERWISE + END SELECT. + +index anfang: + IF gueltiger index + THEN fange neuen index an + ELSE fehler (18, par1) + FI. + +fange neuen index an: + IF sammler fuellend (index nr) + THEN fehler (20, text (index nr)) + ELIF index ist inhaltsverzeichnis + THEN stelle einrueckung fest; + sammler [index nr] . index text := einrueckung; + einrueckung CAT " "; + inhaltsverzeichnis offen := TRUE + ELIF index ist hauptindex + THEN sammler [index nr] . index text := einrueckung; + ELSE sammler [index nr] . index text := einrueckung; + sammler [index nr] . index text CAT text (index nr); + sammler [index nr] . index text CAT " --> " + FI; + sammler [index nr] . zustand := fuellend. + +stelle einrueckung fest: + einrueckung := ""; + INT VAR punkt pos :: pos (zeile, "."); + WHILE punkt pos <> 0 REP + einrueckung CAT " "; + punkt pos := pos (zeile, ".", punkt pos + 1) + END REP. + +index ende: + IF gueltiger index + THEN IF sammler fuellend (index nr) + THEN IF kommando index = ie2 + THEN sammler [index nr] . index text CAT par2; + FI; + leere sammler in outline datei (index nr) + ELSE fehler (21, text (index nr)) + FI + ELSE fehler (18, text (index nr)) + FI; + sammler [index nr] . zustand := leer. + +index ist inhaltsverzeichnis: + index nr = inhalt nr. + +index ist hauptindex: + index nr = 1. +END PROC do outline; + +PROC leere sammler in outline datei (INT CONST nr): + IF index ist inhaltsverzeichnis + THEN line (ausgabe file); + putline (ausgabe file, sammler [nr] . index text); + inhaltsverzeichnis offen := FALSE; + leere zwischenspeicher + ELIF inhaltsverzeichnis offen + THEN fuelle zwischenspeicher + ELSE putline (ausgabe file, sammler [nr] . index text) + FI; + sammler [nr] . zustand := leer. + +index ist inhaltsverzeichnis: + nr = inhalt nr. + +leere zwischenspeicher: + INT VAR i; + FOR i FROM 1 UPTO anz zwischenspeicher REP + putline (ausgabe file, zwischenspeicher [i]) + END REP; + anz zwischenspeicher := 0. + +fuelle zwischenspeicher: + anz zwischenspeicher INCR 1; + IF anz zwischenspeicher <= max indizes + THEN zwischenspeicher [anz zwischenspeicher] := sammler [nr] . index text + FI. +END PROC leere sammler in outline datei; + +(********************* Utility Routinen *****************************) + +PROC ggf ueberschreibe anfrage (TEXT CONST d): + yrichtung INCR 1; + cursor (1, yrichtung); + IF exists (d) + THEN IF yes (d + " überschreiben") + THEN forget (d, quiet) + ELSE put ("wird angefügt") + FI + FI; + IF outline modus + THEN line + ELSE cursor (7, 3) + FI +END PROC ggf ueberschreibe anfrage; + +BOOL PROC gueltiger index: + last conversion ok AND index nr > 0 AND index nr <= max indizes +END PROC gueltiger index; + +PROC suche naechste zeile mit kommandozeichen: + TEXT VAR steuerzeichen :: incharety; + IF steuerzeichen = escape + THEN errorstop ("Abbruch durch ESC") + FI; + downety (eingabe file, "#", lines (eingabe file)); + read record (eingabe file, zeile); + zeilen nr := line no (eingabe file); + cout (zeilen nr); +END PROC suche naechste zeile mit kommandozeichen; + +PROC entschluessele kommando: + komm ende := pos (zeile, kommando zeichen, komm anf + 1); + IF komm ende <> 0 + THEN hole kommando text; + TEXT CONST kommando anfangs zeichen :: kommando SUB 1; + IF pos ("-/"":*", kommando anfangs zeichen) = 0 + THEN analysiere kommando + FI; + komm anf := pos (zeile, kommando zeichen, komm ende + 1); + ELSE fehler (2, ""); + komm anf := 0; + LEAVE entschluessele kommando + END IF. + +hole kommando text: + kommando := subtext (zeile, komm anf + 1, komm ende - 1). + +analysiere kommando: + kommando index := 0; + analyze command (kommando liste, kommando, 3, + kommando index, anz params, par1, par2); + disable stop; + command error; + IF is error + THEN dummy := error message; + clear error; + dummy CAT " -> "; + dummy CAT kommando; + fehler (22, dummy); + enable stop; + komm anf := 0; + kommando index := 0; + LEAVE entschluessele kommando + END IF; + enable stop +END PROC entschluessele kommando; + +PROC fuelle sammler mit restzeile und lese naechste zeile: + restzeile auffuellen; + naechste zeile und zaehlen; + zeilen seit index begin INCR 1; + von := pos (zeile, ""33"", ""255"", 1); + komm anf := pos (zeile, kommando zeichen, von); + IF zeilen seit index begin > 10 (* !!Anzahl Zeilen!! *) + THEN index aufnahme stoppen; + fehler (17, ""); + LEAVE fuelle sammler mit restzeile und lese naechste zeile + ELIF seitenbegrenzung + THEN index aufnahme stoppen; + fehler (7, ""); + END IF. + +restzeile auffuellen: + IF silbentrennung + THEN IF durch silbentrennung gewandeltes k + THEN replace (zeile, length (zeile) - 1, "c") + FI; + komplettiere alle fuellenden sammler (von, length (zeile) - 1) + ELIF bindestrich + THEN komplettiere alle fuellenden sammler (von, length (zeile)); + ELSE komplettiere alle fuellenden sammler (von, length (zeile)); + zeile := " "; + komplettiere alle fuellenden sammler (1, 1) + END IF. + +silbentrennung: + (zeile SUB length (zeile)) = trennzeichen. + +durch silbentrennung gewandeltes k: + (zeile SUB length (zeile) - 1) = trenn k. + +bindestrich: + (zeile SUB length (zeile)) = minuszeichen AND + (zeile SUB length (zeile) - 1) <> blank. +END PROC fuelle sammler mit restzeile und lese naechste zeile; + +(**************************** index routine *************************) + +PROC index: + index (last param) +END PROC index; + +PROC index (TEXT CONST eingabe datei): + outline modus := FALSE; + last param (eingabe datei); + disable stop; + suche indizes (eingabe datei); + IF is error + THEN put error; + clear error; + FI; + enable stop; + nachbehandlung. + +nachbehandlung: + IF anything noted + THEN to line (eingabe file, erste fehler zeilennr); + note edit (eingabe file) + ELSE to line (eingabe file, 1) + FI; + line. +END PROC index; + +(************************** eigentliche index routine *****************) + +PROC suche indizes (TEXT CONST eingabe datei): + enable stop; + IF exists (eingabe datei) + THEN IF pos (eingabe datei, ".p") = 0 + THEN errorstop ("Datei ist keine Druckdatei") + FI; + eingabe file := sequential file (modify, eingabe datei); + datei name := eingabe datei; + erste fehler zeilennr := 0; + initialisiere bildschirm; + deaktiviere sammler; + verarbeite datei; + sortiere die index dateien; + ELSE errorstop ("Datei existiert nicht") + END IF. + +initialisiere bildschirm: + page; + put ("INDEX"); put ("(für"); put (lines (eingabe file)); put ("Zeilen):"); + put (eingabe datei); + cursor (1, 3); + out ("Zeile: "); + out ("Seite:"); + y richtung := 4; + cursor (7, 3). + +verarbeite datei: + lese bis erste seitenbegrenzung; + WHILE NOT eof (eingabe file) REP + lese bis naechste seitenbegrenzung; + setze seiten nr; + gehe auf erste textzeile zurueck; + verarbeite indizes dieser seite + END REP. + +lese bis erste seitenbegrenzung: + to line (eingabe file, 1); + col (eingabe file, 1); + read record (eingabe file, zeile); + zeilen nr := 1; + cout (1); + REP + IF eof (eingabe file) + THEN errorstop ("Datei ist keine Druckdatei") + ELIF seitenbegrenzung + THEN LEAVE lese bis erste seitenbegrenzung + ELSE naechste zeile und zaehlen + END IF + END REP. + +lese bis naechste seitenbegrenzung: + IF line no (eingabe file) >= lines (eingabe file) + THEN LEAVE verarbeite datei + ELSE down (eingabe file) + FI; + INT VAR erste textzeile := line no (eingabe file); + down (eingabe file, "#page##----", lines (eingabe file)); + IF pattern found + THEN read record (eingabe file, zeile) + ELSE LEAVE verarbeite datei + FI. + +gehe auf erste textzeile zurueck: + to line (eingabe file, erste textzeile); + read record (eingabe file, zeile); + zeilennr := lineno (eingabe file); + cout (zeilennr). + +verarbeite indizes dieser seite: + REP + suche naechste zeile mit kommandozeichen; + IF seitenbegrenzung + THEN LEAVE verarbeite indizes dieser seite + FI; + verarbeite index kommandos der naechsten zeilen; + IF seitenbegrenzung + THEN LEAVE verarbeite indizes dieser seite + FI; + down (eingabe file); + col (eingabe file, 1) + END REP. + +verarbeite index kommandos der naechsten zeilen: + komm anf := col (eingabe file); + von := komm anf; + REP + WHILE komm anf <> 0 REP + komplettiere alle fuellenden sammler (von, komm anf - 1); + entschluessele kommando; + von := komm ende + 1; + setze kommando um + END REP; + IF alle sammler leer + THEN LEAVE verarbeite index kommandos der naechsten zeilen + ELSE fuelle sammler mit restzeile und lese naechste zeile + END IF + UNTIL seitenbegrenzung ENDREP; + fehler (7, ""). + +setze kommando um: +SELECT kommando index OF +CASE ib0, ib1, ib2: + zeilen seit index begin := 0; + IF anz params = 0 + THEN index nr := 1 + ELSE index nr := int (par1) + FI; + index anfang; +CASE ie0, ie1, ie2: + IF anz params = 0 + THEN index nr := 1 + ELSE index nr := int (par1) + FI; + index ende; +OTHERWISE +ENDSELECT. + +index anfang: + IF gueltiger index + THEN fange neuen index an + ELSE fehler (18, par1) + END IF. + +fange neuen index an: + IF sammler fuellend (index nr) + THEN fehler (20, text (index nr)) + ELSE fuelle sammler mit (index nr, ""); + IF anz params = 2 + THEN zusatz an seitennummer (index nr, par2) + ELSE zusatz an seitennummer (index nr, "") + END IF + END IF. + +index ende: + IF gueltiger index + THEN schreibe fuellenden sammler + ELSE fehler (18, text (index nr)) + END IF. + +schreibe fuellenden sammler: + IF sammler fuellend (index nr) + THEN IF anz params = 2 + THEN fuelle sammler mit (index nr, par2) + ENDIF; + schreibe sammler (index nr); + ELSE fehler (21, text (index nr)) + END IF. +END PROC suche indizes; + +(********************* Service Routinen ************************) + +BOOL PROC seitenbegrenzung: + subtext (zeile, 2, 5) = "page" AND subtext (zeile, 8, 12) = "-----" +END PROC seitenbegrenzung; + +PROC setze seiten nr: + seiten nr := int (subtext (zeile, ziffern anfang, ziffernende)); + cursor (20, 3); + put (seiten nr); + cursor (7, 3). + +ziffern anfang: + pos (zeile, "0", "9", 10). + +ziffern ende: + pos (zeile, " ", ziffern anfang) - 1 +END PROC setze seiten nr; + +PROC naechste zeile und zaehlen: + zeilen nr INCR 1; + cout (zeilen nr); + naechste zeile +END PROC naechste zeile und zaehlen; + +PROC naechste zeile: + down (eingabe file); + read record (eingabe file, zeile); + col (eingabe file, 1) +END PROC naechste zeile; + +(**************************** Fehler - Routine *********************) + +PROC fehler (INT CONST nr, TEXT CONST addition): + IF erste fehler zeilennr = 0 + THEN erste fehler zeilennr := zeilen nr + FI; + yrichtung INCR 1; + IF yrichtung > 23 + THEN yrichtung := 23; + FI; + cursor (1, yrichtung); + fehler melden; + fehlermeldung auf terminal ausgeben; + IF outline modus + THEN line + ELSE cursor (7, 3) + FI. + +fehler melden: + report text processing error (nr, zeilen nr, fehlerdummy, addition). + +fehlermeldung auf terminal ausgeben: + out (fehlerdummy); +END PROC fehler; + +PROC warnung (INT CONST nr, TEXT CONST addition): + IF erste fehler zeilennr = 0 + THEN erste fehler zeilennr := zeilen nr + FI; + yrichtung INCR 1; + IF yrichtung > 23 + THEN yrichtung := 23; + FI; + cursor (1, yrichtung); + fehler melden; + meldung auf terminal ausgeben; + IF outline modus + THEN line + ELSE cursor (7, 3) + FI. + +fehler melden: + report text processing warning (nr, zeilen nr, fehlerdummy, addition). + +meldung auf terminal ausgeben: + out (fehlerdummy); +END PROC warnung; + +(************************** Sammler-Dienste **************************) + +PROC index aufnahme stoppen: + zeile := "INDEX FEHLER"; + komplettiere alle fuellenden sammler (1, length (zeile)); + schreibe alle sammler; + read record (eingabe file, zeile) +END PROC index aufnahme stoppen; + +PROC deaktiviere sammler: + INT VAR i; + FOR i FROM 1 UPTO max indizes REP + sammler [i] . zustand := nicht angekoppelt + END REP +END PROC deaktiviere sammler; + +BOOL PROC sammler fuellend (INT CONST nr): + sammler [nr] . zustand = fuellend +END PROC sammler fuellend; + +BOOL PROC sammler angekoppelt (INT CONST nr): + NOT (sammler [nr] . zustand = nicht angekoppelt) +END PROC sammler angekoppelt; + +BOOL PROC alle sammler leer: + INT VAR i; + FOR i FROM 1 UPTO max indizes REP + IF sammler [i] . zustand = fuellend + THEN LEAVE alle sammler leer WITH FALSE + END IF + END REP; + TRUE +END PROC alle sammler leer; + +PROC komplettiere alle fuellenden sammler (INT CONST von pos, bis pos): + INT VAR i; + IF von pos > bis pos + THEN LEAVE komplettiere alle fuellenden sammler + FI; + dummy := subtext (zeile, von pos, bis pos); + FOR i FROM 1 UPTO max indizes REP + IF sammler [i] . zustand = fuellend + THEN sammler [i] . index text CAT dummy; + FI + END REP; +END PROC komplettiere alle fuellenden sammler; + +PROC fuelle sammler mit (INT CONST nr, TEXT CONST dazu): + IF sammler [nr] . zustand = nicht angekoppelt + THEN ankoppeln; + sammler [nr] . index text := dazu + ELIF sammler [nr] . zustand = leer + THEN sammler [nr] . index text := dazu + ELIF sammler fuellend (nr) + THEN sammler [nr] . index text CAT dazu + END IF; + sammler [nr] . zustand := fuellend. + +ankoppeln: + yrichtung INCR 1; + cursor (1, yrichtung); + put ("Indizes"); + put (nr); + put ("gehen in Datei:"); + dummy := datei name; + IF subtext (dummy, length (dummy) - 1) = ".p" + THEN replace (dummy, length (dummy) - 1, ".i") + ELSE dummy CAT ".i"; + END IF; + dummy CAT text (nr); + out (dummy); + ggf ueberschreibe anfrage (dummy); + f [nr] := sequential file (output, dummy); + copy attributes (eingabe file, f[nr]); + cursor (7, 3) +END PROC fuelle sammler mit; + +PROC zusatz an seitennummer (INT CONST nr, TEXT CONST zus text): + sammler [nr] . seitennummer zusatz := zus text +END PROC zusatz an seitennummer; + +PROC schreibe sammler (INT CONST nr): + entferne leading blanks; + IF outline modus + THEN leere sammler in outline datei (nr) + ELSE fuege punkte an; + fuege seiten nr an; + fuege zusatz an seitennummer an; + fuege absatzzeichen an; + leere sammler + FI. + +entferne leading blanks: + WHILE (aufgesammelter text SUB 1) = blank REP + delete char (aufgesammelter text, 1) + END REP. + +fuege punkte an: + aufgesammelter text CAT trenner; + IF length (aufgesammelter text) < punkt grenze + THEN dummy := (punkt grenze - length (aufgesammelter text)) * "."; + aufgesammelter text CAT dummy + END IF; + aufgesammelter text CAT " ". + +fuege seiten nr an: + aufgesammelter text CAT text (seiten nr). + +fuege zusatz an seitennummer an: + aufgesammelter text CAT sammler [nr]. seitennummer zusatz. + +fuege absatzzeichen an: + aufgesammelter text CAT blank. + +leere sammler: + putline (f [nr], aufgesammelter text); + sammler [nr] . zustand := leer. + +aufgesammelter text: + sammler [nr] . index text +END PROC schreibe sammler; + +PROC schreibe alle sammler: + INT VAR i; + FOR i FROM 1 UPTO max indizes REP + IF sammler fuellend (i) + THEN schreibe sammler (i) + END IF + END REP +END PROC schreibe alle sammler; + +(**************** Sortieren und Indizes zusammenfuehren ***************) + +PROC sortiere die index dateien: +INT VAR i; + FOR i FROM 1 UPTO max indizes REP + IF index datei erstellt + THEN sortiere diese datei + END IF + END REP. + +index datei erstellt: + sammler angekoppelt (i). + +sortiere diese datei: + y richtung INCR 1; + cursor (1, yrichtung); + dummy := datei name; + IF subtext (dummy, length (dummy) - 1) = ".p" + THEN replace (dummy, length (dummy) - 1, ".i") + ELSE dummy CAT ".i"; + END IF; + dummy CAT text (i); + put (dummy); + IF yes ("sortieren") + THEN lex sort (dummy); + eintraege zusammenziehen (dummy) + END IF; +END PROC sortiere die index dateien; + +PROC eintraege zusammenziehen (TEXT CONST fname): + FILE VAR sorted file :: sequential file (modify, fname); + INT VAR i :: 1; + to line (sorted file, 1); + read record (sorted file, akt zeile); + akt index := subtext (akt zeile, 1, pos (akt zeile, trenner) - 1); + down (sorted file); + WHILE NOT eof (sorted file) REP + read record (sorted file, zweite zeile); + zweiter index := subtext (zweitezeile, 1, pos (zweitezeile, trenner)-1); + i INCR 1; + cout (i); + IF akt index LEXEQUAL zweiter index + THEN fuege seitennummern von zweite in akt zeile ein + ELSE akt zeile := zweite zeile; + akt index := zweiter index + FI; + down (sorted file) + END REP; + to line (sorted file, 1). + +fuege seitennummern von zweite in akt zeile ein: + hole seitennummer der zweiten zeile; + fuege in akt zeile ein; + delete record (sorted file); + up (sorted file); + write record (sorted file, akt zeile). + +hole seitennummer der zweiten zeile: + INT VAR von := pos (zweite zeile, ziffernanfang) + length (ziffernanfang), + bis := von; + WHILE pos (ziffern, zweite zeile SUB bis) <> 0 REP + bis INCR 1 + END REP; + bis DECR 1; + INT VAR zweite nummer := int( subtext (zweite zeile, von, bis)); + TEXT VAR zweiter nummern text := + subtext (zweite zeile, von, length (zweite zeile) - 1). + +fuege in akt zeile ein: + suche einfuege position in akt zeile; + fuege ein. + +suche einfuege position in akt zeile: + INT VAR einfuege pos := + pos (akt zeile, ziffernanfang) + length (ziffernanfang); + von := einfuege pos; + REP + hole neue nummer; + UNTIL am ende der zeile END REP. + +am ende der zeile: + von >= length (akt zeile). + +hole neue nummer: + bis := von; + WHILE pos (ziffern, akt zeile SUB bis) <> 0 REP + bis INCR 1 + END REP; + bis DECR 1; + IF bis < von + THEN bis := von + FI; + INT VAR neue nummer := int (subtext (akt zeile, von, bis)); + IF zweite nummer = neue nummer + THEN fuege ggf zweiten nummern text mit textanhang ein + ELIF zweite nummer > neue nummer + THEN einfuege pos := von; + von := pos (akt zeile, ", ", bis) + 2; + IF von <= 2 + THEN von := length (akt zeile) + FI + ELSE einfuege pos := von; + LEAVE suche einfuege position in akt zeile + FI. + +fuege ggf zweiten nummern text mit textanhang ein: + bis := pos (akt zeile, ", ", von); + IF bis <= 0 + THEN bis := length (akt zeile); + FI; + IF die beiden nummern sind mit textanhang gleich + THEN LEAVE fuege in akt zeile ein + ELSE einfuege pos := von; + LEAVE suche einfuege position in akt zeile + FI. + +die beiden nummern sind mit textanhang gleich: + zweiter nummern text = subtext (akt zeile, von, bis - 1). + +fuege ein: + IF am ende der zeile + THEN change (akt zeile, length (akt zeile), length (akt zeile), ", "); + akt zeile CAT (zweiter nummern text + " ") + ELSE zweiter nummern text CAT ", "; + change + (akt zeile, einfuege pos, einfuege pos -1, zweiter nummern text); + FI. +END PROC eintraege zusammenziehen; + +(*********************** merge routine *********************) + +PROC index merge (TEXT CONST i1, i2): + disable stop; + indizes zusammenziehen (i1, i2); + IF is error + THEN put error; + clear error; + ELSE last param (i2) + FI; + enable stop; + line. +END PROC index merge; + +PROC indizes zusammenziehen (TEXT CONST i1, i2): + enable stop; + ueberschrift schreiben; + dateien assoziieren; + i1 vor i2 einfuegen; + sortieren; + forget (i1). + +dateien assoziieren: + IF exists (i1) + THEN eingabe file := sequential file (modify, i1) + ELSE errorstop (i1 + "existiert nicht") + END IF; + IF exists (i2) + THEN f[2] := sequential file (modify, i2) + ELSE errorstop (i2 + "existiert nicht") + END IF. + +ueberschrift schreiben: + page; + put ("INDEX MERGE:"); put (i1); put ("-->"); put (i2); + cursor (1, 3); + yrichtung := 3. + +i1 vor i2 einfuegen: + to first record (eingabe file); + to first record (f [2]); + zeilen nr := 0; + WHILE NOT eof (eingabe file) REP + zeilennr INCR 1; + cout (zeilennr); + read record (eingabe file, zeile); + insert record (f [2]); + write record (f[2], zeile); + down (f[2]); + down (eingabe file); + END REP. + +sortieren: + y richtung INCR 1; + cursor (1, yrichtung); + put (i2); + IF yes ("sortieren") + THEN lex sort (i2); + eintraege zusammenziehen (i2) + END IF +END PROC indizes zusammenziehen; +END PACKET index program; + +PACKET columns DEFINES col put, col get, col lineform, col autoform: + +INT VAR ende pos, + anfangs pos; + +FILE VAR file, spaltenfile; + +TEXT VAR dummy, + spalte, + zeile; + +LET geschuetztes blank = ""223"", + blank = " "; + +BOOL VAR spalte loeschen; + +DATASPACE VAR local space := nilspace; + +PROC col lineform: + spalte loeschen := TRUE; + columns put; + file := sequential file (modify, local space); + lineform (spaltenfile); + col get +END PROC col lineform; + +PROC col autoform: + spalte loeschen := TRUE; + columns put; + file := sequential file (modify, local space); + autoform (spaltenfile); + col get +END PROC col autoform; + +PROC col put: + spalte loeschen := yes ("Spalte löschen"); + columns put +END PROC col put; + +PROC columns put: + IF aktueller editor > 0 AND mark + THEN editor bereich bearbeiten + ELSE errorstop ("col put arbeitet nur auf markierten Bereich im Editor") + FI. + +editor bereich bearbeiten: + file := editfile; + anfangs pos einholen; + ende pos einholen; + INT VAR letzte zeile := line no (file), + erste zeile := mark line no (file); + to line (file, erste zeile); + col (file, 1); + spalten put; + to line (file, erste zeile); + col (file, anfangs pos); + mark (false); + ueberschrift neu. + +anfangs pos einholen: + anfangs pos := mark col (file). + +ende pos einholen: + ende pos := col (file) - 1; + IF ende pos < anfangs pos + THEN errorstop ("Markierungsende muß rechts vom -anfang sein") + FI. + +spalten put: + spaltendatei einrichten; + satznr neu; + WHILE line no (file) <= letzte zeile REP + satznr zeigen; + read record (file, zeile); + spalte herausholen; + spalte schreiben; + down (file) + END REP. + +spaltendatei einrichten: + forget (local space); + local space := nilspace; + spaltenfile := sequential file (output, local space). + +spalte herausholen: + spalte := subtext (zeile, anfangs pos, ende pos); + IF spalte loeschen + THEN change (zeile, anfangs pos, ende pos, ""); + write record (file, zeile) + FI; + WHILE length (spalte) > 1 AND (spalte SUB length (spalte)) = blank REP + delete char (spalte, length (spalte)) + END REP; + IF spaltenende ist geschuetztes blank + THEN delete char (spalte, length (spalte)); + spalte CAT " " + FI. + +spalte schreiben: + putline (spaltenfile, spalte). + +spaltenende ist geschuetztes blank: + (spalte SUB length (spalte)) = geschuetztes blank. +END PROC columns put; + +PROC col get: + IF aktueller editor > 0 + THEN editor bereich bearbeiten + ELSE errorstop ("col put kann nur im Editor aufgerufen werden") + FI; + columns get; + alles neu. + +editor bereich bearbeiten: + file := editfile; + spaltenfile := sequential file (input, local space). + +columns get: + anfangs pos := col (file) - 1; + spaltenbreite feststellen; + col (file, 1); + satznr neu; + WHILE NOT eof (spaltenfile) REP + satznr zeigen; + getline (spaltenfile, spalte); + read record (file, zeile); + spalte ggf verbreitern; + zeile ggf verbreitern; + spalte in zeile einfuegen; + zeile schreiben; + down (file); + IF eof (file) + THEN errorstop ("Spalte hat zu viele Zeilen für die Datei") + FI + END REP. + +zeile ggf verbreitern: + WHILE length (zeile) < anfangs pos REP + zeile CAT blank + END REP. + +spaltenbreite feststellen: + INT VAR anz spaltenzeichen :: 0; + WHILE NOT eof (spaltenfile) REP + getline (spaltenfile, spalte); + IF length (spalte) > anz spaltenzeichen + THEN anz spaltenzeichen := length (spalte) + FI + END REP; + spaltenfile := sequential file (input, local space). + +spalte ggf verbreitern: + IF (spalte SUB length (spalte)) = blank + THEN delete char (spalte, length (spalte)); + spalte CAT geschuetztes blank + FI; + IF anzufuegende spalte soll nicht ans zeilenende + THEN spalte verbreitern + FI. + +anzufuegende spalte soll nicht ans zeilenende: + anfangs pos <= length (zeile). + +spalte verbreitern: + WHILE length (spalte) < anz spaltenzeichen REP + spalte CAT blank + END REP. + +spalte in zeile einfuegen: + dummy := subtext (zeile, 1, anfangs pos); + dummy CAT spalte; + dummy CAT subtext (zeile, anfangs pos + 1); + zeile := dummy. + +zeile schreiben: + write record (file, zeile). +END PROC col get; +END PACKET columns; + diff --git a/system/multiuser/1.7.5/src/konfigurieren b/system/multiuser/1.7.5/src/konfigurieren new file mode 100644 index 0000000..016fef2 --- /dev/null +++ b/system/multiuser/1.7.5/src/konfigurieren @@ -0,0 +1,254 @@ +(* ------------------- VERSION 4 22.04.86 ------------------- *) +PACKET konfigurieren DEFINES (* Autor: D.Heinrichs *) + + + + ansi cursor, + baudrate , + bits , + cursor logic , + elbit cursor , + enter incode , + enter outcode , + flow , + input buffer size , + link , + new configuration , + new type , + ysize : + +LET max dtype nr = 5, (* maximum number of active device tables *) + device table = 32000, + ack = 0 ; + + +INT VAR next outstring, + next instring; + +BOUND STRUCT (ALIGN space, (* umsetzcodetabelle *) + ROW 128 INT outcodes, + ROW 64 INT outstrings, + ROW 64 INT instrings) VAR x; + + +ROW max dtype nr DATASPACE VAR device code table; + +THESAURUS VAR dtypes ; + + +PROC new configuration : + + dtypes := empty thesaurus ; + INT VAR i ; + insert (dtypes, "psi", i) ; + insert (dtypes, "transparent", i) ; + FOR i FROM 1 UPTO max dtype nr REP + forget (device code table (i)) + PER . + +ENDPROC new configuration ; + + +PROC block out (DATASPACE CONST ds, INT CONST page, code): + INT VAR err; + block out (ds,page,0,code,err); + announce error (err) +END PROC block out; + +PROC announce error (INT CONST err): + SELECT err OF + CASE 0: + CASE 1: errorstop ("unbekanntes Terminalkommando") + CASE 2: errorstop ("Nummer der Terminal-Typ-Tabelle falsch") + CASE 3: errorstop ("falsche Terminalnummer") + OTHERWISE errorstop ("blockout: unzulaessiger Kanal") + ENDSELECT +END PROC announce error; + +PROC flow (INT CONST nr, INT CONST dtype): + control (6, dtype, nr) +END PROC flow; + +PROC ysize (INT CONST channel ,new size, INT VAR old size) : + control (11, channel, new size, old size) +ENDPROC ysize ; + +PROC input buffer size (INT CONST nr,size): + INT VAR err; + control (2,nr,size,err) +END PROC input buffer size; + +PROC baudrate (INT CONST nr, rate) : + control (8, rate, nr) +ENDPROC baudrate ; + +PROC bits (INT CONST channel, number, parity) : + bits (channel, number-1 + 8*parity) +ENDPROC bits ; + +PROC bits (INT CONST channel, key) : + control (9, key, channel) +ENDPROC bits ; + +PROC control (INT CONST function, key, channel) : + + INT VAR err ; + IF key > -128 AND key < 127 + THEN control (function, channel, key, err) + ELIF key = -128 + THEN control (function, channel, -maxint-1, err) + FI + +ENDPROC control ; + + +PROC new type (TEXT CONST dtype): + x := new (dtype); + type (old (dtype), device table); + next outstring := 4; + next instring := 0; + INT VAR i; + (* Defaults, damit trmpret den cursor mitfuehrt: *) + FOR i FROM 1 UPTO 6 REP + enter outcode (i,i) + PER; + enter outcode (8,8); + enter outcode (10,10); + enter outcode (13,13); + enter outcode (14,126); + enter outcode (15,126); +END PROC new type; + +INT PROC activate dtype (TEXT CONST dtype): + + INT VAR i := link (dtypes, dtype); + IF (exists (dtype) CAND type (old (dtype)) = device table) + THEN IF i <= 0 + THEN insert (dtypes, dtype, i); + FI; + forget(device code table (i-2)); + device code table (i-2) := old (dtype) + FI; + IF i > max dtype nr +2 (* 5 neue Typen erlaubt *) + THEN delete (dtypes,i); + error stop ("Anzahl Terminaltypen > "+text (i));0 + ELIF i <= 0 + THEN error stop ("Unbekannter Terminaltyp" + dtype); 0 + ELSE i + FI. + +END PROC activate dtype; + +PROC link (INT CONST nr, TEXT CONST dtype): + + INT VAR lst nr := activate dtype (dtype)-3; + IF lst nr < 0 + THEN lst nr INCR 256 (* fuer std terminal und std device *) + ELSE blockout (device code table(lst nr+1), 2, lst nr); + FI; + INT VAR err := 0; + control (1,nr,lst nr,err) ; + announce error(err) + +END PROC link; + + +PROC enter outcode (INT CONST eumel code, ziel code): + + IF ziel code < 128 + THEN simple entry (eumel code, ziel code) + ELSE enter outcode (eumel code, 0, code (ziel code)) + FI . + +ENDPROC enter outcode ; + +PROC simple entry (INT CONST eumel code, ziel code) : + + INT CONST position := eumel code DIV 2 +1, + teil := eumel code - 2*position + 2; + TEXT VAR h :=" "; + replace (h,1,out word); + replace (h,1+teil,code (ziel code)); + out word := (h ISUB 1). + + out word: x.outcodes (position). + +END PROC simple entry ; + +PROC enter outcode (INT CONST eumel code, wartezeit, + TEXT CONST sequenz): + + INT VAR i; + simple entry (eumel code, next outstring + 128); + enter part (x.outstrings, next outstring, wartezeit); + FOR i FROM 1 UPTO length (sequenz) REP + enter part (x.outstrings, next outstring + i, code (sequenzSUBi)) + PER; + next outstring INCR length (sequenz)+2; + abschluss. + + abschluss: + enter part (x.outstrings, next outstring-1, 0) +END PROC enter outcode; + +PROC enter outcode (INT CONST eumelcode, TEXT CONST wert): + enter outcode (eumelcode,code(wert)) +END PROC enter outcode; + +PROC enter part (ROW 64 INT VAR a,INT CONST index, wert): + INT CONST position := index DIV 2 +1, + teil := index - 2*position + 2; + IF position > 64 THEN errorstop ("Ueberlauf der Terminaltyptabelle") FI; + TEXT VAR h :=" "; + replace (h,1,out word); + replace (h,1+teil,code (wert)); + out word := (h ISUB 1). + + out word: a (position). +END PROC enter part; + + +PROC enter incode (INT CONST elan code, TEXT CONST sequenz): + IF elan code > 254 OR elan code < 0 THEN errorstop ("kein Eingabecode") + ELSE + INT VAR i; + enter part (x.instrings, next instring, elan code); + FOR i FROM 1 UPTO length (sequenz) REP + enter part (x.instrings, next instring + i, code (sequenzSUBi)) + PER; + next instring INCR length (sequenz)+2; + + FI + +END PROC enter incode; + +PROC cursor logic (INT CONST dist, TEXT CONST pre, mid, post): + + cursor logic (dist,255,pre,mid,post) + +END PROC cursor logic; + +PROC ansi cursor (TEXT CONST pre, mid, post): + + cursor logic (0, 1, pre, mid, post) + +END PROC ansi cursor; + +PROC cursor logic (INT CONST dist, modus, TEXT CONST pre, mid, post): + + enter part (x.outstrings,2,dist); + enter part (x.outstrings,3,dist); + enter part (x.outstrings,0,modus); + enter part (x.outstrings,1,modus); + enter outcode (6,0,pre+""0"y"+mid+""0"x"+post+""0"") + +END PROC cursor logic; + +PROC elbit cursor: + cursor logic (0,""27"","",""); + enter part (x.outstrings,0,2); + enter part (x.outstrings,1,255); +END PROC elbit cursor; + +ENDPACKET konfigurieren; + diff --git a/system/multiuser/1.7.5/src/liner b/system/multiuser/1.7.5/src/liner new file mode 100644 index 0000000..bc1f41d --- /dev/null +++ b/system/multiuser/1.7.5/src/liner @@ -0,0 +1,3079 @@ +(* ------------------- VERSION 406 vom 28.05.86 ----(1.7.5)------------- *) +PACKET liner DEFINES line form, + autoform, + hyphenation width, + additional commands: + +(* Programm zur Zeilenformatierung mit unterschiedlichen Schriftypen + Autor: Rainer Hahn + Stand: 1.7.1 Febr. 1984 + 1.7.3 Juli 1984 + 1.7.4 Juni 1985 + 1.7.5 ab Okt. 1985 + *) + +(********************* form deklarationen ********************) + +TEXT VAR zeichen, + aufzaehlungszeichen, + par 1, + par 2, + kommando, + command store, + zielreferenzen, + herkunftsreferenzen, + aktuelle referenz, + alter schriftname, + dummy, + fehlerdummy, + footdummy, + scan symbol, + font table name :: "", + trennwort, + trennwort ohne komm, + wort1, + wort1 ohne komm, + wort2, + font nr speicher, + modifikations speicher, + mod zeilennr speicher, + index speicher, + ind zeilennr speicher, + counter numbering store, + counter reference store, + trennsymbol, + puffer, + neue zeile, + zeile, + einrueckung zweite zeile, + aktuelle blanks, + alte blanks, + zusaetzliche commands :: "", + kommando liste; + +INT CONST rueckwaerts :: -1, + esc char ohne zweites byte ausgang :: - maxint - 1; + +INT VAR anz tabs, + mitzuzaehlende zeichen, + anz blanks freihalten, + kommando index, + scan type, + font nr :: 1, + blankbreite fuer diesen schrifttyp, + aktuelle pitch zeilenlaenge, + eingestellte indentation pitch, + einrueckbreite, + zeilenbreite, + trennbreite in prozent :: 7, + trennbreite, + max trennlaenge, + max trenn laenge ohne komm, + zeichenwert ausgang, + formelbreite, + formelanfang, + zeilennr, + wortanfang, + wortende, + erste fehler zeilennr, + macro kommando ende, + von, + pufferlaenge, + zeichenpos, + zeichenpos bereits verarbeitet; + +BOOL VAR ask type and limit, + format file in situ, + lineform mode, + macro works, + kommandos speichern, + letzter puffer war absatz, + in d und e verarbeitung, + in tabelle, + in foot uebertrag, + in foot; + +LET hop = ""1"", + rechts = ""2"", + cl eol = ""5"", + links = ""8"", + return = ""13"", + begin mark = ""15"", + end mark = ""14"", + escape = ""27"", + trennzeichen = ""221"", + trenn k = ""220"", + blank = " ", + bindestrich = "-", + buchstaben = + "abcdefghijklmnopqrstuvwxyzüäößABCDEFGHIJKLMNOPQRSTUVWXYZÄÜö", + kommando zeichen = "#", + max tabs = 30, + extended char ausgang = 32767, + blank ausgang = 32766, + kommando ausgang = 32765, + such ausgang = 32764, + zeilenende ausgang = 0, + vorwaerts = 1, + type1 = 1, + linefeed = 3, + limit = 4, + free = 5, + page command0= 6, + page command1= 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 command = 51, + d command = 52, + e command = 53, + head on = 54, + head off = 55, + bottom on = 56, + bottom off = 57, + count per page=58, + fillchar = 59, + mark command = 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; + +REAL VAR limit in cm :: 16.0, + fehler wert :: -1.0; + +FILE VAR eingabe, + ausgabe, + file; + +FRANGE VAR alter bereich; + +DATASPACE VAR ds; + +ROW 256 INT VAR pitch table; +ROW max tabs TEXT VAR tab zeichen; +ROW max tabs ROW 3 INT VAR tabs; +(* 1. Eintrag: Position + 2. Eintrag: Art + 3. Eintrag: Bis-Position +*) + +(************************** liner state-Routinen **********************) + +TYPE LINERSTATE = + STRUCT (INT position, from, + BOOL in macro, + TEXT buffer line, next line, + old blanks, actual blanks, + new line); + +LINERSTATE VAR before macro state, + before foot state; + +PROC get liner state (LINERSTATE VAR l): + l . position := zeichenpos; + l . from := von; + l . in macro := macro works; + l . buffer line := puffer; + l . next line := zeile; + l . old blanks := alte blanks; + l . actualblanks:= aktuelle blanks; + l . new line := neue zeile; +END PROC get liner state; + +PROC put liner state (LINERSTATE CONST l): + zeichenpos := l . position; + von := l . from; + macro works := l . in macro; + puffer := l . buffer line ; + zeile := l . next line ; + alte blanks := l . old blanks; + aktuelle blanks := l . actual blanks; + neue zeile := l . new line ; + pufferlaenge := length (puffer); +END PROC put liner state; + +(*********************** Utility Routinen **************************) + +PROC delete int (TEXT VAR resultat, INT CONST delete pos) : + change (resultat, delete pos * 2 - 1, delete pos * 2, "") +END PROC delete int; + +OP CAT (TEXT VAR resultat, INT CONST zahl) : + resultat CAT " "; + replace (resultat, LENGTH resultat DIV 2, zahl); +END OP CAT; + +PROC conversion (REAL VAR cm, INT VAR pitches): + disable stop; + INT VAR i :: x step conversion (cm); + IF is error + THEN dummy := error message; + clear error; + dummy CAT " -> "; + dummy CAT text (cm); + fehler (38, dummy); + cm := fehler wert + ELIF i < 0 + THEN fehler (38, "negativ"); + cm := fehler wert + ELSE pitches := i + FI; + enable stop +END PROC conversion; + +(************************** Fehlermeldungen **********************) + +PROC fehler (INT CONST nr, TEXT CONST addition): + fehler melden; + meldung auf terminal ausgeben und ggf zeilennummer merken. + +fehler melden: + report text processing error (nr, zeilen nr, fehlerdummy, addition). +END PROC fehler; + +PROC warnung (INT CONST nr, TEXT CONST addition): + warnung melden; + meldung auf terminal ausgeben und ggf zeilennummer merken. + +warnung melden: + report text processing warning (nr, zeilennr, fehlerdummy, addition). +END PROC warnung; + +PROC meldung auf terminal ausgeben und ggf zeilennummer merken: + IF online + THEN line ; + out (fehlerdummy); + line ; + FI; + IF erste fehler zeilennr = 0 + THEN erste fehler zeilennr := zeilennr + FI +END PROC meldung auf terminal ausgeben und ggf zeilennummer merken; + +(*********************** Macro-Bearbeitung ***********************) + +PROC fuehre initialisierung fuer macro aus: + get liner state (before macro state); + get macro line (puffer); + pufferlaenge := length (puffer); + get macro line (zeile); + zeichenpos := 1; + von := 1; + macro works := TRUE. +END PROC fuehre initialisierung fuer macro aus; + +PROC macro end command: + kommando := subtext (kommando, 2); + scan (kommando); + next symbol (scan symbol, scan type); + IF NOT macro works + THEN fehler (40, kommando); + LEAVE macro end command + ELIF scan symbol <> "macroend" + THEN fehler (33, kommando) + ELSE put liner state (before macro state); + FI +END PROC macro end command; + +(************************** Schrifttyp einstellen *********************) + +PROC stelle font ein: + IF alter schriftname = par1 + THEN IF zeilen nr > 2 + THEN warnung (8, par1) + ELSE LEAVE stelle font ein + FI + ELIF font exists (par1) + THEN font nr := font (par1); + ELSE fehler (1, par1); + par1 := font (1); + font nr := 1 + FI; + alter schriftname := par1; + hole font und stelle trennbreite ein +END PROC stelle font ein; + +PROC hole font: + INT VAR x; (* height Werte *) + get font (font nr, eingestellte indentation pitch, x, x, x, pitch table); + pitch table [code (kommandozeichen) + 1] := kommando ausgang; + blankbreite fuer diesen schrifttyp := pitch table [code (blank) + 1] +END PROC hole font; + +PROC hole font und stelle trennbreite ein: + hole font; + trennbreite setzen +END PROC hole font und stelle trennbreite ein; + +PROC trennbreite setzen: + trennbreite := berechnete trennbreite. + +berechnete trennbreite: + INT VAR eingestellte trennbreite; + conversion (limit in cm, eingestellte trennbreite); + eingestellte trennbreite := eingestellte trennbreite + DIV 100 * trennbreite in prozent; + IF eingestellte trennbreite <= zweimal blankbreite + THEN zweimal blankbreite + ELSE eingestellte trennbreite + FI. + +zweimal blankbreite: + 2 * eingestellte indentation pitch. +END PROC trennbreite setzen; + +PROC hyphenation width (INT CONST prozente): + IF prozente < 4 OR prozente > 20 + THEN putline ("Fehler: Einstellbare Trennbreite zwischen 4 und 20%") + ELSE trennbreite in prozent := prozente + FI +END PROC hyphenation width; + +(************************** kommando verarbeitung ****************) + +PROC additional commands (TEXT CONST k): + zusaetzliche commands := k +END PROC additional commands; + +TEXT PROC additional commands: + zusaetzliche commands +END PROC additional commands; + +BOOL PROC hinter dem kommando steht nix (INT CONST komm ende): + komm ende = pufferlaenge OR absatz hinter dem kommando. + +absatz hinter dem kommando: + komm ende + 1 = pufferlaenge AND puffer hat absatz. +END PROC hinter dem kommando steht nix; + +PROC verarbeite kommando und neue zeile auffuellen: + neue zeile auffuellen (von, zeichenpos - 1); + von := zeichenpos; + verarbeite kommando; + neue zeile auffuellen (von, zeichenpos - 1); + von := zeichenpos +END PROC verarbeite kommando und neue zeile auffuellen; + +PROC speichere kommando: + command store CAT "#"; + command store CAT kommando; + command store CAT "#" +END PROC speichere kommando; + +PROC execute stored commands: + IF length (command store) <> 0 + THEN kommandos speichern := FALSE; + dummy := puffer; + INT VAR zpos := zeichenpos; + zeichenpos := 1; + puffer := command store; + pufferlaenge := length (puffer); + execute commands; + puffer := dummy; + pufferlaenge := length (puffer); + zeichenpos := zpos; + command store := ""; + FI; + kommandos speichern := TRUE. + +execute commands: + WHILE zeichenpos < pufferlaenge REP + verarbeite kommando + END REP. +END PROC execute stored commands; + +PROC verarbeite kommando: +INT VAR anz params, + intparam, + kommando ende; +REAL VAR realparam; + zeichenpos INCR 1; + kommando ende := pos (puffer, kommando zeichen, zeichenpos); + IF kommando ende <> 0 + THEN kommando oder kommentar kommando verarbeiten; + zeichenpos := kommando ende + 1 + ELSE fehler (2, "") + FI. + +kommando oder kommentar kommando verarbeiten: + kommando := subtext (puffer, zeichenpos, kommando ende - 1); + TEXT CONST erstes kommandozeichen :: (kommando SUB 1); + IF pos ("-/"":*", erstes kommandozeichen) = 0 + THEN scanne kommando und fuehre es aus + ELSE restliche kommandos + FI. + +restliche kommandos: + IF erstes kommandozeichen = "-" OR erstes kommandozeichen = "/" + THEN + ELIF erstes kommandozeichen = """" + THEN scan (kommando); + next symbol (scan symbol, scan type); + INT VAR scan type2; + next symbol (scan symbol, scan type2); + IF scan type <> 4 OR scan type2 <> 7 + THEN fehler (58, kommando) + FI + ELIF erstes kommandozeichen = "*" + THEN zeichenpos := kommando ende + 1; + macroend command; + LEAVE verarbeite kommando + ELIF erstes kommandozeichen = ":" + THEN disable stop; + delete char (kommando, 1); + INT CONST line no before do := line no (eingabe); + do (kommando); + to line (eingabe, line no before do); + IF is error + THEN dummy := error message; + clear error; + dummy CAT " -> "; + dummy CAT kommando; + fehler (9, dummy) + FI; + enable stop + FI. + +scanne kommando und fuehre es aus: + analyze command (kommando liste, kommando, 3, + kommando index, anz params, par1, par2); + disable stop ; + command error ; + IF is error + THEN dummy := error message; + clear error; + dummy CAT " -> "; + dummy CAT kommando; + fehler (22, dummy); + enable stop; + LEAVE scanne kommando und fuehre es aus + FI; + enable stop; + setze kommando um. + +setze kommando um: + SELECT kommando index OF + +CASE type1: + stelle font ein; + modifikations speicher := ""; + mod zeilennr speicher := "" + +CASE limit: + realparam := real (par1); + IF kommandos speichern + THEN speichere kommando + ELIF last conversion ok AND pos (par1, ".") <> 0 + THEN IF realparam = 0.0 + THEN fehler (37, "") + ELSE conversion (realparam, aktuelle pitch zeilenlaenge); + IF realparam <> fehlerwert + THEN limit in cm := realparam; + trennbreite setzen + FI + FI + ELSE fehler (4, par1); + FI + +CASE on, ub, fb: + TEXT VAR mod zeichen; + IF kommando index = ub + THEN mod zeichen := "u" + ELIF kommando index = fb + THEN mod zeichen := "b" + ELSE mod zeichen := (par1 SUB 1); + FI; + INT VAR position :: pos (modifikations speicher, mod zeichen); + IF position <> 0 + THEN dummy := mod zeichen + " in Zeile "; + dummy CAT text (mod zeilennr speicher ISUB position); + fehler (54, dummy); + replace (mod zeilennr speicher, position, zeilennr); + ELSE modifikations speicher CAT mod zeichen; + mod zeilennr speicher CAT zeilennr + FI + +CASE off, fe, ue: + IF kommando index = ue + THEN mod zeichen := "u" + ELIF kommando index = fe + THEN mod zeichen := "b" + ELSE mod zeichen := (par1 SUB 1); + FI; + position := pos (modifikations speicher, mod zeichen); + IF position = 0 + THEN fehler (55, mod zeichen) + ELSE delete char (modifikations speicher, position); + delete int (mod zeilennr speicher, position) + FI + +CASE pagenr, pagelength, start, block, material, setcount, right, center, + linefeed: + +CASE head, headodd, headeven, bottom, bottomodd, bottomeven, end, free, + page command0, page command1, columns, columnsend: + IF NOT hinter dem kommando steht nix (kommando ende) + THEN fehler (19, kommando) + ELIF kommando ende = pufferlaenge + THEN IF (neue zeile SUB length (neue zeile)) = blank + THEN delete char (neue zeile, length (neue zeile)) + FI; + puffer CAT blank; + pufferlaenge := length (puffer) + FI; + in foot := FALSE + +CASE foot: + IF in foot uebertrag + THEN zeilenbreite := aktuelle pitch zeilenlaenge + 1 + ELIF in foot + THEN fehler (3, "") + ELSE fuelle ggf zeile vor foot auf (kommando ende) + FI + +CASE ib0, ib1, ib2: + TEXT VAR ind zeichen; + IF kommando index = ib0 + THEN ind zeichen:= "1" + ELSE ind zeichen := par1 + FI; + position := pos (index speicher, ind zeichen); + IF position <> 0 + THEN dummy := ind zeichen + " in Zeile "; + dummy CAT text (ind zeilennr speicher ISUB position); + fehler (56, dummy); + replace (ind zeilennr speicher, position, zeilennr) + ELSE index speicher CAT ind zeichen; + ind zeilennr speicher CAT zeilennr + FI + +CASE ie0, ie1, ie2: + IF kommando index = ie0 + THEN ind zeichen := "1" + ELSE ind zeichen := par1 + FI; + position := pos (index speicher, ind zeichen); + IF position = 0 + THEN fehler (57, ind zeichen) + ELSE delete char (index speicher, position); + delete int (ind zeilennr speicher, position) + FI + +CASE topage, count1: + herkunftsreferenzen speichern; + zeilenbreite um blankbreite erhoehen (3) + +CASE count0: + zeilenbreite um blankbreite erhoehen (3) + +CASE value0, value1: + IF anz params <> 0 + THEN zielreferenzen speichern ohne warnung + FI; + zeilenbreite um blankbreite erhoehen (3) + +CASE goalpage: + zielreferenzen speichern + +CASE table: + IF in tabelle + THEN fehler (41, "") + ELSE IF hinter dem kommando steht nix (kommando ende) + THEN zeichenpos := pufferlaenge; + neue zeile auffuellen und ausgabe bei zeilenende + ELSE neue zeile auffuellen (von, kommando ende); + puffer := subtext (puffer, kommandoende + 1); + schreibe und initialisiere neue zeile + FI; + verarbeite tabelle; + LEAVE verarbeite kommando + FI + +CASE table end: + IF NOT in tabelle + THEN fehler (59, "") + FI + +CASE r pos: + IF kommandos speichern + THEN speichere kommando + ELSE tabulatorposition eintragen (r pos) + FI + +CASE l pos: + IF kommandos speichern + THEN speichere kommando + ELSE tabulatorposition eintragen (l pos) + FI + +CASE c pos: + IF kommandos speichern + THEN speichere kommando + ELSE tabulatorposition eintragen (c pos) + FI + +CASE d pos: + IF kommandos speichern + THEN speichere kommando + ELSE tabulatorposition eintragen (d pos) + FI + +CASE b pos: + IF kommandos speichern + THEN speichere kommando + ELSE tabulatorposition eintragen (b pos) + FI + +CASE clear pos0: + IF kommandos speichern + THEN speichere kommando + ELSE anz tabs := 0; + FI + +CASE clear pos1: + IF kommandos speichern + THEN speichere kommando + ELSE tabulatorposition loeschen + FI + +CASE skip: + IF hinter dem kommando steht nix (kommando ende) + THEN neue zeile auffuellen und ausgabe bei zeilenende + ELSE neue zeile auffuellen (von, kommandoende); + puffer := subtext (puffer, kommandoende + 1); + schreibe und initialisiere neue zeile + FI; + skip zeilen verarbeiten; + kommando ende := zeichenpos; + +CASE skip end: + +CASE u command, d command: + INT VAR next smaller font; + speichere font nr; + IF next smaller font exists (font nr, next smaller font) + THEN font nr := next smaller font + FI; + hole font und stelle trennbreite ein; + IF NOT in d und e verarbeitung + THEN verarbeite index und exponenten; + LEAVE verarbeite kommando + FI + +CASE e command: + entspeichere font nr + +CASE head on, head off, bottom on, bottom off, count per page, fillchar, + mark command, markend, pageblock: + +CASE bsp: + zeichenpos DECR 2; + IF kommandoende = length (puffer) OR + (puffer SUB kommandoende + 1) = kommandozeichen OR + zeichenpos < 1 OR + (puffer SUB zeichenpos) = kommandozeichen + THEN fehler (28, ""); + LEAVE setze kommando um + FI; + begin of this char (puffer, zeichenpos); + kommandoende INCR 1; + INT VAR diese breite :: breite (puffer, zeichenpos), + naechste breite :: breite (puffer, kommandoende); + IF in d und e verarbeitung + THEN formelbreite DECR diese breite; + formelbreite INCR max (diese breite, naechste breite) + ELSE zeilenbreite DECR diese breite; + zeilenbreite INCR max (diese breite, naechste breite) + FI; + zeichenpos := kommandoende; + char pos move (vorwaerts); + LEAVE verarbeite kommando + +CASE counter1, counter2: + dummy := "#"; + dummy CAT par1; + dummy CAT "#"; + IF pos (counter numbering store, dummy) = 0 + THEN fehler (34, par1); + FI; + IF kommando index = counter1 + THEN par2 := "0" + FI; + anz blanks freihalten := 3 + 2 * int (par2); + zeilenbreite um blankbreite erhoehen (anz blanks freihalten) + +CASE set counter: + dummy := "#"; + dummy CAT par1; + dummy CAT "#"; + IF pos (counter numbering store, dummy) = 0 + THEN counter numbering store CAT dummy + ELSE warnung (15, par1) + FI + +CASE put counter0: + zeilenbreite um blankbreite erhoehen (anz blanks freihalten) + +CASE put counter1: + dummy := "#"; + dummy CAT par1; + dummy CAT "#"; + INT VAR begin pos :: pos (counter reference store, dummy); + IF begin pos = 0 + THEN counter reference store CAT "u"; + counter reference store CAT dummy + ELIF (counter reference store SUB begin pos - 1) <> "u" + THEN insert char (counter reference store,"u", max (begin pos, 1)) + FI; + zeilenbreite um blankbreite erhoehen (5) + +CASE store counter: + dummy := "#"; + dummy CAT par1; + dummy CAT "#"; + begin pos := pos (counter reference store, dummy); + IF begin pos <> 0 + THEN IF (counter reference store SUB begin pos - 1) = "i" OR + (counter reference store SUB begin pos - 2) = "i" + THEN fehler (35, par1) + ELIF (counter reference store SUB begin pos - 1) = "u" + THEN insert char (counter reference store, "i", + max (begin pos - 1, 1)) + ELSE insert char (counter reference store, "i", + max (begin pos, 1)) + FI + ELSE counter reference store CAT "i"; + counter reference store CAT dummy + FI + +OTHERWISE + IF macro command and then process parameters (kommando) + THEN IF macro works + THEN fehler (15, kommando) + ELSE zeichenpos := kommando ende + 1; + neue zeile auffuellen (von, zeichenpos - 1); + von := zeichenpos; + fuehre initialisierung fuer macro aus; + LEAVE verarbeite kommando + FI + ELIF zusaetzliche commands <> "" + THEN analyze command (zusaetzliche commands, kommando, 3, + kommando index, anz params, par1, par2); + IF kommando index = 0 + THEN fehler (8, kommando) + FI + ELSE fehler (8, kommando) + FI; +END SELECT. +END PROC verarbeite kommando; + +(************************* Indizes und Exponenten **********************) + +PROC zeilenbreite um blankbreite erhoehen (INT CONST anz): + INT CONST blankbreite mal anz :: anz * eingestellte indentation pitch; + IF in d und e verarbeitung + THEN formelbreite INCR blankbreite mal anz + ELSE zeilenbreite INCR blankbreite mal anz + FI; + mitzuzaehlende zeichen INCR anz +END PROC zeilenbreite um blankbreite erhoehen; + +PROC speichere font nr: + IF index oder exponent anfang + THEN suche wortanfang in neuer zeile; + zeilenbreite DECR formelbreite + FI; + font nr speicher CAT " "; + font nr speicher CAT text (font nr). + +index oder exponent anfang: + font nr speicher = "". + +suche wortanfang in neuer zeile: + auf das letzte zeichen stellen; + WHILE NOT wortanfang vor formel REP + formelbreite INCR breite (neue zeile, formelanfang); + IF formelanfang = 1 + THEN LEAVE suche wortanfang in neuer zeile + FI; + char pos move (neue zeile, formelanfang, rueckwaerts); + END REP; + char pos move (neue zeile, formelanfang, vorwaerts). + +wortanfang vor formel: + pos (" #", neue zeile SUB formelanfang) <> 0. + +auf das letzte zeichen stellen: + formelanfang := length (neue zeile); + formelbreite := 0; + IF formelanfang > 0 + THEN begin of this char (neue zeile, formelanfang); + ELSE formelanfang := 1; + LEAVE suche wortanfang in neuer zeile + FI +END PROC speichere font nr; + +PROC verarbeite index und exponenten: + in d und e verarbeitung := TRUE; + zeichenpos := pos (puffer, kommandozeichen, zeichenpos) + 1; + INT VAR altes zeichenpos := zeichenpos; + verarbeite index oder exponenten zeichen; + fehler (52, ""); + entspeichere font nr. + +verarbeite index oder exponenten zeichen: + REP + stranalyze (pitch table, formelbreite, + aktuelle pitch zeilenlaenge - zeilenbreite, + puffer, zeichenpos, pufferlaenge, zeichenwert ausgang); + IF zeichenwert ausgang = kommando ausgang + THEN verarbeite zeichen vor kommando; + verarbeite kommando und neue zeile auffuellen; + IF NOT in d und e verarbeitung + THEN zeilenbreite INCR formelbreite; + LEAVE verarbeite index und exponenten + FI; + altes zeichenpos := zeichenpos + ELIF zeichenwert ausgang = extended char ausgang + THEN char pos move (vorwaerts); + zeilenbreite INCR breite (puffer, zeichenpos); + char pos move (vorwaerts) + ELIF zeichenpos >= pufferlaenge + AND formelbreite + zeilenbreite < aktuelle pitch zeilenlaenge + THEN LEAVE verarbeite index oder exponenten zeichen + ELIF formelanfang <= 1 + THEN fehler (53, ""); + formelbreite := 0; + ELIF zeichenwert ausgang = esc char ohne zweites byte ausgang + THEN fehler (23, ""); + LEAVE verarbeite index oder exponenten zeichen + ELSE schreibe neue zeile vor formelanfang + FI + END REP. + +verarbeite zeichen vor kommando: + mitzuzaehlende zeichen INCR + number chars (puffer, altes zeichenpos, zeichenpos); + IF (puffer SUB zeichenpos) <> blank + THEN aufzaehlungszeichen := (puffer SUB zeichenpos) + FI; + char pos move (vorwaerts). + +schreibe neue zeile vor formelanfang: + dummy := subtext (neue zeile, formelanfang); + neue zeile := subtext (neue zeile, 1, formelanfang - 1); + loesche nachfolgende blanks; + schreibe und initialisiere neue zeile; + neue zeile CAT dummy; + formelanfang := 1; + char pos move (vorwaerts) +END PROC verarbeite index und exponenten; + +PROC entspeichere font nr: + INT VAR index := length (font nr speicher); + IF index <= 1 + THEN fehler (51, "") + ELSE suche nr anfang; + entspeichere; + FI. + +suche nr anfang: + WHILE (font nr speicher SUB index) <> " " AND index <> 0 REP + index DECR 1 + END REP. + +entspeichere: + font nr := int (subtext (font nr speicher, index + 1)); + IF index <= 1 + THEN font nr speicher := ""; + in d und e verarbeitung := FALSE + ELSE font nr speicher := subtext (font nr speicher, 1, index - 1) + FI; + hole font und stelle trennbreite ein +END PROC entspeichere font nr; + +(*************************** skip zeilen ****************************) + +PROC skip zeilen verarbeiten: + REP + IF dateiende + THEN errorstop ("Dateiende während skip-Anweisung") + ELIF skip ende kommando + THEN LEAVE skip zeilen verarbeiten + FI; + neue zeile auffuellen und ausgabe bei zeilenende + END REP. + +dateiende: + pufferlaenge = 0. + +skip ende kommando: + TEXT VAR kliste :: "skipend:1.0", k; + INT VAR k anf :: pos (puffer, kommandozeichen), + kende, anz params, kindex; + WHILE noch ein kommando vorhanden REP + kindex := 0; + analysiere das kommando + END REP; + FALSE. + +noch ein kommando vorhanden: + kanf <> 0. + +analysiere das kommando: + kende := pos (puffer, kommandozeichen, kanf + 1); + IF kende = 0 + THEN fehler (2, ""); + LEAVE skip ende kommando WITH FALSE + FI; + k := subtext (puffer, kanf + 1, kende - 1); + analyze command (kliste, k, 3, kindex, anz params, par1, par2); + IF kindex = 1 + THEN zeichenpos := kende; + LEAVE skip ende kommando WITH TRUE + FI; + kanf := pos (puffer, kommandozeichen, kende + 1). +END PROC skip zeilen verarbeiten; + +(**************** sonderbehandlung von zeilen vor foot *******************) + +PROC fuelle ggf zeile vor foot auf (INT VAR com ende): + IF foot am zeilenende ohne absatz AND NOT macro works + THEN letzter puffer war absatz := TRUE; + IF text vor foot AND NOT zeile hat richtige laenge + THEN INT VAR foot zeilennr := line no (eingabe); + INT CONST x1 := com ende; + in foot uebertrag := TRUE; + get liner state (before foot state); + formatiere diese zeile; + to line (eingabe, foot zeilennr); + footdummy := neue zeile; + put liner state (before foot state); + neue zeile := footdummy; + com ende := x1; + in foot uebertrag := FALSE + FI + ELIF NOT hinter dem kommando steht nix (com ende) + THEN fehler (19, kommando); + LEAVE fuelle ggf zeile vor foot auf + FI; + in foot := TRUE. + +foot am zeilenende ohne absatz: + com ende = pufferlaenge. + +text vor foot: + pos (neue zeile, ""33"", ""255"", 1) <> 0. + +formatiere diese zeile: + foot anweisung entfernen; + lese eingabe datei bis end kommando; + zeile nach end in zeile; + formatiere; + schreibe die veraenderte zeile nach end. + +foot anweisung entfernen: + zeichenpos := com ende; + ueberspringe das kommando (puffer, zeichenpos, rueckwaerts); + zeichenpos DECR 1; + puffer := subtext (puffer, 1, zeichenpos); + WHILE NOT within kanji (puffer, zeichenpos) AND + (puffer SUB zeichenpos) = blank AND foot stand nicht am zeilenanfang + REP + zeilenbreite DECR breite (blank); + delete char (puffer, zeichenpos); + delete char (neue zeile, length (neue zeile)); + zeichenpos DECR 1 + END REP; + pufferlaenge := length (puffer). + +foot stand nicht am zeilenanfang: + zeichenpos > 0. + +lese eingabe datei bis end kommando: + TEXT VAR kliste :: "end:1.0"; + dummy := zeile; + WHILE NOT foot ende kommando REP + IF eof (eingabe) + THEN LEAVE formatiere diese zeile + FI; + read record (eingabe, dummy); + down (eingabe); + ENDREP; + INT CONST zeile nach end := line no (eingabe); + IF NOT end kommando steht am zeilenende + THEN LEAVE formatiere diese zeile + FI. + +end kommando steht am zeilenende: + k ende = length (dummy) OR k ende + 1 = length (dummy). + +foot ende kommando: + INT VAR k anf, k ende :: 0, anz params, k index; + WHILE noch ein kommando vorhanden REP + k ende := pos (dummy, kommandozeichen, k anf + 1); + IF k ende = 0 + THEN LEAVE foot ende kommando WITH FALSE + ELSE kommando := subtext (dummy, k anf + 1, k ende - 1); + FI; + analyze command (kliste, kommando, 3, kindex, anz params, par1, par2); + IF k index = 1 + THEN LEAVE foot ende kommando WITH TRUE + FI; + END REP; + FALSE. + +noch ein kommando vorhanden: + k anf := pos (dummy, kommandozeichen, k ende + 1); + k anf <> 0. + +zeile nach end in zeile: + read record (eingabe, zeile); + INT VAR text anf := pos (zeile, ""33"", ""255"", 1); + IF zeile nach end ist leerzeile + THEN LEAVE formatiere diese zeile + ELSE IF text anf > 1 + THEN aktuelle blanks := subtext (zeile, 1, text anf - 1); + zeile := subtext (zeile, text anf) + FI; + FI. + +zeile nach end ist leerzeile: + text anf <= 0. + +formatiere: + IF foot stand nicht am zeilenanfang + THEN verarbeite letztes zeichen von puffer + ELSE puffer CAT zeile; + pufferlaenge := length (puffer) + FI; + REP + stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge, + puffer, zeichenpos, pufferlaenge, zeichenwert ausgang); + IF zeichenwert ausgang = kommando ausgang + THEN zeichenpos INCR 1; + neue zeile auffuellen (von, zeichenpos - 1); + von := zeichenpos; + INT VAR ende der neuen zeile := length (neue zeile), + zpos davor := zeichenpos; + verarbeite kommando; + neue zeile auffuellen (von, zeichenpos - 1); + von := zeichenpos; + IF kommando index = foot + THEN behandlung der zeile vor foot; + LEAVE formatiere + ELIF zeichenpos >= pufferlaenge + OR zeilenbreite > aktuelle pitch zeilenlaenge + THEN ende einer neuen zeile; + LEAVE formatiere + FI + ELIF zeichenwert ausgang = extended char ausgang + THEN char pos move (vorwaerts); + zeilenbreite INCR breite (puffer, zeichenpos); + char pos move (vorwaerts) + ELIF zeichenwert ausgang = zeilenende ausgang + OR zeichenwert ausgang = esc char ohne zweites byte ausgang + THEN up (eingabe); + delete record (eingabe); + neue zeile auffuellen; + IF zeichenwert ausgang = esc char ohne zweites byte ausgang + THEN fehler (23, "") + FI; + LEAVE formatiere diese zeile + ELSE ende einer neuen zeile; + LEAVE formatiere + FI + END REP. + +behandlung der zeile vor foot: + neue zeile := subtext (neue zeile, 1, ende der neuen zeile); + zeichenpos := zpos davor. + +schreibe die veraenderte zeile nach end: + to line (eingabe, zeile nach end); + dummy := (text anf - 1) * blank; + dummy CAT subtext (puffer, zeichenpos); + IF format file in situ + THEN insert record (eingabe) + FI; + write record (eingabe, dummy). +END PROC fuelle ggf zeile vor foot auf; + +(*************** Tabulator- und Tabellen verarbeitung ******************) + +PROC tabulatorposition eintragen (INT CONST tab type): + ROW 3 INT VAR akt tab pos; + IF anz tabs >= max tabs + THEN fehler (32, "") + ELIF tab in cm umwandeln (par1, tab pos in pitches) + THEN IF tab type = b pos AND tab in cm umwandeln (par2, bis tab) + THEN + ELSE bis tab := 0 + FI; + TEXT VAR zentrierzeichen; + IF tab type = d pos + THEN zentrierzeichen := par2 + ELSE zentrierzeichen := "" + FI; + tabs sortiert eintragen + FI. + +tabs sortiert eintragen: + INT VAR i; + type tab := tab type; + FOR i FROM 1 UPTO anz tabs REP + IF tab pos in pitches = tabs [i] [1] + THEN fehler (42, par1); + LEAVE tabulatorposition eintragen + ELIF tabs [i] [1] > tab pos in pitches + THEN vertauschen + FI; + IF ueberschneidende bpos + THEN fehler (12, text (xstepconversion (tab pos in pitches))) + FI; + END REP; + anz tabs INCR 1; + tabs [anz tabs] := akt tab pos; + tab zeichen [anz tabs] := zentrierzeichen. + +ueberschneidende bpos: + tabs [i] [2] = bpos AND naechste anfang pos liegt in diesem bpos bereich. + +naechste anfang pos liegt in diesem bpos bereich: + tab pos in pitches <= tabs [i] [3]. + +vertauschen: + ROW 3 INT CONST hilf1 :: tabs [i]; + TEXT CONST thilf :: tab zeichen [i]; + tabs [i] := akt tab pos; + tab zeichen [i] := zentrierzeichen; + akt tab pos := hilf1; + zentrierzeichen := thilf. + +tab pos in pitches: + akt tab pos [1]. + +type tab: + akt tab pos [2]. + +bis tab: + akt tab pos [3]. +END PROC tabulatorposition eintragen; + +BOOL PROC tab in cm umwandeln (TEXT CONST text wert, INT VAR f breite): + REAL VAR cm := real (text wert); + IF last conversion ok AND pos (text wert, ".") <> 0 + THEN umwandeln + ELSE fehler (4, par1); + TRUE + FI. + +umwandeln: + conversion (cm, f breite); + IF f breite > aktuelle pitch zeilenlaenge + THEN fehler (39, par1) + ELIF cm = fehlerwert + THEN + ELSE LEAVE tab in cm umwandeln WITH TRUE + FI; + FALSE +END PROC tab in cm umwandeln; + +PROC cm angabe der druckposition in dummy (INT CONST nr): + dummy := text (x step conversion (tabs [nr] [1])); + IF (dummy SUB length (dummy)) = "." + THEN dummy CAT "0" + FI; + dummy CAT " cm" +END PROC cm angabe der druckposition in dummy; + +PROC tabulator position loeschen: + INT VAR tab pos in pitches; + IF tab in cm umwandeln (par1, tab pos in pitches) + THEN versuche zu loeschen + FI. + +versuche zu loeschen: + INT VAR i; + FOR i FROM 1 UPTO anz tabs REP + IF tab pos in pitches = tabs [i] [1] + THEN verschiebe eintraege nach unten; + LEAVE tabulator position loeschen + FI + END REP; + fehler (43, par1). + +verschiebe eintraege nach unten: + INT VAR k; + FOR k FROM i UPTO anz tabs - 1 REP + tabs [k] := tabs [k + 1]; + tab zeichen [k] := tab zeichen [k + 1]; + END REP; + anz tabs DECR 1. +END PROC tabulatorposition loeschen; + +PROC verarbeite tabelle: + in tabelle := TRUE; + pitch table auf blank ausgang setzen; + verarbeite tabellenzeilen; + pitch table auf blank setzen; + IF suchausgang gesetzt + THEN pitch table [pos tab zeichen in pitch table] := + breite erstes dezimalzeichen; + suchausgang gesetzt := FALSE; + FI; + in tabelle := FALSE. + +verarbeite tabellenzeilen: + WHILE pufferlaenge <> 0 REP + ueberpruefe tabellenzeile; + zeichenpos := pufferlaenge; + neue zeile auffuellen und ausgabe bei zeilenende + END REP; + puffer := " "; + pufferlaenge := 1; + zeichenpos := 1; + fehler (49, ""). + +ueberpruefe tabellenzeile: +(* Achtung: Zeilenbreite ist Spaltenbreite; + tab zeilen breite ist Summe der Spalten und Positionen *) + INT VAR tab zeilen breite :: 0, + tab no :: 1; + WHILE noch tab positionen OR only command line (puffer) REP + positioniere auf naechste spalte; + errechne spaltenbreite; + IF anz tabs > 0 + THEN ueberpruefe ob es passt; + FI; + tab no INCR 1 + END REP; + IF tabellenzeile breiter als limit + THEN warnung (10, "") + ELIF noch mehr spaltentexte AND anz tabs <> 0 + THEN warnung (11, subtext (puffer, zeichenpos)) + FI. + +noch tab positionen: + tab no <= anz tabs. + +positioniere auf naechste spalte: + zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos); + IF leerzeile oder rest der zeile ist leer + THEN IF NOT only command line (puffer) AND pufferlaenge > 1 + THEN warnung (14, "") + FI; + LEAVE ueberpruefe tabellenzeile + FI. + +leerzeile oder rest der zeile ist leer: + zeichenpos <= 0. + +errechne spaltenbreite: + zeilenbreite := 0; + BOOL VAR suchausgang gesetzt :: FALSE; + IF diese position ist dezimal pos + THEN setze dezimalzeichen auf suchausgang + FI; + REP + stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge, + puffer, zeichenpos, pufferlaenge, zeichenwert ausgang); + zeichenpos INCR 1; + IF zeichenwert ausgang = blank ausgang + THEN behandele dieses blank + ELIF zeichenwert ausgang = kommando ausgang + THEN verarbeite das kommando + ELIF zeichenwert ausgang = extended char ausgang + THEN char pos move (vorwaerts); + zeilenbreite INCR breite (puffer, zeichenpos); + char pos move (vorwaerts) + ELIF zeichenwert ausgang = such ausgang + THEN verarbeite ersten teil der dezimal zentrierung + ELIF zeichenwert ausgang = esc char ohne zweites byte ausgang + THEN fehler (23, ""); + LEAVE ueberpruefe tabellenzeile + ELIF zeilenbreite + zeichenwert ausgang > aktuelle pitch zeilenlaenge + THEN fehler (36, ""); + LEAVE ueberpruefe tabellenzeile + ELSE tabellenzeile ohne absatz + FI + END REP. + +diese position ist dezimal pos: + tabs [tab no] [2] = dpos. + +setze dezimalzeichen auf suchausgang: + INT CONST pos tab zeichen in pitch table :: + code (tab zeichen [tab no] SUB 1) + 1; + INT VAR breite erstes dezimalzeichen :=breite (tab zeichen [tab no] SUB 1), + breite excl dezimalzeichen := 0; + suchausgang gesetzt := TRUE; + pitch table [pos tab zeichen in pitch table] := such ausgang. + +verarbeite ersten teil der dezimal zentrierung: + IF pos (puffer, tab zeichen [tab no], zeichenpos) = zeichenpos + THEN pitch table [pos tab zeichen in pitch table] := + breite erstes dezimalzeichen; + suchausgang gesetzt := FALSE; + breite excl dezimalzeichen := zeilenbreite + FI; + zeilenbreite INCR breite (puffer SUB zeichenpos); + zeichenpos INCR 1. + +behandele dieses blank: + IF doppelblank OR absatz + THEN LEAVE errechne spaltenbreite + ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp; + zeichenpos INCR 1 + FI. + +doppelblank: + (puffer SUB zeichenpos + 1) = blank. + +verarbeite das kommando: + pitch table auf blank setzen; + verarbeite kommando und neue zeile auffuellen; + pitch table auf blank ausgang setzen; + IF kommando index = table end + THEN LEAVE verarbeite tabellenzeilen + ELIF suchausgang gesetzt AND + pitch table [pos tab zeichen in pitch table] <> suchausgang + THEN pitch table [pos tab zeichen in pitch table] := suchausgang + FI. + +tabellenzeile ohne absatz: + IF zeilenende eines macros + THEN zeile in puffer und zeile lesen; + zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos); + ELSE LEAVE errechne spaltenbreite + FI. + +zeilenende eines macros: + zeichenwert ausgang = zeilenende ausgang AND macro works. + +ueberpruefe ob es passt: + INT CONST akt tab pos :: tabs [tab no] [1]; + IF vorherige spalte ueberschreibt tabulator position + THEN cm angabe der druckposition in dummy (tab no - 1); + fehler (44, dummy); + tab zeilenbreite := akt tab pos + ELIF only command line (puffer) + THEN + ELSE ueberpruefe nach art des tabulators + FI. + +ueberpruefe nach art des tabulators: + IF tabs [tab no] [2] = r pos + THEN nach links schreibend + ELIF tabs [tab no] [2] = l pos + THEN nach rechts schreibend + ELIF tabs [tab no] [2] = b pos + THEN nach rechts blockend schreibend + ELIF tabs [tab no] [2] = c pos + THEN zentrierend + ELSE zentrierend um zeichen + FI. + +vorherige spalte ueberschreibt tabulator position: + tab zeilenbreite > akt tab pos. + +nach links schreibend: + IF tab zeilenbreite + zeilenbreite > akt tab pos + THEN cm angabe der druckposition in dummy (tab no); + fehler (45, dummy); + FI; + tab zeilenbreite := akt tab pos. + +nach rechts schreibend: + tab zeilenbreite := akt tab pos + zeilenbreite. + +nach rechts blockend schreibend: + IF akt tab pos + zeilenbreite > tabs [tab no] [3] + THEN cm angabe der druckposition in dummy (tab no); + fehler (48, dummy) + FI; + tab zeilenbreite := tabs [tab no] [3]. + +zentrierend: + IF tab zeilenbreite + (zeilenbreite DIV 2) > akt tab pos + THEN cm angabe der druckposition in dummy (tab no); + fehler (46, dummy) + FI; + tab zeilenbreite := akt tab pos + (zeilenbreite DIV 2). + +zentrierend um zeichen: + IF breite excl dezimalzeichen = 0 + THEN cm angabe der druckposition in dummy (tab no); + fehler (50, dummy) + ELIF tab zeilenbreite + breite excl dezimalzeichen > akt tab pos + THEN cm angabe der druckposition in dummy (tab no); + fehler (47, dummy) + FI; + IF suchausgang gesetzt + THEN pitch table [pos tab zeichen in pitch table] := + breite erstes dezimalzeichen; + suchausgang gesetzt := FALSE; + FI; + tab zeilenbreite := akt tab pos + + (zeilenbreite - breite excl dezimalzeichen). + +tabellenzeile breiter als limit: + tab zeilenbreite > aktuelle pitch zeilenlaenge + einrueckbreite. + +noch mehr spaltentexte: + pos (puffer, ""33"", ""255"", zeichenpos) <> 0. +END PROC verarbeite tabelle; + +(*********************** referenzen ueberpruefen **********************) + +PROC aktuelle referenz erstellen: + aktuelle referenz := "#"; + aktuelle referenz CAT par1; + aktuelle referenz CAT "#"; +END PROC aktuelle referenz erstellen; + +PROC zielreferenzen speichern ohne warnung: + aktuelle referenz erstellen; + IF pos (zielreferenzen, aktuelle referenz) = 0 + THEN delete char (aktuelle referenz, 1); + zielreferenzen CAT aktuelle referenz + FI +END PROC zielreferenzen speichern ohne warnung; + +PROC zielreferenzen speichern: + aktuelle referenz erstellen; + IF pos (zielreferenzen, aktuelle referenz) <> 0 + THEN warnung (9, par1) + ELSE delete char (aktuelle referenz, 1); + zielreferenzen CAT aktuelle referenz + FI +END PROC zielreferenzen speichern; + +PROC herkunftsreferenzen speichern: + aktuelle referenz erstellen; + IF pos (herkunftsreferenzen, aktuelle referenz) = 0 + THEN delete char (aktuelle referenz, 1); + herkunftsreferenzen CAT aktuelle referenz + FI +END PROC herkunftsreferenzen speichern; + +PROC referenzen ueberpruefen: + ueberpruefe zielreferenzen; + ueberpruefe restliche herkunftsreferenzen. + +ueberpruefe zielreferenzen: + REP + hole naechste zielreferenz; + IF pos (herkunfts referenzen, aktuelle referenz) = 0 + THEN change all (aktuelle referenz,"#", ""); + warnung (3, aktuelle referenz) + ELSE delete char (aktuelle referenz, length (aktuelle referenz)); + change (herkunftsreferenzen, aktuelle referenz, ""); + FI + END REP. + +hole naechste zielreferenz: + IF length (zielreferenzen) > 1 + THEN aktuelle referenz := + subtext (zielreferenzen, 1, pos (zielreferenzen, "#", 2)); + zielreferenzen := + subtext (zielreferenzen, pos (zielreferenzen, "#", 2)) + ELSE LEAVE ueberpruefe zielreferenzen + FI. + +ueberpruefe restliche herkunftsreferenzen: + WHILE length (herkunftsreferenzen) > 1 REP + aktuelle referenz := + subtext (herkunftsreferenzen, 1, pos (herkunftsreferenzen, "#", 2) - 1); + change (herkunftsreferenzen, aktuelle referenz, ""); + delete char (aktuelle referenz, 1); + warnung (4, aktuelle referenz) + END REP. +END PROC referenzen ueberpruefen; + +(*************************** Utilities *******************************) + +INT PROC breite (TEXT CONST z): + INT VAR b; + IF z = "" + THEN display and pause (1) + ELIF z = kommandozeichen + THEN display and pause (2); b := 1 + ELSE b := pitch table [code (z) + 1] + FI; + IF zeilenbreite > maxint - b + THEN display and pause (3); b := 1 + FI; + b. +END PROC breite; + +INT PROC breite (TEXT CONST ein text, INT CONST zpos): + TEXT CONST z :: ein text SUB zpos; + INT VAR zeichen breite; + IF z = "" + THEN display and pause (4); zeichen breite := 1 + ELIF z = kommandozeichen + THEN display and pause (6); zeichen breite := 1 + ELSE zeichen breite := pitch table [code (z) + 1] + FI; + IF zeichen breite = extended char ausgang + THEN zeichen breite := extended char pitch (font nr, + ein text SUB zpos, ein text SUB zpos + 1) + FI; + zeichen breite +END PROC breite; + +PROC char pos move (INT CONST richtung): + char pos move (zeichenpos, richtung) +END PROC char pos move; + +PROC char pos move (INT VAR zpos, INT CONST richtung): + char pos move (puffer, zpos, richtung) +END PROC char pos move; + +BOOL PROC absatz: + zeichenpos = pufferlaenge AND puffer hat absatz +END PROC absatz; + +BOOL PROC puffer hat absatz: + NOT within kanji (puffer, pufferlaenge) AND + (puffer SUB pufferlaenge) = blank +END PROC puffer hat absatz; + +PROC pitch table auf blank ausgang setzen: + IF pitch table [code (blank) + 1] <> blank ausgang + THEN blank breite fuer diesen schrifttyp := breite (blank); + pitch table [code (blank) + 1] := blank ausgang + FI +END PROC pitch table auf blank ausgang setzen; + +PROC pitch table auf blank setzen: + pitch table [code (blank) + 1] := blank breite fuer diesen schrifttyp +END PROC pitch table auf blank setzen; + +(*PROC zustands test (TEXT CONST anf): +line ;put(anf); +line ;put("zeilenbreite, aktuelle pitch zeilenlaenge:"); + put(zeilenbreite);put(aktuelle pitch zeilenlaenge); +line ;put("zeichenpos, pufferlaenge, ausgang, zeichen:"); +put(zeichenpos);put(pufferlaenge); +IF zeichenwert ausgang = blank ausgang + THEN put ("blank") +ELIF zeichenwert ausgang = kommando ausgang + THEN put ("kommando") +ELIF zeichenwert ausgang = such ausgang + THEN put ("such") +ELIF zeichenwert ausgang = zeilenende ausgang + THEN put ("zeilenende") + ELSE put(zeichenwert ausgang); +FI; put ("ausgang"); +out(">");out(puffer SUB zeichenpos);out("<"); +line ;out("puffer >"); +IF length (puffer) > 65 + THEN outsubtext (puffer, 1, 65); + line ; outsubtext (puffer, 66) + ELSE out(puffer); +FI; +out("<"); +line ;out("zeile >"); +IF length (zeile) > 65 + THEN outsubtext (zeile, 1, 65); + line ; outsubtext (zeile, 66) + ELSE out (zeile); +FI; +out("<"); +line ;out("neue zeile >"); +IF length (neue zeile) > 65 + THEN outsubtext (neue zeile, 1, 65); + line ; outsubtext (neue zeile, 66) + ELSE out(neue zeile); +FI; +out("<"); +line ; +END PROC zustands test;*) + +(*************************** eigentliche form routine ********************) + +PROC zeilen form (TEXT CONST datei): + enable stop; + form initialisieren (datei); + formiere absatzweise; + letzte neue zeile ausgeben. + +formiere absatzweise: + REP + letzter puffer war absatz := FALSE; + einrueckbreite := eingestellte indentation pitch; + IF einfacher absatz nach absatz + THEN gebe einfachen absatz aus + ELSE verarbeite abschnitt nach absatz + FI + UNTIL pufferlaenge = 0 END REP. + +einfacher absatz nach absatz: + absatz. + +gebe einfachen absatz aus: + neue zeile := blank; + ausgabe bei zeilenende. + +verarbeite abschnitt nach absatz: + berechne erste zeile nach absatz; + IF NOT letzter puffer war absatz + THEN formiere + FI. + +formiere: + INT VAR letzte zeilennr; + REP + stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge, + puffer, zeichenpos, pufferlaenge, zeichenwert ausgang); + IF zeichenwert ausgang = kommando ausgang + THEN zeichenpos INCR 1; + verarbeite kommando und neue zeile auffuellen; + IF letzter puffer war absatz + THEN ausgabe bei zeilenende; + LEAVE verarbeite abschnitt nach absatz + ELIF zeichenpos > pufferlaenge OR absatz + THEN letzte zeilennr := zeilennr; + verarbeite letztes zeichen von puffer; + IF neue zeile ausgeloest + THEN LEAVE verarbeite abschnitt nach absatz + ELSE letzter puffer war absatz := FALSE + FI + FI + ELIF zeichenwert ausgang = extended char ausgang + THEN char pos move (vorwaerts); + zeilenbreite INCR breite (puffer, zeichenpos); + char pos move (vorwaerts) + ELIF zeichenwert ausgang = zeilenende ausgang + OR zeichenwert ausgang = esc char ohne zweites byte ausgang + THEN letzte zeilennr := zeilennr; + verarbeite letztes zeichen von puffer; + IF zeichenwert ausgang = esc char ohne zweites byte ausgang + THEN fehler (23, "") + FI; + IF neue zeile ausgeloest + THEN LEAVE verarbeite abschnitt nach absatz + ELSE letzter puffer war absatz := FALSE + FI + ELSE ende einer neuen zeile + FI; + UNTIL pufferlaenge = 0 END REP. + +neue zeile ausgeloest: + letzte zeilennr < zeilennr. +END PROC zeilen form; + +PROC berechne erste zeile nach absatz: + INT CONST anz einrueckungszeichen :: zeilenbreite DIV einrueckbreite; + INT VAR anz zeichen fuer einzeilige einrueckung :: 0, + anz zeichen :: 0, + schlepper zeichenpos :: 1, + letzte zeilennr; + BOOL CONST puffer hatte anfangs absatz :: puffer hat absatz; + BOOL VAR noch kein blank gewesen :: TRUE; + pitch table auf blank ausgang setzen; + berechne erste zeile; + pitch table auf blank setzen. + +berechne erste zeile: + REP + stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge, + puffer, zeichenpos, pufferlaenge, zeichenwert ausgang); + IF zeichenwert ausgang = blank ausgang + THEN verarbeite text + ELIF zeichenwert ausgang = extended char ausgang + THEN char pos move (vorwaerts); + zeilenbreite INCR breite (puffer, zeichenpos); + char pos move (vorwaerts) + ELIF zeichenwert ausgang = kommando ausgang + THEN verarbeite dieses kommando + ELIF zeichenwert ausgang = zeilenende ausgang + OR zeichenwert ausgang = esc char ohne zweites byte ausgang + THEN behandele zu kurze zeile + ELSE behandele zu lange zeile + FI + END REP. + +verarbeite dieses kommando: + textzeichen mitzaehlen; + IF pos (" #", (puffer SUB zeichenpos)) = 0 + THEN aufzaehlungszeichen := (puffer SUB zeichenpos) + FI; + char pos move (vorwaerts); + mitzuzaehlende zeichen := 0; + pitch table auf blank setzen; + verarbeite kommando und neue zeile auffuellen; + pitch table auf blank ausgang setzen; + IF letzter puffer war absatz + THEN neue zeile auffuellen und ausgabe bei zeilenende; + LEAVE berechne erste zeile + ELIF zeichenpos > pufferlaenge OR absatz + THEN letzte zeilennr := zeilennr; + verarbeite letztes zeichen von puffer; + IF neue zeile ausgeloest + THEN LEAVE berechne erste zeile + ELSE letzter puffer war absatz := FALSE + FI + ELIF anweisung erlaubt keine aufzaehlung + THEN LEAVE berechne erste zeile + FI; + anz zeichen INCR mitzuzaehlende zeichen; + schlepper zeichenpos := zeichenpos. + +neue zeile ausgeloest: + letzte zeilennr < zeilennr. + +anweisung erlaubt keine aufzaehlung: + kommando index = center OR kommando index = right. + +verarbeite text: + char pos move (vorwaerts); + IF absatz + THEN verarbeite letztes zeichen von puffer; + LEAVE berechne erste zeile + ELIF zeilenbreite + blankbreite fuer diesen schrifttyp > + aktuelle pitch zeilenlaenge + THEN behandele zu lange zeile + ELIF mehrfaches blank + THEN positionierung mit doppelblank + ELIF noch kein blank gewesen AND + anz zeichen + + number chars (puffer, schlepper zeichenpos, zeichenpos) <= 20 + THEN ggf aufzaehlung aufnehmen + ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp + FI; + noch kein blank gewesen := FALSE; + zeichenpos INCR 1. + +mehrfaches blank: + (puffer SUB zeichenpos + 1) = blank. + +positionierung mit doppelblank: + WHILE NOT within kanji (puffer, zeichenpos + 1) AND + (puffer SUB zeichenpos + 1) = blank REP + zeichenpos INCR 1 + END REP; + textzeichen mitzaehlen; + pruefe auf ueberschreibung + (zeilenbreite, anz zeichen + anz einrueckungszeichen). + +ggf aufzaehlung aufnehmen: + IF NOT within kanji (puffer, zeichenpos - 1) AND + (puffer SUB zeichenpos - 1) <> kommandozeichen + THEN aufzaehlungszeichen := (puffer SUB zeichenpos - 1); + FI; + textzeichen mitzaehlen; + IF aufzaehlungszeichen = ":" + OR (aufzaehlungszeichen = "-" AND anz zeichen <= 2) + OR (anz zeichen <= 7 AND ( aufzaehlungszeichen = ")" + OR aufzaehlungszeichen = ".")) + THEN anz zeichen fuer einzeilige einrueckung := anz zeichen; + pruefe auf ueberschreibung + (zeilenbreite, anz zeichen + anz einrueckungszeichen) + ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp + FI. + +textzeichen mitzaehlen: + anz zeichen INCR number chars (puffer, schlepper zeichenpos, zeichenpos); + IF is kanji esc (puffer SUB zeichenpos) + THEN schlepper zeichenpos := zeichenpos + 2 + ELSE schlepper zeichenpos := zeichenpos + 1 + FI. + +behandele zu kurze zeile: + textzeichen mitzaehlen; + IF zeichenwert ausgang = esc char ohne zweites byte ausgang + THEN fehler (23, ""); + neue zeile auffuellen; + schreibe und initialisiere neue zeile; + zeichenpos := 1; + LEAVE berechne erste zeile + FI; + letzte zeilennr := zeilennr; + verarbeite letztes zeichen von puffer; + IF neue zeile ausgeloest + THEN LEAVE berechne erste zeile + FI; + schlepper zeichenpos := 1. + +behandele zu lange zeile: + pitch table auf blank setzen; + IF zeilenende bei erstem zeichen + THEN loesche nachfolgende blanks; + schreibe und initialisiere neue zeile; + zeichenpos := 1; + LEAVE berechne erste zeile + ELIF (puffer SUB zeichenpos) = kommandozeichen + THEN zeichenpos INCR 1 + ELSE zeilenbreite DECR breite (puffer, zeichenpos) + FI; + IF puffer hatte anfangs absatz + THEN einrueckung gemaess pufferanfang + FI; + LEAVE berechne erste zeile. + +zeilenende bei erstem zeichen: + zeichenpos < 1. + +einrueckung gemaess pufferanfang: +alte blanks := +(anz einrueckungszeichen + anz zeichen fuer einzeilige einrueckung) * blank. +END PROC berechne erste zeile nach absatz; + +PROC pruefe auf ueberschreibung (INT CONST aufzaehlungsbreite, + anz aufzaehlungszeichen): + IF ueberschreibung + THEN fehlende blanks errechnen; + INT VAR aufzaehlungsende :: zeichenpos - 1; + WHILE (puffer SUB aufzaehlungsende) = blank REP + aufzaehlungsende DECR 1 + END REP; + dummy := ">"; + dummy CAT subtext (puffer, + aufzaehlungsende - 15, aufzaehlungsende); + dummy CAT "< Fehlende Blanks: "; + dummy CAT text (anz fehlende blanks); + warnung (12, dummy) + FI; + zeilenbreite := anz aufzaehlungszeichen * einrueckbreite. + +ueberschreibung: + INT CONST anz zeichen mal einrueckbreite :: + anz aufzaehlungszeichen * einrueckbreite, + min zwischenraum :: (einrueckbreite DIV 4); + aufzaehlungsbreite + min zwischenraum > anz zeichen mal einrueckbreite. + +fehlende blanks errechnen: + INT VAR anz fehlende blanks :: + (aufzaehlungsbreite + min zwischenraum + - anz zeichen mal einrueckbreite + einrueckbreite - 1) + DIV einrueckbreite. +END PROC pruefe auf ueberschreibung; + +(********************** eingabe routinen **************************) + +PROC zeile lesen: + alte blanks := aktuelle blanks; + hole zeile; + behandele einrueckung. + +hole zeile: + IF macro works + THEN get macro line (zeile); + ELIF eof (eingabe) + THEN zeile := ""; + LEAVE zeile lesen + ELSE lesen + FI; + IF zeile = "" + THEN zeile := blank + ELIF (zeile SUB length (zeile) - 1) = blank + THEN ggf ueberfluessige leerzeichen am ende entfernen + FI. + +lesen: + IF format file in situ + THEN read record (eingabe, zeile); + delete record (eingabe) + ELSE read record (eingabe, zeile); + down (eingabe) + FI. + +ggf ueberfluessige leerzeichen am ende entfernen: + WHILE NOT within kanji (zeile, length (zeile) - 1) AND + subtext (zeile, length (zeile) - 1) = " " REP + delete char (zeile, length (zeile)) + END REP. + +behandele einrueckung: + aktuelle blanks := ""; + IF zeile <> blank + THEN INT VAR einrueckung := pos (zeile, ""33"", ""255"", 1); + IF einrueckung > 1 + THEN aktuelle blanks := subtext (zeile, 1, einrueckung - 1); + zeile := subtext (zeile, einrueckung) + FI + FI +END PROC zeile lesen; + +PROC zeile in puffer und zeile lesen: + puffer := zeile; + zeichenpos := 1; + von := 1; + zeile lesen; + pufferlaenge := length (puffer); + ggf absatz an puffer anfuegen; +END PROC zeile in puffer und zeile lesen; + +PROC ggf absatz an puffer anfuegen: + IF (zeile ist nur absatz AND NOT puffer hat absatz) + OR (NOT puffer hat absatz AND only command line (puffer) + AND only command line (zeile)) + THEN puffer CAT blank; + pufferlaenge := length (puffer) + ELIF puffer ist nur absatz AND (zeile SUB length (zeile)) <> " " AND + only command line (zeile) + THEN zeile CAT " " + FI. + +puffer ist nur absatz: + puffer = blank. + +zeile ist nur absatz: + zeile = blank. +END PROC ggf absatz an puffer anfuegen; + +(****************** routinen fuer zeilenende behandlung ***********) + +PROC verarbeite letztes zeichen von puffer: + zeichenpos := length (puffer); + begin of this char (puffer, zeichenpos); + zeichen := puffer SUB zeichenpos; + IF trennung vorhanden + THEN IF zeile hat richtige laenge + THEN neue zeile auffuellen und ausgabe bei zeilenende + ELSE getrennte zeilen zusammenziehen + FI + ELSE neue zeile auffuellen; + IF absatz + THEN letzter puffer war absatz := TRUE; + IF letztes kommando war macro AND macro hat absatz getaetigt + THEN zeile in puffer und zeile lesen; + initialisiere neue zeile; + ELSE ausgabe bei zeilenende; + FI + ELSE neue zeile ggf weiterfuehren + FI + FI. + +neue zeile ggf weiterfuehren: + IF macro end in dieser oder naechster zeile + THEN + ELIF zeile = "" + THEN schreibe und initialisiere neue zeile; + letzter puffer war absatz := TRUE + ELIF zeilenbreite + blank breite fuer diesen schrifttyp > + aktuelle pitch zeilenlaenge + THEN loesche nachfolgende blanks; + schreibe und initialisiere neue zeile + ELIF in neuer zeile steht etwas + THEN neue zeile CAT blank; + zeilenbreite INCR blank breite fuer diesen schrifttyp + FI; + zeile in puffer und zeile lesen. + +macro end in dieser oder naechster zeile: + macro works AND (pos (puffer, "#*") <> 0 OR pos (zeile, "#*") <> 0). + +in neuer zeile steht etwas: + pos (neue zeile, ""33"", ""255"", 1) <> 0. + +letztes kommando war macro: + pos (kommando, "macro") <> 0. + +macro hat absatz getaetigt: + NOT in neuer zeile steht etwas. +END PROC verarbeite letztes zeichen von puffer; + +PROC getrennte zeilen zusammenziehen: + zeichen := puffer SUB pufferlaenge; + IF NOT within kanji (puffer, pufferlaenge) AND zeichen = trennzeichen + THEN zeilenbreite DECR breite (trennzeichen); + delete char (puffer, pufferlaenge); + pufferlaenge := length (puffer); + IF ((puffer SUB pufferlaenge) = trenn k) AND ((zeile SUB 1) = "k") + THEN replace (puffer, pufferlaenge, "c"); + zeilenbreite DECR breite ("k"); + zeilenbreite INCR breite ("c"); + FI; + zeichenpos := pufferlaenge + 1 + FI; + puffer CAT zeile; + zeile lesen; + pufferlaenge := length (puffer); + ggf absatz an puffer anfuegen; +END PROC getrennte zeilen zusammenziehen; + +BOOL PROC trennung vorhanden: + IF within kanji (puffer, pufferlaenge) + THEN LEAVE trennung vorhanden WITH FALSE + FI; + zeichen := puffer SUB pufferlaenge; + zeichen = trennzeichen OR wort mit bindestrich. + +wort mit bindestrich: + zeichen = bindestrich AND kein leerzeichen davor + AND NOT naechstes wort ist konjunktion AND kein loser gedankenstrich. + +kein leerzeichen davor: + NOT within kanji (puffer, pufferlaenge - 1) AND + (puffer SUB pufferlaenge - 1) <> blank. + +naechstes wort ist konjunktion: + pos (zeile, "und") = 1 + OR pos (zeile, "oder") = 1 + OR pos (zeile, "bzw") = 1 + OR pos (zeile, "sowie") = 1. + +kein loser gedankenstrich: + pufferlaenge > 1. +END PROC trennung vorhanden; + +BOOL PROC zeile hat richtige laenge: + zeilenbreite > aktuelle pitch zeilenlaenge - trennbreite +END PROC zeile hat richtige laenge; + +(*********************** ausgabe routinen *******************) + +PROC ende einer neuen zeile: + IF zeichenpos > 0 + THEN begin of this char (puffer, zeichenpos); + FI; + zeichen := puffer SUB zeichenpos; + zeichenpos bereits verarbeitet := 0; + IF naechstes zeichen ist absatz + THEN zeichenpos := pufferlaenge; + verarbeite letztes zeichen von puffer; + LEAVE ende einer neuen zeile + ELIF zeichen = blank + THEN neue zeile auffuellen (von, zeichenpos - 1); + zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos); + von := zeichenpos; + ELIF nach zeichenpos beginnt ein neues wort + THEN neue zeile auffuellen (von, zeichenpos); + zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos + 1); + von := zeichenpos + ELIF letzter puffer passte genau + THEN (* erstes zeichen des neuen puffers > zeilenbreite *) + zeichenpos := 1; + von := 1 + ELSE zeichenpos bereits verarbeitet := zeichenpos; + trennung eventuell vornehmen; + IF erstes wort auf der absatzzeile laesst sich nicht trennen + THEN alte blanks := aktuelle blanks + FI + FI; + loesche nachfolgende blanks; + IF NOT in foot uebertrag + THEN schreibe und initialisiere neue zeile; + zeilenbreite und zeichenpos auf das bereits verarbeitete + zeichen setzen; + FI. + +erstes wort auf der absatzzeile laesst sich nicht trennen: + pos (neue zeile, ""33"", ""255"", 1) = 0 AND (*keine buchstaben*) + length (neue zeile) > 1 AND (*einrueckung*) + (neue zeile SUB length (neue zeile)) = blank. (* Absatz *) + +naechstes zeichen ist absatz: + zeichenpos + 1 = pufferlaenge AND puffer hat absatz. + +nach zeichenpos beginnt ein neues wort: + (pufferlaenge > zeichenpos + 2) AND (puffer SUB zeichenpos + 1) = blank. + +letzter puffer passte genau: + zeichenpos <= 0. + +zeilenbreite und zeichenpos auf das bereits verarbeitete zeichen setzen: + IF zeichenpos bereits verarbeitet <> 0 + THEN INT VAR bis := zeichenpos, einfuege pos := bis; + zeilenbreite um die bereits verarbeiteten zeichen erhoehen; + zeichenpos := zeichenpos bereits verarbeitet; + IF einfuege pos > 1 + THEN insert char (puffer, blank, einfuege pos); + pufferlaenge := length (puffer); + von := einfuege pos + 1; + char pos move (vorwaerts) + FI; + char pos move (vorwaerts); + FI. + +zeilenbreite um die bereits verarbeiteten zeichen erhoehen: + zeichenpos := zeichenpos bereits verarbeitet; + WHILE (puffer SUB bis) = kommandozeichen REP + bis := pos (puffer, kommandozeichen, bis + 1) + 1 + END REP; + begin of this char (puffer, zeichenpos); + WHILE zeichenpos >= bis REP + IF (puffer SUB zeichenpos) = kommandozeichen + THEN ueberspringe das kommando (puffer, zeichenpos, rueckwaerts) + ELSE zeilenbreite INCR breite (puffer, zeichenpos); + FI; + IF zeichenpos <= 1 + THEN LEAVE zeilenbreite um die bereits verarbeiteten zeichen erhoehen + FI; + char pos move (rueckwaerts) + END REP. +END PROC ende einer neuen zeile; + +PROC loesche nachfolgende blanks: + WHILE NOT within kanji (neue zeile, length (neue zeile)) AND + (neue zeile SUB length (neue zeile)) = blank REP + delete char (neue zeile, length (neue zeile)) + END REP +END PROC loesche nachfolgende blanks; + +PROC neue zeile auffuellen: + dummy := subtext (puffer, von); + neue zeile CAT dummy +END PROC neue zeile auffuellen; + +PROC neue zeile auffuellen (INT CONST from, to): + dummy := subtext (puffer, from, to); + neue zeile CAT dummy +END PROC neue zeile auffuellen; + +PROC schreibe neue zeile: + IF macro works + THEN IF alte neue zeile einschliesslich macro ist auszugeben + THEN schreibe textteil einschliesslich macro; + FI + ELSE schreibe; + pruefe auf abbruch + FI. + +alte neue zeile: + before macro state . new line. + +alter puffer: + before macro state . buffer line. + +alte neue zeile einschliesslich macro ist auszugeben: + INT VAR text anf :: pos (alte neue zeile, ""33"", ""255"", 1); + text anf <> 0. + +schreibe textteil einschliesslich macro: + dummy := neue zeile; + neue zeile := alte neue zeile; + IF macro hatte absatz danach + THEN neue zeile CAT " " + ELSE zeilennr INCR 1 + FI; + schreibe; + neue zeile := dummy; + alte neue zeile := subtext (alte neue zeile, 1, text anf - 1). + +macro hatte absatz danach: + length (alter puffer) - 1 = length (alte neue zeile) AND + (alter puffer SUB length (alter puffer)) = " ". + +pruefe auf abbruch: + IF incharety = escape + THEN errorstop ("Abbruch mit ESC") + FI. +END PROC schreibe neue zeile; + +PROC schreibe: + IF format file in situ + THEN insert record (eingabe); + write record (eingabe, neue zeile); + down (eingabe) + ELSE insert record (ausgabe); + write record (ausgabe, neue zeile); + down (ausgabe); + speicher ueberlauf + FI; + execute stored commands; + IF (neue zeile SUB length (neue zeile)) = blank + THEN einrueckbreite := eingestellte indentation pitch + FI. + +speicher ueberlauf: + INT VAR size, used; + storage (size, used); + IF used > size + THEN errorstop ("Speicherengpaß") + FI. +END PROC schreibe; + +PROC schreibe und initialisiere neue zeile: + schreibe neue zeile; + initialisiere neue zeile +END PROC schreibe und initialisiere neue zeile; + +PROC ausgabe bei zeilenende: + schreibe und initialisiere neue zeile; + zeile in puffer und zeile lesen +END PROC ausgabe bei zeilenende; + +PROC neue zeile auffuellen und ausgabe bei zeilenende: + neue zeile auffuellen; + schreibe und initialisiere neue zeile; + zeile in puffer und zeile lesen +END PROC neue zeile auffuellen und ausgabe bei zeilenende; + +PROC initialisiere neue zeile: + einrueckung in die neue zeile; + zeilennummer mitzaehlen. + +einrueckung in die neue zeile: + IF zeichenpos < pufferlaenge AND + (puffer hat absatz OR foot ohne absatz am zeilenende) + THEN neue zeile := alte blanks + ELSE neue zeile := aktuelle blanks + FI; + zeilenbreite := length (neue zeile) * einrueckbreite; + IF zeilenbreite +trennbreite +einrueckbreite >= aktuelle pitch zeilenlaenge + THEN fehler (10, ""); + zeilenbreite := 0; + FI. + +foot ohne absatz am zeilenende: + pos (puffer, "#foot#") > 1 AND pos (puffer, "#foot#") = length (puffer) -5. + +zeilennummer mitzaehlen: + IF NOT macro works + THEN zeilennr INCR 1; + cout (zeilennr); + FI. +END PROC initialisiere neue zeile; + +PROC letzte neue zeile ausgeben: + IF pos (neue zeile, ""33"", ""255"", 1) <> 0 + THEN schreibe neue zeile + FI; + offene modifikationen ausgeben; + offene indizes ausgeben; + IF aktueller editor < 1 + THEN referenzen ueberpruefen; + offene counter referenzen ausgeben; + FI. + +offene modifikationen ausgeben: + WHILE length (modifikations speicher) <> 0 REP + dummy := (modifikations speicher SUB 1); + delete char (modifikations speicher, 1); + dummy CAT " in Zeile "; + dummy CAT text (mod zeilennr speicher ISUB 1); + delete int (mod zeilennr speicher, 1); + warnung (5, dummy) + END REP. + +offene indizes ausgeben: + WHILE length (index speicher) <> 0 REP + dummy := (index speicher SUB 1); + delete char (index speicher, 1); + dummy CAT " in Zeile "; + dummy CAT text (ind zeilennr speicher ISUB 1); + delete int (ind zeilennr speicher, 1); + warnung (6, dummy) + END REP. + +offene counter referenzen ausgeben: + INT VAR begin pos := pos (counter reference store, "#"); + WHILE begin pos > 0 REP + INT VAR end pos := pos (counter reference store, "#", begin pos + 1); + IF (counter reference store SUB begin pos - 1) <> "u" + THEN fehler (60, subtext (counter reference store, begin pos + 1, + end pos - 1)) + ELIF (counter reference store SUB begin pos - 2) <> "i" + THEN fehler (61, subtext (counter reference store, begin pos + 1, + end pos - 1)) + FI; + begin pos := pos (counter reference store, "#", end pos + 1) + END REP. +END PROC letzte neue zeile ausgeben; + +(*********************** silbentrenn routinen *******************) + +INT PROC position von (TEXT CONST such zeichen, INT CONST richtung, + INT VAR anz zeich, breite der z): + INT VAR index :: zeichenpos; + TEXT VAR akt z; + anz zeich := 0; + breite der z := 0; + WHILE index > 1 AND index < pufferlaenge REP + akt z := puffer SUB index; + IF akt z = such zeichen + THEN LEAVE position von WITH index + ELIF akt z = kommandozeichen + THEN ueberspringe das kommando (puffer, index, richtung); + IF nur ein kommandozeichen gefunden + THEN gehe nur bis erstes kommandozeichen + ELIF index <= 1 OR index >= pufferlaenge + THEN LEAVE position von WITH index + FI + ELSE anz zeich INCR 1; + breite der z INCR breite (puffer, index) + FI; + char pos move (index, richtung) + END REP; + anz zeich INCR 1; + breite der z INCR breite (puffer, index); + index. + +nur ein kommandozeichen gefunden: + (puffer SUB index) <> kommandozeichen. + +gehe nur bis erstes kommandozeichen: + index := zeichenpos; anz zeich := 0; breite der z := 0; + WHILE (puffer SUB index) <> kommandozeichen REP + anz zeich INCR 1; + breite der z INCR breite (puffer, index); + char pos move (index, richtung) + END REP; + IF richtung <> rueckwaerts + THEN index DECR 1 + FI; + LEAVE position von WITH index. +END PROC position von; + +PROC ueberspringe das kommando (TEXT CONST t, INT VAR i, INT CONST richtung): + REP + i INCR richtung; + IF within kanji (t, i) + THEN i INCR richtung + FI + UNTIL (t SUB i) = kommandozeichen OR i <= 1 OR i >= length (t) END REP. +END PROC ueberspringe das kommando; + +PROC trennung eventuell vornehmen: +INT VAR xwort1, ywort1, + anz zeichen davor, + breite davor; + IF macro works + THEN fehler (6, "") + FI; + trennsymbol := trennzeichen; + wortanfang := position von + (blank, rueckwaerts, anz zeichen davor, breite davor); + bereite neue zeile bis wortanfang auf; + IF trennung sinnvoll + THEN versuche zu trennen + ELSE zeichenpos := wortanfang + FI. + +bereite neue zeile bis wortanfang auf: + IF wortanfang > 1 + THEN wortanfang INCR 1 + FI; + IF von > wortanfang + THEN eliminiere zeichen in neuer zeile bis wortanfang + ELSE neue zeile auffuellen (von, wortanfang - 1) + FI; + von := wortanfang. + +eliminiere zeichen in neuer zeile bis wortanfang: + INT VAR y :: length (neue zeile); + begin of this char (neue zeile, y); + WHILE y >= 1 REP + IF (neue zeile SUB y) = kommandozeichen + THEN ueberspringe das kommando (neue zeile, y, rueckwaerts) + FI; + char pos move (neue zeile, y, rueckwaerts) + UNTIL (neue zeile SUB y) = blank END REP; + neue zeile := subtext (neue zeile, 1, y). + +trennung sinnvoll: + anz zeichen davor > 2 AND breite davor > trennbreite. + +versuche zu trennen: + INT CONST k := zeichenpos; + naechste zeile ggf heranziehen; + zeichenpos := k; + wortteile holen; + trenn (trennwort ohne komm, wort1 ohne komm, trennsymbol, + max trennlaenge ohne komm); + wort1 mit komm ermitteln; + IF lineform mode + THEN wort2 := subtext (trennwort, length (wort1) + 1, max trennlaenge); + display vorherige zeile bis wortanfang; + schreibe nicht trennbaren teil des trennwortes; + schreibe zeile nach trennwort; + skip input; + interaktive worttrennung + FI; + neue zeile mit trennwort versehen; + IF wort1 <> "" AND NOT lineform mode + THEN note (zeilen nr); note (": "); + note (trennwort); + note (" --> "); + note (wort1); note (trennsymbol); + wort2 := subtext (trennwort, length (wort1) + 1); + note (wort2); + note line + FI. + +wortteile holen: + zeichenpos durch trennzeichenbreite verschieben; + wort1 := subtext (puffer, wortanfang, zeichenpos); + max trennlaenge := length (wort1); + wortende ermitteln; + wort2 := subtext (puffer, zeichenpos, wortende); + trennwort := subtext (puffer, wortanfang, wortende); + trennwort ohne komm ermitteln; + wort1 ohne komm := subtext (trennwort ohne komm, 1, anz zeichen davor); + max trenn laenge ohne komm := anz zeichen davor. + +trennwort ohne komm ermitteln: + trennwort ohne komm := trennwort; + WHILE pos (trennwort ohne komm, kommando zeichen) <> 0 REP + INT CONST komm anf := pos (trennwort ohne komm, kommando zeichen), + komm ende:= pos (trennwort ohne komm, kommando zeichen, + komm anf + 1); + IF komm ende = 0 + THEN LEAVE trennwort ohne komm ermitteln + FI; + dummy := subtext (trennwort ohne komm, komm ende + 1); + trennwort ohne komm := subtext (trennwort ohne komm, 1, komm anf - 1); + trennwort ohne komm CAT dummy; + END REP. + +wort1 mit komm ermitteln: + IF length (wort1 ohne komm) = 0 + THEN wort1 := ""; + LEAVE wort1 mit komm ermitteln + FI; + INT VAR index ohne := 0, + index mit := 0; + REP + index ohne INCR 1; + index mit INCR 1; + WHILE (wort1 SUB index mit) = kommando zeichen REP + index mit := pos (wort1, kommando zeichen, index mit + 1) + 1 + END REP; + UNTIL index ohne >= length (wort1 ohne komm) END REP; + wort1 := subtext (wort1, 1, index mit). + +zeichenpos durch trennzeichenbreite verschieben: + REP + zeichen := puffer SUB zeichenpos; + IF zeichen = kommandozeichen + THEN ueberspringe das kommando (puffer, zeichenpos, rueckwaerts); + char pos move (rueckwaerts) + ELIF zeichenpos < wortanfang + 1 + THEN zeichenpos := wortanfang; + LEAVE trennung eventuell vornehmen + ELSE zeilenbreite DECR breite (puffer, zeichenpos); + anz zeichen davor DECR 1; + char pos move (rueckwaerts); + IF zeilenbreite+breite(trennzeichen) <= aktuellepitchzeilenlaenge + AND (puffer SUB zeichenpos) <> kommandozeichen + THEN LEAVE zeichenpos durch trennzeichenbreite verschieben + FI + FI; + END REP. + +wortende ermitteln: + INT VAR x1, x2; + wortende := position von (blank, 1, x1, x2); + IF pufferlaenge > wortende + THEN wortende DECR 1 + FI. + +display vorherige zeile bis wortanfang: + dummy := neue zeile; + dummy CAT subtext (puffer, von, wortanfang - 2); + line ; + outsubtext (dummy, length (dummy) - 78). + +schreibe nicht trennbaren teil des trennwortes: + line ; + get cursor (xwort1, ywort1); + IF length (trennwort) < 70 + THEN cursor (max trennlaenge + 4, ywort1); + outsubtext (trennwort, max trennlaenge + 1) + FI. + +schreibe zeile nach trennwort: + dummy := subtext (puffer, wortende + 1); + get cursor (trennwort endepos, ywort1); + IF length (trennwort) >= 70 + THEN + ELIF length (dummy) > 75 - trennwort ende pos + THEN outsubtext (dummy, 1, 75 - trennwort endepos); + ELSE out (dummy); + IF (dummy SUB length (dummy)) = blank + THEN cursor (78, ywort1); + out (begin mark); + out (end mark) + FI + FI. + +trennwort endepos: + xwort1. + +interaktive worttrennung: + REP + out (return); + schreibe erstes wort; + get cursor (xwort1, ywort1); + schreibe trennung; + schreibe zweites wort; + schreibe rest bei zu langem trennwort; + cursor (xwort1, ywort1); + hole steuerzeichen und veraendere worte + END REP. + +schreibe erstes wort: + out (begin mark); + IF length (trennwort) < 70 + THEN out (wort1) + ELSE outsubtext (wort1, length (wort1) - 60) + FI. + +schreibe trennung: + IF ck vorhanden + THEN out (links); out ("k"); + FI; + out (trennsymbol). + +schreibe zweites wort: + IF length (trennwort) < 70 + THEN out (wort2) + ELSE outsubtext (wort2, 1, 70 - xwort1); + FI; + out (end mark). + +schreibe rest bei zu langem trennwort: + IF length (trennwort) >= 70 + THEN INT VAR xakt pos; + out (cl eol); + get cursor (xakt pos, ywort1); + outsubtext (trennwort, max trennlaenge + 1, + max trennlaenge + 1 + (78 - xakt pos)) + FI. + +ck vorhanden: + (wort1 SUB length (wort1)) = "c" AND + (trennwort SUB (length (wort1) + 1)) = "k". + +hole steuerzeichen und veraendere worte: +TEXT VAR steuerzeichen; + inchar (steuerzeichen); + IF steuerzeichen = links + THEN nach links + ELIF steuerzeichen = rechts + THEN nach rechts + ELIF steuerzeichen = hop + THEN sprung + ELIF steuerzeichen = return + THEN line ; + LEAVE interaktive worttrennung + ELIF steuerzeichen = escape + THEN errorstop ("Abbruch mit ESC") + ELIF code (steuerzeichen) < 32 + THEN + ELSE trennsymbol := steuerzeichen; + LEAVE hole steuerzeichen und veraendere worte + FI; + IF wort1 = "" + OR (wort1 SUB length (wort1)) = bindestrich + THEN trennsymbol := blank + ELSE trennsymbol := trennzeichen + FI. + +nach links: +TEXT VAR ein zeichen; +INT VAR position; + IF length (wort1) <> 0 + THEN position := length (wort1); + IF (wort1 SUB position) = kommando zeichen + THEN ueberspringe das kommando (wort1, position, rueckwaerts); + FI; + position DECR 1; + wort1 := subtext (trennwort, 1, position); + wort2 := subtext (trennwort, position + 1, max trennlaenge); + IF rechtes teilwort mit bindestrich + THEN ein zeichen := (wort1 SUB length (wort1)); + delete char (wort1, length (wort1)); + insert char (wort2, ein zeichen, 1) + FI + FI. + +nach rechts: + IF length (wort1) < max trennlaenge + THEN position := length (wort1) + 1; + IF (trennwort SUB position) = kommando zeichen + THEN ueberspringe das kommando (trennwort, position, +1); + FI; + wort1 := subtext (trennwort, 1, position); + wort2 := subtext (trennwort, position + 1, max trennlaenge); + IF rechtes teilwort mit bindestrich + THEN wort1 CAT bindestrich; + delete char (wort2, 1) + FI + FI. + +rechtes teilwort mit bindestrich: + (wort2 SUB 1) = bindestrich AND + pos (buchstaben, wort1 SUB length (wort1)) <> 0. + +sprung: + inchar(steuerzeichen); + IF steuerzeichen = rechts + THEN wort1 := subtext (trennwort, 1, max trennlaenge); + wort2 := "" + ELIF steuerzeichen = links + THEN wort1 := ""; + wort2 := subtext (trennwort, 1, max trennlaenge) + FI. + +neue zeile mit trennwort versehen: + IF wort1 = "" + THEN keine trennung + ELSE zeichenpos := wortanfang + length (wort1); + mit trennsymbol trennen; + von := zeichenpos + FI. + +keine trennung: + IF wort ist zu lang fuer limit + THEN warnung (7, trennwort); + neue zeile CAT trennwort; + zeichenpos := wortende + 1; + zeichenpos bereits verarbeitet := 0; + von := zeichenpos + ELSE loesche nachfolgende blanks; + zeichenpos := wortanfang + FI. + +wort ist zu lang fuer limit: + length (alte blanks) * einrueckbreite + breite davor + trennbreite + >= aktuelle pitch zeilenlaenge. + +mit trennsymbol trennen: + IF (wort1 SUB length (wort1)) = "c" AND + (trennwort SUB (length (wort1) + 1)) = "k" + THEN replace (wort1, length (wort1), trenn k) + FI; + neue zeile CAT wort1; + IF trennsymbol <> blank + THEN neue zeile CAT trennsymbol + FI. +END PROC trennung eventuell vornehmen; + +PROC naechste zeile ggf heranziehen: + IF puffer hat absatz + OR puffer hat noch mindestens zwei woerter + OR zeile hat eine foot anweisung + OR in foot uebertrag + THEN LEAVE naechste zeile ggf heranziehen + ELIF trennung vorhanden + THEN IF zeichenpos < pufferlaenge + THEN zeilenbreite INCR breite (trennzeichen) + FI; + getrennte zeilen zusammenziehen; + LEAVE naechste zeile ggf heranziehen + FI; + puffer CAT blank; + puffer CAT zeile; + zeile lesen; + pufferlaenge := length (puffer); + ggf absatz an puffer anfuegen. + +puffer hat noch mindestens zwei woerter: + INT VAR anz :: 0, i :: zeichenpos; + WHILE pos (puffer, " ", i) > 0 REP + anz INCR 1; + i := pos (puffer, " ", i) + 1 + END REP; + anz > 1. + +zeile hat eine foot anweisung: + pos (puffer, "#foot") <> 0. +END PROC naechste zeile ggf heranziehen; + +(******************** initialisierungs routine *******************) + +PROC form initialisieren (TEXT CONST datei): + kommando liste := +"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"; + kommando liste 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"; + kommando liste 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"; + kommando liste CAT +"ub:70.0ue:71.0fb:72.0fe:73.0"; + line ; + erste fehlerzeilennr := 0; + anz tabs := 0; + zeilennr := 0; + zeilenbreite := 0; + anz blanks freihalten := 3; + herkunftsreferenzen := "#"; + zielreferenzen := "#"; + aktuelle blanks := ""; + font nr speicher := ""; + modifikationsspeicher := ""; + mod zeilennr speicher := ""; + index speicher := ""; + ind zeilennr speicher := ""; + counter numbering store := ""; + counter reference store := ""; + command store := ""; + kommando := ""; + neue zeile := ""; + zeile := ""; + puffer := " "; + macro works := FALSE; + in tabelle := FALSE; + in d und e verarbeitung := FALSE; + kommandos speichern := TRUE; + in foot := FALSE; + in foot uebertrag := FALSE; + test ob font table vorhanden; + bildschirm initialisieren; + zeile lesen; + zeile in puffer und zeile lesen; + einrueckung zweite zeile := "xxx"; + limit und type ggf anfragen; + einrueckbreite := eingestellte indentation pitch ; + initialisiere neue zeile; + IF einrueckung zweite zeile <> "xxx" + THEN aktuelle blanks := einrueckung zweite zeile + FI. + +test ob font table vorhanden: + INT VAR xxx :: x step conversion (0.0). + +bildschirm initialisieren: + IF online + THEN init + FI. + +init: + page; + IF lineform mode + THEN put ("LINEFORM") + ELSE put ("AUTOFORM") + FI; + put ("(für"); put (lines (eingabe)); put ("Zeilen):"); + put (datei); + cursor (1, 3). +END PROC form initialisieren; + +PROC limit und type ggf anfragen: + conversion (limit in cm, aktuelle pitch zeilenlaenge); + IF ask type and limit + THEN type und limit setzen + ELSE alter schriftname := kein vorhandener schriftname; + stelle font ein + FI; + REAL VAR x :: limit in cm; + conversion (x, aktuelle pitch zeilenlaenge); + IF x = fehler wert + THEN limit in cm := 16.0; + conversion (limit in cm, aktuelle pitch zeilenlaenge) + ELSE limit in cm := x + FI; + trennbreite setzen. + +type und limit setzen: + LET type text = "#type (""", + limit text = "#limit (", + kommando ende text = ")#", + kein vorhandener schriftname = "#####"; + IF type und limit anweisungen nicht vorhanden + THEN type und limit fragen + ELSE hole font; + alter schriftname := kein vorhandener schriftname + FI. + +type und limit fragen: + type anfragen; + type in neue zeile; + limit anfragen; + limit in neue zeile; + IF NOT format file in situ + THEN schreibe neue zeile; + zeilen nr INCR 1 + FI; + IF NOT puffer hat absatz + THEN einrueckung zweite zeile := aktuelle blanks; + aktuelle blanks := alte blanks;(* Einrueckung fuer die erste zeile*) + FI; + line. + +type und limit anweisungen nicht vorhanden: + (pos (puffer, type text) <> 1 OR pos (puffer, "limit") < 12). + +type anfragen: + put ("Bitte Schrifttyp :"); + IF font table name = font table + THEN dummy := font (font nr); + ELSE dummy := font (1); + font table name := font table + FI; + REP + editget (dummy); + IF font exists (dummy) + THEN alter schriftname := dummy; + font nr := font (dummy); + hole font; + LEAVE type anfragen + ELSE line ; + put ("ERROR: unbekannter Schrifttyp"); + line (2); + put ("Schrifttyp bitte nochmal:") + FI + END REP. + +type in neue zeile: + neue zeile := type text; + neue zeile CAT dummy; + neue zeile CAT """"; + neue zeile CAT kommando ende text. + +limit anfragen: + line ; + put ("Zeilenbreite (in cm):"); + dummy := text (limit in cm); + REP + editget (dummy); + limit in cm := real (dummy); + IF last conversion ok AND pos (dummy, ".") <> 0 + THEN LEAVE limit anfragen + ELSE line ; + put ("ERROR: Falsche Angabe"); + line (2); + put ("Zeilenbreite (in cm) bitte nochmal:"); + FI + END REP. + +limit in neue zeile: + neue zeile CAT limit text; + neue zeile CAT dummy; + neue zeile CAT kommando ende text; + neue zeile CAT " ". +END PROC limit und type ggf anfragen; + +PROC start form (TEXT CONST datei): + IF NOT format file in situ + THEN last param (datei); + FI; + disable stop; + dateien assoziieren; + zeilen form (datei); + IF is error + THEN fehlerbehandlung + ELSE datei neu nach alt kopieren + FI; + zwischendatei loeschen; + enable stop; + col (eingabe, 1); + IF aktueller editor > 0 + THEN set range (file, alter bereich) + FI; + IF anything noted + THEN IF aktueller editor = 0 + THEN to line (eingabe, erste fehler zeilen nr); + ELSE alles neu + FI; + note edit (eingabe) + ELIF NOT format file in situ + THEN to line (eingabe, 1) + FI. + +dateien assoziieren: + IF format file in situ + THEN + ELIF exists (datei) + THEN IF subtext (datei, length (datei) - 1) = ".p" + THEN errorstop + ("'.p'-Datei kann nicht mit lineform bearbeitet werden") + FI; + eingabe := sequential file (modify, datei); + ausgabe datei einrichten + ELSE errorstop ("Datei existiert nicht") + FI; + to line (eingabe, 1); + col (eingabe, 1). + +ausgabe datei einrichten: + ds := nilspace; + ausgabe := sequential file (modify, ds); + to line (ausgabe, 1); + copy attributes (eingabe, ausgabe). + +fehlerbehandlung: + put error; + clear error; + font nr := 1; + font table name := ""; + limit in cm := 16.0; + IF format file in situ + THEN insert record (eingabe); + write record (eingabe, neue zeile); + down (eingabe); + insert record (eingabe); + write record (eingabe, puffer); + down (eingabe); + insert record (eingabe); + write record (eingabe, zeile) + FI. + +datei neu nach alt kopieren: + IF NOT format file in situ + THEN forget (datei, quiet); + copy (ds, datei); + eingabe := sequential file (modify, datei) + FI. + +zwischendatei loeschen: + IF NOT format file in situ + THEN forget (ds) + FI. +END PROC start form; + +(************** line/autoform fuer benannte Dateien ******************) + +PROC lineform: + IF aktueller editor > 0 + THEN IF mark + THEN editor bereich bearbeiten + ELSE errorstop ("kein markierter Bereich") + FI + ELSE lineform (last param) + FI. + +editor bereich bearbeiten: + disable stop; + file := editfile; + set marked range (file, alter bereich); + lineform (file); + enable stop; +END PROC lineform; + +PROC lineform (TEXT CONST datei): + ask type and limit := TRUE; + lineform mode := TRUE; + format file in situ := FALSE; + start form (datei) +END PROC lineform; + +PROC autoform: + IF aktueller editor > 0 + THEN IF mark + THEN editor bereich bearbeiten + ELSE errorstop ("kein markierter Bereich") + FI + ELSE auto form (last param) + FI. + +editor bereich bearbeiten: + disable stop; + file := editfile; + set marked range (file, alter bereich); + autoform (file); + enable stop +END PROC autoform; + +PROC autoform (TEXT CONST datei): + ask type and limit := TRUE; + lineform mode := FALSE; + format file in situ := FALSE; + start form (datei) +END PROC autoform; + +(******************** line/autoform fuer files ************************) + +PROC lineform (FILE VAR f): + enable stop; + eingabe := f; + format file in situ := TRUE; + ask type and limit := TRUE; + lineform mode := TRUE; + start form (""); +END PROC lineform; + +PROC autoform (FILE VAR f): + enable stop; + eingabe := f; + format file in situ := TRUE; + ask type and limit := TRUE; + lineform mode := FALSE; + start form (""); +END PROC autoform; + +PROC lineform (FILE VAR f, TEXT CONST type name, REAL CONST file limit): + eingabe := f; + format file in situ := TRUE; + lineform mode := TRUE; + ask type and limit := FALSE; + par1 := type name; + limit in cm := file limit; + start form (""); +END PROC lineform; + +PROC autoform (FILE VAR f, TEXT CONST type name, REAL CONST file limit): + eingabe := f; + format file in situ := TRUE; + lineform mode := FALSE; + ask type and limit := FALSE; + par1 := type name; + limit in cm := file limit; + start form (""); +END PROC autoform; +END PACKET liner; +(* +REP + copy("lfehler","zz"); + IF yes ("autoform") + THEN autoform ("zz") + ELSE lineform ("zz") + FI; + edit("zz"); + forget("zz") +UNTIL yes ("ENDE") ENDREP; +*) + diff --git a/system/multiuser/1.7.5/src/macro store b/system/multiuser/1.7.5/src/macro store new file mode 100644 index 0000000..dc13a1b --- /dev/null +++ b/system/multiuser/1.7.5/src/macro store @@ -0,0 +1,298 @@ +(* ------------------- VERSION 13 vom 28.05.86 -------------------- *) +PACKET macro store DEFINES macro command and then process parameters, + get macro line, + number macro lines, + load macros, + list macros: + +(* Programm zur Behandlung von Textkosemtik-Macros + Autor: Rainer Hahn + Stand: 1.7.1 (Febr. 1984) +*) + +INITFLAG VAR this packet :: FALSE; + +DATASPACE VAR ds; + +BOUND MACROTABLE VAR macro table; + +FILE VAR f; + +LET MACROTABLE = STRUCT (ROW max macros TEXT replacement store, + ROW max macro zeilen TEXT macro zeilen, + ROW max macros TEXT macro namen, + ROW max macros INT anz parameter, + ROW max macros INT macro start); + + +LET tag = 1, + number = 3, + delimiter = 6, + end of scan = 7, + max macro zeilen = 1000, + max macros = 200; + +INT VAR index aktuelle macro zeile, + type, + anz zeilen in macro, + anz macro zeilen, + anz macros :: 0; + +TEXT VAR symbol, + fehlertext, + dummy, + kommando, + zeile; + +BOOL VAR with parameters, + macro end gewesen; + +PROC init macros: + IF NOT initialized (this packet) + THEN ds := nilspace; + macro table := ds; + macros leeren + FI. + +macros leeren: + anz macro zeilen := 0; + anz macros := 0. +END PROC init macros; + +PROC load macros (TEXT CONST fname): + init macros; + line; + IF exists (fname) + THEN f := sequential file (input, fname); + forget (ds); + ds := nilspace; + macro table := ds; + macros einlesen + ELSE errorstop ("Datei existiert nicht") + FI. + +macros einlesen: + macro end gewesen := TRUE; + anz macros := 0; + anz macro zeilen := 0; + WHILE NOT eof (f) REP + anz macro zeilen INCR 1; + IF anz macro zeilen > max macro zeilen + THEN errorstop ("Zu viele Zeilen (max.1000)") + FI; + cout (anz macro zeilen); + getline (f, zeile); + IF zeile = "" + THEN zeile := " " + ELIF pos (zeile, "#*") > 0 + THEN macro name oder end vermerken + FI; + IF macro end gewesen AND zeile = " " + THEN anz macro zeilen DECR 1 + ELSE macro table . macro zeilen [anz macro zeilen] := zeile + FI + END REP; + anz macro zeilen INCR 1; + macro table . macro zeilen [anz macro zeilen] := " "; + IF anz macros = 0 + THEN putline ("Macros geleert") + FI. + +macro name oder end vermerken: + INT CONST komm anfang :: pos (zeile, "#*") + 2, + komm ende :: pos (zeile, "#", komm anfang); + IF komm anfang <> 3 OR hinter dem kommando steht noch was + THEN errorstop ("Macro-Anweisung steht nicht alleine auf der Zeile"); + FI; + kommando := subtext (zeile, komm anfang, komm ende -1); + scan (kommando); + next symbol (symbol, type); + IF type = tag + THEN macro namen aufnehmen + ELSE errorstop ("kein Macroname nach #*") + FI; + next symbol (symbol, type); + IF type >= end of scan + THEN macro table . anz parameter [anz macros] := 0; + LEAVE macro name oder end vermerken + ELIF symbol = "(" + THEN parameter aufsammeln; + ELSE errorstop ("keine ( nach Macro-Name") + FI. + +macro namen aufnehmen: + IF symbol = "macroend" + THEN put ("mit"); put (macro table . anz parameter [anz macros]); + put ("Parameter(n) geladen"); + macro end gewesen := TRUE; + line; + LEAVE macro name oder end vermerken + ELIF NOT macro end gewesen + THEN errorstop ("macro end fehlt") + ELSE macro end gewesen := FALSE; + anz macros INCR 1; + IF anz macros > max macros + THEN errorstop ("Zu viele Macros (max. 200") + FI; + macro table . macro namen [anz macros] := symbol; + macro table . macro start [anz macros] := anz macro zeilen; + line; + put (symbol); + FI. + +hinter dem kommando steht noch was: + NOT (komm ende = length (zeile) COR + (komm ende + 1 = length (zeile) AND (zeile SUB komm ende + 1) = " ")). + +parameter aufsammeln: + INT VAR parameter number :: 1; + next symbol (symbol, type); + WHILE symbol = "$" REP + next symbol (symbol, type); + IF type = number CAND int (symbol) = parameter number + THEN IF parameter number > 9 + THEN errorstop ("Anzahl Parameter > 9") + FI; + macro table . anz parameter [anz macros] := parameter number; + parameter number INCR 1; + ELSE errorstop ("Parameter-Nummer inkorrekt: " + symbol) + FI; + next symbol (symbol, type); + IF symbol = ")" + THEN LEAVE parameter aufsammeln + ELIF symbol = "," + THEN next symbol (symbol, type) + ELSE errorstop (", oder ) erwartet:" + symbol) + FI + END REP; + errorstop ("Parameterliste inkorrekt bei" + symbol). +END PROC load macros; + +PROC load macros: + load macros (last param) +END PROC load macros; + +PROC list macros: + init macros; + note (""); + INT VAR i := 1; + WHILE i <= anz macro zeilen REP + cout (i); + note (macro table . macro zeilen [i]); + note line; + i INCR 1 + END REP; + note edit +END PROC list macros; + +BOOL PROC macro exists (TEXT CONST name, INT VAR anz params): + INT VAR i; + FOR i FROM 1 UPTO anz macros REP + IF macro table . macro namen [i] = name + THEN anz params := macro table . anz parameter [i]; + index aktuelle macro zeile := macro table . macro start [i] + 1; + berechne anzahl zeilen in macro; + IF anz params = 0 + THEN with parameters := FALSE + ELSE with parameters := TRUE; + lade macro in replacement store; + index aktuelle macro zeile := 1; + FI; + LEAVE macro exists WITH TRUE + FI + END REP; + FALSE. + +berechne anzahl zeilen in macro: + IF i = anz macros + THEN anz zeilen in macro := + anz macro zeilen - index aktuelle macro zeile; + ELSE anz zeilen in macro := + macro table . macro start [i + 1] - index aktuelle macro zeile + FI. + +lade macro in replacement store: + INT VAR k; + FOR k FROM 1 UPTO anz zeilen in macro REP + macro table . replacement store [k] := + macro table . macro zeilen [index aktuelle macro zeile +k-1] + END REP. +END PROC macro exists; + +PROC replace macro parameter (INT CONST number, TEXT CONST param): + TEXT VAR param text := "$" + text (number); + INT VAR k; + FOR k FROM 1 UPTO anz zeilen in macro - 1 REP + change all (macro table . replacement store [k], param text, param); + END REP +END PROC replace macro parameter; + +BOOL PROC macro command and then process parameters (TEXT VAR komm): + init macros; + LET tag = 1; + scan (komm); + next symbol (symbol, type); + IF type = tag + THEN untersuche ob deklariertes macro + ELSE FALSE + FI. + +untersuche ob deklariertes macro: + INT VAR anz macro params; + IF macro exists (symbol, anz macro params) + THEN fehlertext := "in Makro: "; fehlertext CAT symbol; + IF anz macro params > 0 + THEN macro parameter ersetzen + FI; + TRUE + ELSE FALSE + FI. + +macro parameter ersetzen: + next symbol (symbol, type); + IF symbol = "(" + THEN ersetze + ELSE report text processing error (34, 0, dummy, symbol + fehlertext); + LEAVE macro command and then process parameters WITH FALSE + FI. + +ersetze: + LET text type = 4, + end of scan = 7; + INT VAR number parameter :: 1; + REP + next symbol (symbol, type); + IF type = texttype + THEN replace macro parameter (number parameter, symbol); + ELSE report text processing error (35, 0, dummy, fehlertext + symbol); + LEAVE macro command and then process parameters WITH FALSE + FI; + number parameter INCR 1; + IF number parameter > anz macro params + THEN LEAVE macro command and then process parameters WITH TRUE + FI; + next symbol (symbol, type); + IF symbol <> "," OR type >= end of scan + THEN report text processing error (36, 0, dummy, fehlertext + symbol); + LEAVE macro command and then process parameters WITH FALSE + FI + END REP. +END PROC macro command and then process parameters; + +PROC get macro line (TEXT VAR macro zeile): + IF index aktuelle macro zeile > anz zeilen in macro + THEN macro zeile := "#### " + ELIF with parameters + THEN macro zeile := + macro table . replacement store [index aktuelle macro zeile] + ELSE macro zeile := + macro table . macro zeilen [index aktuelle macro zeile] + FI; + index aktuelle macro zeile INCR 1; +END PROC get macro line; + +INT PROC number macro lines: + anz zeilen in macro +END PROC number macro lines; +END PACKET macro store; + diff --git a/system/multiuser/1.7.5/src/multi user monitor b/system/multiuser/1.7.5/src/multi user monitor new file mode 100644 index 0000000..dd3051e --- /dev/null +++ b/system/multiuser/1.7.5/src/multi user monitor @@ -0,0 +1,93 @@ +(* ------------------- VERSION 2 16.05.86 ------------------- *) +PACKET multi user monitor DEFINES (* Autor: J.Liedtke *) + + monitor : + + +LET command list = + +"edit:1.01run:4.01runagain:6.0insert:7.01forget:9.01rename:11.2copy:12.2 +list:13.0storageinfo:14.0taskinfo:15.0 +fetch:16.1save:17.01break:19.0saveall:20.0 " ; + +LET text param type = 4 ; + + +INT VAR command index , number of params , previous heap size ; +TEXT VAR param 1, param 2 ; + + + lernsequenz auf taste legen ("q", ""1""8""1""12"break"13"") ; + lernsequenz auf taste legen ("e", ""1""8""1""12"edit"13"") ; + + +PROC monitor : + + disable stop ; + previous heap size := heap size ; + REP + command dialogue (TRUE) ; + sysin ("") ; + sysout ("") ; + cry if not enough storage ; + get command ("gib kommando :") ; + reset editor ; + analyze command (command list, text param type, + command index, number of params, param1, param2) ; + execute command ; + collect heap garbage if necessary + PER . + +collect heap garbage if necessary : + IF heap size > previous heap size + 10 + 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 . + +reset editor : + WHILE aktueller editor > 0 REP + quit + PER ; + clear error . + +ENDPROC monitor ; + +PROC execute command : + + enable stop ; + SELECT command index OF + CASE 1 : edit + CASE 2 : edit (param1) + CASE 3 : (* war frueher paralleleditor *) + 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: break + CASE 20: save all + + OTHERWISE do command + ENDSELECT . + +ENDPROC execute command ; + +ENDPACKET multi user monitor ; + diff --git a/system/multiuser/1.7.5/src/nameset b/system/multiuser/1.7.5/src/nameset new file mode 100644 index 0000000..8ea4359 --- /dev/null +++ b/system/multiuser/1.7.5/src/nameset @@ -0,0 +1,355 @@ +(* ------------------- VERSION 3 17.03.86 ------------------- *) +PACKET name set DEFINES (* Autor: J.Liedtke *) + + ALL , + SOME , + LIKE , + + , + - , + / , + do , + FILLBY , + remainder , + + fetch , + save , + fetch all , + save all , + forget , + erase , + insert , + edit : + + +LET cr lf = ""13""10"" ; + +TEXT VAR name ; +DATASPACE VAR edit space ; + +THESAURUS VAR remaining thesaurus := empty thesaurus ; + + +THESAURUS OP + (THESAURUS CONST left, right) : + + THESAURUS VAR union := left ; + INT VAR index := 0 ; + get (right, name, index) ; + WHILE name <> "" REP + IF NOT (union CONTAINS name) + THEN insert (union, name) + FI ; + get (right, name, index) + PER ; + union . + +ENDOP + ; + +THESAURUS OP + (THESAURUS CONST left, TEXT CONST right) : + + THESAURUS VAR union := left ; + IF NOT (union CONTAINS right) + THEN insert (union, right) + FI ; + union . + +ENDOP + ; + +THESAURUS OP - (THESAURUS CONST left, right) : + + THESAURUS VAR difference := empty thesaurus ; + INT VAR index := 0 ; + get (left, name, index) ; + WHILE name <> "" REP + IF NOT (right CONTAINS name) + THEN insert (difference, name) + FI ; + get (left, name, index) + PER ; + difference . + +ENDOP - ; + +THESAURUS OP - (THESAURUS CONST left, TEXT CONST right) : + + THESAURUS VAR difference := left ; + INT VAR index ; + delete (difference, right, index) ; + difference . + +ENDOP - ; + +THESAURUS OP / (THESAURUS CONST left, right) : + + THESAURUS VAR intersection := empty thesaurus ; + INT VAR index := 0 ; + get (left, name, index) ; + WHILE name <> "" REP + IF right CONTAINS name + THEN insert (intersection, name) + FI ; + get (left, name, index) + PER ; + intersection . + +ENDOP / ; + +THESAURUS OP ALL (TEXT CONST file name) : + + FILE VAR file := sequential file (input, file name) ; + THESAURUS VAR thesaurus := empty thesaurus ; + thesaurus FILLBY file ; + thesaurus . + +ENDOP ALL ; + +THESAURUS OP SOME (THESAURUS CONST thesaurus) : + + copy thesaurus into file ; + edit file ; + copy file into thesaurus . + +copy thesaurus into file : + forget (edit space) ; + edit space := nilspace ; + FILE VAR file := sequential file (output, edit space) ; + file FILLBY thesaurus . + +edit file : + modify (file) ; + edit (file) . + +copy file into thesaurus : + THESAURUS VAR result := empty thesaurus ; + input (file) ; + result FILLBY file ; + forget (edit space) ; + result . + +ENDOP SOME ; + +THESAURUS OP SOME (TASK CONST task) : + + SOME ALL task + +ENDOP SOME ; + +THESAURUS OP SOME (TEXT CONST file name) : + + SOME ALL file name + +ENDOP SOME ; + +THESAURUS OP LIKE (THESAURUS CONST thesaurus, TEXT CONST pattern) : + + THESAURUS VAR result:= empty thesaurus ; + INT VAR index:= 0 ; + REP get (thesaurus, name, index) ; + IF name = "" + THEN LEAVE LIKE WITH result + ELIF name LIKE pattern + THEN insert (result, name) + FI + PER ; + result . + +ENDOP LIKE ; + +THESAURUS PROC remainder : + + remaining thesaurus + +ENDPROC remainder ; + +PROC do (PROC (TEXT CONST) operate, THESAURUS CONST thesaurus) : + + INT VAR index := 0 , operation number := 0 ; + TEXT VAR name ; + + remaining thesaurus := empty thesaurus ; + disable stop ; + work off thesaurus ; + fill leftover with remainder . + +work off thesaurus : + REP + get (thesaurus, name, index) ; + IF name = "" + THEN LEAVE work off thesaurus + FI ; + operation number INCR 1 ; + cout (operation number) ; + execute (PROC (TEXT CONST) operate, name) + UNTIL is error ENDREP . + +fill leftover with remainder : + WHILE name <> "" REP + insert (remaining thesaurus, name) ; + get (thesaurus, name, index) + PER . + +ENDPROC do ; + +PROC execute (PROC (TEXT CONST) operate, TEXT CONST name) : + + enable stop ; + operate (name) + +ENDPROC execute ; + +PROC do (PROC (TEXT CONST, TASK CONST) operate, THESAURUS CONST thesaurus, + TASK CONST task) : + + INT VAR index := 0 , operation number := 0 ; + TEXT VAR name ; + + remaining thesaurus := empty thesaurus ; + disable stop ; + work off thesaurus ; + fill leftover with remainder . + +work off thesaurus : + REP + get (thesaurus, name, index) ; + IF name = "" + THEN LEAVE work off thesaurus + FI ; + operation number INCR 1 ; + cout (operation number) ; + execute (PROC (TEXT CONST, TASK CONST) operate, name, task) + UNTIL is error ENDREP . + +fill leftover with remainder : + WHILE name <> "" REP + insert (remaining thesaurus, name) ; + get (thesaurus, name, index) + PER . + +ENDPROC do ; + +PROC execute (PROC (TEXT CONST, TASK CONST) operate, + TEXT CONST name, TASK CONST task) : + + enable stop ; + operate (name, task) + +ENDPROC execute ; + +OP FILLBY (THESAURUS VAR thesaurus, FILE VAR file) : + + WHILE NOT eof (file) REP + getline (file, name) ; + delete trailing blanks ; + IF name <> "" CAND NOT (thesaurus CONTAINS name) + THEN insert (thesaurus, name) + FI + PER . + +delete trailing blanks : + WHILE (name SUB LENGTH name) = " " REP + name := subtext (name, 1, LENGTH name - 1) + PER . + +ENDOP FILLBY ; + +OP FILLBY (FILE VAR file, THESAURUS CONST thesaurus) : + + INT VAR index := 0 ; + REP + get (thesaurus, name, index) ; + IF name = "" + THEN LEAVE FILLBY + FI ; + putline (file, name) + PER . + +ENDOP FILLBY ; + +OP FILLBY (TEXT CONST file name, THESAURUS CONST thesaurus) : + + FILE VAR f := sequential file (output, file name) ; + f FILLBY thesaurus + +ENDOP FILLBY ; + + + +PROC fetch (THESAURUS CONST nameset) : + + do (PROC (TEXT CONST) fetch, nameset) + +ENDPROC fetch ; + +PROC fetch (THESAURUS CONST nameset, TASK CONST task) : + + do (PROC (TEXT CONST, TASK CONST) fetch, nameset, task) + +ENDPROC fetch ; + +PROC save (THESAURUS CONST nameset) : + + do (PROC (TEXT CONST) save, nameset) + +ENDPROC save ; + +PROC save (THESAURUS CONST nameset, TASK CONST task) : + + do (PROC (TEXT CONST, TASK CONST) save, nameset, task) + +ENDPROC save ; + +PROC fetch all : + + fetch all (father) + +ENDPROC fetch all ; + +PROC fetch all (TASK CONST manager) : + + fetch (ALL manager, manager) + +ENDPROC fetch all ; + +PROC save all : + + save all (father) + +ENDPROC save all ; + +PROC save all (TASK CONST manager) : + + save (ALL myself, manager) + +ENDPROC save all ; + +PROC forget (THESAURUS CONST nameset) : + + do (PROC (TEXT CONST) forget, nameset) + +ENDPROC forget ; + +PROC erase (THESAURUS CONST nameset) : + + do (PROC (TEXT CONST) erase, nameset) + +ENDPROC erase ; + +PROC erase (THESAURUS CONST nameset, TASK CONST task) : + + do (PROC (TEXT CONST, TASK CONST) erase, nameset, task) + +ENDPROC erase ; + +PROC insert (THESAURUS CONST nameset) : + + do (PROC (TEXT CONST) insert, nameset) + +ENDPROC insert ; + +PROC edit (THESAURUS CONST nameset) : + + do (PROC (TEXT CONST) edit, nameset) + +ENDPROC edit ; + +ENDPACKET name set ; + diff --git a/system/multiuser/1.7.5/src/pager b/system/multiuser/1.7.5/src/pager new file mode 100644 index 0000000..35189a4 --- /dev/null +++ b/system/multiuser/1.7.5/src/pager @@ -0,0 +1,2451 @@ +(*-------------------- VERSION 197 vom 05.05.86 -------(1.7.5)------ *) +PACKET seiten formatieren DEFINES pageform, + auto pageform, + number empty lines before foot, + first head, + last bottom: + +(* Programm zur interaktiven Formatierung von Seiten, Fussnoten, Kopf- und + Fusszeilen, Seitennummern usw. + Autor: Rainer Hahn + *) + +(***************** Deklarationen fuer pageform ************) + +LET type1 = 1, + linefeed = 3, + limit = 4, + free = 5, + page command0= 6, + page command1= 7, + pagenr = 8, + pagelength = 9, + foot = 10, + end = 11, + head = 12, + headeven = 13, + headodd = 14, + bottom = 15, + bottomeven = 16, + bottomodd = 17, + columns = 18, + columnsend = 19, + topage = 20, + goalpage = 21, + count0 = 22, + count1 = 23, + setcount = 24, + value0 = 25, + value1 = 26, + on = 27, + off = 28, + head on = 29, + head off = 30, + bottom on = 31, + bottom off = 32, + count per page=33, + foot contd = 34, + table = 35, + table end = 36, + r pos = 37, + l pos = 38, + c pos = 39, + d pos = 40, + b pos = 41, + clearpos0 = 42, + clearpos1 = 43, + fillchar = 44, + pageblock = 45, + counter1 = 46, + counter2 = 47, + counter store= 48, + countervalue0= 49, + countervalue1= 50, + set counter = 51, + u = 52, + d = 53, + e = 54, + fehler index = 100, + hop = ""1"", + upchar = ""3"", + cl eop = ""4"", + cl eol = ""5"", + downchar = ""10"", + rub in = ""11"", + rub out = ""12"", + return = ""13"", + end mark = ""14"", + begin mark = ""15"", + begin end mark = ""15""14"", + esc = ""27"", + blank = " ", + kommando zeichen = "#", + kopf = 1, + kopf gerade = 2, + fuss = 3, + fuss gerade = 4, + kopf ungerade = 5, + fuss ungerade = 6, + foot note = 7, + dina4 limit = "16.0", + dina4 pagelength = 25.0, + pos seitengrenze = 17, + zeilen nach oben = 13, + zeilen nach unten = 6, + max foot zeilen = 120, + max zeilen zahl = 15, + max refers = 300, + max anz seitenzeichen = 3; + +BOOL VAR interaktiv, + bereich aufnehmen, + zeile noch nicht verarbeitet, + es war ein linefeed in der zeile, + mindestens ein topage gewesen, + insert first head :: TRUE, + insert last bottom :: TRUE, + pageblock on, + ausgeschalteter head, + ausgeschalteter bottom, + count seitenzaehlung, + file works, + in tabelle, + in nullter seite, + letzte textzeile war mit absatz, + letztes seitenende war mit absatz, + letztes seitenende war in tabelle; + +INT VAR kommando anfangs pos, + kommando ende pos, + kommando index, + number blank lines before foot :: 1, + in index oder exponent, + durchgang, + nummer erste seite, + nummer letzte seite, + laufende spaltennr, + anz refers, + counter, + anz spalten, + anz zeilen nach oben, + anz vertauschte zeilen, + font nr, + type zeilenvorschub, + berechneter zeilenvorschub, + max zeilenvorschub, + max type zeilenvorschub, + textbegin zeilennr, + anz textzeilen, + text laenge vor columns, + bereichshoehe, + aktuelle seitenlaenge, + eingestellte seitenlaenge; + +REAL VAR real eingestellter zeilenvorschub, + realparam; + +TEXT VAR kommando, + par1, par2, + macro line, + vor macro, + nach macro, + dummy, + fehlerdummy, + modifikation, + modifikations speicher, + kommando seitenspeicher, + dec value, + counter numbering store, + counter reference store, + letzte kommandoleiste, + kommando speicher, + tab pos speicher, + bereich kommando speicher, + seitenzeichen, + name druck datei, + name eingabe datei, + zeile, + eingestellter typ, + eingestelltes limit; + +TEXT VAR kommando liste :: +"type:1.1linefeed:3.1limit:4.1free:5.1page:6.01pagenr:8.2pagelength:9.1 +foot:10.0end:11.0head:12.0headeven:13.0headodd:14.0bottom:15.0bottomeven:16.0 +bottomodd:17.0columns:18.2columnsend:19.0topage:20.1goalpage:21.1count:22.01 +setcount:24.1"; + +kommando liste CAT +"value:25.01on:27.1off:28.1headon:29.0headoff:30.0bottomon:31.0bottomoff:32.0 +countperpage:33.0footcontinued:34.0table:35.0tableend:36.0rpos:37.1lpos:38.1 +cpos:39.1dpos:40.2bpos:41.2clearpos:42.01fillchar:44.1pageblock:45.0"; + +kommando liste CAT +"counter:46.12storecounter:48.1putcounter:49.01setcounter:51.2u:52.0d:53.0 +e:54.0"; + +FILE VAR eingabe, + ausgabe; + +ROW 6 ROW max zeilenzahl TEXT VAR kopf fuss zeilen; + +ROW max foot zeilen TEXT VAR foot zeilen; + +ROW max foot zeilen BOOL VAR kommandos vorhanden; + +ROW 7 INT VAR anz kopf oder fuss zeilen, + kopf oder fuss laenge; + +ROW max anz seitenzeichen INT VAR laufende seitennr; + +BOUND ROW max refers REFER VAR refer sammler; + +LET REFER = STRUCT (TEXT kennzeichen, INT nummer, BOOL referenced); + +DATASPACE VAR ds; + +(********************* Einstell-Prozeduren ***************************) + +PROC first head (BOOL CONST was): + insert first head := was +END PROC first head; + +PROC last bottom (BOOL CONST was): + insert last bottom := was +END PROC last bottom; + +PROC number empty lines before foot (INT CONST n): + IF n >= 0 AND n < 10 + THEN number blank lines before foot := n + ELSE errorstop ("nur einstellbar zwischen 0 und 9") + FI +END PROC number empty lines before foot; + +(************************** Fehlermeldungen **********************) + +PROC fehler (INT CONST nr, TEXT CONST addition): + IF durchgang = 1 OR + kommando index = goalpage OR kommandoindex = count0 OR + kommando index = count1 OR kommando index = value1 OR + kommando index = topage OR kommando index = pagelength OR + kommando index = counterstoreOR kommando index = counter1 OR + kommando index = counter2 OR kommando index = countervalue1 + THEN fehler melden; + fehlermeldung auf terminal ausgeben + FI. + +fehler melden: + report text processing error (nr, line no (ausgabe), fehlerdummy, addition). + +fehlermeldung auf terminal ausgeben: + IF interaktiv + THEN cursor(1,2); out(cleop); + ELSE line + FI; + out (fehlerdummy); + line. +END PROC fehler; + +PROC warnung (INT CONST nr, TEXT CONST addition): + IF durchgang = 1 OR + kommando index = goalpage OR kommandoindex = count0 OR + kommando index = count1 OR kommando index = value1 OR + kommando index = topage OR kommando index = set counter + THEN fehler melden; + meldung auf terminal ausgeben + FI. + +fehler melden: + report text processing warning (nr, line no (ausgabe), fehlerdummy, addition). + +meldung auf terminal ausgeben: + IF interaktiv + THEN cursor(1,2); out(cleop); + ELSE line + FI; + out (fehlerdummy); + line. +END PROC warnung; + +(*************************** Globale Dateibehandlung **************) + +PROC datei assoziieren: + IF exists (name eingabe datei) + THEN ausgabe datei einrichten + ELSE errorstop (name eingabe datei + " existiert nicht") + FI. + +ausgabe datei einrichten: + IF name eingabe datei = name druck datei + THEN errorstop ("Name Eingabedatei = Name Ausgabedatei") + ELIF subtext (name eingabe datei, length (name eingabe datei) - 1) = ".p" + THEN errorstop ("Druckdatei kann nicht nochmal formatiert werden") + ELSE eingabe := sequential file (input, name eingabe datei); + copy (name eingabedatei, name druck datei); + ausgabe := sequential file (modify, name druck datei); + copy attributes (eingabe, ausgabe); + headline (ausgabe, name druck datei); + FI +END PROC datei assoziieren; + +PROC record einfuegen (TEXT CONST rec): + insert record (ausgabe); + write record (ausgabe, rec); + down (ausgabe); +END PROC record einfuegen; + +(******************** Kopf- oder Fusszeilen aufnehmen *************) + +PROC fussnote aufnehmen: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN aufnehmen (footnote) + ELSE fehler (19, kommando) + FI; + in index oder exponent := 0; + bereich aufnehmen := FALSE +END PROC fussnote aufnehmen; + +PROC aufnehmen (INT CONST was): + kommando zustand vor bereich speichern; + aktuelle zeile ggf mitzaehlen; + aufnehmen initialisieren; + kopf oder fuss zeilen aufnehmen. + +kommando zustand vor bereich speichern: + kommandos in dummy speichern; + bereich kommando speicher := dummy. + +aktuelle zeile ggf mitzaehlen: +INT VAR einleitungs kommando anfang :: kommando anfangs pos; + IF kommando anfangs pos > 1 + THEN IF NOT only command line (zeile) + THEN aktuelle seitenlaenge INCR max zeilenvorschub + FI; + read record (ausgabe, zeile) + FI. + +aufnehmen initialisieren: + IF was = foot note + THEN initialisierung fuer fussnoten + ELSE anz kopf oder fuss zeilen [was] := 1; + kommandos in dummy speichern; + kopf fuss zeilen [was] [1] := dummy; + kopf oder fuss laenge [was] := 0; + FI; + bereichshoehe := kopf oder fusslaenge [was]. + +initialisierung fuer fussnoten: + INT CONST fussnotenlaenge vorher :: kopf oder fuss laenge [footnote], + anz fusszeilen vorher :: anz kopf oder fusszeilen [footnote]; + anz kopf oder fuss zeilen [footnote] INCR 1; + kommandos in dummy speichern; + kommandoleiste in fussnote speichern; (* davor *) + IF anz kopf oder fuss zeilen [footnote] = 1 + THEN unterstreichungsstrich + FI. + +kommandoleiste in fussnote speichern: + foot zeilen [anz kopf oder fuss zeilen [footnote]] := dummy; + kommandos vorhanden [anz kopf oder fuss zeilen [footnote]]:= TRUE. + +unterstreichungsstrich: + FOR i FROM 2 UPTO max foot zeilen REP + kommandos vorhanden [i] := FALSE + ENDREP; + FOR i FROM 1 UPTO number blank lines before foot REP + foot zeilen [i + 1] := " " + END REP; + foot zeilen [number blank lines before foot + 2] := + "#on(""underline"")#               #off(""underline"")# "; + kopf oder fuss laenge [footnote] := + (number blank lines before foot + 1) * berechneter zeilenvorschub; + anz kopf oder fuss zeilen [footnote] := number blank lines before foot + 2. + +kopf oder fuss zeilen aufnehmen: +INT VAR anzahl :: 1; + REP + naechste zeile lesen; + cout (line no (ausgabe)); + IF mindestens ein kommando vorhanden + THEN kommandos von kopf oder fuss verarbeiten + FI; + in index oder exponent := 0; + zeile aufnehmen; + anzahl INCR 1 + UNTIL eof (ausgabe) END REP; + errorstop ("end fehlt bei Dateiende"). + +kommandos von kopf oder fuss verarbeiten: + max zeilenvorschub := berechneter zeilenvorschub; + max type zeilenvorschub := type zeilenvorschub; + kommando anfangs pos := pos (zeile, kommando zeichen); + WHILE kommando anfangs pos <> 0 REP + verarbeite kommando; + kommandos von kopf oder fuss pruefen; + kommando anfangs pos := + pos (zeile, kommando zeichen, kommando ende pos + 1) + END REP. + +kommandos von kopf oder fuss pruefen: + IF kommandoindex = end + THEN aufnehmen beenden + ELIF kommando index = free + THEN IF y step conversion (realparam) >= eingestellte seitenlaenge + THEN fehler (24, text (realparam)) + ELSE kopf oder fusslaenge [was] INCR y step conversion (realparam) + FI + ELIF seitenende + THEN INT VAR xx := durchgang; + durchgang := 1; + fehler (25, ""); + durchgang := xx; + zeile zurueck lesen; + kommando index := end; + LEAVE aufnehmen + ELIF kommando index = fehler index + THEN LEAVE aufnehmen + ELIF kommando index > free AND kommando index < to page + THEN fehler (11, kommando); + kommando index := fehler index; + LEAVE aufnehmen + FI. + +aufnehmen beenden: + IF kommando anfangs pos > 1 + THEN IF absatzzeile + THEN zeile := subtext (zeile, 1, kommando anfangs pos -1); + zeile CAT blank; + ELSE zeile := subtext (zeile, 1, kommando anfangs pos -1); + FI; + zeile aufnehmen + FI; + IF NOT (durchgang = 1 AND was = footnote) + THEN die aufgenommenen zeilen in druckdatei loeschen + FI; + LEAVE aufnehmen. + +die aufgenommenen zeilen in druckdatei loeschen: + INT VAR i; + delete record (ausgabe); + FOR i FROM 1 UPTO anzahl - 1 REP + up (ausgabe); + delete record (ausgabe) + END REP; + zeile zurueck lesen; + letztes kommando dieser zeile loeschen; + ggf kommandoleiste generieren. + +letztes kommando dieser zeile loeschen: + IF einleitungs kommando anfang = 1 + THEN delete record (ausgabe); + IF line no (ausgabe) = 1 + THEN zeile noch nicht verarbeitet := TRUE + ELSE zeile zurueck lesen + FI + ELSE dummy := subtext (zeile, 1, einleitungs kommando anfang - 1); + IF absatz zeile + THEN dummy CAT blank; + ELIF (dummy SUB length (dummy)) = " " + THEN delete char (dummy, length (dummy)) + FI; + write record (ausgabe, dummy) + FI. + +ggf kommandoleiste generieren: + kommandos in dummy speichern; + IF was = footnote + THEN anz kopf oder fusszeilen [footnote] INCR 1; + kommandoleiste in fussnote speichern (* danach *) + FI; + IF dummy <> bereich kommando speicher + THEN down (ausgabe); + record einfuegen (dummy); + up (ausgabe, 2); + FI. + +zeile aufnehmen: + zeile speichern (was, anzahl); + IF erreichte seitenlaenge > eingestellte seitenlaenge + THEN bereich aufnehmen := FALSE; + IF kommando index = end + THEN seitenende nach geteilter fussnote + ELSE seitenende vor der fussnote + FI; + kommando index := end; + LEAVE aufnehmen + FI. + +seitenende nach geteilter fussnote: + kopf oder fuss laenge [footnote] DECR max zeilenvorschub; + anz kopf oder fuss zeilen [footnote] DECR 1; + seitenende einbringen und zurueck. + +seitenende vor der fussnote: + kopf oder fuss laenge [footnote] := fussnotenlaenge vorher; + anz kopf oder fuss zeilen [footnote] := anz fusszeilen vorher; + ende einer seite. +END PROC aufnehmen; + +PROC zeile speichern (INT CONST was, anzahl): + zeile mitzaehlen; + IF was = footnote + THEN fussnote aufnehmen + ELIF anz kopf oder fuss zeilen [was] > max zeilenzahl + THEN errorstop ("Zu viele 'head' oder 'bottom' Zeilen"); + ELSE kopf fuss zeilen [was] [anz kopf oder fuss zeilen [was]] := zeile + FI. + +zeile mitzaehlen: + anz kopf oder fuss zeilen [was] INCR 1; + IF NOT only command line (zeile) + THEN IF mindestens ein kommando vorhanden + THEN kopf oder fuss laenge [was] INCR max zeilenvorschub; + bereichshoehe INCR max zeilenvorschub + ELSE kopf oder fuss laenge [was] INCR berechneter zeilenvorschub; + bereichshoehe INCR berechneter zeilenvorschub + FI; + IF bereichshoehe >= eingestellte seitenlaenge + THEN errorstop + ("head, bottom oder footzeilen > Seitenlänge (end vergessen?)") + FI + FI; + IF es war ein linefeed in der zeile + THEN berechne zeilenvorschub; + es war ein linefeed in der zeile := FALSE + FI; + IF erreichte seitenlaenge > eingestellte seitenlaenge + THEN fussnotenumbruch pruefung + FI. + +fussnote aufnehmen: + IF anz kopf oder fuss zeilen [footnote] > max footzeilen + THEN errorstop ("Zu viele Fußnotenzeilen") + ELIF bereichshoehe > eingestellte seitenlaenge - seitenlaenge fester teil + - (eingestellte seitenlaenge DIV 100 * 15) + THEN errorstop ("Fußnote > 85% der Seitenlänge (end vergessen?)") + ELSE foot zeilen [anz kopf oder fuss zeilen [footnote]] := zeile + FI. + +fussnotenumbruch pruefung: + IF fussnotenumbruch moeglich + THEN ggf fussnote aufbrechen + ELSE lese rueckwaerts um (anzahl); + IF only command line (zeile) + THEN lese rueckwaerts um (1) + FI + FI. + +fussnotenumbruch moeglich: + was = footnote AND anzahl > 2. + +ggf fussnote aufbrechen: + up (ausgabe); + IF interaktiv + THEN fussnotenumbruch anfrage; + line (2) + FI; + anweisungen fuer umbruch einfuegen. + +fussnotenumbruch anfrage: + schreibe titelzeile ("Weiterführen der Fußnote auf nächster Seite (j/n)?"); + line (2); + schreibe bildschirm; + cursor (53, 1); + skip input; + REP + TEXT VAR steuerzeichen; + inchar (steuerzeichen); + IF steuerzeichen = "n" + THEN lese rueckwaerts um (anzahl - 1); + IF only command line (zeile) + THEN lese rueckwaerts um (1) + FI; + LEAVE ggf fussnote aufbrechen + ELIF steuerzeichen = "j" OR steuerzeichen = return + THEN LEAVE fussnotenumbruch anfrage + ELIF steuerzeichen = esc + THEN errorstop ("Abbruch durch ESC") + FI + END REP. + +anweisungen fuer umbruch einfuegen: + record einfuegen ("#end#"); + record einfuegen ("#foot continued#"); + kommandos in dummy speichern; + record einfuegen (dummy); + record einfuegen ("Forts. von letzter Seite: "); + lese rueckwaerts um (3); + kommando index := end. +END PROC zeile speichern; + +PROC lese rueckwaerts um (INT CONST anzahl): + to line (ausgabe, line no (ausgabe) - anzahl); + read record (ausgabe, zeile) +END PROC lese rueckwaerts um; + +PROC schreibe kopf oder fuss (INT CONST was): + IF was = footnote + THEN fussnoten generieren + ELIF laufende spaltennr < 2 + THEN kopf oder fuss zeilen generieren + FI. + +kopf oder fusszeilen generieren: +INT VAR i :: 1; +BOOL VAR in generierter zeile war kommando :: FALSE; + ggf anfangs kommandos generieren; + FOR i FROM 2 UPTO anz kopf oder fuss zeilen [was] REP + dummy := kopf fuss zeilen [was] [i]; + IF NOT in generierter zeile war kommando + THEN in generierter zeile war kommando := + pos (dummy, kommandozeichen) <> 0 + FI; + fuege seitennr ein; + record einfuegen (dummy) + END REP; + ggf ende kommandos generieren. + +ggf anfangs kommandos generieren: + kommandos in dummy speichern; + IF dummy <> kopf fuss zeilen [was] [1] + THEN record einfuegen (kopf fuss zeilen [was] [1]) + FI. + +ggf ende kommandos generieren: + kommandos in dummy speichern; + IF dummy <> kopf fuss zeilen [was] [1] OR + in generierter zeile war kommando + THEN record einfuegen (dummy) + FI. + +fuege seitennr ein: +INT VAR k; + change all (dummy, + (seitenzeichen SUB 1) + (seitenzeichen SUB 1), + text (laufende seitennr [1] +1)); + FOR k FROM 1 UPTO length (seitenzeichen) REP + change all (dummy, seitenzeichen SUB k, text (laufende seitennr [k])); + END REP. + +fussnoten generieren: + kommandos in dummy speichern; + letzte kommandoleiste := dummy; + i := 1; + WHILE i < anz kopf oder fusszeilen [footnote] REP + IF kommandos vorhanden [i] + THEN IF letzte kommandoleiste <> footzeilen [i] + THEN record einfuegen (footzeilen [i]); + letzte kommandoleiste := footzeilen [i] + FI + ELSE record einfuegen (footzeilen [i]) + FI; + i INCR 1 + END REP; + IF footzeilen [i] <> dummy + THEN record einfuegen (dummy) + FI +END PROC schreibe kopf oder fuss; + +PROC fussnoten loeschen: + kopf oder fuss laenge [footnote] := 0; + anz kopf oder fuss zeilen [footnote] := 0 +END PROC fussnoten loeschen; + +PROC schreibe ggf fuss: + record einfuegen ("#text end#"); + ggf tabellenende generieren; + letztes seitenende war mit absatz := letzte textzeile war mit absatz; + IF erreichte seitenlaenge <> eingestellte seitenlaenge + THEN schreibe freien platz + FI; + IF kopf oder fuss laenge [footnote] > 0 + THEN ggf tabellenende generieren; + schreibe kopf oder fuss (footnote); + fussnoten loeschen + FI; + IF (NOT insert last bottom AND laufende seitennr [1] = nummer letzte seite) + OR ausgeschalteter bottom + THEN + ELSE schreibe mal fussbereich + FI. + +schreibe mal fussbereich: + IF kopf oder fuss laenge [fuss] > 0 + THEN schreibe kopf oder fuss (fuss) + ELIF kopf oder fuss laenge [fuss gerade] > 0 AND + (laufende seitennr [1] MOD 2 = 0) + THEN schreibe kopf oder fuss (fuss gerade) + ELIF kopf oder fuss laenge [fuss ungerade] > 0 AND + (laufende seitennr [1] MOD 2 <> 0) + THEN schreibe kopf oder fuss (fuss ungerade) + FI. + +ggf tabellenende generieren: + IF tab pos speicher <> "" + THEN record einfuegen ("#clear pos# ") + FI; + IF in tabelle + THEN record einfuegen ("#table end# "); + letztes seitenende war in tabelle := TRUE; + in tabelle := FALSE + FI. + +schreibe freien platz: + IF pageblock on + THEN schreibe ggf stauchung oder streckungs anweisung + ELSE schreibe free (eingestellte seitenlaenge - erreichte seitenlaenge) + FI. + +schreibe ggf stauchung oder streckungs anweisung: + IF interaktiv AND seitenluecke > fuenf prozent der seitenlaenge + THEN cursor (1, 2); + dummy := begin mark; + dummy CAT "Soll die Seite beim Druck gestreckt werden ("; + dummy CAT text (ystepconversion (seitenluecke)); + dummy CAT " cm)"; + dummy CAT end mark; + IF no (dummy) + THEN cursor (1, 2); + out (cl eol); + schreibe free + (eingestellte seitenlaenge - erreichte seitenlaenge); + line; + LEAVE schreibe ggf stauchung oder streckungs anweisung + FI; + cursor (1, 2); + out (cl eol); + line + FI; + INT VAR i :: lineno (ausgabe); + to line (ausgabe, textbegin zeilennr); + dummy := "#textbegin ("; + dummy CAT text (anz textzeilen); + dummy CAT ", """; + dummy CAT text (ystepconversion (seitenluecke)); + dummy CAT """)#"; + read record (ausgabe, zeile); + IF (zeile SUB length (zeile)) = blank + THEN dummy CAT blank + FI; + write record (ausgabe, dummy); + to line (ausgabe, i). + +seitenluecke: + eingestellte seitenlaenge - erreichte seitenlaenge. + +fuenf prozent der seitenlaenge: + ((eingestellte seitenlaenge + 99) DIV 100) * 5. +END PROC schreibe ggf fuss; + +(**************************** kommando speicherung *****************) + +PROC grenzmarkierung in dummy speichern: + dummy := "#page##"; + dummy CAT (3 * "-----------"); + dummy CAT " Ende der Seite "; + IF in nullter seite + THEN dummy CAT "0 " + ELSE dummy CAT (text (laufende seitennr [1]) + blank) + FI; + IF anz spalten > 1 + THEN dummy CAT "und Spalte "; + dummy CAT (text (laufende spaltennr) + blank) + ELSE dummy CAT "-----------" + FI; + dummy CAT kommando zeichen +END PROC grenzmarkierung in dummy speichern; + +PROC kommandos in dummy speichern: + type speichern; + dummy CAT modifikation; + limit speichern; + linefeed mit absatzblank speichern. + +type speichern: + dummy := "#type("""; + dummy CAT eingestellter typ; + dummy CAT """)#". + +limit speichern: + dummy CAT "#limit("; + dummy CAT eingestelltes limit; + dummy CAT ")#". + +linefeed mit absatzblank speichern: + dummy CAT "#linefeed(0"; + dummy CAT text (real eingestellter zeilenvorschub); + dummy CAT ")# ". +END PROC kommandos in dummy speichern; + +PROC kommandos aufheben: + kommandos in dummy speichern; + kommando speicher := dummy +END PROC kommandos aufheben; + +PROC kommandos wiederherstellen: + zeile := kommando speicher; + kommandos verarbeiten; + berechneter zeilenvorschub := + int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5); + max zeilenvorschub := berechneter zeilenvorschub; + max type zeilenvorschub := type zeilenvorschub +END PROC kommandos wiederherstellen; + +(**************************** headzeilen einfuegen ************************) + +PROC schreibe ggf kopf: + IF (NOT insert first head AND laufende seiten nr [1] = nummer erste seite) + OR ausgeschalteter head + THEN + ELSE schreibe mal + FI; + ggf tabellenanfang generieren; + text begin anweisung generieren. + +schreibe mal: + IF kopf oder fuss laenge [kopf] > 0 + THEN schreibe kopf oder fuss (kopf); + aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf] + ELIF kopf oder fuss laenge [kopf gerade] > 0 + AND (laufende seitennr [1] MOD 2 = 0) + THEN schreibe kopf oder fuss (kopf gerade); + aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf gerade] + ELIF kopf oder fuss laenge [kopf ungerade] > 0 + AND (laufende seitennr [1] MOD 2 <> 0) + THEN schreibe kopf oder fuss (kopf ungerade); + aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf ungerade] + FI. + +ggf tabellenanfang generieren: + IF tab pos speicher <> "" + THEN record einfuegen ("#clearpos#"); + record einfuegen (tab pos speicher) + FI; + IF letztes seitenende war in tabelle + THEN record einfuegen ("#table# "); + letztes seitenende war in tabelle := FALSE; + in tabelle := TRUE + FI. + +text begin anweisung generieren: + dummy := "#text begin#"; + IF letztes seitenende war mit absatz + THEN dummy CAT " " + FI; + record einfuegen (dummy); + textbegin zeilennr := line no (ausgabe) - 1. +END PROC schreibe ggf kopf; + +PROC erhoehe seiten und spaltennr: + IF anz spalten > 1 + THEN erhoehe spaltennummer + FI; + IF NOT in nullter seite + THEN erhoehe seitennummer + FI. + +erhoehe spaltennummer: + laufende spaltennr INCR 1; + IF laufende spaltennr > anz spalten + THEN laufende spaltennr := 1; + text laenge vor columns := 0 + ELSE LEAVE erhoehe seiten und spaltennr + FI. + +erhoehe seitennummer: + INT VAR i; + FOR i FROM 1 UPTO length (seitenzeichen) REP + laufende seitennr [i] INCR 1 + END REP +END PROC erhoehe seiten und spaltennr; + +PROC seitennummer setzen (INT CONST akt nummer): + IF pos (seitenzeichen, par1) = 0 + THEN IF length (seitenzeichen) >= max anz seitenzeichen + THEN fehler (16, ""); + LEAVE seitennummer setzen + FI; + seitenzeichen CAT par1 + FI; + laufende seitennr [pos (seitenzeichen, par1)] := akt nummer. +END PROC seitennummer setzen; + +PROC kommando seitenspeicher fuellen: + kommando seitenspeicher CAT "#"; + kommando seitenspeicher CAT kommando; + kommando seitenspeicher CAT "#" +END PROC kommando seitenspeicher fuellen; + +(************************** kommandos verarbeiten ********************) + +PROC verarbeite kommando: +INT VAR anz params, intparam; + kommando ende pos := + pos (zeile, kommando zeichen, kommando anfangs pos + 1); + IF kommando ende pos <> 0 + THEN kommando oder kommentar kommando verarbeiten + ELSE fehler (2, + subtext (zeile, kommandoanfangspos, kommandoanfangspos+9)+"..."); + zeile CAT kommando zeichen; + write record (ausgabe, zeile); + kommando ende pos := length (zeile) + FI. + +kommando oder kommentar kommando verarbeiten: + IF pos ("-/"":", zeile SUB kommando anfangs pos + 1) = 0 + THEN kommando := + subtext (zeile, kommando anfangs pos + 1, kommando ende pos - 1); + scanne kommando; + setze kommando um + ELSE kommando index := 0 + FI. + +scanne kommando: + analyze command (kommandoliste, kommando, 3, + kommando index, anz params, par1, par2); + disable stop; + command error; + IF is error + THEN dummy := error message; + clear error; + dummy CAT " -> "; + dummy CAT kommando; + fehler (22, dummy); + enable stop; + LEAVE verarbeite kommando + FI; + enable stop. + +setze kommando um: + IF durchgang = 3 AND kommando index <> value1 AND kommando index <> to page + AND kommando index <> counter value1 + THEN LEAVE verarbeite kommando + FI; + SELECT kommando index OF + +CASE type1: + modifikation := ""; + IF in index oder exponent > 0 + THEN LEAVE setze kommando um + ELIF font exists (par1) + THEN font nr := font (par1); + eingestellter typ := par1; + type zeilenvorschub := + font height (fontnr) + font lead (fontnr) + font depth (fontnr); + IF type zeilenvorschub > max type zeilenvorschub + THEN max type zeilenvorschub := type zeilenvorschub + FI + ELSE fehler (1, par1) + FI; + berechne zeilenvorschub + +CASE linefeed: + realparam := real (par1); + IF last conversion ok AND pos (par1, ".") <> 0 + THEN real eingestellter zeilenvorschub := realparam; + es war ein linefeed in der zeile := TRUE + ELSE fehler (4, par1) + FI + +CASE limit: + eingestelltes limit := par1 + +CASE free: + realparam := real (par1); + IF last conversion ok AND pos (par1, ".") <> 0 + THEN IF keine zeichen ausser blank nach dem kommando + THEN free kommando ausfuehren + ELSE fehler (19, kommando); + FI + ELSE fehler (4, par1) + FI + +CASE page command0: + IF keine zeichen ausser blank nach dem kommando + THEN page behandlung; + schreibe titelzeile + ELSE fehler (19, kommando) + FI + +CASE page command1: + IF keine zeichen ausser blank nach dem kommando + THEN INT VAR seitennummer mit page := int (par1); + page behandlung; + laufende spaltennr := 1; + text laenge vor columns := 0; + IF seitennummer mit page <= 0 + THEN fehler (27, "page (" + text (seitennummer mit page) + ")") + ELSE laufende seitennr [1] := seitennummer mit page + FI + ELSE fehler (19, kommando) + FI + +CASE pagenr: + IF in nullter seite OR durchgang = 4 + THEN intparam := int (par2); + IF length (par1) <> 1 + THEN fehler (14, "") + ELIF NOT last conversion ok + THEN fehler (5, kommando) + ELIF intparam <= 0 + THEN fehler (27, kommando) + ELSE seitennummer setzen (intparam) + FI + ELIF durchgang = 2 + THEN kommando seitenspeicher fuellen + FI + +CASE pagelength: + realparam := real (par1); + IF last conversion ok AND pos (par1, ".") <> 0 + THEN IF in nullter seite OR durchgang = 4 + THEN eingestellte seitenlaenge := y step conversion (realparam) + ELIF durchgang = 2 + THEN kommando seitenspeicher fuellen + FI + ELSE fehler (4, kommando) + FI + +CASE foot, foot contd: + fussnote aufnehmen + +CASE end: + IF NOT bereich aufnehmen + THEN fehler (31, "") + FI; + bereich aufnehmen := FALSE; + kommando index := end; + IF NOT keine zeichen ausser blank nach dem kommando + THEN fehler (19, kommando) + FI + +CASE head: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [kopf ungerade] := 0; + kopf oder fuss laenge [kopf gerade] := 0; + aufnehmen (kopf) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE headeven: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [kopf] := 0; + aufnehmen (kopf gerade) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE headodd: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [kopf] := 0; + aufnehmen (kopf ungerade) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE bottom: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [fuss ungerade] := 0; + kopf oder fuss laenge [fuss gerade] := 0; + aufnehmen (fuss) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE bottomeven: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [fuss] := 0; + aufnehmen (fuss gerade) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE bottomodd: + bereich aufnehmen := TRUE; + IF keine zeichen ausser blank nach dem kommando + THEN kopf oder fuss laenge [fuss] := 0; + aufnehmen (fuss ungerade) + ELSE fehler (19, kommando) + FI; + bereich aufnehmen := FALSE + +CASE columns: + IF anz spalten > 1 + THEN fehler (29, "") + ELSE anz spalten := int (par1); + laufende spalten nr := 1; + IF anz spalten < 2 + THEN fehler (26, ""); + anz spalten := 2 + FI; + text laenge vor columns := + aktuelle seitenlaenge + kopf oder fuss laenge [footnote] + FI + +CASE columnsend: + IF durchgang = 1 + THEN delete record (ausgabe); + IF NOT nur dateiende danach + THEN seitenende einbringen und zurueck; + record einfuegen ("#columnsend#"); + text laenge vor columns := 0; + laufende spaltennr := 1; + anz spalten := 1; + kommando index := page command0; + down (ausgabe) + FI + FI + +CASE topage: + IF durchgang > 1 + THEN ggf gespeicherte nummer einsetzen (par1); + mindestens ein topage gewesen := TRUE + FI + +CASE goalpage: + IF durchgang > 1 + THEN nummer und kennzeichen speichern (laufende seitennr[1], par1) + FI + +CASE count0, count1: + IF durchgang > 1 + THEN counter INCR 1; + change (zeile, + kommando anfangs pos, kommando ende pos, text(counter)); + kommando ende pos := kommando anfangs pos; + write record (ausgabe, zeile); + IF anz params = 1 + THEN nummer und kennzeichen speichern (counter, par1) + FI + FI + +CASE setcount: + intparam := int (par1); + IF last conversion ok AND intparam >= 0 + THEN counter := intparam - 1 + ELSE fehler (30, par1) + FI + +CASE value0: + IF durchgang > 1 + THEN change (zeile, kommando anfangs pos, kommando ende pos, + text (counter)); + write record (ausgabe, zeile); + kommando ende pos := kommando anfangs pos + FI + +CASE value1: + IF durchgang > 1 + THEN ggf gespeicherte nummer einsetzen (par1) + FI + +CASE on: + change all (par1, " ", ""); + par1 := (par1 SUB 1); + modifikation CAT "#on(""" + par1 + """)#" + +CASE off: + change all (par1, " ", ""); + par1 := (par1 SUB 1); + changeall (modifikation, "#on(""" + par1 + """)#", ""); + +CASE head on: ausgeschalteter head := FALSE +CASE head off: ausgeschalteter head := TRUE + +CASE bottom on: ausgeschalteter bottom := FALSE +CASE bottom off: ausgeschalteter bottom := TRUE + +CASE count per page: count seitenzaehlung := TRUE + +CASE table: + IF durchgang > 1 + THEN in tabelle := TRUE + FI + +CASE table end: + IF durchgang > 1 + THEN in tabelle := FALSE + FI + +CASE r pos, l pos, c pos, d pos, b pos, clearpos1, fillchar: + IF durchgang > 1 + THEN tab pos speicher CAT "#"; + tab pos speicher CAT kommando; + tab pos speicher CAT "#" + FI + +CASE clearpos0: + IF durchgang > 1 + THEN tab pos speicher := "" + FI + +CASE pageblock : pageblock on := TRUE + +CASE counter1, counter2: + IF durchgang > 1 + THEN process counter + FI + +CASE set counter: + IF durchgang > 1 + THEN process set counter + FI + +CASE counter store: + IF durchgang > 1 + THEN process counter store + FI + +CASE counter value0: + IF durchgang > 1 + THEN write dec value into file + FI + +CASE counter value1: + IF durchgang > 1 + THEN process counter value + FI + +CASE u, d: + in index oder exponent INCR 1 + +CASE e: + in index oder exponent DECR 1 + +OTHERWISE + kommando index := 0; + IF macro command and then process parameters (kommando) + THEN ersetze macro + FI +END SELECT. + +nur dateiende danach: + INT VAR diese zeile :: line no (ausgabe); + WHILE NOT eof (ausgabe) REP + read record (ausgabe, zeile); + IF length (zeile) > 1 + THEN to line (ausgabe, diese zeile); + read record (ausgabe, zeile); + LEAVE nur dateiende danach WITH FALSE + FI; + down (ausgabe) + END REP; + to line (ausgabe, diese zeile); + read record (ausgabe, zeile); + TRUE. +END PROC verarbeite kommando; + +(************************ Makro-Ersetzung **************************) + +PROC ersetze macro: + INT VAR erste zeile :: line no (ausgabe); + hole texte um macro herum; + fuege macro zeilen ein; + fuege text nach macro an; + positioniere zurueck. + +hole texte um macro herum: + vor macro := subtext (zeile, 1, kommando anfangs pos - 1); + nach macro := subtext (zeile, kommando ende pos + 1). + +fuege macro zeilen ein: + INT VAR anz :: 1; + WHILE anz < number macro lines REP + get macro line (macro line); + IF anz = 1 + THEN vor macro CAT macro line ; + write record (ausgabe, vor macro); + ELSE down (ausgabe); + insert record (ausgabe); + write record (ausgabe, macro line) + FI; + anz INCR 1 + END REP. + +fuege text nach macro an: + read record (ausgabe, zeile); + IF length (nach macro) <> 0 + THEN zeile CAT nach macro + ELIF (zeile SUB length (zeile)) <> blank AND number macro lines > 2 + THEN delete record (ausgabe); + read record (ausgabe, dummy); + zeile CAT dummy + FI; + IF subtext (zeile, length (zeile) - 1, length (zeile)) = " " + THEN delete char (zeile, length (zeile)) + FI; + write record (ausgabe, zeile). + +positioniere zurueck: + to line (ausgabe, erste zeile); + read record (ausgabe, zeile); + IF in nullter seite + THEN zeile noch nicht verarbeitet := TRUE + FI; + kommando ende pos := kommando anfangs pos - 1. +END PROC ersetze macro; + +(************************ Zeilenvorschub-Berechnung ****************) + +PROC berechne zeilenvorschub: + berechneter zeilenvorschub := + int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5); + IF real eingestellter zeilenvorschub >= 1.0 + THEN max zeilenvorschub := max + (int (real (max type zeilenvorschub)*real eingestellter zeilenvorschub + 0.5), + berechneter zeilenvorschub) + ELIF berechneter zeilenvorschub > max zeilenvorschub + THEN max zeilenvorschub := berechneter zeilenvorschub + FI +END PROC berechne zeilenvorschub; + +(**************************** counter processing **********************) + +PROC process counter: + dummy := "#"; + dummy CAT par1; + dummy CAT "#"; + IF pos (counter numbering store, dummy) = 0 + THEN fehler (34, par1); + LEAVE process counter + FI; + get dec value (counter numbering store); + IF kommando index = counter2 + THEN resize dec value to needed points + FI; + IF dec value was just initialized + THEN dec value := subtext (dec value, 2) + ELIF kommando index = counter1 + THEN digit value := int (dec value); + digit value INCR 1; + dec value := text (digit value) + ELSE incr counter value + FI; + write dec value into file; + replace value in numbering store (dec value). + +resize dec value to needed points: + INT VAR needed points :: int (par2), + begin of last digit :: 1; + WHILE needed points > 0 REP + IF next point pos = 0 + THEN IF needed points = 1 + THEN dec value CAT ".0" + ELSE dec value CAT ".1" + FI; + begin of last digit := length (dec value) + ELSE begin of last digit := next point pos + 1 + FI; + needed points DECR 1 + END REP; + INT VAR end of last digit := next point pos - 1; + IF end of last digit < 0 + THEN end of last digit := length (dec value) + FI; + dec value := subtext (dec value, 1, end of last digit). + +next point pos: + pos (dec value, ".", begin of last digit). + +dec value was just initialized: + (dec value SUB 1) = "i". + +incr counter value: + INT VAR digit value :: int ( + subtext (dec value, begin of last digit, end of last digit)); + digit value INCR 1; + change (dec value, begin of last digit, end of last digit, + text (digit value)). +END PROC process counter; + +PROC process set counter: + dummy := "#"; + dummy CAT par1; + dummy CAT "#"; + IF pos (counter numbering store, dummy) <> 0 + THEN warnung (15, par1); + replace value in numbering store (par2); + INT VAR begin pos :: pos (counter numbering store, dummy) + 1; + begin pos := pos (counter numbering store, "#", beginpos) + 1; + insert char (counter numbering store, "i", begin pos) + ELSE counter numbering store CAT dummy; + counter numbering store CAT "i"; + counter numbering store CAT par2 + FI. +END PROC process set counter; + +PROC process counter store: + IF pos (counter reference store, par1) <> 0 + THEN fehler (35, par1) + ELSE store it + FI. + +store it: + counter reference store CAT "#"; + counter reference store CAT par1; + counter reference store CAT "#"; + counter reference store CAT dec value +END PROC process counter store; + +PROC process counter value: + dummy := "#"; + dummy CAT par1; + dummy CAT "#"; + IF pos (counter reference store, dummy) <> 0 + THEN get dec value (counter reference store); + write dec value into file + ELIF durchgang = 3 + THEN fehler (61, par1) + FI. +END PROC process counter value; + +PROC replace value in numbering store (TEXT CONST val): + INT VAR begin pos :: pos (counter numbering store, dummy) + 1; + begin pos := pos (counter numbering store, "#", begin pos) + 1; + INT VAR end pos := pos (counter numbering store, "#", begin pos)-1; + IF end pos <= 0 + THEN end pos := length (counter numbering store) + FI; + change (counter numbering store, begin pos, end pos, val) +END PROC replace value in numbering store; + +PROC write dec value into file: + change (zeile, kommando anfangs pos, kommando ende pos, dec value); + kommando ende pos := kommando anfangs pos; + write record (ausgabe, zeile) +END PROC write dec value into file; + +PROC get dec value (TEXT CONST store): + INT VAR value begin :: pos (store, dummy); + value begin := pos (store, "#", value begin + 1) + 1; + INT VAR value end :: pos (store, "#", value begin)-1; + IF value end < 0 + THEN value end := length (store) + FI; + dec value := subtext (store, value begin, value end). +END PROC get dec value; + +(************************** Zaehler routinen ('refer') ***************) + +PROC nummer und kennzeichen speichern (INT CONST number, TEXT VAR kennung): + ueberpruefe auf bereits vorhandenes kennzeichen; + anz refers INCR 1; + IF anz refers > max refers + THEN errorstop ("Anzahl Referenzen zu gross") + FI; + refer sammler [anz refers] . kennzeichen := kennung; + refer sammler [anz refers] . nummer := number; + refer sammler [anz refers] . referenced := FALSE. + +ueberpruefe auf bereits vorhandenes kennzeichen: + INT VAR i; + FOR i FROM 1 UPTO anz refers REP + IF refer sammler [i] . kennzeichen = kennung + THEN warnung (9, kennung); + LEAVE nummer und kennzeichen speichern + FI + END REP. +END PROC nummer und kennzeichen speichern; + +PROC ggf gespeicherte nummer einsetzen (TEXT VAR kennung): + IF kennzeichen vorhanden + THEN change (zeile, kommando anfangs pos, kommando ende pos, textnummer); + refer sammler [i] . referenced := TRUE; + kommando ende pos := kommando anfangs pos; + write record (ausgabe, zeile) + ELIF durchgang = 3 + THEN warnung (4, kennung) + FI. + +textnummer: + text (refer sammler [i] . nummer). + +kennzeichen vorhanden: +INT VAR i; + FOR i FROM 1 UPTO anz refers REP + IF refer sammler [i] . kennzeichen = kennung + THEN LEAVE kennzeichen vorhanden WITH TRUE + FI + END REP; + FALSE. +END PROC ggf gespeicherte nummer einsetzen; + +(************************** free-Kommando *****************************) + +PROC free kommando ausfuehren: +INT CONST wert in y steps :: y step conversion (realparam); + IF bereich aufnehmen + THEN + ELIF wert in y steps>=eingestellte seitenlaenge - seitenlaenge fester teil + THEN fehler (13, "") + ELIF erreichte seitenlaenge + wert in y steps > eingestellte seitenlaenge + THEN ende einer seite; + kommando index := fehler index + ELSE aktuelle seitenlaenge INCR wert in y steps + FI +END PROC free kommando ausfuehren; + +(*************************** page-Kommando ******************************) + +PROC page behandlung: +TEXT VAR steuerzeichen; + page kommando entfernen; + IF aktuelle seitenlaenge <= 0 + THEN IF line no (ausgabe) = 1 + THEN zeile noch nicht verarbeitet := TRUE + ELSE up (ausgabe) + FI; + LEAVE page behandlung + FI; + IF interaktiv + THEN initialisiere bildschirm fuer page; + mit page interaktiv formatieren; + schreibe titelzeile; + FI; + BOOL CONST hilf :: pageblock on; + pageblock on := FALSE; + seitenende einbringen und zurueck; + pageblock on := hilf; + kommando index := page command0. + +page kommando entfernen: + IF kommando anfangs pos = 1 + THEN delete record (ausgabe); + IF line no (ausgabe) = 1 + THEN zeile noch nicht verarbeitet := TRUE + FI + ELSE zeile := subtext (zeile, 1, kommando anfangs pos - 1); + write record (ausgabe, zeile); + IF NOT only command line (zeile) + THEN aktuelle seitenlaenge INCR max zeilenvorschub + FI; + down (ausgabe) + FI. + +initialisiere bildschirm fuer page: + schreibe titelzeile + ("#page# bestaetigen: RETURN / loeschen: HOP RUBOUT / Abbruch: ESC"); + line ; out (cleol); + put ("#page# nach"); + put (y step conversion (erreichte seitenlaenge)); put ("cm"); + schreibe bildschirm; + out (hop). + +mit page interaktiv formatieren: + REP + inchar (steuerzeichen); + IF steuerzeichen = return + THEN zeilenmitteilung loeschen; + LEAVE mit page interaktiv formatieren + ELIF steuerzeichen = rubout + THEN weitermachen + ELIF steuerzeichen = esc + THEN errorstop ("Abbruch mit ESC") + FI + END REP. + +weitermachen: + zeilenmitteilung loeschen; + up (ausgabe); + LEAVE page behandlung. + +zeilenmitteilung loeschen: + cursor (1, 2); out (cleol); line. +END PROC page behandlung; + +PROC seite nochmal durchgehen: + zurueck bis seitenende; + kommandos wiederherstellen; + down (ausgabe); + IF count seitenzaehlung + THEN counter := 0 + FI; + schreibe ggf kopf; + read record (ausgabe, zeile); + seitenlaenge initialisieren; + fussnoten loeschen; + bis seitenende lesen und kommandos verarbeiten; + schreibe ggf fuss; + initialisieren fuer neue seite. + +bis seitenende lesen und kommandos verarbeiten: + durchgang := 2; + zeilen und kommandos verarbeiten; + durchgang := 1. + +zeilen und kommandos verarbeiten: + anz textzeilen := 0; + WHILE NOT seitenende REP + IF mindestens ein kommando vorhanden + THEN IF NOT only command line (zeile) + THEN anz textzeilen INCR 1 + FI; + kommandos verarbeiten und ggf zeile mitzaehlen; + ELSE aktuelle seitenlaenge INCR berechneter zeilenvorschub; + anz textzeilen INCR 1 + FI; + naechste zeile lesen + END REP. + +initialisieren fuer neue seite: + kommandos aufheben; + fussnoten loeschen; + erhoehe seiten und spaltennr; + seitenlaenge initialisieren +END PROC seite nochmal durchgehen; + +PROC seitenlaenge initialisieren: + IF anz spalten > 1 AND laufende spaltennr > 1 + THEN aktuelle seitenlaenge := text laenge vor columns + ELSE aktuelle seitenlaenge := 0; + verarbeite seitenkommandos + FI. + +verarbeite seitenkommandos: + IF kommando seitenspeicher <> "" + THEN zeile := kommando seitenspeicher; + kommando seitenspeicher := ""; + INT CONST xx := durchgang; + durchgang := 4; + kommandos verarbeiten; + durchgang := xx + FI. +END PROC seitenlaenge initialisieren; + +PROC zurueck bis seitenende: + up (ausgabe, "#page##---", line no (ausgabe)); + IF anz spalten > 1 AND laufende spaltennr > 1 + THEN down (ausgabe); + schreibe free (text laenge vor columns + head laenge); + up (ausgabe) + FI; + read record (ausgabe, zeile); + cout (line no (ausgabe)); +END PROC zurueck bis seitenende; + +BOOL PROC seitenende: + pos (zeile, "#page#") = 1 AND pos (zeile, "-----", 8) = 8 +END PROC seitenende; + +(**************************** eigentliche seitenform-routine *********) + +PROC seiten form: + enable stop; + datei assoziieren; + page form initialisieren; + to line (ausgabe, 1); + read record (ausgabe, zeile); + in nullter seite := TRUE; + nullte seite verarbeiten; + nullte seitengrenze einfuegen; + in nullter seite := FALSE; + formieren. + +nullte seite verarbeiten: + aktuelle seitenlaenge := 0; + WHILE only command line (zeile) REP + IF seitenende + THEN errorstop ("Bitte Originaldatei bearbeiten (keine Druckdatei)") + FI; + kommandos verarbeiten; + IF es war ein free kommando OR tabellen kommando + THEN LEAVE nullte seite verarbeiten + ELIF es war ein linefeed in der zeile + THEN berechne zeilenvorschub; + es war ein linefeed in der zeile := FALSE; + naechste zeile lesen + ELIF zeile noch nicht verarbeitet + THEN read record (ausgabe, zeile); + zeile noch nicht verarbeitet := FALSE + ELSE naechste zeile lesen + FI; + cout (line no (ausgabe)) + ENDREP. + +es war ein free kommando: + aktuelle seitenlaenge <> 0. + +tabellen kommando: + kommando index >= 35 AND kommando index <= 44. + +nullte seitengrenze einfuegen: + laufende spaltennr := 0; + grenzmarkierung in dummy speichern; + record einfuegen (dummy); + read record (ausgabe, zeile); + kommandos aufheben; + aktuelle seitenlaenge := 0; + erhoehe seiten und spaltennr; + nummer erste seite := laufende seiten nr [1]. + +formieren: + REP + cout (line no (ausgabe)); + IF mindestens ein kommando vorhanden + THEN kommandos verarbeiten und ggf zeile mitzaehlen + ELSE aktuelle seitenlaenge INCR berechneter zeilenvorschub; + FI; + IF erreichte seitenlaenge > eingestellte seitenlaenge + THEN ende einer seite + FI; + IF eof (ausgabe) + THEN eof behandlung; + LEAVE formieren + ELSE down (ausgabe); + IF eof (ausgabe) + THEN eof behandlung; + LEAVE formieren + ELSE read record (ausgabe, zeile) + FI + FI + END REP. +END PROC seiten form; + +PROC eof behandlung: + grenzmarkierung in dummy speichern; + insert record (ausgabe); + write record (ausgabe, dummy); + nummer letzte seite := laufende seiten nr [1]; + pageblock on := FALSE; + seite nochmal durchgehen; + IF anz refers <> 0 OR mindestens ein topage gewesen + OR counter reference store <> "" + THEN ausgabe datei nochmals durchgehen; + offene referenzen pruefen + FI. + +ausgabe datei nochmals durchgehen: + to line (ausgabe, 1); col (ausgabe, 1); + durchgang := 3; + REP + down (ausgabe, "#", lines (ausgabe)); + IF pattern found + THEN read record (ausgabe, zeile); + cout (line no (ausgabe)); + kommandos verarbeiten; + IF eof (ausgabe) + THEN LEAVE ausgabe datei nochmals durchgehen + ELSE down (ausgabe); col (ausgabe, 1) + FI + ELSE LEAVE ausgabe datei nochmals durchgehen + FI + END REP. + +offene referenzen pruefen: + INT VAR i; + FOR i FROM 1 UPTO anz refers REP + IF NOT refer sammler [i] . referenced + THEN report text processing warning + (3, 0, fehlerdummy, CONCR(refersammler) [i] . kennzeichen) + FI + END REP. +END PROC eof behandlung; + +(************************** kommando verarbeitung **********) + +BOOL PROC mindestens ein kommando vorhanden: + pos (zeile, kommando zeichen) <> 0. +END PROC mindestens ein kommando vorhanden; + +PROC kommandos verarbeiten: + kommando anfangs pos := pos (zeile, kommando zeichen); + WHILE kommando anfangs pos <> 0 REP + verarbeite kommando; + IF kommando index = end OR kommando index = page command0 + OR kommando index = page command1 OR kommando index = fehler index + THEN LEAVE kommandos verarbeiten + ELSE kommando anfangs pos := + pos (zeile, kommando zeichen, kommando ende pos + 1) + FI + END REP. +END PROC kommandos verarbeiten; + +PROC kommandos verarbeiten und ggf zeile mitzaehlen: + max zeilenvorschub := berechneter zeilenvorschub; + max type zeilenvorschub := type zeilenvorschub; + kommandos verarbeiten; + in index oder exponent := 0; + zeile zur seitenlaenge ggf addieren; + IF es war ein linefeed in der zeile + THEN berechne zeilenvorschub; + es war ein linefeed in der zeile := FALSE + FI. + +zeile zur seitenlaenge ggf addieren: + IF only command line (zeile) OR + kommando index = end OR kommando index = page command0 OR + kommando index = page command1 OR kommando index = fehler index + THEN + ELSE aktuelle seitenlaenge INCR max zeilenvorschub; + FI. +END PROC kommandos verarbeiten und ggf zeile mitzaehlen; + +BOOL PROC keine zeichen ausser blank nach dem kommando: + IF kommando anfangs pos > 1 AND + pos (zeile, ""33"", ""255"", 1) = kommando anfangs pos + THEN warnung (13, kommando) + FI; + kommando ende pos = length (zeile) OR + pos (zeile, ""33"", ""254"", kommando ende pos + 1) = 0 +END PROC keine zeichen ausser blank nach dem kommando; + +BOOL PROC absatz zeile: + (zeile SUB length (zeile)) = blank +END PROC absatz zeile; + +(********************** routinen fuers seitenende *************) + +INT PROC erreichte seitenlaenge: + aktuelle seitenlaenge + kopf oder fuss laenge [footnote] + + seitenlaenge fester teil +END PROC erreichte seitenlaenge; + +INT PROC seitenlaenge fester teil: + head laenge + bottom laenge. + +bottom laenge: + IF (NOT insert last bottom AND laufende seitennr [1] = nummer letzte seite) + OR ausgeschalteter bottom + THEN 0 + ELSE kopf oder fuss laenge [fuss] + + bottom laenge fuer gerade oder ungerade seiten + FI. + +bottom laenge fuer gerade oder ungerade seiten: + IF laufende seitennr [1] MOD 2 = 0 + THEN kopf oder fuss laenge [fuss gerade] + ELSE kopf oder fuss laenge [fuss ungerade] + FI. +END PROC seitenlaenge fester teil; + +INT PROC head laenge: + IF (NOT insert first head AND laufende seitennr [1] = nummer erste seite) + OR ausgeschalteter head + THEN 0 + ELSE kopf oder fuss laenge [kopf] + + head laenge fuer gerade oder ungerade seiten + FI. + +head laenge fuer gerade oder ungerade seiten: + IF laufende seitennr [1] MOD 2 = 0 + THEN kopf oder fuss laenge [koπ3Πφ&η6φζ� + ELSE kopf oder fuss laenge [kopf ungerade] + FI. +END PROC head laenge; + +PROC ende einer seite: + IF interaktiv + THEN seitenende ggf verschieben + ELSE seitenende fuer autopageform ggf verschieben + FI; + seitenende einbringen und zurueck. + +seitenende ggf verschieben: + BOOL VAR veraenderungen in der seite :: FALSE; + formatiere ueber bildschirm (veraenderungen in der seite); + schreibe titelzeile; + IF veraenderungen in der seite + THEN zum seitenanfang zur erneuten bearbeitung; + LEAVE ende einer seite + FI. + +seitenende fuer autopageform ggf verschieben: +INT VAR i, hier :: line no (ausgabe); + FOR i FROM 1 UPTO 4 REP + zeile zurueck lesen; + IF absatz zeile OR line no (ausgabe) <= 2 + THEN ggf um leerzeilen nach oben lesen; + naechste zeile lesen; + LEAVE seitenende fuer autopageform ggf verschieben + FI + END REP; + to line (ausgabe, hier); + read record (ausgabe, zeile); + IF pageblock on + THEN FOR i FROM 1 UPTO 4 REP + IF absatz zeile OR eof (ausgabe) OR pos (zeile, "#foot") <> 0 + OR pos (zeile, "#free") <> 0 + THEN naechste zeile lesen; + LEAVE seitenende fuer autopageform ggf verschieben + FI; + naechste zeile lesen + END REP; + to line (ausgabe, hier); + read record (ausgabe, zeile) + FI. + +ggf um leerzeilen nach oben lesen: + INT VAR ii := i; + WHILE zeile = " " AND pageblock on AND ii <= 4 REP + IF line no (ausgabe) <= 2 + THEN LEAVE ggf um leerzeilen nach oben lesen + FI; + zeile zurueck lesen; + ii INCR 1 + END REP. +END PROC ende einer seite; + +PROC seitenende einbringen und zurueck: + letzte textzeile war mit absatz := letzte zeile; + down (ausgabe); + grenzmarkierung in dummy speichern; + record einfuegen (dummy); + up (ausgabe); + seite nochmal durchgehen. + +letzte zeile: + up (ausgabe); + read record (ausgabe, zeile); + absatz zeile. +END PROC seitenende einbringen und zurueck; + +PROC zum seitenanfang zur erneuten bearbeitung: + zurueck bis seitenende; + durchgang := 1; + aktuelle seitenlaenge := 0; + fussnoten loeschen; + kommandos wiederherstellen +END PROC zum seitenanfang zur erneuten bearbeitung; + +(********************** positionierungs routinen ************) + +PROC naechste zeile lesen: + down (ausgabe); + read record (ausgabe, zeile) +END PROC naechste zeile lesen; + +PROC zeile zurueck lesen: + up (ausgabe); + read record (ausgabe, zeile); +END PROC zeile zurueck lesen; + +(***************** seitenende interaktiv positionieren **********) + +PROC formatiere ueber bildschirm (BOOL VAR veraenderungen): + veraenderungen := FALSE; + anz zeilen nach oben := 0; + erste bildschirmzeile schreiben; + schreibe bildschirm; + REP + positioniere lfd satz nach steuerzeichen und ggf schirm schreiben + END REP. + +positioniere lfd satz nach steuerzeichen und ggf schirm schreiben: +TEXT VAR steuerzeichen; + inchar (steuerzeichen); + IF steuerzeichen = upchar + THEN nach oben; + IF fussnoten ende + THEN ueberspringe fussnote nach oben; + schreibe bildschirm + FI + ELIF steuerzeichen = downchar + THEN IF fussnoten anfang + THEN ueberspringe fussnote nach unten; + schreibe bildschirm + ELSE nach unten; + IF fussnoten anfang + THEN ueberspringe fussnote nach unten; + schreibe bildschirm + FI + FI + ELIF steuerzeichen = hop + THEN sprung oder leerzeilen veraenderung; + schreibe bildschirm; + ELIF steuerzeichen = return + THEN IF anz zeilen nach oben < 0 + THEN down (ausgabe); + read record (ausgabe, zeile) + FI; + IF zeile = "" OR zeile = " " + THEN leerzeilen vor neuer seite loeschen + FI; + LEAVE formatiere ueber bildschirm + ELIF steuerzeichen = esc + THEN errorstop ("Abbruch mit ESC") + FI. + +fussnoten anfang: + pos (zeile, "#foot") <> 0 AND anz zeilen nach oben > 0. + +fussnoten ende: + pos (zeile, "#end") <> 0. + +nach oben: + IF anz zeilen nach oben < 0 + THEN nach oben unterhalb der seitengrenze + ELIF eine zeile nach oben war moeglich + THEN IF fussnoten ende + THEN ueberspringe fussnote nach oben; + schreibe bildschirm + ELIF anz vertauschte zeilen < zeilen nach oben + THEN out (upchar); raus; out (upchar); + schreibe seitenbegrenzung auf bildschirm; + anz vertauschte zeilen INCR 1 + ELSE schreibe bildschirm + FI + FI. + +nach oben unterhalb der seitengrenze: + IF anz zeilen nach oben = -1 + THEN cursor (1, pos seitengrenze); out (cl eop); + schreibe seitenbegrenzung auf bildschirm; + cursor (1, pos seitengrenze); + schreibe untere zeilen; + anz zeilen nach oben := 0 + ELSE INT VAR bildschirmzeile unterhalb :: + pos seitengrenze + abs (anz zeilen nach oben) + 1; + cursor (1, bildschirmzeile unterhalb); + out (cl eol); + outsubtext (zeile, 1, 76); + anz zeilen nach oben INCR 1; + bildschirmzeile unterhalb DECR 1; + cursor (1, bildschirmzeile unterhalb); + schreibe seitenbegrenzung auf bildschirm; + zeile zurueck lesen; + cursor (1, pos seitengrenze) + FI. + +nach unten: + IF anz zeilen nach oben < -4 + THEN + ELIF anz zeilen nach oben < 1 + THEN ggf nach unten formatieren + ELIF anz vertauschte zeilen > 0 + THEN out (upchar); raus; line ; + schreibe seitenbegrenzung auf bildschirm; + eine zeile nach unten wenn moeglich; + anz vertauschte zeilen DECR 1 + ELSE eine zeile nach unten wenn moeglich; + IF fussnoten anfang + THEN ueberspringe fussnote nach unten; + FI; + schreibe bildschirm + FI. + +ggf nach unten formatieren: + IF pageblock on + THEN zeile nach unten ueber seitengrenze; + cursor (1, pos seitengrenze); + FI. + +zeile nach unten ueber seitengrenze: + IF eof (ausgabe) OR page oder free oder foot anweisung + THEN LEAVE zeile nach unten ueber seitengrenze + ELSE naechste zeile lesen; + IF eof (ausgabe) OR page oder free oder foot anweisung + THEN zeile zurueck lesen; + LEAVE zeile nach unten ueber seitengrenze + FI; + zeile zurueck lesen + FI; + IF anz zeilen nach oben = 0 + THEN out (cl eol); + out (begin mark); + out ("Über Seitenende hinaus (Stauchung): UP/DOWN"); + out (end mark); + cursor (1, pos seitengrenze + 1); + schreibe untere zeilen; + ELSE naechste zeile lesen; + FI; + cursor (1, pos seitengrenze + abs (anz zeilen nach oben) + 1); + out (cl eol); + outsubtext (zeile, 1, 76); + anz zeilen nach oben DECR 1; + cursor (1, pos seitengrenze + abs (anz zeilen nach oben) + 1); + schreibe seitenbegrenzung auf bildschirm. + +page oder free oder foot anweisung: + pos (zeile, "#page") <> 0 OR pos (zeile, "#free") <> 0 + OR pos (zeile, "#foot") <> 0. + +sprung oder leerzeilen veraenderung: + INT VAR i :: 0; + REP + inchar (steuerzeichen); + IF steuerzeichen = upchar + THEN sprung nach oben + ELIF steuerzeichen = downchar + THEN sprung nach unten + ELIF steuerzeichen = rub out + THEN zeile loeschen; + ELIF steuerzeichen = rub in + THEN leerzeilen einfuegen; + FI + END REP. + +sprung nach oben: + WHILE eine zeile nach oben war moeglich REP + i INCR 1; + IF fussnoten ende + THEN ueberspringe fussnote nach oben; + LEAVE sprung oder leerzeilen veraenderung + FI + UNTIL i >= zeilen nach oben END REP; + LEAVE sprung oder leerzeilen veraenderung. + +sprung nach unten: + WHILE i < zeilen nach oben REP + IF fussnoten anfang + THEN ueberspringe fussnote nach unten; + LEAVE sprung oder leerzeilen veraenderung + ELSE eine zeile nach unten wenn moeglich; + i INCR 1; + FI; + IF fussnoten anfang + THEN ueberspringe fussnote nach unten; + LEAVE sprung oder leerzeilen veraenderung + FI + END REP; + LEAVE sprung oder leerzeilen veraenderung. + +zeile loeschen: + veraenderungen := TRUE; + up (ausgabe); + read record (ausgabe, zeile); + IF seiten ende + THEN down (ausgabe); + ELSE delete record (ausgabe); + FI; + LEAVE formatiere ueber bildschirm. + +leerzeilen einfuegen: + veraenderungen := TRUE; + out (cl eop); + REP + inchar (steuerzeichen); + IF steuerzeichen = return + THEN insert record (ausgabe); + zeile := " "; + write record (ausgabe, zeile); + out (upchar); + raus; + line + ELIF steuerzeichen = rubin + THEN LEAVE formatiere ueber bildschirm + FI + END REP. +END PROC formatiere ueber bildschirm; + +PROC leerzeilen vor neuer seite loeschen: + WHILE zeile = "" OR zeile = " " REP + delete record (ausgabe); + IF eof (ausgabe) + THEN LEAVE leerzeilen vor neuer seite loeschen + ELSE read record (ausgabe, zeile) + FI + END REP. +END PROC leerzeilen vor neuer seite loeschen; + +PROC ueberspringe fussnote nach oben: + WHILE eine zeile nach oben war moeglich REP + IF fussnoten anfang + THEN IF eine zeile nach oben war moeglich + THEN + FI; + LEAVE ueberspringe fussnote nach oben + FI + END REP. + +fussnoten anfang: + pos (zeile, "#foot#") <> 0. +END PROC ueberspringe fussnote nach oben; + +PROC ueberspringe fussnote nach unten: + REP + eine zeile nach unten wenn moeglich; + IF fussnoten ende + THEN eine zeile nach unten wenn moeglich; + LEAVE ueberspringe fussnote nach unten + FI + END REP. + +fussnoten ende: + pos (zeile, "#end#") <> 0. +END PROC ueberspringe fussnote nach unten; + +PROC schreibe free (INT CONST wert): +REAL CONST wert in y steps :: y step conversion (wert); + dummy := "#free("; + IF wert in y steps < 1.0 + THEN dummy CAT "0"; + FI; + dummy CAT text (wert in y steps); + dummy CAT ")#"; + record einfuegen (dummy); +END PROC schreibe free; + +BOOL PROC eine zeile nach oben war moeglich: + IF line no (ausgabe) = 1 + THEN FALSE + ELSE zeile zurueck lesen; + IF seitenende OR columns kommando in dieser zeile + THEN naechste zeile lesen; + FALSE + ELSE anz zeilen nach oben INCR 1; + TRUE + FI + FI. + +columns kommando in dieser zeile: + anz spalten > 1 AND pos (zeile, "#columns") <> 0. +END PROC eine zeile nach oben war moeglich; + +PROC eine zeile nach unten wenn moeglich: + IF anz zeilen nach oben > 0 + THEN naechste zeile lesen; + anz zeilen nach oben DECR 1 + FI +END PROC eine zeile nach unten wenn moeglich; + +PROC erste bildschirmzeile schreiben: + IF anz spalten > 1 + THEN dummy := "Spalten" + ELSE dummy := "Seiten" + FI; + dummy CAT "ende verschieben: UP, DOWN / bestaetigen: RETURN / Abbruch: ESC"; + schreibe titelzeile (dummy). +END PROC erste bildschirmzeile schreiben; + +PROC schreibe bildschirm: + anz vertauschte zeilen := 0; + cursor (1, 3); + out (cl eop); + gehe zurueck; + wieder nach vorne und zeilen ausgeben; + cursor (1, pos seitengrenze); + schreibe seitenbegrenzung auf bildschirm; + cursor (1, pos seitengrenze); + schreibe untere zeilen. + +gehe zurueck: + INT VAR hier :: line no (ausgabe) -1; + to line (ausgabe, hier - zeilen nach oben + 1); + INT VAR anz read zeilen :: hier - line no (ausgabe) + 2. + + wieder nach vorne und zeilen ausgeben: + IF line no (ausgabe) = 1 + THEN ggf leerzeilen auf bildschirm schreiben; + FI; + WHILE line no (ausgabe) <= hier REP + read record (ausgabe, zeile); + raus; + down (ausgabe); + END REP; + read record (ausgabe, zeile). + +ggf leerzeilen auf bildschirm schreiben: + IF zeilen nach oben - anz read zeilen >= 0 + THEN INT VAR i; + FOR i FROM 1 UPTO zeilen nach oben - anz read zeilen REP + line ; out (cl eol); out(" ") + END REP; + line ; out (cl eol); + out ("<< DATEI ANFANG >>"); out (return) + FI. +END PROC schreibe bildschirm; + +PROC schreibe untere zeilen: + gehe weiter und gebe zeilen aus; + gehe wieder zurueck; + skip input; + cursor (1, pos seitengrenze). + +gehe weiter und gebe zeilen aus: +INT VAR anz read zeilen :: 0, + i :: line no (ausgabe); + WHILE anz read zeilen < zeilen nach unten REP + IF eof (ausgabe) + THEN line ; out (cleol); out ("<< DATEI ENDE >>"); + LEAVE gehe weiter und gebe zeilen aus + FI; + raus; + naechste zeile lesen; + anz read zeilen INCR 1 + END REP. + +gehe wieder zurueck: + to line (ausgabe, i); + read record (ausgabe, zeile). +END PROC schreibe untere zeilen; + +(***************** schreib-routinen fuer den bildschirm ************) + +PROC schreibe seitenbegrenzung auf bildschirm: + out (cl eol); out (begin mark); + grenzmarkierung in dummy speichern; + out (dummy); + out (end mark); + out (return) +END PROC schreibe seitenbegrenzung auf bildschirm; + +PROC raus: +INT VAR xzeile, yspalte; + line ; out (cl eol); + outsubtext (zeile, 1, 76); + IF absatz zeile + THEN get cursor (yspalte, xzeile); + cursor (77, xzeile); + out (begin end mark) + FI; + out (return) +END PROC raus; + +PROC schreibe titelzeile: + IF online + THEN schreibe + FI. + +schreibe: + out (hop); out (cleol); + put ("PAGEFORM"); put ("(für"); put (lines (ausgabe)); put ("Zeilen):"); + put (name eingabe datei); + put ("->"); + put (name druck datei); + cursor (1, 3). +END PROC schreibe titelzeile; + +PROC schreibe titelzeile (TEXT CONST t): + IF online + THEN schreibe + FI. + +schreibe: + out (hop); out (cl eol); + out (begin mark); + out (t); + out (end mark) +END PROC schreibe titelzeile; + +(************************** initialisierungs-routine ************) + +PROC page form initialisieren: +BOOL VAR exists; +INT VAR i; + letzte textzeile war mit absatz := TRUE; + letztes seitenende war mit absatz := TRUE; + pageblock on := FALSE; + zeile noch nicht verarbeitet := FALSE; + bereich aufnehmen := FALSE; + count seitenzaehlung := FALSE; + ausgeschalteter head := FALSE; + ausgeschalteter bottom := FALSE; + in tabelle := FALSE; + es war ein linefeed in der zeile := FALSE; + letztes seitenende war in tabelle := FALSE; + mindestens ein topage gewesen := FALSE; + in index oder exponent := 0; + anz refers := 0; + kommando index := 0; + counter := 0; + laufende seitennr [1] := 1; + durchgang := 1; + anz spalten := 1; + modifikation := ""; + tab pos speicher := ""; + kommando seitenspeicher := ""; + counter numbering store := ""; + counter reference store := ""; + dec value := ""; + seitenzeichen := "%"; + eingestelltes limit := dina4 limit; + IF NOT file works + THEN font nr := 1; + eingestellter typ := font (1); + type zeilenvorschub := + font height (1) + font lead (1) + font depth (1); + eingestellte seitenlaenge := y step conversion (dina4 pagelength); + real eingestellter zeilenvorschub := 1.0 + FI; + berechneter zeilenvorschub := + int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5); + max zeilenvorschub := berechneter zeilenvorschub; + max type zeilenvorschub := type zeilenvorschub; + FOR i FROM 1 UPTO 7 REP + kopf oder fuss laenge [i] := 0; + anz kopf oder fuss zeilen [i] := 0 + END REP; + IF online + THEN page + FI; + IF command dialogue + THEN interaktiv := TRUE; + ELSE interaktiv := FALSE; + FI; + IF online + THEN page + FI; + schreibe titelzeile +END PROC page form initialisieren; + +PROC central pagefo9ü̈NSγJr+�Cβ+̂γ��{s�β�KrΓλγb�#Τκ�ZK�� + name eingabe datei := input; + name druck datei := druck; + IF exists (druck) + THEN forget (druck, quiet) + FI; + disable stop; + ds := nilspace; + refer sammler := ds; + seiten form; + forget(ds); + IF is error + THEN put error; + clear error; + last param (name eingabe datei) + ELSE last param (name druck datei) + FI; + enable stop; + IF anything noted + THEN note edit (ausgabe) + FI. +END PROC central pageform routine; + +PROC pageform (TEXT CONST input, druck): + file works := FALSE; + central pageform routine (input, druck). +END PROC pageform; + +PROC pageform (TEXT CONST input): + file works := FALSE; + central pageform routine (input, input + ".p"). +END PROC pageform; + +PROC pageform: + file works := FALSE; + pageform (last param) +END PROC pageform; + +PROC pageform (TEXT CONST input, REAL CONST lf, seitenlaenge): + file works := TRUE; + eingestellte seitenlaenge := y step conversion (seitenlaenge); + real eingestellter zeilenvorschub := lf; + central pageform routine (input, input + ".p") +END PROC pageform; + +PROC autopageform: + autopageform (last param) +END PROC autopageform; + +PROC autopageform (TEXT CONST input): + command dialogue (false); + pageform (input); + command dialogue (true) +END PROC autopageform; +END PACKET seiten formatieren; +(* +REP + IF yes ("autopageform") + THEN autopageform ("pfehler") + ELSE pageform ("pfehler") + FI; + edit("pfehler.p"); +UNTIL yes ("ENDE") ENDREP; +*) + diff --git a/system/multiuser/1.7.5/src/print cmd b/system/multiuser/1.7.5/src/print cmd new file mode 100644 index 0000000..1fcb475 --- /dev/null +++ b/system/multiuser/1.7.5/src/print cmd @@ -0,0 +1,29 @@ + +PACKET print cmd DEFINES print, printer : + +PROC print : + + print (last param) + +ENDPROC print ; + +PROC print (TEXT CONST file name) : + + save (file name, task ("PRINTER")) ; + +ENDPROC print ; + +PROC print (THESAURUS CONST nameset) : + + do (PROC (TEXT CONST) print, nameset) + +ENDPROC print ; + +TASK PROC printer : + + task ("PRINTER") + +ENDPROC printer ; + +ENDPACKET print cmd ; + diff --git a/system/multiuser/1.7.5/src/priv ops b/system/multiuser/1.7.5/src/priv ops new file mode 100644 index 0000000..a92ee76 --- /dev/null +++ b/system/multiuser/1.7.5/src/priv ops @@ -0,0 +1,268 @@ +(* ------------------- VERSION 10 22.04.86 ------------------- *) +PACKET privileged operations DEFINES (* Autor: J.Liedtke *) + + block , + calendar , + collect garbage blocks , + define collector , + fixpoint , + info password , + prio , + save system , + send , + set clock , + set date , + shutup , + unblock : + +LET prio field = 6 , + cr = ""13"" , + archive channel = 31 , + + ack = 0 , + + garbage collect code = 1 , + fixpoint code = 2 , + shutup code = 4 , + shutup and save code = 12 , + reserve code = 19 , + release code = 20 ; + + + +INT PROC prio (TASK CONST task) : + pcb (task, prio field) +ENDPROC prio ; + +PROC prio (TASK CONST task, INT CONST new prio) : + pcb (task, prio field, new prio) +ENDPROC prio ; + +TEXT VAR date text ; + +PROC collect garbage blocks : + + system operation (garbage collect code) + +ENDPROC collect garbage blocks ; + +PROC fixpoint : + + system operation (fixpoint code) + +ENDPROC fixpoint ; + +PROC info password (TEXT CONST old info password, new info password) : + + INT VAR error code ; + IF online + THEN say (""3""5""10"") + FI ; + IF LENGTH new info password < 10 + THEN infopw (old info password + cr, new info pw, error code) ; + IF error code = 0 + THEN shutup + ELSE errorstop ("Falsches Info-Passwort") + FI + ELSE errorstop ("Passwort zu lang (max. 9 Zeichen)") + FI ; + cover tracks . + +new info pw : + IF new info password = "-" + THEN "-" + 9 * "0" + ELSE new info password + "cr" + FI . + +ENDPROC info password ; + +PROC shutup : + + system operation (shutup code) ; + IF command dialogue + THEN wait for configurator ; + page ; + set date + FI + +ENDPROC shutup ; + +PROC save system : + + INT VAR reply ; + TASK VAR channel owner ; + enable stop ; + reserve archive channel ; + IF yes ("Leere Floppy eingelegt") + THEN + reserve archive channel ; + system operation (shutup and save code) ; + release archive channel ; + IF command dialogue + THEN wait for configurator ; + page ; + set date + FI + FI ; + release archive channel . + +reserve archive channel : + channel owner := task (archive channel) ; + IF NOT is niltask (channel owner) + THEN ask channel owner to reserve the channel ; + IF channel owner does not reserve channel + THEN errorstop ("Task """ + name (channel owner) + + """ gibt Kanal " + + text (archive channel) + + " nicht frei") + FI + FI . + +ask channel owner to reserve the channel : + forget (ds) ; + ds := nilspace ; + pingpong (channel owner, reserve code, ds, reply) . + +channel owner does not reserve channel : + (reply <> ack) AND task exists . + +task exists : + reply <> -1 . + +release archive channel : + forget (ds) ; + ds := nilspace ; + pingpong (channel owner, release code, ds, reply) . + +ENDPROC save system ; + +PROC system operation (INT CONST code) : + + INT VAR size, used ; + storage (size, used) ; + IF used <= size + THEN sys op (code) + ELSE errorstop ("Speicherengpass") + FI + +ENDPROC system operation ; + +DATASPACE VAR ds := nilspace ; + +PROC wait for configurator : + + INT VAR i , receipt ; + FOR i FROM 1 UPTO 20 WHILE configurator exists REP + pause (30) ; + forget (ds) ; + ds := nilspace ; + ping pong (configurator, ack, ds, receipt) + UNTIL receipt >= 0 PER . + +configurator exists : + disable stop ; + TASK VAR configurator := task ("configurator") ; + clear error ; + NOT is niltask (configurator) . + +ENDPROC wait for configurator ; + +BOOL VAR hardware clock ok ; +REAL VAR now ; + +PROC set date : + + hardware clock ok := TRUE ; + try to get date and time from hardware ; + IF NOT hardware clock ok + THEN get date and time from user + FI ; + define date and time . + +try to get date and time from hardware : + disable stop ; + REAL VAR previous now ; + now := 0.0 ; + INT VAR try ; + FOR try FROM 1 UPTO 3 WHILE hardware clock ok REP + previous now := now ; + now := date (hardwares today) + time (hardwares time) + UNTIL now = previous now OR is error PER ; + clear error ; + enable stop . + +get date and time from user : + line (2) ; + put (" Bitte geben Sie das heutige Datum ein :") ; + date text := date ; + TEXT VAR exit char ; + editget (date text, cr, "", exit char) ; + now := date (date text) ; + line ; + put (" und die aktuelle Uhrzeit :") ; + date text := time of day ; + editget (date text, cr, "", exit char) ; + now INCR time (date text) ; + IF NOT last conversion ok + THEN errorstop ("Falsche Zeitangabe") + FI . + +hardwares today : calendar (3) + "." + calendar (4) + "." + calendar (5) . + +hardwares time : calendar (2) + ":" + calendar (1) . + +define date and time : + set clock (now) . + +ENDPROC set date ; + +TEXT PROC calendar (INT CONST index) : + + INT VAR bcd ; + control (10, index, 0, bcd) ; + IF bcd < 0 + THEN hardware clock ok := FALSE ; "" + ELSE text (low digit + 10 * high digit) + FI . + +low digit : bcd AND 15 . + +high digit: (bcd AND (15*256)) DIV 256 . + +ENDPROC calendar ; + +PROC infopw (TEXT CONST old, new, INT VAR error code) : + EXTERNAL 81 +ENDPROC infopw ; + +PROC sys op (INT CONST code) : + EXTERNAL 90 +ENDPROC sys op ; + +PROC set clock (REAL CONST time) : + EXTERNAL 103 +ENDPROC set clock ; + +PROC pcb (TASK CONST task, INT CONST field, value) : + EXTERNAL 105 +ENDPROC pcb ; + +PROC unblock (TASK CONST task) : + EXTERNAL 108 +ENDPROC unblock ; + +PROC block (TASK CONST task) : + EXTERNAL 109 +ENDPROC block ; + +PROC send (TASK CONST from, to, INT CONST order, DATASPACE VAR ds, + INT VAR receipt) : + EXTERNAL 127 +ENDPROC send ; + +PROC define collector (TASK CONST task) : + EXTERNAL 128 +ENDPROC define collector ; + +ENDPACKET privileged operations ; + diff --git a/system/multiuser/1.7.5/src/silbentrennung b/system/multiuser/1.7.5/src/silbentrennung new file mode 100644 index 0000000..dfbdf75 --- /dev/null +++ b/system/multiuser/1.7.5/src/silbentrennung @@ -0,0 +1,1166 @@ +(* ------------------- VERSION 170 vom 30.09.85 -------------------- *) +PACKET silbentrennung DEFINES + trenn, + schreibe trennvektor, + ist ausnahme wort, + lade ausnahmen, + entlade ausnahmen: + +(* Programm zur Silbentrennung + Autor: Klaus-Uwe Koschnick / Rainer Hahn + Stand: 1.7.1 (Febr. 1984) + 1.7.4 (Mai 1984) (Ausnahme-Woerterbuch, Verbesserungen) +*) + +(*--------------------- Ausnahme Woerterbuch -----------------------*) + +DATASPACE VAR ds1 :: nilspace; + +FILE VAR f; + +LET name table length = 1024, + max hash chars = 5; + +INT VAR anz worte :: 0, + hash index; + +INITFLAG VAR this packet :: FALSE; + +TEXT VAR dummy, + name ohne trennstellen, + trennstellen, + blanked name; + +BOUND ROW name table length TEXT VAR name table; + +PROC init packet: + IF NOT initialized (this packet) + THEN anz worte := 0 + FI +END PROC init packet; + +PROC init name table: + forget (ds1); + ds1 := nilspace; + name table := ds1; + INT VAR i; + FOR i FROM 1 UPTO name table length REP + cout (i); + name table [i] := "" + END REP; + anz worte := 0. +END PROC init name table; + +PROC lade ausnahmen: + lade ausnahmen (last param) +END PROC lade ausnahmen; + +PROC lade ausnahmen (TEXT CONST filename): + IF exists (filename) + THEN lade + ELSE errorstop ("Datei nicht vorhanden") + FI. + +lade: + init packet; + IF anz worte > 0 + THEN IF yes ("überschreiben") + THEN init nametable + ELIF no ("anfügen") + THEN LEAVE lade ausnahmen + FI + ELSE init nametable + FI; + line (2); + f := sequential file (input, file name); + WHILE NOT eof (f) REP + get (f, dummy); + IF subtext (dummy, 1, 2) = "(*" + THEN ueberlese kommentar + ELSE lade wort (* Vor.: Worte ohne Blanks *) + FI + END REP. + +ueberlese kommentar: + WHILE NOT eof (f) AND pos (dummy, "*)") = 0 REP + get (f, dummy); + END REP. + +lade wort: + line ; + anz worte INCR 1; + put (anz worte); + stelle namen ohne trennstellen her; + put (name ohne trennstellen); + blanked name := " "; + name ohne trennstellen CAT " "; + blanked name CAT name ohne trennstellen; + hash; + IF pos (name table [hash index], blanked name) > 0 + THEN put ("(bereits geladen)") + ELSE insert char (name ohne trennstellen, " ", 1); + name ohne trennstellen CAT trennstellen; + name table [hash index] CAT name ohne trennstellen; + FI. + +stelle namen ohne trennstellen her: + INT VAR number; + name ohne trennstellen := dummy; + trennstellen := ""; + WHILE pos (name ohne trennstellen, "-") > 0 REP + number := pos (name ohne trennstellen, "-"); + delete char (name ohne trennstellen, number); + trennstellen CAT text (number - 1); + trennstellen CAT " " + END REP. +END PROC lade ausnahmen; + +PROC entlade ausnahmen (TEXT CONST file name): + init packet; + IF exists (file name) + THEN errorstop ("Datei existiert bereits") + ELSE unload + FI. + +unload: + f := sequential file (output, file name); + INT VAR i; + FOR i FROM 1 UPTO name table length REP + cout (i); + IF name table [i] <> "" + THEN putline (f, name table [i]) + FI + END REP. +END PROC entlade ausnahmen; + +BOOL PROC ist ausnahme wort (TEXT CONST word, + INT CONST maximum, INT VAR trenn position): + init packet; + IF anz worte > 0 + THEN blanked name fuer hash bilden; + hash; + IF pos (name table [hash index], blanked name) > 0 + THEN trennstelle suchen + FI + FI; + FALSE. + +blanked name fuer hash bilden: + blanked name := " "; + IF maximum <= max hash chars + THEN eliminiere ggf satzzeichen hinter dem wort; + blanked name CAT + subtext (word, 1, min (max hash chars, wortlaenge)) + ELSE blanked name CAT subtext (word, 1, maximum); + FI. + +eliminiere ggf satzzeichen hinter dem wort: + INT VAR wort laenge := length (word); + WHILE letztes zeichen ist kein buchstabe REP + wort laenge DECR 1; + IF wort laenge <= 2 + THEN LEAVE ist ausnahme wort WITH FALSE + FI + END REP. + +letztes zeichen ist kein buchstabe: + TEXT CONST letztes zeichen :: (word SUB wortlaenge); + NOT (letztes zeichen >= "A" AND letztes zeichen <= "Z" OR + letztes zeichen >= "a" AND letztes zeichen <= "z" OR + letztes zeichen >= "Ä" AND letztes zeichen <= "k" OR + letztes zeichen = "ß"). + +trennstelle suchen: + index der ersten ziffer suchen; + INT VAR neue ziffer := 0; + trenn position := 0; + ziffern holen. + +index der ersten ziffer suchen: + dummy := name table [hash index]; + INT VAR ziffern index := pos (dummy, blanked name); + ziffern index := pos (dummy, " ", ziffern index + 1) + 1. + +ziffern holen: + WHILE ist ziffer REP + hole neue ziffer; + IF gefundene ziffer ist ausserhalb des trennbereichs + THEN LEAVE ist ausnahme wort WITH TRUE + FI; + trenn position := neue ziffer + END REP; + LEAVE ist ausnahme wort WITH TRUE. + +ist ziffer: + ziffern index < length (dummy) AND +((dummy SUB ziffern index + 1) = " " OR (dummy SUB ziffern index + 2) = " "). + +hole neue ziffer: + INT VAR ende position :: pos (dummy, " ", ziffern index); + neue ziffer := int (subtext (dummy, ziffern index, ende position - 1)); + ziffern index := ende position + 1. + +gefundene ziffer ist ausserhalb des trennbereichs: + neue ziffer > maximum. +END PROC ist ausnahme wort; + +PROC hash: + INT VAR i; + hash index := code (blanked name SUB 2); + FOR i FROM 3 UPTO min (length (blanked name), max hash chars) REP + hash index INCR hash index; + hash index INCR code (blanked name SUB i); + decrementiere hash index + END REP. + +decrementiere hash index: + WHILE hash index > name table length REP + hash index DECR 1023 + END REP. +END PROC hash; + +(*-------------- eigentlicher Trenn-Algorithmus --------------*) + +LET zeichenkette n = "-/", + regelmaessig = " bl br chl chr dr fl fr gl gr kl kn kr pf ph pl pr + sp st schl schm schn schr schw th tr zw ", + vokal string = "aeiouyäöü", + buchstaben = + "abcdefghijklmnopqrstuvwxyzäöüßABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ", + grosse buchstaben = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", + trennstrich = ""221"", + cv a = 97 , cv b = 98 , cv c = 99 , cv d = 100, cv e = 101, + cv f = 102, cv g = 103, cv i = 105, cv k = 107, + cv l = 108, cv m = 109, cv n = 110, cv o = 111, + cv p = 112, cv r = 114, cv s = 115, cv t = 116, + cv u = 117, cv w = 119, cv x = 120, cv y = 121, + cv ae = 217 , cv oe = 218 , cv ue = 219 , cv sz = 251, + weder h noch ch = 0 , + buchstabe h = 1 , + zeichenfolge ch = 2 ; + +INT CONST minus one :: - 1; + +INT VAR i, grenze, absolute grenze, sonderzeichen trennpos, + zeichen vor teilwort, teilwort laenge, a pos, e pos, + a pos minus 2, a pos minus 1, a pos plus 1, a pos plus 2, + e pos minus 1; + +ROW 50 INT VAR vektor ; + +TEXT VAR wort, + teilwort, + kons gr, + search, + zeichen; + +BOOL VAR trennstelle gefunden ; + +PROC trenn (TEXT CONST word, TEXT VAR part1, trennsymbol, INT CONST maximum): + IF ist ausnahme wort (word, maximum, position) + THEN ausnahme wort behandlung; + LEAVE trenn + FI; + INT VAR laenge :: length (word) ; + IF laenge < 4 + THEN trennung nicht moeglich + ELSE wort := word ; + grenze := min (50, maximum) ; + absolute grenze := min (laenge, grenze + 5) ; + trennung versuchen + FI . + +ausnahme wort behandlung: + IF position <= 0 + THEN trennung nicht moeglich + ELSE part1 := subtext (word, 1, position); + IF pos (zeichenkette n, word SUB position + 1) > 0 + THEN trennsymbol := " " + ELSE trennsymbol := trennstrich + FI + FI. + +trennung nicht moeglich : + part 1 := ""; + trennsymbol := " ". + +trennung versuchen : + erstelle trennvektor ; + IF sonderzeichen trennpos > 0 + THEN part 1 := subtext (word, 1, sonderzeichen trennpos) ; + trennsymbol := " " + ELSE bestimme trennposition ; + IF position = 0 + THEN trennung nicht moeglich + ELSE part 1 := subtext (wort, 1, position) ; + trennsymbol := trennstrich + FI + FI . + +bestimme trennposition : + INT VAR position ; + FOR position FROM grenze DOWNTO 1 REP + IF vektor [position] = 1 + THEN LEAVE bestimme trennposition + FI + END REP ; + position := 0 +END PROC trenn ; + +BOOL PROC buchstabe (INT CONST posi) : + pos (buchstaben, wort SUB posi) > 0 OR spezialcode. + +spezialcode: + INT CONST z code :: code (wort SUB posi) ; + (zcode > 96 AND zcode < 123). +END PROC buchstabe ; + +OP SPERRE (INT CONST element) : + INT CONST w element :: zeichen vor teilwort + element ; + IF w element > 0 AND w element <= grenze + THEN vektor [w element] := minus one + FI +END OP SPERRE ; + +OP SETZE (INT CONST element) : + INT CONST w element :: zeichen vor teilwort + element; + IF w element > 0 AND w element <= grenze AND vektor [w element] <> minus one + THEN vektor [w element] := 1 ; + trennstelle gefunden := TRUE + FI +END OP SETZE ; + +BOOL PROC vorletzter buchstabe oderkeine trennung oder sperre gesetzt + (INT CONST akt buchstabenpos): + vorletzter buchstabe (akt buchstabenpos) + OR NOT trennung oder sperre gesetzt (akt buchstabenpos). +END PROC vorletzter buchstabe oderkeine trennung oder sperre gesetzt; + +BOOL PROC vorletzter buchstabe (INT CONST akt buchstabenpos): + akt buchstabenpos = absolute grenze - 1 +END PROC vorletzter buchstabe; + +BOOL PROC trennung oder sperre gesetzt (INT CONST element): + INT CONST w element :: zeichen vor teilwort + element; + IF w element > 1 AND w element < teilwort laenge + THEN vektor [w element] = 1 OR gesperrt + ELSE TRUE + FI. + +gesperrt: + IF w element >= length (wort) - 1 + THEN TRUE + ELSE vektor [w element] = minus one + FI. +END PROC trennung oder sperre gesetzt; + +PROC sperren und setzen (INT CONST element) : + INT CONST w element :: zeichen vor teilwort + element ; + vektor [w element - 1] := minus one; + vektor [w element] := 1 +END PROC sperren und setzen ; + +TEXT PROC string (INT CONST anf pos, end pos) : + subtext (teilwort, maximum, minimum). + +maximum: + IF anf pos > 1 + THEN anf pos + ELSE 1 + FI. + +minimum: + IF teilwort laenge < end pos + THEN teilwort laenge + ELSE end pos + FI. +END PROC string ; + +BOOL PROC silbenanfang vor (INT CONST akt buchstabenpos): + zwei silber (akt buchstabenpos - 2) OR drei silber (akt buchstabenpos - 3) +END PROC silbenanfang vor; + +BOOL PROC silbenanfang nach (INT CONST akt buchstabenpos): + zwei silber (akt buchstabenpos + 1) OR drei silber (akt buchstabenpos + 1) +END PROC silbenanfang nach; + +BOOL PROC zwei silber (INT CONST akt buchstabenpos): + TEXT VAR zweier :: string (akt buchstabenpos, akt buchstabenpos + 1); + length (zweier) = 2 AND + pos ("ab an ar be er ge in um un zu re", zweier) > 0 +END PROC zwei silber; + +BOOL PROC drei silber (INT CONST akt buchstabenpos): + TEXT VAR dreier :: string (akt buchstabenpos, akt buchstabenpos + 2); + length (dreier) = 3 AND + pos ("auf aus bei ein end ent mit", dreier) > 0 +END PROC drei silber; + +BOOL PROC reg (INT CONST st pos) : + INT CONST code one :: code (teilwort SUB st pos) , + code two :: code (teilwort SUB st pos + 1) ; + pos (regelmaessig, konsonanten) > 0 . + +konsonanten : + search := " " ; + IF code one = cv c + THEN search CAT string (st pos, st pos + 2) + ELIF code one = cv s AND code two = cv c + THEN search CAT string (st pos, st pos + 3) + ELSE search CAT string (st pos, st pos + 1) + FI ; + search CAT " " ; + search +END PROC reg ; + +INT PROC grenz position (INT CONST start pos, richtung): + INT VAR posit :: start pos ; + REP + posit INCR richtung + UNTIL sonderzeichen oder position unzulaessig END REP; + posit - richtung. + +sonderzeichen oder position unzulaessig: + posit = 0 AND posit > absolute grenze OR ist kein buchstabe. + +ist kein buchstabe: + pos (buchstaben, wort SUB posit) = 0 AND kein spezialcode. + +kein spezialcode: + INT CONST z code :: code (wort SUB posit) ; + (zcode < 97 OR zcode > 121). +END PROC grenz position ; + +PROC schreibe trennvektor (TEXT CONST ttt): +line ; put (ttt); INT VAR ii; +FOR ii FROM 1 UPTO length (wort) REP put(vektor [ii]) PER +END PROC schreibe trennvektor; + +PROC erstelle trennvektor : +INT VAR akt pos, anfang teilwort, ende teilwort, anzahl, + zuletzt, tr pos, ind, code 1, code 2, code 3, + rechts von a pos, z code, posit; +BOOL VAR sonderzeichen modus, + aktueller buchstabe ist vokal, + vorsilbe oder nachsilbe; + + sonderzeichen trennpos := 0 ; + trennstelle gefunden := FALSE ; + initialisiere trennvektor ; + akt pos := grenze ; + IF buchstabe (akt pos) + THEN zuerst teilwort + ELSE zuerst sonderzeichenblock + FI; + WHILE akt pos > 0 REP + IF sonderzeichen modus + THEN behandle sonderzeichenblock + ELSE suche trennstellen in teilwort + FI + END REP. + +initialisiere trennvektor : + FOR i FROM 1 UPTO grenze REP vektor [i] := 0 END REP . + +zuerst teilwort: + ende teilwort := grenz position (akt pos, 1) ; + sonderzeichen modus := FALSE . + +zuerst sonderzeichenblock: + sonderzeichen modus := TRUE . + +behandle sonderzeichenblock: + WHILE sonderzeichen modus REP + IF buchstabe (akt pos) + THEN sonderzeichen modus := FALSE + ELSE zeichen := wort SUB akt pos ; + IF pos (zeichenkette n, zeichen) <> 0 + THEN sonderzeichen trennpos := akt pos ; + LEAVE erstelle trennvektor + FI ; + akt pos DECR 1 ; + IF akt pos = 0 + THEN LEAVE erstelle trennvektor + FI + FI + END REP; + ende teilwort := akt pos . + +suche trennstellen in teilwort: + bestimme anfang von teilwort ; + IF teilwort lang genug + THEN teilwort ausbauen und wandeln ; + SPERRE 1 ; SPERRE (teilwort laenge - 1) ; + vorsilben untersuchen ; + nachsilben untersuchen ; + vorsilbe oder nachsilbe := trennstelle gefunden ; + trennstelle gefunden := FALSE ; + weitere trennstellen suchen ; + IF vorsilbe oder nachsilbe + THEN LEAVE erstelle trennvektor + FI + FI ; + akt pos := anfang teilwort - 1 ; + sonderzeichen modus := TRUE . + +bestimme anfang von teilwort: + anfang teilwort := grenz position (ende teilwort, minus one) . + +teilwort lang genug: + teilwort laenge := ende teilwort - anfang teilwort + 1 ; + teilwort laenge > 3 . + +teilwort ausbauen und wandeln: + teilwort := subtext (wort, anfang teilwort, ende teilwort); + zeichen vor teilwort := anfang teilwort - 1 ; + IF pos (grosse buchstaben, teilwort SUB 1) > 0 + THEN replace (teilwort, 1, code (code (teilwort SUB 1) + 32)) + FI . + (* Es ist nicht notwendig, gross geschriebene Umlaute am + Wortanfang zu wandeln! *) + +weitere trennstellen suchen: + e pos := teilwort laenge ; + aktueller buchstabe ist vokal := letzter buchstabe ist vokal ; + WHILE e pos > 1 REP + anzahl := 0 ; + a pos := e pos ; + IF aktueller buchstabe ist vokal + THEN behandle vokalgruppe + ELSE behandle konsonantengruppe + FI ; + IF trennstelle gefunden + THEN LEAVE erstelle trennvektor + FI ; + e pos := a pos - 1 ; + END REP . + +letzter buchstabe ist vokal: + pos (vokal string,teilwort SUB e pos) > 0 . + +behandle vokalgruppe: + vokalgruppe lokalisieren ; + IF a pos > 1 AND e pos < teilwort laenge + THEN a pos plus 1 := a pos + 1 ; + a pos plus 2 := a pos + 2 ; + IF anzahl = 2 + THEN vokal 2 + ELIF anzahl > 2 + THEN vokal 3 + ELSE vokal 1 + FI + FI . + +vokalgruppe lokalisieren: + zuletzt := 0 ; + WHILE aktueller buchstabe ist vokal REP + zeichen := teilwort SUB a pos ; + IF pos (vokal string,zeichen) > 0 + THEN z code := code(zeichen) ; + IF zuletzt <> cv e + OR (z code <> cv a AND z code <> cv o AND z code <> cv u) + THEN anzahl INCR 1 + FI ; + IF a pos > 1 + THEN a pos DECR 1 ; + zuletzt := z code + ELSE aktueller buchstabe ist vokal := FALSE + FI + ELSE a pos INCR 1 ; + aktueller buchstabe ist vokal := FALSE + FI + END REP . + +behandle konsonantengruppe: + konsonantengruppe lokalisieren ; + IF a pos > 1 AND e pos < teilwort laenge + THEN a pos minus 2 := a pos - 2 ; + a pos minus 1 := a pos - 1 ; + a pos plus 1 := a pos + 1 ; + a pos plus 2 := a pos + 2 ; + e pos minus 1 := e pos - 1 ; + SELECT anzahl OF + CASE 1 : konsonant 1 + CASE 2 : konsonant 2 + OTHERWISE : konsonant 3 + END SELECT + FI . + +konsonantengruppe lokalisieren: + rechts von a pos := weder h noch ch ; + REP + zeichen := teilwort SUB a pos ; + IF pos (vokal string, zeichen) = 0 + THEN anzahl INCR 1 ; + IF zeichen = "h" + THEN rechts von a pos := buchstabe h + ELIF zeichen = "c" AND rechts von a pos = buchstabe h + THEN anzahl DECR 1 ; + rechts von a pos := zeichenfolge ch + ELIF zeichen = "s" AND rechts von a pos = zeichenfolge ch + THEN anzahl DECR 1 ; + rechts von a pos := weder h noch ch + ELSE rechts von a pos := weder h noch ch + FI ; + IF a pos > 1 + THEN a pos DECR 1 + ELSE aktueller buchstabe ist vokal := TRUE + FI + ELSE a pos INCR 1 ; + aktueller buchstabe ist vokal := TRUE + FI + UNTIL aktueller buchstabe ist vokal END REP . + +vorsilben untersuchen: + code 2 := code (teilwort SUB 2); + code 3 := code (teilwort SUB 3); + IF ch vierer silbe + THEN sperren und setzen (4) + ELSE restliche vorsilben + FI. + +ch vierer silbe: + string (2, 4) = "ach" OR string (2, 4) = "och" OR string (2, 4) = "uch". + +restliche vorsilben: + ind := pos ("abdefghimnrstuvwüu", teilwort SUB 1); +SELECT ind OF +CASE1(*a*): IF drei silber (1) + THEN sperren und setzen (3) + ELIF code 2 = cv b (*ab*) + THEN IF string(3,5) = "end" (*abend*) + THEN SPERRE 2; sperren und setzen (5) + ELIF string(3,4) = "er" (*aber*) + THEN sperren und setzen (4) + ELSE sperren und setzen (2) + FI + ELIF code 2 = cv n AND string(3,5) <> "alo" (*analo*) + THEN SETZE 2 + FI +CASE2(*b*): IF code 2 = cv e (* be *) + THEN IF (teilwort SUB 3) = "h" (* be-handeln usw *) + OR (teilwort SUB 3) = "a" (* beamter *) + THEN sperren und setzen (2) + ELIF string (3, 4) = "ob" (* beobachten *) + THEN SETZE 2; sperren und setzen (4) + FI + ELIF string (2, 3) = "au" (* bauer usw *) + THEN sperren und setzen (3) + FI +CASE3(*d*): IF (code 3 = cv s AND (code 2 = cv i OR code 2 = cv e)) + OR string (2, 3) = "ar" (* dis, des, dar*) + THEN sperren und setzen (3) + ELIF string (2, 4) = "enk" (* denk.. *) + THEN sperren und setzen (4) + ELIF string(2,5) = "urch" (*durch*) + THEN SPERRE 3 ; SETZE 5 + FI +CASE4(*e*): IF code 2 = cv r AND code 3 <> cv n AND code 3 <> cv d + AND string (3, 4) <> "ro" (* er, aber nicht: ern, erd, erro *) + THEN SETZE 2 + ELIF code 2 = cv x (* ex *) + THEN SETZE 2 + ELIF (code 2 = cv m AND code 3 = cv p AND (teilwort SUB 4) = "f") + OR (code 2 = cv n AND code 3 = cv t) (* empf, ent *) + THEN sperren und setzen (3) + FI +CASE5(*f*): +CASE6(*g*): IF string (2, 5) = "egen" (* gegen *) + THEN sperren und setzen (5) + ELIF string (2, 6) = "leich" (* gleich *) + THEN IF vorletzter buchstabe (5) + THEN SPERRE 6 + ELIF vorletzter buchstabe (6) + THEN sperren und setzen (4) + ELSE sperren und setzen (6) + FI + ELIF zwei silber (1) + THEN SETZE 2 + FI +CASE7(*h*): IF string (2, 3) = "in" OR string (2, 3) = "er" (* hin, her *) + THEN sperren und setzen (3) + FI +CASE8(*i*): IF code 2 = cv n (* in *) + THEN IF string (3, 5) = "ter" (* inter *) + THEN sperren und setzen (5) + ELIF subtext (teilwort, 1, 5) = "insbe" + THEN sperren und setzen (3) + ELSE sperren und setzen (2) + FI; + FI +CASE9(*m*): IF string (2, 3) = "ög" AND teilwort laenge > 5 (* mög *) + THEN sperren und setzen (3); + FI +CASE10(*n*): IF string (2, 4) = "ach" AND teilwort laenge >= 7 + AND (teilwort SUB 5) <> "t" (* nach, aber nicht: nacht *) + THEN SETZE 4 + ELIF string (2, 6) = "ieder" (* nieder *) + THEN sperren und setzen (6) + ELIF string (2, 5) = "icht" (* nicht *) + THEN sperren und setzen (5) + ELIF string (2, 3) = "eu" (* neu *) + THEN sperren und setzen (3); + IF dreisilber (4) + THEN sperren und setzen (6) + FI + ELIF string (2, 5) = "iste" + THEN sperren und setzen (2) + FI +CASE11(*r*): IF code 2 = cv e (* re *) + THEN IF silbenanfang nach (4) (* Realeinkommen *) + THEN sperren und setzen (4) + ELSE sperren und setzen (2) + FI + FI +CASE12(*s*): IF string (2, 6) = "elbst" (* selbst *) + THEN sperren und setzen (6); SPERRE 4 + FI +CASE13(*t*): IF string (2, 3) = "at" (* tat *) + THEN sperren und setzen (3) + ELIF string (2, 5) = "rans" (* trans *) + THEN sperren und setzen (5) + ELIF string (2, 4) = "heo" (* theo *) + THEN sperren und setzen (4) + FI +CASE14(*u*): IF code 2 = cv m (* um *) + THEN SETZE 2 + ELIF code 2 = cv n (* un *) + THEN IF code 3 = cv i (* uni *) + THEN sperren und setzen (3) + ELSE sperren und setzen (2); + IF string (3, 5) = "ter" (* unter *) + THEN sperren und setzen (5) + FI + FI + FI +CASE15(*v*): IF string (2, 3) = "or" OR string (2, 3) = "on" OR + string (2, 3) = "er" (* vor, von, ver *) + THEN sperren und setzen (3) + FI +CASE16(*w*): IF code 2 = cv e AND code 3 = cv g (* weg *) + THEN sperren und setzen (3) + ELIF code 2 = cv i (* wi *) + THEN IF string(3,5) = "der" (* wider *) + THEN sperren und setzen (5) + ELIF string(3,6) = "eder" (* weder *) + THEN sperren und setzen (6) + FI + FI +CASE17(*ü*): IF string (2, 4) = "ber" (* über *) + THEN sperren und setzen (4) + FI +CASE18(*z*): IF code 2 = cv u (*zu*) + THEN sperren und setzen (2); + IF drei silber (3) (* zuein *) + THEN sperren und setzen (5) + FI + FI +END SELECT. + +nachsilben untersuchen: + IF (teilwort SUB teilwort laenge) = "t" + THEN IF (string (teilwort laenge - 3,teilwort laenge) = "heit" + AND (teilwort SUB teilwort laenge - 4) <> "c") + OR string (teilwort laenge - 3, teilwort laenge -1) = "kei" + THEN sperren und setzen (teilwort laenge - 4) + FI + ELIF string (teilwort laenge - 2, teilwort laenge) = "tag" + THEN sperren und setzen (teilwort laenge - 3) + ELIF string (teilwort laenge - 3, teilwort laenge) = "tags" + THEN sperren und setzen (teilwort laenge - 4) + FI. + +vokal 1: + IF string (a pos, a pos plus 2) = "uel" + THEN SETZE a pos + FI. + +vokal 2 : + ind := pos (vokal string, teilwort SUB a pos); + code 2 := code (teilwort SUB a pos plus 1); +SELECT ind OF +CASE1(*a*): IF code 2 = cv a OR code 2 = cv i OR code 2 = cv y (*aa,ai,ay*) + THEN + ELIF code 2 = cv u + THEN silbe au behandlung + ELSE SETZE a pos + FI +CASE2(*e*): IF code 2 = cv u AND (teilwort SUB a pos plus 2) = "e" (*eue*) + THEN SETZE a pos plus 1 + ELIF code 2 = cv o OR code 2 = cv ae OR code 2 = cv ue + OR code 2 = cv oe (*eo, eä, eü, eö *) + THEN SETZE a pos + FI +CASE3(*i*): IF code 2 <> cv e AND code 2 <> cv o (* i, aber nicht: ie, io *) + THEN SETZE a pos + FI +CASE4(*o*): IF code 2 = cv o OR code 2 = cv u (* oo, ou *) + THEN + ELIF code 2 = cv e (* oe *) + THEN SETZE a pos plus 1 + ELSE SETZE a pos + FI +CASE5(*u*): IF (teilwort SUB a pos - 1) = "q" (* qu *) + THEN + ELIF code 2 = cv e (* ue *) + THEN SETZE a pos plus 1 + ELSE SETZE a pos + FI +CASE7(*y*): IF code 2 <> cv u (* yu *) + THEN SETZE a pos + FI +OTHERWISE (*äöü*): SETZE a pos +END SELECT. + +silbe au behandlung: + IF (teilwort SUB a pos + 2) = "e" (* aue, wie in dau-ernd *) + THEN SETZE a pos plus 1 + ELIF a pos > 2 AND trennung oder sperre gesetzt (a pos + 2) AND + ((teilwort SUB a pos + 2) = "f" OR (teilwort SUB a pos + 2) = "s") + (* aus- oder auf-Mittelsilben *) + THEN SETZE (a pos - 1) + FI. + +vokal 3 : + IF string (a pos, a pos plus 2) <> "eau" + AND string (a pos plus 1, a pos+3) <> "eau" + THEN IF e pos - a pos = anzahl - 1 + THEN SETZE a pos plus 1 + ELSE code 1 := code(teilwort SUB a pos) ; + tr pos := a pos plus 1 ; + IF (code 1 = cv a OR code 1 = cv o OR code 1 = cv u) + AND (teilwort SUB a pos plus 1) = "e" + THEN tr pos INCR 1 + FI; + code 2 := code (teilwort SUB tr pos) ; + IF (code 2 = cv a OR code 2 = cv o OR code 2 = cv u) + AND (teilwort SUB tr pos + 1) = "e" + THEN tr pos INCR 1 + FI ; + SETZE tr pos + FI + FI . + +konsonant 1 : + ind := pos ("bcklmnrstß", teilwort SUB a pos); +SELECT ind OF +CASE1(*b*): IF string (a pos minus 1, a pos plus 2) = "über" + THEN SETZE a pos minus 2 + ELIF silbenanfang nach (a pos) + AND NOT trennung oder sperre gesetzt (a pos minus 1) + THEN SETZE a pos + ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt + (a pos) + THEN SETZE a pos minus 1 + FI; +CASE2(* c oder ch *): + IF ((teilwort SUB a pos plus 1) = "h" + AND (silbenanfang nach (a pos plus 1) + OR string (a pos, a pos + 3) = "chen")) + OR (teilwort SUB a pos plus 1) <> "h" + THEN SETZE a pos minus 1 + ELSE SETZE a pos plus 1 + FI +CASE3(*k*): IF string (a pos minus 2, a pos minus 1) = "ti" (* tik *) + AND silbenanfang nach (a pos) + THEN SETZE a pos + ELSE SETZE a pos minus 1 + FI +CASE4(*l*): IF string (a pos - 3, a pos plus 1) = "reali" + THEN SETZE a pos plus 1 + ELIF string (a pos minus 1, a pos plus 1) = "aly" + THEN SETZE a pos minus 1 + ELIF string (a pos minus 2, a pos minus 1) = "ta" (*..tal..*) + OR string (a pos minus 2, a pos minus 1) = "na" (*..nal..*) + OR string (a pos minus 2, a pos minus 1) = "ia" (*..ial..*) + THEN SETZE a pos + ELSE SETZE a pos minus 1 + FI +CASE5(*m*): IF string (a pos minus 2, a pos minus 1) = "to" (* ..tom..*) + THEN SETZE a pos + ELSE SETZE a pos minus 1 + FI +CASE6(*n*): IF string (a pos - 4, a pos minus 1) = "gege" + OR string (a pos - 4, a pos minus 1) = "nebe" (*gegen, neben*) + THEN SETZE (a pos - 3) ; SETZE a pos + ELIF string (a pos minus 1, a pos plus 1) = "ini" + THEN + ELIF NOT silbenanfang vor (a pos) + AND ((teilwort SUB a pos minus 1) = "e" (* en *) + OR (teilwort SUB a pos minus 1) = "u") (* un *) + AND (silbenanfang nach (a pos) + OR string (a pos plus 1, a pos plus 2) = "ob") + THEN SETZE a pos + ELIF string (a pos minus 2, a pos plus 1) = "eina" + THEN SETZE a pos + ELSE SETZE a pos minus 1 + FI +CASE7(*r*): IF string (a pos minus 2, a pos minus 1) = "tu" (*..tur..*) + THEN IF string (a pos plus 1, a pos plus 2) = "el" + OR (string (a pos plus 1, a pos plus 2) = "en" + AND string (a pos minus 1, apos +3) <> "ent") + (* turel OR <>turentwick*) + THEN SETZE a pos minus 1 + ELSE SETZE a pos + FI + ELIF string (a pos minus 2, a pos minus 1) = "ve" (*..ver..*) + OR string (a pos minus 2, a pos minus 1) = "vo" (*..vor..*) + THEN SETZE a pos + ELIF string (a pos minus 2, a pos minus 1) = "te" (* ter *) + THEN IF dreisilber (a pos plus 1) + OR string (a pos plus 1, a pos plus 1) = "a" (*tera*) + OR string (a pos - 3, a pos minus 2) <> "zt" (*zter*) + THEN SETZE a pos + ELSE SETZE a pos minus 1 + FI + ELIF (teilwort SUB a pos minus 1) = "e" (* er*) + AND silbenanfang nach (a pos) + AND string (a pos plus 1, a pos + 3) <> "ung" (*erung*) + AND string (a pos plus 1, a pos plus 2) <> "er" (*erer*) + THEN SETZE a pos + ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt + (a pos) + THEN SETZE a pos minus 1 + FI +CASE8(*s*): IF string (a pos minus 2, a pos minus 1) = "de" (* des *) + OR string (a pos minus 2, a pos minus 1) = "xi" (* ..xis *) + THEN SETZE a pos + ELIF string (a pos minus 2, a pos minus 1) = "ni" (* nis *) + AND silbenanfang nach (a pos) + THEN SETZE a pos + ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt + (a pos) + THEN SETZE apos minus 1 + FI +CASE9(*t*): IF string (a pos plus 1, a pos + 3) = "ion" (* tion *) + THEN SETZE a pos minus 1 + ELIF string (a pos plus 1, a pos + 3) <> "ier" (* imitieren *) + AND (string (a pos minus 2, a pos minus 1) = "mi"(*...mit..*) + OR string (a pos minus 2, a pos minus 1) = "va"(*privat..*) + OR string (a pos minus 2, a pos minus 1) = "fi"(*profit..*) + OR string (a pos - 3, a pos minus 1) = "zei")(*..zeit..*) + THEN SETZE a pos + ELSE SETZE a pos minus 1 + FI +CASE10(*ß*): IF string (a pos, a pos plus 2) = "ßen" + OR vorletzter buchstabe (a pos) + THEN SETZE a pos minus 1 + ELSE SETZE a pos + FI +OTHERWISE: IF vorletzter buchstabe oderkeine trennung oder sperre gesetzt + (a pos) + THEN SETZE a pos minus 1 + FI +END SELECT. + +konsonant 2 : + kons gr := string (a pos, e pos); + IF a pos > 2 AND trennung oder sperre gesetzt (a pos minus 1) + THEN + ELIF ausnahme fuer zwei konsonanten + THEN SETZE a pos + ELIF kons gr = "ts" + THEN IF NOT trennung oder sperre gesetzt (a pos) + (* für <> Tatsache, tatsächlich *) + THEN SETZE e pos + FI + ELIF kons gr = "tz" + THEN IF (teilwort SUB a pos plus 2) = "e" (* ..tze.. *) + OR (teilwort SUB a pos plus 2) = "u" (* ..tzu.. *) + THEN SETZE a pos + ELSE SETZE a pos plus 1 + FI + ELIF string (a pos, a pos plus 1) = "ch"(* ch zaehlt als 1 Buchstabe *) + THEN SETZE a pos plus 1 (* darum keine Abfrage mit kons gr *) + ELIF (kons gr = "dt" OR kons gr = "kt") + AND silbenanfang nach (e pos) + THEN SETZE e pos + ELIF kons gr = "ns" AND + (string (a pos - 2, a pos - 1) = "io" (* ..ions *) + OR (string (a pos minus 1, a pos) ="en" (*..ens..*) + AND (teilwort SUB a pos minus 2) <> "t")) (* aber nicht ..tensiv*) + THEN SETZE e pos + ELIF string (a pos minus 2, a pos plus 1) = "nach" + THEN IF (teilwort SUB a pos plus 2) <> "t" + THEN SETZE a pos plus 1 + FI + ELIF string (e pos, e pos + 3) = "lich" + THEN IF string (a pos minus 2, a pos) = "mög" + THEN SETZE a pos + ELIF pos ("hg", teilwort SUB e pos minus 1) > 0 + THEN SPERRE e pos minus 1 + ELSE SETZE e pos minus 1 + FI; + ELIF (reg (a pos) AND NOT trennung oder sperre gesetzt (a pos)) + OR (kons gr = "sp" AND silbenanfang vor (a pos)) + THEN SETZE a pos minus 1 + ELIF string (a pos, a pos plus 2) = "sch" + THEN SETZE a pos plus 2 + ELSE SETZE a pos + FI. + +ausnahme fuer zwei konsonanten: + string (a pos minus 2, a pos) = "nis" AND a pos > 1 + (*..nis.., aber nicht nisten *) + OR string (a pos minus 2, a pos plus 1) = "rafr" (* strafrecht *) + OR string (a pos - 4, a pos) = "undes" (* Bundes *) + OR string (a pos minus 1, a pos + 3) = "unter" + OR silbenanfang vor (e pos). + +konsonant 3 : + code 1 := code (teilwort SUB a pos); + code 2 := code (teilwort SUB a pos plus 1); + code 3 := code (teilwort SUB a pos plus 2); + IF NOT (ausnahme 1 OR ausnahme 2 OR ausnahme 3 OR ausnahme 4) + THEN suche regelmaessige konsonantenverbindung + FI. + +ausnahme 1 : + ind := pos ("cfgklnprt", code (code 1)); + SELECT ind OF +CASE1(*c*): IF code 2 = cv k (* ck *) + THEN SETZE a pos plus 1 + ELIF string (a pos, a pos + 3) = "chts" + (* Rechts.., Gesichts.., .. machts..*) + THEN SETZE (a pos + 3) + ELIF string (a pos plus 1, a pos + 5) = "hstag" (* Reichstag *) + OR (string (a pos, a pos plus 2) = "chs" AND (* ..chs.. *) + string (a pos plus 2, a pos +3) <> "st") + THEN SETZE a pos plus 2 + ELSE LEAVE ausnahme 1 WITH FALSE + FI; + TRUE +CASE2(*f*): IF code 2 = cv f (*ff*) + THEN IF code 3 = cv s + THEN SETZE a pos plus 2 (* ffs *) + ELSE SETZE a pos plus 1 + FI + ELIF string (a pos minus 1, a pos plus 1) = "aft" (*..aft..*) + THEN IF (teilwort SUB a pos plus 2) = "s" + THEN SETZE a pos plus 2 + ELSE SETZE a pos plus 1 + FI + ELSE LEAVE ausnahme 1 WITH FALSE + FI; + TRUE +CASE3(*g*): IF string (a pos minus 2, a pos minus 1) = "ag" (* ags *) + THEN SETZE a pos plus 1 + ELSE LEAVE ausnahme 1 WITH FALSE + FI; + TRUE +CASE4(*k*): IF string (a pos, a pos plus 1) = "kt" + AND silbenanfang nach (a pos plus 1) + THEN SETZE a pos plus 1 + ELSE LEAVE ausnahme 1 WITH FALSE + FI; + TRUE +CASE5(*l*): IF code 2 = cv d OR code 2 = cv g OR code 2 = cv k (*ld, lg, lk*) + THEN SETZE a pos plus 1 + ELIF string (a pos, a pos + 4) = "ltspr" (* Anwaltsprogramm *) + THEN SETZE (a pos + 2) + ELSE LEAVE ausnahme 1 WITH FALSE + FI; + TRUE +CASE6(*n*): IF string (a pos - 2, a pos) = "ein" + THEN SETZE a pos + ELIF code 2 = cv d (* nd *) + THEN IF code 3 = cv s (* nds, wie in ...stands... *) + THEN SETZE a pos plus 2 + ELSE SETZE a pos plus 1 + FI + ELIF code 2 = cv g (* ng *) + THEN IF code 3 = cv s (* ..ngs.. *) + THEN SETZE a pos plus 2 + ELIF code 3 = cv r (* ..ngr.. *) + THEN SETZE a pos + ELIF code 3 = cv l (* ungleich *) + THEN + ELSE SETZE a pos plus 1 + FI + ELIF string (a pos - 3, a pos plus 1) = "trans" + OR string (a pos - 3, a pos plus 1) = "tions" (*tionsplan*) + THEN SETZE a pos plus 1 + ELIF string (a pos plus 1, a pos + 6) = "ftsper" (*ftsperspek*) + THEN SETZE (a pos + 3) + ELSE LEAVE ausnahme 1 WITH FALSE + FI; + TRUE +CASE7(*p*): IF code 2 = cv p (* pp *) + OR (code 2 = cv f AND code 3 = cv t) (* pft *) + THEN SETZE a pos plus 1; TRUE + ELSE FALSE + FI +CASE8(*r*): IF string (a pos plus 1, a pos + 4) = "tner" (* rtner *) + THEN SETZE a pos plus 1 + ELIF trennung oder sperre gesetzt (a pos) + THEN + ELSE LEAVE ausnahme 1 WITH FALSE + FI; + TRUE +CASE9(*t*): IF string (a pos plus 1, a pos plus 2) = "st" (*tst*) + THEN SETZE a pos + ELIF string (a pos plus 1, a pos plus 2) = "zt" + (* letzt.. *) + THEN IF (teilwort SUB a pos + 3) = "e" (*letzte..*) + THEN SETZE a pos plus 1 + ELSE SETZE a pos plus 2 + FI + ELIF string (apos - 2, a pos plus 1) = "eits" + (* ..heits.., ..keits.., ..beits.. *) + OR string (a pos plus 1, a pos plus 1)= "z" (*tz*) + THEN SETZE a pos plus 1 + ELSE LEAVE ausnahme 1 WITH FALSE + FI; + TRUE +OTHERWISE: FALSE +END SELECT. + +ausnahme 2 : + IF e pos - a pos = 2 + THEN FALSE + ELIF code 2 = cv p AND string (a pos plus 2, a pos + 3) = "ft" (* pft *) + THEN SETZE a pos plus 2; TRUE + ELSE FALSE + FI . + +ausnahme 3 : + IF code 1 = cv s + THEN IF code 2 = cv t AND code 3 <> cv r (* st, aber nicht: str *) + AND pos (vokal string, teilwort SUB a pos plus 2) = 0 + THEN SETZE a pos plus 1 ; TRUE + ELSE FALSE + FI + ELIF code 2 = cv s + THEN IF code 3 = cv t AND (teilwort SUB a pos + 3) <> "r" + AND pos (vokal string, teilwort SUB (a pos + 3)) = 0 + THEN SETZE a pos plus 2; TRUE + ELSE FALSE + FI + ELSE FALSE + FI . + +ausnahme 4 : + IF string (e pos, e pos + 3) = "lich" + THEN IF pos ("hg", teilwort SUB e pos minus 1) > 0 + THEN SPERRE e pos minus 1 + ELSE SETZE e pos minus 1 + FI; + TRUE + ELSE FALSE + FI . + +suche regelmaessige konsonantenverbindung : + FOR posit FROM a pos UPTO e pos minus 1 REP + IF reg (posit) + THEN SETZE (posit - 1); LEAVE konsonant 3 + FI + END REP ; + IF (teilwort SUB e pos) <> "h" OR (teilwort SUB e pos minus 1) <> "c" + THEN SETZE e pos minus 1 + ELIF (teilwort SUB e pos - 2) <> "s" + THEN SETZE (e pos - 2) + ELSE SETZE (e pos - 3) + FI +END PROC erstelle trennvektor ; +END PACKET silbentrennung; + diff --git a/system/multiuser/1.7.5/src/spool manager b/system/multiuser/1.7.5/src/spool manager new file mode 100644 index 0000000..ac0295a --- /dev/null +++ b/system/multiuser/1.7.5/src/spool manager @@ -0,0 +1,887 @@ +PACKET spool manager DEFINES (* Autor: J. Liedtke *) + (* R. Nolting *) + (* R. Ruland *) + (* Stand: 25.04.86 *) + + spool manager , + + server channel , + spool duty, + station only, + spool control task : + +LET que size = 101 , + + ack = 0 , + nak = 1 , + error nak = 2 , + message ack = 3 , + question ack = 4 , + second phase ack = 5 , + + fetch code = 11 , + save code = 12 , + file save code old = 13 , + erase code = 14 , + list code = 15 , + all code = 17 , + param fetch code = 21 , + file save code = 22 , + entry line code = 23 , + killer code = 24 , + first code = 25 , + start code = 26 , + stop code = 27 , + halt code = 28 , + wait for halt code = 29 , + + continue code = 100 , + + file type = 1003 ; + +LET begin char = ""0"", + end char = ""1""; + +LET PARAMS = STRUCT (TEXT name, userid, password, sendername, INT station), + ENTRY = STRUCT (PARAMS ds params, TEXT entry line, DATASPACE space); + +ROW que size ENTRY VAR que ; + +PARAMS CONST empty params := PARAMS : ("", "", "", "", -1); + +PARAMS VAR save params, file save params; + +ENTRY VAR fetch entry; + +FILE VAR file; + +INT VAR order, last order, phase, reply, old heap size, first, last, list index, + begin pos, end pos, order task station, sp channel, counter; + +TEXT VAR order task name, buffer, sp duty, start time; + +BOOL VAR server is waiting, stop command pending, stat only, valid fetch entry; + +TASK VAR order task, last order task, server, calling parent, task in control; + +INITFLAG VAR in this task := FALSE; + +DATASPACE VAR ds; + +BOUND STRUCT (TEXT name, userid, password) VAR msg; +BOUND STRUCT (TEXT entry line, INT index) VAR control msg; +BOUND PARAMS VAR fetch msg; +BOUND THESAURUS VAR all msg; +BOUND TEXT VAR error msg ; + + +. first entry : que (first) +. list entry : que (list index) +. last entry : que (last) + +. que is empty : first = last +. que is full : first = next (last) +.; + +sp channel := 0; +sp duty := ""; +stat only := FALSE; +task in control := myself; + +PROC server channel (INT CONST channel nr) : + IF channel nr <= 0 OR channel nr >= 33 + THEN errorstop ("falsche Kanalangabe") FI; + sp channel := channel nr; +END PROC server channel; + +INT PROC server channel : + sp channel +END PROC server channel; + + +PROC station only (BOOL CONST flag) : + stat only := flag +END PROC station only; + +BOOL PROC station only : + stat only +END PROC station only; + + +PROC spool duty (TEXT CONST duty) : + sp duty := duty; +END PROC spool duty; + +TEXT PROC spool duty : + sp duty +END PROC spool duty; + + +PROC spool control task (TASK CONST task id): + task in control := task id; +END PROC spool control task; + +TASK PROC spool control task : + task in control +END PROC spool control task; + + +PROC spool manager (PROC server start) : + + spool manager (PROC server start, TRUE) + +END PROC spool manager; + + +PROC spool manager (PROC server start, BOOL CONST with start) : + + set autonom ; + break ; + disable stop ; + initialize spool manager ; + REP forget (ds) ; + wait (ds, order, order task) ; + IF order <> second phase ack + THEN prepare first phase ; + spool (PROC server start); + ELIF order task = last order task + THEN prepare second phase ; + spool (PROC server start); + ELSE send nak + FI ; + send error if necessary ; + collect heap garbage if necessary + PER + + . initialize spool manager : + initialize if necessary; + stop; + erase fetch entry; + IF with start THEN start (PROC server start) FI; + + . initialize if necessary : + IF NOT initialized (in this task) + THEN FOR list index FROM 1 UPTO que size + REP list entry. space := nilspace PER; + fetch entry. space := nilspace; + ds := nilspace; + last order task := niltask; + server := niltask; + calling parent := niltask; + server is waiting := FALSE; + stop command pending := FALSE; + old heap size := 0; + clear spool; + FI; + + . prepare first phase : + IF order = save code OR order = erase code OR order = stop code + THEN phase := 1 ; + last order := order ; + last order task := order task ; + FI; + + . prepare second phase : + phase INCR 1 ; + order := last order + + . send nak : + forget (ds) ; + ds := nilspace ; + send (order task, nak, ds); + + . send error if necessary : + IF is error + THEN forget (ds) ; + ds := nilspace ; + error msg := ds ; + CONCR (error msg) := error message; + clear error; + send (order task, error nak, ds) + FI; + + . collect heap garbage if necessary : + IF heap size > old heap size + 2 + THEN collect heap garbage; + old heap size := heap size; + FI; + +END PROC spool manager; + + +PROC spool (PROC server start): + + command dialogue (FALSE); + enable stop; + IF station only CAND station (ordertask) <> station (myself) + THEN errorstop ("kein Zugriffsrecht auf Task " + text (station(myself)) + + "/""" + name(myself) + """") + FI; + + SELECT order OF + + CASE fetch code : out of que + CASE param fetch code : send fetch params + CASE save code : new que entry + CASE file save code, file save code old : + new file que entry + CASE erase code : erase que entry + CASE list code : send spool list + CASE all code : send owners ds names + + OTHERWISE : + + IF order >= continue code AND order task = supervisor + THEN forget (ds); + spool command (PROC server start) + + ELIF spool control allowed by order task + THEN SELECT order OF + CASE entry line code : send next entry line + CASE killer code : kill entry + CASE first code : make to first + CASE start code : start server + CASE stop code : stop server + CASE halt code : halt server + CASE wait for halt code : wait for halt + OTHERWISE : errorstop ("falscher Auftrag fuer Task """ + + name(myself) + """") + END SELECT + + ELSE errorstop ("falscher Auftrag fuer Task """ + + name(myself) + """") + FI; + END SELECT; + + +. spool control allowed by order task : + (order task = spool control task OR order task < spool control task + OR spool control task = supervisor) + AND station (order task) = station (myself) +. + out of que : + IF NOT (order task = server) + THEN errorstop ("keine Servertask") + ELIF stop command pending + THEN forget (ds); + stop; + erase fetch entry; + ELIF que is empty + THEN forget (ds) ; + erase fetch entry; + server is waiting := TRUE; + ELSE send first entry; + FI; + +. + send fetch params : + IF order task = server + THEN send params + ELSE errorstop ("keine Servertask") + FI; + + . send params : + forget(ds); ds := nilspace; fetch msg := ds; + fetch msg := fetch entry. ds params; + send (order task, ack, ds); + +. + new que entry : + IF phase = 1 + THEN prepare into que + ELSE into que + FI; + +. + prepare into que : + msg := ds ; + save params. name := msg.name; + save params. userid := msg.userid; + save params. password := msg.password; + save params. sendername := name (order task); + save params. station := station (order task); + forget (ds); ds := nilspace; + send (order task, second phase ack, ds); + +. + new file que entry : + IF type (ds) <> file type + THEN errorstop ("Datenraum hat falschen Typ"); + ELSE get file params; + into que; + FI; + + . get file params : + file := sequential file (input, ds); + end pos := 0; + next headline information (file save params. name); + next headline information (file save params. userid); + next headline information (file save params. password); + next headline information (file save params. sendername); + next headline information (buffer); + file save params. station := int (buffer); + IF NOT last conversion ok + THEN file save params. station := station (order task) FI; + IF file save params. sendername = "" + THEN file save params. sendername := name (order task) FI; + IF file save params. name = "" + THEN IF headline (file) <> "" + THEN file save params. name := headline (file); + ELSE errorstop ("Name unzulaessig") + FI; + ELSE headline (file, file save params. name); + FI; + +. + erase que entry : + msg := ds ; + order task name := name (order task); + order task station := station (order task); + IF phase = 1 + THEN ask for erase + ELSE erase entry from order task + FI; + + . ask for erase : + to first que entry; + WHILE next que entry found + REP IF is entry from order task (msg. name) + THEN manager question ("""" + msg.name + """ loeschen"); + LEAVE erase que entry + FI; + PER ; + manager message ("""" + msg.name + """ existiert nicht"); + + . erase entry from order task : + IF is entry from order task (msg. name) + THEN delete que entry; + LEAVE erase que entry + ELSE to first que entry; + WHILE next que entry found + REP IF is entry from order task (msg. name) + THEN delete que entry; + LEAVE erase que entry + FI ; + PER ; + manager message ("""" + msg.name + """ existiert nicht"); + FI; + + . delete que entry : + erase entry (list index) ; + send ack; + +. + send owners ds names: + order task name := name (order task); + order task station := station (order task); + forget (ds); ds := nilspace; all msg := ds; + all msg := empty thesaurus; + to first que entry; + WHILE next que entry found + REP IF is entry from order task ("") + THEN insert (all msg, list entry. ds params. name) + FI; + PER; + send (order task, ack, ds) + +. + send spool list : + list spool; + send (order task, ack, ds); + +. + send next entry line : + control msg := ds; + get next entry line (control msg. entry line, control msg. index); + send (order task, ack, ds); + +. + kill entry : + control msg := ds; + list index := control msg. index; + IF is valid que entry (list index) + THEN erase entry (list index) + FI; + send (order task, ack, ds); + +. + make to first : + control msg := ds; + list index := control msg. index; + IF is valid que entry (list index) + THEN new first (list entry); + erase entry (list index); + FI; + send (order task, ack, ds); + +. + start server : + IF exists (server) THEN errorstop ("Spool muß zuerst gestoppt werden") FI; + start (PROC server start); + IF server channel <= 0 OR server channel >= 33 + THEN manager message ("WARNUNG : Serverkanal nicht eingestellt"); + ELSE send ack + FI; + +. + stop server: + IF phase = 1 + THEN stop; + IF valid fetch entry + THEN valid fetch entry := FALSE; + manager question (""13""10"" + + fetch entry. entry line + " neu eintragen"); + ELSE erase fetch entry; + send ack; + FI; + ELSE IF fetch entry. entry line <> "" THEN new first (fetch entry) FI; + erase fetch entry; + send ack; + FI; + +. + halt server : + stop command pending := TRUE; + IF NOT exists (server) OR server is waiting + THEN stop; + erase fetch entry; + FI; + send ack; + +. + wait for halt : + IF exists (calling parent) + THEN errorstop ("Task """ + name (calling parent) + """ wartet schon auf halt") + ELSE calling parent := order task; + stop command pending := TRUE; + forget (ds); + IF NOT exists (server) OR server is waiting + THEN stop; + erase fetch entry; + FI; + FI; + +END PROC spool; + + +PROC send first entry : + + forget (ds); ds := first entry. space; + send (server, ack, ds, reply) ; + IF reply = ack + THEN server is waiting := FALSE; + start time := time of day; + start time CAT " am "; + start time CAT date; + erase fetch entry; + fetch entry := first entry; + erase entry (first); + valid fetch entry := TRUE; + ELSE forget (ds); + FI; + +END PROC send first entry; + + +PROC into que : + + IF que is full + THEN errorstop ("Spool ist voll") + ELSE make new entry; + send ack; + awake server if necessary + FI; + + . make new entry : + IF order = save code + THEN last entry. ds params := save params; + save params := empty params; + ELSE last entry. ds params := file save params; + file save params := empty params; + FI; + last entry. space := ds; + counter INCR 1; + build entry line; + last := next (last) ; + + . build entry line : + IF LENGTH last entry. ds params. sender name > 16 + THEN buffer := subtext (last entry. ds params. sender name, 1, 13); + buffer CAT "..."""; + ELSE buffer := last entry. ds params. sender name; + buffer CAT """"; + buffer := text (buffer, 17); + FI; + last entry. entry line := text (last entry. ds params. station, 2); + last entry. entry line CAT "/"""; + last entry. entry line CAT buffer; + last entry. entry line CAT " : """ ; + last entry. entry line CAT last entry. ds params. name; + last entry. entry line CAT """ (" ; + last entry. entry line CAT text (storage (last entry. space)); + last entry. entry line CAT " K)"; + + . awake server if necessary : + IF server is waiting THEN send first entry FI; + +END PROC into que; + + +PROC list spool : + + forget (ds); ds := nilspace; + file := sequential file (output, ds) ; + max line length (file, 1000); + headline(file, text (station(myself)) + "/""" + name (myself) + """"); + put spool duty; + put current job; + put spool que; + + . put spool duty : + IF spool duty <> "" + THEN write (file, "Aufgabe: "); + write (file, spool duty ); + line (file, 2); + FI; + + . put current job : + IF valid fetch entry AND exists (server) + THEN write (file, "In Bearbeitung seit "); + write (file, start time); + write (file, ":"); + line (file, 2); + putline (file, fetch entry. entry line); + IF stop command pending + THEN putline (file, "Spool wird nach diesem Auftrag deaktiviert"); + FI; + line (file); + ELSE write (file, "kein Auftrag in Bearbeitung"); + IF NOT exists (server) + THEN write (file, ", da Spool deaktiviert"); + ELIF que is empty + THEN write (file, ", da Warteschlange leer"); + LEAVE list spool; + FI; + line (file, 2); + FI; + + . put spool que : + IF que is empty + THEN putline (file, "Warteschlange ist leer"); + ELSE write (file, "Warteschlange ("); + write (file, text (counter)); + write (file, " Auftraege):"); + line (file, 2); + to first que entry ; + WHILE next que entry found + REP putline (file, list entry. entry line) PER; + FI; + +END PROC list spool ; + + +PROC clear spool : + + first := 1; + last := 1; + counter := 0; + FOR list index FROM 1 UPTO que size + REP list entry. ds params := empty params; + list entry. entry line := ""; + forget (list entry. space) + PER; + +END PROC clear spool; + +(*********************************************************************) +(* Hilfsprozeduren zum Spoolmanager *) + +BOOL PROC is valid que entry (INT CONST index) : + + que (index). entry line <> "" + +END PROC is valid que entry; + + +INT PROC next (INT CONST index) : + + IF index < que size + THEN index + 1 + ELSE 1 + FI + +END PROC next; + + +PROC to first que entry : + + list index := first - 1; + +ENDPROC to first que entry ; + + +BOOL PROC next que entry found : + + list index := next (list index); + WHILE is not last que entry + REP IF is valid que entry (list index) + THEN LEAVE next que entry found WITH TRUE FI; + list index := next (list index); + PER; + FALSE + + . is not last que entry : + list index <> last + +ENDPROC next que entry found ; + + +PROC get next entry line (TEXT VAR entry line, INT VAR index) : + + IF index = 0 + THEN list index := first - 1 + ELSE list index := index + FI; + IF next que entry found + THEN entry line := list entry. entry line; + index := list index; + ELSE entry line := ""; + index := 0; + FI; + +END PROC get next entry line; + + +PROC new first (ENTRY VAR new first entry) : + + IF que is full + THEN errorstop ("Spool ist voll") + ELSE first DECR 1 ; + IF first = 0 THEN first := que size FI; + first entry := new first entry; + counter INCR 1; + FI; + +END PROC new first; + + +PROC erase entry (INT CONST index) : + + entry. ds params := empty params; + entry. entry line := ""; + forget (entry.space) ; + counter DECR 1; + IF index = first + THEN inc first + FI ; + + . entry : que (index) + + . inc first : + REP first := next (first) + UNTIL que is empty OR is valid que entry (first) PER + +END PROC erase entry; + + +PROC erase fetch entry : + + fetch entry. ds params := empty params; + fetch entry. entry line := ""; + forget (fetch entry. space); + valid fetch entry := FALSE; + +END PROC erase fetch entry; + + +BOOL PROC is entry from order task (TEXT CONST file name) : + + correct order task CAND correct filename + + . correct order task : + order task name = list entry. ds params. sendername + AND order task station = list entry. ds params. station + + . correct file name : + file name = "" OR file name = list entry. ds params. name + +END PROC is entry from order task; + + +PROC start (PROC server start): + + begin (PROC server start, server); + +END PROC start; + + +PROC stop : + + stop server; + send calling parent reply if necessary; + + . stop server: + IF exists (server) THEN end (server) FI; + server := niltask; + server is waiting := FALSE; + stop command pending := FALSE; + + . send calling parent reply if necessary : + IF exists (calling parent) + THEN forget (ds); ds := nilspace; + send (calling parent, ack, ds); + calling parent := niltask; + FI; + +END PROC stop; + + +PROC next headline information (TEXT VAR t): + + begin pos := pos (headline (file), begin char, end pos + 1); + IF begin pos = 0 + THEN begin pos := LENGTH headline (file) + 1; + t := ""; + ELSE end pos := pos (headline (file), end char, begin pos + 1); + IF end pos = 0 + THEN end pos := LENGTH headline (file) + 1; + t := ""; + ELSE t := subtext (headline (file), begin pos+1, end pos-1) + FI + FI + +END PROC next headline information; + + +PROC send ack : + + forget (ds); ds := nilspace; + send (order task, ack, ds) + +END PROC send ack; + + +PROC manager question (TEXT CONST question) : + + forget (ds); ds := nilspace; error msg := ds ; + error msg := question ; + send (order task, question ack, ds) + +ENDPROC manager question ; + + +PROC manager message (TEXT CONST message) : + + forget (ds); ds := nilspace; error msg := ds ; + error msg := message ; + send (order task, message ack, ds) + +ENDPROC manager message ; + +(*********************************************************************) +(* Spool - Kommandos *) + +INT VAR command index , params ; +TEXT VAR command line, param 1, param 2 ; + +LET spool command list = +"break:1.0start:2.01stop:4.0halt:5.0first:6.0killer:7.0listspool:8.0 +clearspool:9.0spoolcontrolby:10.1"; + +PROC spool command (PROC server start) : + + enable stop ; + continue (order - continue code) ; + disable stop ; + REP command dialogue (TRUE) ; + get command ("gib Spool-Kommando:", command line); + analyze command (spool command list, command line, 3, command index, + params, param1, param2); + execute command (PROC server start); + UNTIL NOT online PER; + command dialogue (FALSE); + break (quiet); + set autonom; + +END PROC spool command; + + +PROC execute command (PROC server start) : + + enable stop; + SELECT command index OF + CASE 1 : break + CASE 2 : start server + CASE 3 : start server with new channel + CASE 4 : stop server + CASE 5 : halt server + CASE 6 : first cmd + CASE 7 : killer cmd + CASE 8 : show spool list + CASE 9 : clear spool + CASE 10 : spool control task (task (param1)) + OTHERWISE do (command line) + END SELECT; + + . start server : + IF server channel <= 0 OR server channel >= 33 + THEN line; + putline ("WARNUNG : Serverkanal nicht eingestellt"); + FI; + stop server; + start (PROC server start); + + . start server with new channel: + INT VAR i := int (param1); + IF last conversion ok + THEN server channel (i); + start server; + ELSE errorstop ("falsche Kanalangabe") + FI; + + . stop server : + disable stop; + stop; + IF valid fetch entry CAND + yes (""13""10"" + fetch entry. entry line + " neu eintragen") + THEN new first (fetch entry) FI; + erase fetch entry; + enable stop; + + . halt server : + stop command pending := TRUE; + IF NOT exists (server) OR server is waiting + THEN stop server; + erase fetch entry; + FI; + + . first cmd : + line ; + to first que entry ; + WHILE next que entry found + REP say (list entry. entry line) ; + IF yes (" als erstes") + THEN new first (list entry); + erase entry (list index); + LEAVE first cmd + FI ; + PER; + + . killer cmd : + line ; + to first que entry ; + WHILE next que entry found + REP say (list entry. entry line) ; + IF yes (" loeschen") THEN erase entry (list index) FI ; + PER; + + . show spool list : + list spool; + disable stop; + show (file); + forget (ds); + +ENDPROC execute command ; + +ENDPACKET spool manager; + diff --git a/system/multiuser/1.7.5/src/supervisor b/system/multiuser/1.7.5/src/supervisor new file mode 100644 index 0000000..00874b2 --- /dev/null +++ b/system/multiuser/1.7.5/src/supervisor @@ -0,0 +1,774 @@ +(* ------------------- VERSION 19 03.06.86 ------------------- *) +PACKET supervisor : (* Autor: J.Liedtke *) + + + + +LET ack = 0 , + nak = 1 , + error nak = 2 , + + system catalogue code = 3 , + begin code = 4 , + end code = 5 , + break code = 6 , + rename code = 7 , + halt code = 8 , + password code = 9 , + family password code = 40 , + set autonom code = 41 , + reset autonom code = 42 , + define canal code = 43 , + go back to old canal code = 44 , + task of channel code = 45 , + canal of channel code = 46 , + set automatic startup code = 47 , + reset automatic startup code = 48 , + + continue code low = 100 , + continue code high = 132 , + + system start code = 100 , + define station code = 32000 , + max station no = 127 , + + nil = 0 , + + number of tasks = 125 , + + number of channels = 32 , + highest terminal channel = 16 , + highest user channel = 24 , + highest system channel = 32 , + configurator channel = 32 , + + shutup and save code = 12 , + + channel field = 4 , + fromid field = 11 , + nilchannel = 0 ; + + + +TASK VAR order task ; +INT VAR order code , + channel nr , + channel index ; + +DATASPACE VAR ds ; + +BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR msg ; +BOUND TEXT VAR error msg ; + +REAL VAR last rename time := 0.0 ; + + +TEXT VAR actual password, supply password ; + + +ROW highest terminal channel TASK VAR canal ; + +ROW number of channels TASK VAR connected task ; + +FOR channel index FROM 1 UPTO highest terminal channel REP + canal (channel index) := niltask ; +PER ; +FOR channel index FROM 1 UPTO number of channels REP + connected task (channel index) := niltask +PER ; + + +ROW number of tasks BOOL VAR autonom flag ; +ROW number of tasks BOOL VAR automatic startup flag ; +ROW number of tasks TEXT VAR task password ; + +task password (1) := "-" ; +task password (2) := "-" ; + +set clock (date ("09.06.86")) ; + +TASK VAR dummy task ; +command dialogue (TRUE) ; + +ke ; (* maintenance ke *) + +create son (myself, "SYSUR", dummy task, proca (PROC sysur)) ; + +PROC sysur : + + disable stop ; + begin ("ARCHIVE", PROC archive manager, dummy task) ; + begin ("OPERATOR", PROC monitor, dummy task) ; + begin ("conf", PROC configurator, dummy task) ; + system manager + +ENDPROC sysur ; + +PROC configurator : + + page ; + REP UNTIL yes("Archiv 'dev' eingelegt") PER; + archive ("dev") ; + fetch all (archive) ; + release (archive) ; + REP UNTIL yes ("save system") PER ; + command dialogue (FALSE) ; + save system ; + command dialogue (TRUE) ; + rename myself ("configurator") ; + disable stop ; + REP + configuration manager ; + clear error + PER + +ENDPROC configurator ; + + +erase last bootstrap source dataspace ; +channel (myself, 1) ; +command dialogue (TRUE) ; +IF yes("Leere Floppy eingelegt") + THEN channel (myself, nilchannel) ; + command dialogue (FALSE) ; + sys op (shutup and save code) + ELSE channel (myself, nilchannel) ; + command dialogue (FALSE) +FI ; +supervisor ; + + +PROC supervisor : + + disable stop ; + INT VAR old session := session ; + REP + wait (ds, order code, order task) ; + IF is niltask (order task) + THEN interrupt + ELIF station (order task) = station (myself) + THEN order from task + FI + PER . + +interrupt : + IF order code = 0 + THEN IF old session <> session + THEN disconnect all terminal tasks ; + old session := session + FI ; + system start interrupt + ELSE supervisor interrupt (canal (order code), order code, + connected task (order code)) + FI . + +disconnect all terminal tasks : + INT VAR i ; + FOR i FROM 1 UPTO highest terminal channel REP + TASK VAR id := connected task (i) ; + IF NOT (is niltask (id) COR automatic startup flag (index (id)) + COR is niltask (canal (i))) + THEN break task + FI + PER . + +break task : + IF task direct connected to channel + THEN channel (id, nilchannel) ; + connected task (i) := niltask + ELSE disconnect if at terminal but overloaded by canal + FI . + +task direct connected to channel : + pcb (id, channel field) <> nilchannel . + +disconnect if at terminal but overloaded by canal : + connected task (i) := niltask . + +order from task : + channel index := channel (order task) ; + IF is command analyzer task + THEN order from command analyzer (connected task (channel index)) + ELSE order from user task + FI ; + IF is error + THEN send back error message + FI . + +is command analyzer task : + channel index <> nilchannel + CAND channel index <= highest terminal channel + CAND order task = canal (channel index) . + +send back error message : + forget (ds) ; + ds := nilspace ; + error msg := ds ; + CONCR (error msg) := error message ; + clear error ; + send (order task, error nak, ds) . + +ENDPROC supervisor ; + +PROC supervisor interrupt (TASK VAR command analyzer, INT CONST channel nr, + TASK VAR terminal task) : + + IF NOT is niltask (terminal task) + THEN channel (terminal task, nilchannel) + FI ; + create command analyzer if necessary ; + IF already at terminal + THEN halt process (command analyzer) + ELSE send acknowledge + FI ; + channel (command analyzer, channel nr) ; + activate (command analyzer) . + +create command analyzer if necessary : + IF is niltask (command analyzer) + THEN create son (myself, "-", command analyzer, proca (PROC analyze supervisor command)) + FI . + +send acknowledge : + forget (ds) ; + ds := nilspace ; + send (command analyzer, ack, ds) . + +already at terminal : channel (command analyzer) = channel nr . + +ENDPROC supervisor interrupt ; + +PROC order from command analyzer (TASK VAR terminal task) : + +enable stop ; +IF is continue THEN sv cmd continue +ELIF order code = system catalogue code THEN task info cmd +ELIF order code = task of channel code THEN sv cmd task of channel +ELSE SELECT order code OF CASE ack : + CASE end code : sv cmd end + CASE break code : sv cmd break + CASE halt code : sv cmd halt + OTHERWISE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""") + END SELECT ; + channel (command analyzer, nilchannel) +FI ; + +forget (ds) ; +IF NOT is niltask (terminal task) AND order code <> system catalogue code + THEN channel (order task, nilchannel) ; + channel (terminal task, channel index) ; + activate (terminal task) +FI . + +sv cmd task of channel : + msg := ds ; + msg.task := terminal task ; + send (order task,ack, ds) ; + LEAVE order from command analyzer . + +sv cmd end : + IF NOT is niltask (terminal task) + THEN delete task (terminal task) ; + terminal task := niltask + FI . + +sv cmd break : + terminal task := niltask . + +sv cmd continue : + sv cmd break ; + continue cmd by canal . + +sv cmd halt : + IF is niltask (terminal task) + THEN errorstop ("keine Task angekoppelt") + ELSE halt process (terminal task) + FI . + +is continue : + order code > continue code low AND order code <= continue code high . + +command analyzer : canal (channel index) . + +ENDPROC order from command analyzer ; + +PROC order from user task : + + enable stop ; + SELECT order code OF + CASE nak, error nak : + CASE system catalogue code : task info cmd + CASE begin code : user begin cmd + CASE end code : user end cmd + CASE break code : user break cmd + CASE rename code : user rename cmd + CASE password code : password cmd + CASE family password code : family password cmd + CASE set autonom code : set autonom cmd + CASE reset autonom code : reset autonom cmd + CASE define canal code : define new canal + CASE go back to old canal code : go back to old canal + CASE task of channel code : task of channel + CASE canal of channel code : canal of channel + CASE set automatic startup code : set automatic startup cmd + CASE reset automatic startup code : reset automatic startup cmd + OTHERWISE IF is continue + THEN user continue cmd + ELIF is define station + THEN define new station + ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""") + FI + ENDSELECT . + +user begin cmd : + msg := ds ; + create son (order task, new task name, new task, new start proc) ; + send (order task, ack, ds) . + +user end cmd : + msg := ds ; + TASK VAR to be erased := CONCR (msg).task ; + IF task end permitted + THEN delete task (to be erased) + ELSE errorstop ("'end' unzulaessig") + FI ; + IF exists (order task) + THEN send (order task, ack, ds) + ELSE forget (ds) + FI . + +task end permitted : + ( (task is dead AND system catalogue contains entry) OR exists (to be erased)) + CAND ( to be erased = order task + COR to be erased < order task + COR (order task < myself AND NOT (order task < to be erased)) ) . + +task is dead : + status (to be erased) > 6 . + +system catalogue contains entry : + task in catalogue (to be erased, index (to be erased)) . + +user rename cmd : + IF last rename was long ago + THEN msg := ds ; + name (order task, CONCR (msg).tname) ; + update entry in connected task array ; + send (order task, ack, ds) ; + remember rename time + ELSE send (order task, nak, ds) + FI . + +update entry in connected task array : + IF channel (order task) <> nilchannel + THEN connected task (channel (order task)) := order task + FI . + +remember rename time : + last rename time := clock (1) . + +last rename was long ago : abs (clock (1) - last rename time) > 20.0 . + +user break cmd : + break order task ; + send (order task, ack, ds) . + +break order task : + IF task direct connected to channel + THEN channel (order task, nilchannel) ; + terminal task := niltask + ELSE disconnect if at terminal but overloaded by canal + FI . + +task direct connected to channel : channel index <> nilchannel . + +terminal task : connected task (channel index) . + +disconnect if at terminal but overloaded by canal : + INT VAR i ; + FOR i FROM 1 UPTO highest terminal channel REP + IF connected task (i) = order task + THEN connected task (i) := niltask ; + LEAVE disconnect if at terminal but overloaded by canal + FI + PER . + +user continue cmd : + INT CONST dest channel := order code - continue code low ; + IF dest channel <= highest user channel OR order task < myself + THEN IF NOT channel really existing + THEN errorstop ("kein Kanal") + ELIF dest channel is free OR task is already at dest channel + THEN break order task ; + continue (order task, dest channel) ; + autonom flag (index (order task)) := FALSE ; + send (order task, ack, ds) + ELSE errorstop ("Kanal belegt") + FI + ELSE errorstop ("ungueltiger Kanal") + FI . + +channel really existing : + channel type (dest channel) <> 0 OR dest channel = configurator channel . + +dest channel is free : + (is niltask (connected task (dest channel)) OR channel (connected task (dest channel)) = nilchannel) + AND no canal active . + +no canal active : + dest channel > highest terminal channel COR + is niltask (canal (dest channel)) COR + channel (canal (dest channel)) = nilchannel . + +task is already at dest channel : + channel index = dest channel . + + +password cmd : + msg := ds ; + task password (index (order task)) := new task password ; + forget (ds) ; + ds := nilspace ; + send (order task, ack, ds) . + +family password cmd : + msg := ds ; + actual password := new task password ; + supply password := task password (index (order task)) ; + change pw of all sons where necessary (son (order task)) ; + task password (index (order task)) := actual password ; + forget (ds) ; + ds := nilspace ; + send (order task, ack, ds) . + +set autonom cmd : + autonom flag (index (order task)) := TRUE ; + send (order task, ack, ds) . + +reset autonom cmd : + autonom flag (index (order task)) := FALSE ; + send (order task, ack, ds) . + +define new canal : + IF order task < myself AND + channel index > 0 AND channel index <= highest terminal channel CAND + is niltask (canal (channel index)) + THEN canal (channel index) := order task ; + connected task (channel index) := niltask ; + send (order task, ack, ds) + ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""") + FI . + +go back to old canal : + IF order task < myself AND + channel index > 0 AND channel index <= highest terminal channel + THEN IF NOT is niltask (canal (channel index)) + THEN delete task (canal (channel index)) + FI ; + send (order task, ack, ds) + ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""") + FI . + +task of channel : + msg := ds ; + channel nr := int (msg.tname) ; + msg.task := channel task ; + send (order task, ack, ds). + +channel task : + IF channel nr <= highest terminal channel + THEN IF no command analyzer active + THEN connected task (channel nr) + ELSE canal (channel nr) + FI + ELSE connected task (channel nr) + FI . + +no command analyzer active : + channel (canal (channel nr)) = nilchannel . + +canal of channel : + msg := ds ; + channel nr := int (msg.tname) ; + msg.task := canal (channel nr) ; + send (order task, ack, ds). + +set automatic startup cmd : + automatic startup flag (index (order task)) := TRUE ; + send (order task, ack, ds) . + +reset automatic startup cmd : + automatic startup flag (index (order task)) := FALSE ; + send (order task, ack, ds) . + +is continue : + order code > continue code low AND order code <= continue code high . + +new task name : CONCR (msg).tname . + +new task : CONCR (msg).task . + +new task password : subtext (CONCR (msg).tpass, 1, 100) . + +new start proc : CONCR (msg).start proc . + +is define station : + order code >= define station code AND order task < myself AND + order code <= define station code + max station no . + +ENDPROC order from user task ; + +PROC continue cmd by canal : + + access task name and password ; + check password if necessary ; + continue or send continue request ; + channel (order task, nilchannel) . + +access task name and password : + msg := ds ; + TASK CONST user task := task (CONCR (msg).tname) ; + INT CONST task index := index (user task) ; + actual password := task password (task index) ; + supply password := CONCR (msg).tpass . + +check password if necessary : + IF actual password <> "" + THEN IF supply password = "" + THEN ask for password ; + LEAVE continue cmd by canal + ELIF actual password <> supply password OR actual password = "-" + THEN errorstop ("Passwort falsch") + FI + FI . +ask for password : + send (order task, password code, ds) . + +continue or send continue request : + IF autonom flag (task index) + THEN send continue request to user task + ELSE continue (user task, order code - continue code low) + FI . + +send continue request to user task : + INT VAR request count , quit ; + FOR request count FROM 1 UPTO 10 REP + send (user task, order code, ds, quit) ; + IF quit = ack + THEN LEAVE send continue request to user task + FI ; + pause (3) + PER ; + errorstop ("Task antwortet nicht") . + +ENDPROC continue cmd by canal ; + +PROC continue (TASK CONST id, INT CONST channel nr) : + + IF NOT is niltask (id) CAND channel (id) <> channel nr + THEN check whether not linked to another channel ; + channel (id, channel nr) ; + connected task (channel nr) := id ; + prio (id, 0) ; + activate (id) + FI . + +check whether not linked to another channel : + INT VAR i ; + FOR i FROM 1 UPTO number of channels REP + IF connected task (i) = id + THEN errorstop ("bereits an Kanal " + text (i) ) ; + LEAVE continue + FI + PER . + +ENDPROC continue ; + +PROC task info cmd : + + forget (ds) ; + ds := sys cat ; + send (order task, ack, ds) . + +ENDPROC task info cmd ; + +PROC delete task (TASK CONST superfluous) : + + delete all sons of superfluous ; + delete superfluous itself . + +delete superfluous itself : + update cpu time of father ; + erase process (superfluous) ; + delete (superfluous) ; + erase terminal connection remark . + +update cpu time of father : + TASK CONST father task := father (superfluous) ; + IF NOT is niltask (father task) + THEN disable stop ; + REAL CONST father time := clock (father task) + clock (superfluous); + IF is error + THEN clear error + ELSE set clock (father task, father time) + FI ; + enable stop + FI . + +erase terminal connection remark : + INT VAR i ; + FOR i FROM 1 UPTO number of channels REP + IF connected task (i) = superfluous + THEN connected task (i) := niltask ; + LEAVE erase terminal connection remark + FI + PER ; + FOR i FROM 1 UPTO highest terminal channel REP + IF canal (i) = superfluous + THEN canal (i) := niltask ; + LEAVE erase terminal connection remark + FI + PER . + +delete all sons of superfluous : + TASK VAR son task ; + REP + son task := son (superfluous) ; + IF is niltask (son task) + THEN LEAVE delete all sons of superfluous + FI ; + delete task (son task) + PER . + +ENDPROC delete task ; + +PROC create son (TASK CONST father, TEXT CONST task name, TASK VAR new task, PROCA CONST start) : + + entry (father, task name, new task) ; + autonom flag (index (new task)) := FALSE ; + automatic startup flag (index (new task)) := TRUE ; + task password (index (new task)) := "" ; + create (father, new task, privilege, start) . + +privilege : + IF new task < myself + THEN 1 + ELSE 0 + FI . + +ENDPROC create son ; + + +PROC system start interrupt : + + IF exists task ("configurator") + THEN send system start message + FI . + +send system start message : + ds := nilspace ; + INT VAR request count, quit ; + FOR request count FROM 1 UPTO 10 REP + send (task ("configurator"), system start code, ds, quit) ; + IF quit = ack + THEN LEAVE send system start message + FI ; + pause (3) + PER ; + forget (ds) . + +ENDPROC system start interrupt ; + +PROC define new station : + + INT CONST station := order code - define station code ; + INT VAR i ; + FOR i FROM 1 UPTO highest terminal channel REP + IF NOT is niltask (canal (i)) + THEN delete task (canal (i)) + FI + PER ; + define station (station) ; + FOR i FROM 1 UPTO number of channels REP + update (connected task (i)) + PER ; + forget (ds) . + +ENDPROC define new station ; + +PROC change pw of all sons where necessary (TASK CONST first son) : + + TASK VAR actual task := first son ; + WHILE NOT is niltask (actual task) REP + change pw ; + change pw of all sons where necessary (son (actual task)); + actual task := brother (actual task) + PER. + + change pw : + IF task password (index (actual task)) = supply password + OR + task password (index (actual task)) = "" + THEN task password (index (actual task)) := actual password + FI. + +END PROC change pw of all sons where necessary ; + +(******************* basic supervisor operations **********************) + + +PROC channel (TASK CONST id, INT CONST channel nr) : + pcb (id, channel field, channel nr) +ENDPROC channel ; + +INT PROC channel type (INT CONST channel nr) : + disable stop ; + channel (myself, channel nr) ; + INT VAR type ; + control (1, 0, 0, type) ; + channel (myself, nilchannel) ; + type +ENDPROC channel type ; + +PROC erase last bootstrap source dataspace : + + disable stop ; + errorstop ("") ; + clear error + +ENDPROC erase last bootstrap source dataspace ; + +PROC set clock (TASK CONST id, REAL CONST clock value) : + EXTERNAL 82 +ENDPROC set clock ; + +PROC sys op (INT CONST code) : + EXTERNAL 90 +END PROC sys op ; + +PROC create (TASK CONST father, son, INT CONST priv, PROCA CONST start) : + EXTERNAL 95 +ENDPROC create ; + +PROC pcb (TASK CONST id, INT CONST field, value) : + EXTERNAL 105 +ENDPROC pcb ; + +PROC activate (TASK CONST id) : + EXTERNAL 108 +ENDPROC activate ; + +PROC deactivate (TASK CONST id) : + EXTERNAL 109 +ENDPROC deactivate ; + +PROC halt process (TASK CONST id) : + EXTERNAL 110 +ENDPROC halt process ; + +PROC erase process (TASK CONST id) : + EXTERNAL 112 +ENDPROC erase process ; + +ENDPACKET supervisor ; + diff --git a/system/multiuser/1.7.5/src/sysgen off b/system/multiuser/1.7.5/src/sysgen off new file mode 100644 index 0000000..9cb999b --- /dev/null +++ b/system/multiuser/1.7.5/src/sysgen off @@ -0,0 +1,9 @@ +ke ; (* maintenance ke *) + +PROC sysgen off (INT CONST mode, INT VAR a,b,c,d,e,f,g,h,i,j,k) : + EXTERNAL 256 +ENDPROC sysgen off ; + +INT VAR x := 0 ; +sysgen off (3,x,x,x,x,x,x,x,x,x,x,x) ; + diff --git a/system/multiuser/1.7.5/src/system info b/system/multiuser/1.7.5/src/system info new file mode 100644 index 0000000..c29dfc2 --- /dev/null +++ b/system/multiuser/1.7.5/src/system info @@ -0,0 +1,342 @@ + +PACKET system info DEFINES (* Autor: J.Liedtke *) + (* Stand: 10.09.84 *) + task info , + task status , + storage info , + help : + + +LET supervisor mode = 0 , + simple mode = 1 , + status mode = 2 , + storage mode = 3 , + + ack = 0 , + + channel field = 4 , + prio field = 6 , + + cr lf = ""13""10"" , + cr = ""13"" , + page = ""1""4"" , + begin mark= ""15"" , + end mark = ""14"" , + bell = ""7"" , + esc = ""27"" ; + + + +TEXT VAR task name , record ; +DATASPACE VAR ds := nilspace ; + + +PROC task info : + + task info (simple mode) + +ENDPROC task info ; + +PROC task info (INT CONST mode) : + + open list file ; + task info (mode, list file) ; + show task info . + +open list file : + forget (ds) ; + ds := nilspace ; + FILE VAR list file := sequential file (output, ds) . + +show task info : + IF mode <> supervisor mode + THEN show (list file) + ELSE open editor (list file, FALSE) ; + edit (groesster editor, "q", PROC (TEXT CONST) no orders) + FI . + +ENDPROC task info ; + +PROC task info (INT CONST mode, FILE VAR list file) : + + access catalogue ; + IF mode > simple mode + THEN generate head + FI ; + list tree (list file, supervisor,0, mode) . + +generate head : + put (list file, date) ; + put (list file, " ") ; + put (list file, time of day) ; + put (list file, " ") ; + IF mode = storage mode + THEN put (list file, "K ") + FI ; + put (list file, " CPU PRIO CHAN STATUS") ; + line (list file) . + +ENDPROC task info ; + +PROC task info (INT CONST level, fremdstation): + IF fremdstation = station (myself) + THEN task info (level) + ELSE + disable stop; + DATASPACE VAR x:= nilspace; + BOUND INT VAR l := x; l := level; + call (collector, 256+fremdstation, x, rtn); + INT VAR rtn; + IF rtn = ack + THEN FILE VAR ti:= sequential file (modify, x) ; + show (ti) + ELSE forget (x) ; + errorstop ("Station " + text (fremdstation) + " antwortet nicht") + FI ; + forget (x) + FI +END PROC task info; + +PROC no orders (TEXT CONST ed kommando taste) : + + IF ed kommando taste = "q" + THEN quit + ELSE out (""7"") + FI + +ENDPROC no orders ; + +PROC list tree (FILE VAR list file, + TASK CONST first son, INT CONST depth, mode) : + + enable stop ; + TASK VAR actual task := first son ; + WHILE NOT is niltask (actual task) REP + list actual task ; + list tree (list file, son (actual task), depth+1, mode) ; + actual task := brother (actual task) + PER . + +list actual task : + record := "" ; + generate layout and task name ; + IF mode > simple mode + THEN tab to info position ; + show storage if wanted ; + record CAT cpu time of (actual task) ; + record CAT prio of actual task ; + record CAT channel of actual task ; + record CAT " " ; + record CAT status of (actual task) + FI ; + putline (list file, record) . + +generate layout and task name : + INT VAR i ; + FOR i FROM 1 UPTO depth REP + record CAT " " + PER ; + task name := name (actual task) ; + record CAT task name . + +tab to info position : + record := subtext (record, 1, 40) ; + FOR i FROM LENGTH record + 1 UPTO 40 REP + record CAT "." + PER ; + record CAT " " . + +show storage if wanted : + IF mode = storage mode + THEN record CAT text (storage (actual task), 5) ; + record CAT " " + FI . + +prio of actual task : + text (pcb (actual task, prio field),4) . + +channel of actual task : + INT CONST channel := pcb (actual task, channel field) ; + IF channel = 0 + THEN " -" + ELSE text (channel,4) + FI . + +ENDPROC list tree ; + +TEXT PROC cpu time of (TASK CONST actual task) : + + disable stop ; + TEXT VAR result := subtext (time (clock (actual task), 12), 1, 10) ; + IF is error + THEN clear error ; + result := 10 * "*" + FI ; + result + +ENDPROC cpu time of ; + +TEXT PROC status of (TASK CONST actual task) : + + SELECT status (actual task) OF + CASE 0 : "-busy-" + CASE 1 : "i/o" + CASE 2 : "wait" + CASE 4 : "busy-blocked" + CASE 5 : "i/o -blocked" + CASE 6 : "wait-blocked" + OTHERWISE "--dead--" + END SELECT . + +ENDPROC status of ; + +PROC task status : + + task status (myself) + +ENDPROC task status ; + +PROC task status (TEXT CONST task name) : + + task status (task (task name)) + +ENDPROC task status ; + +PROC task status (TASK CONST actual task) : + + IF exists (actual task) + THEN put status of task + ELSE errorstop ("Task nicht vorhanden") + FI . + +put status of task : + line ; + put (date); put (time of day) ; + put (" TASK:") ; + put (name (actual task)) ; + line (2) ; + put ("Speicher:"); put (storage (actual task)); putline ("K"); + put ("CPU-Zeit:"); put (cpu time of (actual task)) ; line; + put ("Zustand :"); write (status of (actual task)); + put (", (prio"); + write (text (pcb (actual task, prio field))); + put ("), Kanal") ; + IF channel (actual task) = 0 + THEN put ("-") + ELSE put (channel (actual task)) + FI ; + line . + +ENDPROC task status ; + +PROC storage info : + + INT VAR size, used ; + storage (size, used) ; + out (""13""10" ") ; + put (used) ; + put ("K von") ; + put (size plus reserve) ; + putline ("K sind belegt!") . + +size plus reserve : + int (real (size + 24) * 64.0 / 63.0 ) . + +ENDPROC storage info ; + + +PROC help : + + IF NOT exists ("help") + THEN get help file + FI ; + FILE VAR f := sequential file (modify, "help") ; + help (f) . + +get help file : + TEXT VAR old std param := std ; + IF exists ("help", father) + THEN fetch ("help") + ELSE fetch ("help", public) + FI ; + last param (old std param) . + +ENDPROC help ; + +PROC help (FILE VAR help file) : + + initialize help command ; + REP + out (page) ; + to paragraph ; + show paragraph ; + get show command + UNTIL is quit command PER . + +initialize help command : + TEXT VAR + help command := getcharety ; + IF help command = "" + THEN help command := "0" + FI . + +to paragraph : + col (help file, 1) ; + to line (help file, 1) ; + downety (help file, "#" + help command + "#") ; + IF eof (help file) + THEN to line (help file, 1) ; + out (bell) + FI . + +show paragraph : + show headline ; + WHILE NOT end of help subfile REP + show help line + PER ; + show bottom line . + +show headline : + out (begin mark) ; + INT CONST dots := (x size - len (help file) - 5) DIV 2 ; + dots TIMESOUT "." ; + exec (PROC show line, help file, 4) ; + dots TIMESOUT "." ; + out (end mark) ; + down (help file) . + +show help line : + out (cr lf) ; + exec (PROC show line, help file, 1) ; + down (help file) . + +show bottom line : + cursor (5, y size) ; + exec (PROC show line, help file, 3) ; + out (cr) . + +get show command : + TEXT VAR char ; + get char (char) ; + IF char = esc + THEN get char (char) + FI ; + IF char >= " " + THEN help command := char + ELSE out (bell) + FI . + +end of help subfile : pos (help file,"##",1) <> 0 OR eof (help file) . + +is quit command : help command = "q" OR help command = "Q" . + +ENDPROC help ; + +PROC show line (TEXT CONST line, INT CONST from) : + + outsubtext (line, from, x size - from) + +ENDPROC show line ; + +ENDPACKET system info ; + diff --git a/system/multiuser/1.7.5/src/system manager b/system/multiuser/1.7.5/src/system manager new file mode 100644 index 0000000..5406ff0 --- /dev/null +++ b/system/multiuser/1.7.5/src/system manager @@ -0,0 +1,117 @@ +(* ------------------- VERSION 4 vom 31.01.86 ------------------- *) +PACKET system manager DEFINES (* F. Klapper *) + system manager , + generate shutup manager , + put log : + +LET ack = 0 , + error nak = 2 , + fetch code = 11 , + list code = 15 , + all code = 17 , + log code = 21 , + eszet = ""251"" , + log file name = "logbuch"; + +DATASPACE VAR ds; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ; +BOUND TEXT VAR log message, + error msg; + +INT VAR reply; + +TEXT VAR xname; + +FILE VAR log file; + +PROC system manager: + lernsequenz auf taste legen ("s", eszet) ; + global manager + (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) sys manager) + +END PROC system manager; + +PROC sys manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task): + enable stop; + SELECT order OF + CASE log code : y put log + CASE list code : y list + CASE all code : y all + CASE fetch code : y fetch + OTHERWISE std manager (ds, order, phase, order task) + END SELECT. + +y fetch : + msg := ds; + xname := msg.name; + IF read permission (xname, msg.read pass) + THEN forget (ds) ; + ds := old (xname) ; + send (order task, ack, ds) + ELSE errorstop ("Passwort falsch") + FI . + +y list : + forget (ds) ; + ds := nilspace ; + FILE VAR list file := sequential file (output, ds) ; + list (list file) ; + send (order task, ack, ds) . + +y all : + forget (ds); + ds := nilspace; + BOUND THESAURUS VAR all names := ds ; + all names := all ; + send (order task, ack, ds) . + +y put log : + log file := sequential file (output, log file name) ; + IF lines (log file) < 4000 + THEN max line length (log file,1000); + put (log file, date) ; + put (log file, time of day) ; + put (log file, text (name (order task), 8)); + log message := ds ; + put (log file, CONCR (log message)) ; + FI ; + send (order task, ack, ds) . + +END PROC sys manager; + +PROC put log (TEXT CONST message) : + enable stop; + forget (ds) ; + ds := nilspace ; + log message := ds ; + CONCR (log message) := message ; + call (task("SYSUR"), log code, ds, reply) . + +ENDPROC put log ; + +PROC generate shutup manager : + + TASK VAR son ; + begin ("shutup", PROC shutup manager, son) + +ENDPROC generate shutup manager ; + +PROC shutup manager : + disable stop ; + task password ("") ; + command dialogue (TRUE) ; + REP + break ; + line ; + IF yes ("shutup") + THEN clear error ; + shutup + FI + PER + +ENDPROC shutup manager ; + +ENDPACKET system manager ; + diff --git a/system/multiuser/1.7.5/src/tasks b/system/multiuser/1.7.5/src/tasks new file mode 100644 index 0000000..276011e --- /dev/null +++ b/system/multiuser/1.7.5/src/tasks @@ -0,0 +1,978 @@ +(* ------------------- VERSION 9 vom 09.06.86 ------------------- *) +PACKET tasks DEFINES (* Autor: J.Liedtke *) + + TASK , + PROCA , + := , + = , + < , + / , + niltask , + is niltask , + exists , + exists task , + supervisor , + myself , + public , + proca , + collector , + access , + name , + task , + canal , + dataspaces , + index , + station , + update , + father , + son , + brother , + next active , + access catalogue , + family password , + task in catalogue , + entry , + delete , + define station , + + pcb , + status , + channel , + clock , + storage , + callee , + + send , + wait , + call , + pingpong , + collected destination , + + begin , + end , + break , + continue , + rename myself , + task password , + set autonom , + reset autonom , + set automatic startup , + reset automatic startup , + + sys cat : + + + +LET nil = 0 , + + max version = 30000 , + max task = 125 , + max station no = 127 , + sv no = 1 , + + hex ff = 255 , + hex 7f00 = 32512 , + + collected dest field 1 = 2 , + collected dest field 2 = 3 , + channel field = 4 , + myself no field = 9 , + myself version field = 10 , + callee no field = 11 , + callee version field = 12 , + + highest terminal channel = 16 , + number of channels = 32 , + + wait state = 2 , + + ack = 0 , + nak = 1 , + error nak = 2 , + system catalogue code = 3 , + begin code = 4 , + end code = 5 , + break code = 6 , + rename code = 7 , + password code = 9 , + family password code = 40 , + set autonom code = 41 , + reset autonom code = 42 , + task of channel code = 45 , + canal of channel code = 46 , + set automatic startup code = 47 , + reset automatic startup code = 48 , + + continue code = 100, + define station code = 32000, + + lowest ds number = 4 , + highest ds number = 255 ; + + +TYPE TASK = STRUCT (INT no, version) , + PROCA = STRUCT (INT a, b) ; + +OP := (PROCA VAR right, PROCA CONST left) : + CONCR (right) := CONCR (left) +ENDOP := ; + +PROCA PROC proca (PROC p) : + + push (0, PROC p) ; + pop + +ENDPROC proca ; + +PROC push (INT CONST dummy, PROC p) : ENDPROC push ; + +PROCA PROC pop : + PROCA VAR res; + res +ENDPROC pop ; + +TASK CONST niltask := TASK: (0,0) , + collector := TASK: (-1,0) ; + +TASK PROC supervisor : + + TASK: (my station id + sv no, 0) . + +my station id : pcb (myself no field) AND hex 7f00 . + +ENDPROC supervisor ; + +TASK VAR father task ; + +INITFLAG VAR catalogue known := FALSE , father known := FALSE ; + + + +LET TASKVECTOR = STRUCT (INT version, father, son, brother) ; + + +DATASPACE VAR catalogue space , sv space ; + +BOUND STRUCT (THESAURUS dir, + ROW max task TASKVECTOR link) VAR system catalogue ; + initialize catalogue ; + +BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg ; + + +PROC initialize catalogue : + + catalogue space := nilspace ; + system catalogue := catalogue space ; + system catalogue.dir := empty thesaurus ; + + insert (system catalogue.dir, "SUPERVISOR") ; + insert (system catalogue.dir, "UR") ; + system catalogue.link (1) := TASKVECTOR:(0,0,0,2) ; + system catalogue.link (2) := TASKVECTOR:(0,0,0,0) . + +ENDPROC initialize catalogue ; + +DATASPACE PROC sys cat : + catalogue space +ENDPROC sys cat ; + + +TASK PROC myself : + + TASK: (pcb (myself no field), pcb (myself version field)) + +ENDPROC myself ; + + +OP := (TASK VAR dest, TASK CONST source): + + CONCR (dest) := CONCR (source) + +ENDOP := ; + +BOOL OP = (TASK CONST left, right) : + + left.no = right.no AND left.version = right.version + +ENDOP = ; + +BOOL PROC is niltask (TASK CONST t) : + + t.no = 0 + +ENDPROC is niltask ; + +BOOL OP < (TASK CONST left, right) : + + IF both of my station + THEN access (left) ; + access (right) ; + ( index (left) > 0 CAND index (left) <= max task ) + CAND + ( father (left) = right COR father (left) < right ) + ELSE FALSE + FI . + +both of my station : + station (left) = station (right) AND station (right) = station (myself) . + +ENDOP < ; + +BOOL PROC exists (TASK CONST task) : + + EXTERNAL 123 + +ENDPROC exists ; + +BOOL PROC exists task (TEXT CONST name) : + + task id (name).no <> 0 + +ENDPROC exists task ; + +TEXT PROC name (TASK CONST task) : + + IF is task of other station + THEN external name (task) + ELSE + access (task) ; + INT CONST task no := index (task) ; + IF task in catalogue (task ,task no) + THEN name (system catalogue.dir, task no) + ELSE "" + FI + FI. + +is task of other station : + (task.no AND hex 7f00) <> (pcb (myself no field) AND hex 7f00) . + +ENDPROC name ; + +BOOL PROC task in catalogue (TASK CONST task, INT CONST task no) : + + access catalogue ; + task no >= 1 CAND task no <= max task CAND + task.version = system catalogue.link (task no).version . + +ENDPROC task in catalogue ; + +PROC access (TASK CONST task) : + + INT CONST task no := task.no AND hex ff ; + IF task no < 1 OR task no > max task + THEN + ELIF is task of other station + THEN errorstop ("TASK anderer Station") + ELIF actual task id not in catalogue COR NOT exists (task) + THEN access catalogue + FI . + +actual task id not in catalogue : + NOT initialized (catalogue known) COR + ( task no > 0 CAND catalogue version <> task.version ) . + +catalogue version : system catalogue.link (task no).version . + +is task of other station : + (task.no AND hex 7f00) <> (pcb (myself no field) AND hex 7f00) . + +ENDPROC access ; + +TASK PROC task (TEXT CONST task name) : + + TASK CONST id := task id (task name) ; + IF id.no = 0 + THEN errorstop (""""+task name+""" gibt es nicht") + FI ; + id + +ENDPROC task ; + +TASK PROC task id (TEXT CONST task name) : + + IF task name = "-" OR task name = "" + THEN errorstop ("Taskname unzulaessig") + FI ; + IF NOT initialized (catalogue known) + THEN access catalogue + FI ; + + TASK VAR + id := task id (link (system catalogue.dir, task name)) ; + IF NOT exists (id) + THEN access catalogue ; + id := task id (link (system catalogue.dir, task name)) ; + FI ; + id . + +ENDPROC task id ; + +TASK OP / (TEXT CONST task name) : + + task (task name) + +ENDOP / ; + +INT PROC index (TASK CONST task) : + + IF NOT initialized (catalogue known) + THEN access catalogue + FI ; + task.no AND hex ff + +ENDPROC index ; + +INT PROC station (TASK CONST task) : + + task.no DIV 256 + +ENDPROC station ; + +PROC update (TASK VAR task) : + + IF task.no <> nil + THEN task.no := (task.no AND hex ff) + new station number + FI . + +new station number : (pcb (myself no field) AND hex 7f00) . + +ENDPROC update ; + + +TASK PROC public : + + task ("PUBLIC") + +ENDPROC public ; + +TASK PROC father : + + IF NOT initialized (father known) COR station or rename changed father id + THEN access catalogue ; + father task := father (myself) + FI ; + father task . + +station or rename changed father id : + NOT exists (father task) . + +ENDPROC father ; + +INT VAR task no ; + +TASK PROC father (TASK CONST task) : + + task no := index (task) ; + task id (system catalogue.link (task no).father) . + +ENDPROC father ; + +TASK PROC son (TASK CONST task) : + + task no := index (task) ; + IF task no = nil + THEN supervisor + ELSE task id (system catalogue.link (task no).son) + FI . + +ENDPROC son ; + +TASK PROC brother (TASK CONST task) : + + task no := index (task) ; + task id (system catalogue.link (task no).brother) . + +ENDPROC brother ; + +PROC next active (TASK VAR task) : + + next active task index (task.no) ; + IF task.no > 0 + THEN task.version := pcb (task, myself version field) + ELSE task.version := 0 + FI + +ENDPROC next active ; + +PROC next active task index (INT CONST no) : + + EXTERNAL 118 + +ENDPROC next active task index ; + +TASK PROC task id (INT CONST task nr) : + + INT VAR task index := task nr AND hex ff ; + TASK VAR result ; + result.no := task index ; + IF task index = nil + THEN result.version := 0 + ELSE result.version := system catalogue.link (task index).version ; + result.no INCR my station id + FI ; + result . + +my station id : pcb (myself no field) AND hex 7f00 . + +ENDPROC task id ; + +PROC access catalogue : + + IF this is not supervisor + THEN get catalogue from supervisor + FI . + +this is not supervisor : + (pcb (myself no field) AND hex ff) <> sv no . + +get catalogue from supervisor : + INT VAR dummy reply ; + forget (catalogue space) ; + catalogue space := nilspace ; + call (supervisor, system catalogue code, catalogue space, dummy reply) ; + system catalogue := catalogue space . + +ENDPROC access catalogue ; + + +PROC entry (TASK CONST father task, TEXT CONST task name, + TASK VAR son task) : + + IF task name <> "-" CAND (system catalogue.dir CONTAINS task name) + THEN errorstop (""""+task name+""" existiert bereits") + ELIF is niltask (father task) + THEN errorstop ("Vatertask existiert nicht") + ELSE entry task + FI . + +entry task : + INT VAR son task nr ; + INT CONST father task nr := index (father task) ; + insert (system catalogue.dir, task name, son task nr) ; + IF son task nr = nil OR son task nr > max task + THEN delete (system catalogue.dir, son task nr) ; + son task := niltask ; + errorstop ("zu viele Tasks") + ELSE insert task (father task, father vec, son task, son vec, son tasknr) + FI . + +father vec : system catalogue.link (father task nr) . + +son vec : system catalogue.link (son task nr) . + +ENDPROC entry ; + +PROC insert task (TASK CONST father task, TASKVECTOR VAR father vec, + TASK VAR son task, TASKVECTOR VAR son vec, INT CONST nr) : + + initialize version number if son vec is first time used ; + increment version (son vec) ; + son task.no := my station id + nr ; + son task.version := son vec.version ; + link into task tree . + +initialize version number if son vec is first time used : + IF son vec.version < 0 + THEN son vec.version := 0 + FI . + +link into task tree : + son vec.son := nil ; + son vec.brother := father vec.son ; + son vec.father := index (father task) ; + father vec.son := son task.no . + +my station id : pcb (myself no field) AND hex 7f00 . + +END PROC insert task ; + + +PROC delete (TASK CONST superfluous) : + + INT CONST superfluous nr := index (superfluous) ; + delete (system catalogue.dir, superfluous nr) ; + delete superfluous task ; + increment version (superfluous vec) . + +delete superfluous task : + INT CONST successor of superfluous := superfluous vec.brother ; + TASK VAR + last := father (superfluous) , + actual := son (last) ; + IF actual = superfluous + THEN delete first son of last + ELSE search previous brother of superfluous ; + delete from brother chain + FI . + +delete first son of last : + last vec.son := successor of superfluous . + +search previous brother of superfluous : + REP + last := actual ; + actual := brother (actual) + UNTIL actual = superfluous PER . + +delete from brother chain : + last vec.brother := successor of superfluous . + +last vec : system catalogue.link (index (last)) . + +superfluous vec : system catalogue.link (superfluous nr) . + +ENDPROC delete ; + + +PROC name (TASK VAR task, TEXT CONST new name) : + + INT CONST task no := index (task) ; + IF (system catalogue.dir CONTAINS new name) AND (new name <> "-") + AND (name (task) <> new name) + THEN errorstop (""""+new name+""" existiert bereits") + ELSE rename (system catalogue.dir, task no, new name) ; + increment version (system catalogue.link (task no)) ; + IF this is supervisor + THEN update task version in pcb and task variable + FI + FI . + +this is supervisor : (pcb (myself no field) AND hex ff) = sv no . + +update task version in pcb and task variable : + INT CONST new version := system catalogue.link (task no).version ; + write pcb (task, myself version field, new version) ; + task.version := new version . + +ENDPROC name ; + + +PROC increment version (TASKVECTOR VAR task vec) : + + task vec.version := task vec.version MOD max version + 1 + +ENDPROC increment version ; + + +INT PROC pcb (TASK CONST id, INT CONST field) : + + EXTERNAL 104 + +ENDPROC pcb ; + +INT PROC status (TASK CONST id) : + + EXTERNAL 107 + +ENDPROC status ; + +INT PROC channel (TASK CONST id) : + + pcb (id, channel field) + +ENDPROC channel ; + +REAL PROC clock (TASK CONST id) : + + EXTERNAL 106 + +ENDPROC clock ; + +INT PROC storage (TASK CONST id) : + + INT VAR ds number, storage sum := 0, ds size; + FOR ds number FROM lowest ds number UPTO highest ds number REP + ds size := pages (ds number, id) ; + IF ds size > 0 + THEN storage sum INCR ((ds size + 1) DIV 2) + FI + PER ; + storage sum + +ENDPROC storage ; + +INT PROC pages (INT CONST ds number, TASK CONST id) : + + EXTERNAL 88 + +ENDPROC pages ; + +TASK PROC callee (TASK CONST from) : + + IF status (from) = wait state + THEN TASK:(pcb (from, callee no field), pcb (from, callee version field)) + ELSE niltask + FI + +ENDPROC callee ; + + +PROC send (TASK CONST dest, INT CONST send code, DATASPACE VAR ds, + INT VAR quit) : + EXTERNAL 113 + +ENDPROC send ; + +PROC send (TASK CONST dest, INT CONST send code, DATASPACE VAR ds) : + + INT VAR dummy quit ; + send (dest, send code, ds, dummy quit) ; + forget (ds) + +ENDPROC send ; + +PROC wait (DATASPACE VAR ds, INT VAR receive code, TASK VAR source) : + + EXTERNAL 114 + +ENDPROC wait ; + +PROC call (TASK CONST dest, INT CONST order code, DATASPACE VAR ds, + INT VAR reply code) : + EXTERNAL 115 + +ENDPROC call ; + +PROC pingpong (TASK CONST dest, INT CONST order code, DATASPACE VAR ds, + INT VAR reply code) : + EXTERNAL 122 + +ENDPROC pingpong ; + +TASK PROC collected destination : + + TASK: (pcb (collected dest field 1), pcb (collected dest field 2)) + +ENDPROC collected destination ; + + +PROC begin (PROC start, TASK VAR new task) : + + begin ("-", PROC start, new task) + +ENDPROC begin ; + +PROC begin (TEXT CONST son name, PROC start, TASK VAR new task) : + + enable stop ; + forget (sv space) ; + sv space := nilspace ; + sv msg := sv space ; + CONCR (sv msg).tname := son name ; + CONCR (sv msg).start proc := proca (PROC start) ; + supervisor call (begin code) ; + sv msg := sv space ; + new task := CONCR (sv msg).task . + +ENDPROC begin ; + +PROC begin (DATASPACE VAR ds, PROC start, INT VAR reply) : + + sv msg := ds ; + sv msg.start proc := proca (PROC start) ; + call (supervisor, begin code, ds, reply) + +ENDPROC begin ; + +PROC end : + + command dialogue (TRUE) ; + say ("task """) ; + say (name (myself)) ; + IF yes (""" loeschen") + THEN eumel must advertise ; + end (myself) + FI + +ENDPROC end ; + +PROC end (TASK CONST id) : + + forget (sv space) ; + sv space := nilspace ; + sv msg := sv space ; + CONCR (sv msg).task := id ; + supervisor call (end code) + +ENDPROC end ; + +PROC break (QUIET CONST quiet) : + + simple supervisor call (break code) + +ENDPROC break ; + +PROC break : + + eumel must advertise ; + simple supervisor call (break code) + +ENDPROC break ; + +PROC continue (INT CONST channel nr) : + + simple supervisor call (continue code + channel nr) + +ENDPROC continue ; + +PROC rename myself (TEXT CONST new name) : + + forget (sv space) ; + sv space := nilspace ; + sv msg := sv space ; + CONCR (sv msg).tname := new name ; + supervisor call (rename code) . + +ENDPROC rename myself ; + + +PROC simple supervisor call (INT CONST code) : + + forget (sv space) ; + sv space := nilspace ; + supervisor call (code) + +ENDPROC simple supervisor call ; + +PROC supervisor call (INT CONST code) : + + INT VAR answer ; + call (supervisor, code, sv space, answer) ; + WHILE answer = nak REP + pause (20) ; + call (supervisor, code, sv space, answer) + PER ; + IF answer = error nak + THEN BOUND TEXT VAR error message := sv space ; + errorstop (CONCR (error message)) + FI + +ENDPROC supervisor call ; + +PROC task password (TEXT CONST password) : + + IF online + THEN say (""3""5""10"") + FI ; + forget (sv space) ; + sv space := nilspace ; + sv msg := sv space ; + CONCR (sv msg).tpass := password ; + supervisor call (password code) ; + cover tracks . + +ENDPROC task password ; + +PROC set autonom : + + simple supervisor call (set autonom code) + +ENDPROC set autonom ; + +PROC reset autonom : + + simple supervisor call (reset autonom code) + +ENDPROC reset autonom ; + +PROC set automatic startup : + simple supervisor call (set automatic startup code) +ENDPROC set automatic startup ; + +PROC reset automatic startup : + simple supervisor call (reset automatic startup code) +ENDPROC reset automatic startup ; + +PROC define station (INT CONST station number) : + + IF this is supervisor + THEN update all tasks + ELIF i am privileged + THEN IF station number is valid + THEN send define station message + ELSE errorstop ("ungueltige Stationsnummer (0 - 127)") + FI + ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""") + FI . + +update all tasks : + start at supervisor ; + REP + get next task ; + IF no more task found + THEN update station number of supervisor ; + LEAVE update all tasks + FI ; + update station number of actual task + PER . + +i am privileged : + myself < supervisor . + +station number is valid : + station number >= 0 AND station number <= max station no . + +start at supervisor : + TEXT VAR name ; + INT VAR index := sv no . + +get next task : + get (system catalogue.dir, name, index) . + +no more task found : index = 0 . + +update station number of actual task : + write pcb (task id (index), myself no field, station number * 256 + index). + +update station number of supervisor : + write pcb (supervisor, myself no field, station number * 256 + sv no) . + +send define station message : + forget (sv space) ; + sv space := nilspace ; + INT VAR receipt ; + REP + send (supervisor, define station code+station number, sv space, receipt) + UNTIL receipt = ack PER . + +this is supervisor : + (pcb (myself no field) AND hex ff) = sv no . + +ENDPROC define station ; + + +TASK OP / (INT CONST station number, TEXT CONST task name) : + + IF station number = station (myself) + THEN task (task name) + ELSE get task id from other station + FI . + +get task id from other station : + enable stop ; + forget (sv space) ; + sv space := nilspace ; + BOUND TEXT VAR name message := sv space ; + name message := task name ; + INT VAR reply ; + call (collector, station number, sv space, reply) ; + IF reply = ack + THEN BOUND TASK VAR result := sv space ; + CONCR (result) + ELIF reply = error nak + THEN name message := sv space; + disable stop; + errorstop (name message) ; + forget (sv space) ; + niltask + ELSE forget (sv space); + errorstop ("Collector-Task fehlt") ; + niltask + FI + +ENDOP / ; + + +TASK OP / (INT CONST station number, TASK CONST tsk): + + station number / name (tsk) + +END OP / ; + + +TEXT PROC external name (TASK CONST tsk): + + IF tsk = nil task + THEN + "" + ELIF tsk = collector + THEN + "** collector **" + ELSE + name via net + FI. + +name via net: + enable stop ; + forget (sv space); + sv space := nil space; + BOUND TASK VAR task message := sv space; + task message := tsk; + INT VAR reply; + call (collector, 256, sv space, reply); + BOUND TEXT VAR result := sv space; + CONCR (result). + +END PROC external name; + +PROC write pcb (TASK CONST task, INT CONST field, value) : + EXTERNAL 105 +ENDPROC write pcb ; + +TASK PROC task (INT CONST channel number) : + + IF channel number < 1 OR channel number > 32 + THEN errorstop ("ungueltige Kanalnummer") + FI ; + forget (sv space) ; + sv space := nilspace ; + sv msg := sv space ; + sv msg.tname := text (channel number) ; + supervisor call (task of channel code) ; + sv msg := sv space ; + sv msg.task + +END PROC task; + +TASK PROC canal (INT CONST channel number) : + + IF channel number < 1 OR channel number > highest terminal channel + THEN errorstop ("ungueltige Kanalnummer") + FI ; + forget (sv space); + sv space := nilspace ; + sv msg := sv space ; + sv msg.tname := text (channel number) ; + supervisor call (canal of channel code) ; + sv msg := sv space ; + sv msg.task + +END PROC canal ; + +PROC family password (TEXT CONST password) : + + IF online + THEN say (""3""5""10"") + FI ; + forget (sv space) ; + sv space := nilspace ; + sv msg := sv space ; + sv msg.tpass := password ; + supervisor call (family password code) ; + cover tracks . + +ENDPROC family password ; + +INT PROC dataspaces (TASK CONST task) : + + INT VAR ds number, spaces := 0 ; + FOR ds number FROM lowest ds number UPTO highest ds number REP + IF pages (ds number, index (task)) >= 0 + THEN spaces INCR 1 + FI + PER ; + spaces + +ENDPROC dataspaces ; + +INT PROC dataspaces : + dataspaces (myself) +ENDPROC dataspaces ; + +INT PROC pages (INT CONST ds number, INT CONST task no) : + EXTERNAL 88 +ENDPROC pages ; + +ENDPACKET tasks ; + diff --git a/system/multiuser/1.7.5/src/ur start b/system/multiuser/1.7.5/src/ur start new file mode 100644 index 0000000..efbf8c1 --- /dev/null +++ b/system/multiuser/1.7.5/src/ur start @@ -0,0 +1,40 @@ +(* ------------------- VERSION 2 06.03.86 ------------------- *) +PROC begin process (TASK CONST father, son, INT CONST priv, PROCA CONST start) : + EXTERNAL 95 +ENDPROC begin process ; + +PROC ur : + TASK VAR dummy ; + begin ("PUBLIC", PROC public manager, dummy) ; + global manager (PROC ur manager) +ENDPROC ur ; + +PROC public manager : + + page ; + REP UNTIL yes("Archiv 'help' eingelegt") PER; + archive ("help") ; + fetch ("help", archive) ; + release (archive) ; + free global manager + +ENDPROC public manager ; + +PROC ur manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task) : + + LET begin code = 4 ; + enable stop ; + IF order = begin code + THEN std manager (ds, order, phase, order task) + ELSE errorstop ("falscher Auftrag fuer Task ""UR""") + FI + +ENDPROC ur manager ; + +check on ; +command dialogue (TRUE) ; +begin process (supervisor, task ("UR"), 0, proca (PROC ur)) ; +command dialogue (FALSE) ; +check off; + diff --git a/system/net/1.7.5/doc/EUMEL Netz b/system/net/1.7.5/doc/EUMEL Netz new file mode 100644 index 0000000..ad39db3 --- /dev/null +++ b/system/net/1.7.5/doc/EUMEL Netz @@ -0,0 +1,832 @@ +#type ("trium8")##limit (11.0)# +#start(2.5,1.5)##pagelength (17.4)# +#block# +#headeven# + +% EUMEL-Netzbeschreibung + + +#end# +#headodd# + +#center#Inhalt#right#% + + +#end# + +#type ("triumb12")# +1. Einleitung + + +Teil 1: Netz einrichten und benutzen +#type ("trium8")# + +1. Benutzung des Netzes + +2. Hardwarevoraussetzungen + +3. Einrichten des Netzes + +4. Informationsmglichkeiten + +5. Eingriffsmglichkeiten + +6. Fehlerbehebung im Netz + +#type ("triumb12")# + +Teil 2: Arbeitsweise der Netzsoftware +#type ("trium8")# + +1. Die Netztask + +2. Protokollebenen + +3. Stand der Netzsoftware + +#page# +#headodd# + +#center#Einleitung#right#% + + +#end# + +#type("triumb12")# +1. Einleitung #type("trium8")# + + +Das EUMEL-Netz dient dazu mehrere EUMEL-Rechner (sog. Stationen) mit- +einander zu koppeln. Diese Kopplung wird von Betriebsystem dazu benutzt, das +Sendungskonzept (siehe Systemhandbuch 1.7, Intertaskkommunikation) so auszu- +dehnen, da Tasks verschiedener Stationen einander Datenrume zusenden +knnen. Auf dem Sendungskonzept aufbauende Konzepte nutzen daher automa- +tisch das Netz aus: So ist es z.B. mglich + +- von einer Station aus auf einer anderen zu Drucken, + +- in PUBLIC einer anderen Station Dateien zu sichern (save), vorausgesetzt, da + PUBLIC dort ein free global manager ist, + +- auf einer anderen Station zu archivieren (z.B. wenn das eigene Archivlaufwerk + defekt ist oder ein anderes Format hat). + +Das Netz kann ab EUMEL-Version 1.7.3 eingesetzt werden. + + +#type("triumb12")# +Teil 1: Netz einrichten und benutzen + +1. Benutzung des Netzes #type("trium8")# +#headodd# + +#center#Teil 1: Netz einrichten und benutzen#right#% + + +#end# + + Zur Benutzung des Netzes stehen folgende Operatoren und Prozeduren zur + Verfgung: + + +1.1 + + TASK OP / (INT CONST station, TEXT CONST taskname) + + liefert die Task #on("bold")#taskname#off("bold")# von der Station #on("bold")#station#off("bold")#. + + Wenn die Station #on("bold")#station#off("bold")# nicht am Netz ist oder nicht eingeschaltet ist, wird + solange gewartet, bis das der Fall ist. + + Fehlerflle: + + - task "..." gibt es nicht + + Die angeforderte Task gibt es in der Zielstation nicht. + + - Collectortask fehlt + + Das Kommando #on("bold")#define collector#off("bold")# wurde nicht gegeben (siehe 4.2). + + - Station x antwortet nicht + + Eine nicht vorhandene oder abgeschaltete Station wurde angesprochen. + Hinweis: Dieser Fehler wird angenommen, wenn eine berwachungszeit + von ca. 30 Sekunden verschrichen ist, ohne da Station x die + Taskidentifikation angeliefert hat. + + Beispiel: + + list (5/"PUBLIC") + + Dateiliste von PUBLIC auf Station 5 wird angefordert. + +1.2 + + TASK OP / (INT CONST station, TASK CONST task) + + liefert + + station / name (task) . + + + Beispiel: + + list (4/archive) + + +1.3 + + INT PROC station (TASK CONST task) + + liefert die Stationsnummer der Task #on("bold")#task#off("bold")#. + + Beispiel: + + put (station (myself)) + + gibt die eigene Stationsnummer aus. + + +1.4 + + PROC archive (TEXT CONST archivename, INT CONST station) + + dient dazu das Archiv auf der Station #on("bold")#station#off("bold")# anzumelden. + + Beispiel: + + archive ("std", 4); list (4/archive) + + gibt das Inhaltsverzeichnis der Archivfloppy im Laufwerk der Station 4 aus. + Hinweis: Vergessen Sie bei solchen Querarchivierungen nicht die Stations- + angabe bei jedem einzelnen Archivkommando (z.B fetch ("xxx", #on("bold")#4/#off("bold")# + archive). + Hinweis: Querarchivieren ist langsam. Verwenden Sie es nur, wenn Sie Flop- + pyformate umsetzen wollen. + + +1.5 + + PROC free global manager + + dient dazu, die eigene Task ber das Netz ansprechbar zu machen. Jede + andere Task im Netz kann dann die blichen Manageraufrufe ('save', 'fetch', + u.s.w.) an die eigene Task machen, sofern diese nicht an ein Terminal gekop- + pelt ist. + + Die Task wird (wie bei 'break') abgekoppelt und meldet sich in Zukunft mit + 'maintenance' statt mit 'gib kommando'. + + Beispiel: + + An Station 4 ruft man in der Task 'hugo' das Kommando #on("bold")#free global manager#off("bold")# + auf. Anschlieend kann man von jeder Station aus z.B. 'list (4/"hugo")' u.s.w. + machen. + + +1.6 + + TEXT PROC name (TASK CONST t) + + Diese (schon immer vorhandene) Prozedur wurde dahingehend erweitert, da der + Name einer Task einer anderen Station ber Netz angefordert wird. + + Fehlerfall: + + Station x antwortet nicht + + + + +#type("triumb12")#2. Hardwarevoraussetzungen#type("trium8")# + +2.1 Zwei Stationen + + Sie knnen zwei Stationen miteinander Vernetzen, wenn Sie dafr an jeder + Station eine V24-Schnittstelle zur Verfgung stellen. + + Diese beiden Schnittstellen verbinden Sie mit einem Kabel zur Rechner- + kopplung (siehe Systemhandbuch 1.7 Teil 2). + +2.2 Mehrere Stationen + + Wenn Sie mehr als zwei Stationen vernetzen wollen, brauchen neben je + einer V24 an jeder Station noch je eine Netzanschlubox. + + Jede Box besitzt eine V24-Schnittstelle zum Anschlu an die V24- + Schnittstelle der zugeorneten Station und eine weitere Schnittstelle zur + Verbindung der Boxen untereinander. + + +#type("triumb12")#3. Einrichten des Netzes #type("trium8")# + +Hinweis: Dieses Kapitel ist nur fr Systembetreuer wichtig. + +3.1 Legen Sie Stationsnummern fr die am Netz beteiligten Rechner fest (von 1 an + aufsteigend). + + Die Boxen haben ebenfalls Stationsnummern. Die Stationsnummern der Box + und des zugeordneten Rechners mssen bereinstimmen. + + +3.2 Holen Sie an jeder Station die Task #on("bold")#configurator#off("bold")# an ein Terminal und geben Sie + das Kommando #on("bold")#define collector ("net port")#off("bold")#. Geben Sie auerdem das + Kommando #on("bold")#define station (x)#off("bold")#, wobei #on("bold")#x#off("bold")# die gewhlte Stationsnummer ist. + + Hinweis: Taskkommunikationen, die zu dem Zeitpunkt laufen, fhren zu feh- + lerhaften Verhalten. Dies liegt daran, da durch #on("bold")#define station#off("bold")# alle + Task-Id's gendert werden mssen, weil eine Task-Id u.a. die + Stationsnummer der eigenen Station enthlt (siehe 2.3). TASK- + Variable, die noch Task-Id's mit keiner oder falscher Stationsnum- + mer enthalten, knnen nicht mehr zum Ansprechen einer Task + verwendet werden. + + Beispiel: Der Spoolmanager (siehe Benutzerhandbuch 1.7 Teil 12) richtet + beim Kommando #on("bold")#start#off("bold")# einen Worker ein und merkt sich dessen + Task-Id in einer TASK-Variablen, um sicherzustellen, da nur der + Worker Dateien zum Drucken abholt. Wird jetzt das Kommando #on("bold")# + define station#off("bold")# gegeben, kann der Spoolmanager seinen Worker + nicht mehr identifizieren, weil der Worker eine neue Task-Id er- + halten hat. Man mu daher den Worker lschen und mit dem + Kommando #on("bold")#start#off("bold")# im Spoolmanager wieder neu einrichten. + + + Sinnvollerweise gibt man #on("bold")#define station#off("bold")# sofort nach den Laden eines + frischen Systems von Archiv. + + Konfigurieren Sie mit dem Kommando #on("bold")#configurate#off("bold")# den fr das Netz vorgese- + henen Kanal auf + + - transparent + - 9600 Baud (Standardeinstellung der Boxen) + - RTS/CTS-Protokoll + - groen Puffer + - 8 bit + - even parity + - 1 stopbit. + + Falls diese Einstellungen nicht alle angeboten werden, klren Sie mit Ihrem + Rechnerlieferanten, ob und wie diese Einstellungen erreicht werden knnen. + Hinweis: Notfalls kann auf das RTS/CTS-Protokoll verzichtet werden, wenn + der Eingabepuffer der Station gro genug ist. Die Anzahl simultan + laufender Netzkommunikationen ist dann auf + + puffergre DIV 150 + + begrenzt (bei Z80, 8086: 3; bei M20: 10). + Hinweis: Es knnen auch andere Baudraten (2400, 4800, 19200) an der Box + eingestellt werden. + +3.3 Achten Sie bei der Verbindung von der Station zur Netzbox (bzw. zur Gegen- + station bei einem Zweistationennetz ohne Boxen) darauf, da neben den + Empfangs- und Sendeleitungen auch die Leitungen RTS und CTS verdrahtet + werden, also ein 5 poliges Kabel verwendet wird (siehe Systemhandbuch 1.7 + Teil 2). Die Pin-Belegung der Boxen entspricht den dortigen Angaben. + + Beispiel: + + Verbindung eines CSK-Systems mit der Box: + + Stecker Stecker + Pin Pin + + 2 <---------> 3 + 3 <---------> 2 + 4 <---------> 5 + 5 <---------> 4 + 7 <---------> 7 + + +3.4 Richten Sie eine Task #on("bold")#net#off("bold")# unter #on("bold")#SYSUR#off("bold")# ein und insertieren Sie dort die Datei- +en + + net report/M + basic net + net manager/M. + + Beantworten Sie die Frage nach dem Kanal fr das Netz und nach der Flu- + kontrolle (RTS/CTS). + + +#type("triumb12")#4. Informationsmglichkeiten #type("trium8")# + + In der Task #on("bold")#net#off("bold")# wird eine Datei #on("bold")#report#off("bold")# gefhrt in der Fehlersituationen des + Netzes verzeichnet werden. Diese Datei kann in jeder anderen Task mit #on("bold")#list + (/"net")#off("bold")# angezeigt werden. + + In jeder Task kann durch das Kommando #on("bold")#list (/"net port")#off("bold")# eine bersicht ber + die momentan laufenden Netzbertragungen der eigenen Station erhalten + werden. + + +#type("triumb12")#5. Eingriffsmglichkeiten #type("trium8")# +#headodd# + +#center#Eingriffsmglichkeiten#right#% + + +#end# + +5.1 Jede Task kann Sende- und Empfangsstrme, die bei #on("bold")#list (/"net port")#off("bold")# gemel- + det worden sind und die eigene Task betreffen, abbrechen. Hierzu ist das + Kommando #on("bold")#erase ("x",/"net port")#off ("bold")# zu geben, wobei x die Stromnummer (aus + dem 'list') ist. + + Unberechtigte Lschversuche werden abgewiesen. + + Von der Task 'net' aus knnen jedoch damit beliebige Strme abgebrochen + werden. + +5.2 Durch das Kommando #on("bold")#start#off("bold")# kann von der Task 'net' aus das Netz neu gestartet + werden. Dabei werden alle augenblicklichen Netzkommunikationen gelscht. + Die Tasks 'net port' und 'net timer' werden dabei gelscht und neu eingerich- + tet. + + #on("bold")#start (kanal, quit)#off("bold")# wirkt wie #on("bold")#start#off("bold")#. Zustzlich wird als Netzkanal 'kanal' eingestellt + und maximal 'quit' Empfangsstrme zugelassen. 'quit' ist auf 3 zu setzen, + wenn der Kanal ohne RTS/CTS angeschlossen ist (siehe 3.2). + + +#type("triumb12")#6. Fehlersuche im Netz #type("trium8")# + + Fehler im Netz knnen sich verschiedenartig auswirken. Im Folgenden wird auf + einige Beispiele eingegangen: + + Beispiel: + + Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Station 4 antwortet nicht'. + + Fehlermglichkeiten: + + - Station 4 gibt es nicht am Netz. + Abhilfe: Richtige Station angeben. + + - Station 4 ist nicht eingeschaltet. + Abhilfe: Station 4 einschalten. Kommando erneut geben. + + - Netztask an Station 4 ist nicht arbeitsfhig. + Abhilfe: Kommando 'start' in der Task 'net'. + + - Stationsnummern und Boxnummern stimmen nicht berein. + Abhilfe: Mit 'define station' Stationsnummern korrigieren (siehe 3.2). + + - Verbindung Rechner/Box am eigenen Rechner oder an Station 4 fehlt. + Abhilfe: Verbindungen berprfen. Durch Ansprechen einer dritten Station + kann oft schnell geklrt werden, welche Rechner/Box-Verbindung + defekt sein mu. + + - Verbindung der Boxen untereinander defekt. + Abhilfe: Fehlende Verbindung, Masseschlu und Dreher (keine 1:1 Ver- + bindung) berprfen und beheben. + Hinweis: Liegt z.B. ein Masseschlu vor, so kann es durchaus sein, da + Boxen, die nicht in der Nhe des Masseschlu stehen noch mitei- + nander arbeiten knnen. Man kann aus der Tatsache, da zwei + Boxen miteinander arbeiten knnen, also nicht schlieen, da man + nicht nach diesem Fehler suchen mu. + + + Beispiel: + + Auf #on("bold")#list (4/public)#off("bold")# erfolgt keine Reaktion. + + + - Station 4 ist whrend dieser Sendung zusammengebrochen. + Abhilfe: Station 4 wieder starten. Die Bearbeitung des 'list'-Kommandos + wird automatisch wieder aufgenommen. + + - PUBLIC auf Station 4 ist nicht im Managerzustand. + Abhilfe: PUBLIC in den Managerzustand versetzen. + + + Hinweis: Das Netz hat nocht nicht die volle Sendungslogik des EUMEL. So + wird nur ca. 10 Minuten lang versucht, eine Sendung zuzustellen. + Danach wird die Sendung gelscht. Ist dies eingetreten, so mu + das list-Kommando erneut gegeben werden. + + - Fehler in der Netzhardware. + berprfen Sie, ob + + - die Boxen eingeschaltet sind, + - die Bereitlampe blinkt (wenn nicht: RESET an der Box) + - die V24-Kabel richtig stecken, + - die Boxen untereinander verbunden sind (1 zu 1 Verbindungen der 5 + poligen Diodenbuchsen). + + + - Die Netzsoftware ist auf einen nicht vorhergesehenen Fehler gelaufen. + Dieser wird im Report vermerkt. + Abhilfe: Geben Sie in der Task #on("bold")#net#off("bold")# das Kommando #on("bold")#start#off("bold")#. Dadurch wird die + Netzsoftware neu gestartet. Alle Netzkommunikationen dieser + Station gehen verloren. + + + Beispiel: + + Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Collectortask fehlt'. + + - In der Task 'configurator' wurde das Kommando 'define collector' (siehe 3.2) + nicht gegeben. + + - Die Task 'net port' existiert nicht mehr. + Abhilfe: Kommando 'start' in der Task 'net'. + + + Beispiel: + + Nach #on("bold")#fetch ("hugo",4/public)#off("bold")# sind Teile von der Datei "hugo" verflscht. + + - Die V24-Verbindung zur Box ist nicht in Ordnung. + Abhilfe: Abstand zwischen Rechner und Box verkrzen; Baudrate ernie- + drigen; Durch Wechseln der V24-Schnittstelle feststellen, ob + diese defekt ist. + Hinweis: Die Verbindung zwischen den Boxen ist durch Prfsummen abge- + sichert (Hardware). + +#headodd# + +#center#Teil 2: Arbeitsweise der Netzsoftware#right#% + + +#end# +#page# +#type("triumb12")# + +Teil 2: Arbeitsweise der Netzsoftware + + +1. Die Netztask #type ("trium8")# + +In diesem Kapitel wird beschrieben, wie eine Netztask in das System +eingebettet ist und welche Aufgaben sie hat. Unter Einhaltung dieser +Konzepte kann die ausgelieferte Netztask so gendert werden, da sie +beliebige andere Netzhardware untersttzt. Z.Zt. ist die Netzsoftware noch +nicht so gegliedert, da nur eine hardwareabhngige Komponente ausgetauscht +werden mu. + +Die Kommunikation zwischen Tasks im EUMEL-Betriebssystem basiert auf einem +Rendevouskonzept: Die Zieltask einer Sendung mu empfangsbereit sein, wenn die +Quelltask sendet. + +Die Kommunikationsprozeduren auf der niedrigsten Ebene sind 'send' (Senden) +und 'wait' (Warten auf Empfang). Bei der Kommunikation werden eine Integer +'code' und ein Datenraum 'dr' bergeben. 'code' mu >= 0 sein, da negative +Codes systemintern verwandt werden. Ist die empfangende Task an einen Kanal +gekoppelt ('continue'), so fhrt eine Zeicheneingabe auf diesem Kanal dazu, +da eine +Sendung mit dem Code -4 ankommt. Die Eingabedaten mssen mit den blichen +Eingabeprozeduren ('inchar' u.s.w.) abgeholt werden. Der bermittelte Datenraum +und die Absendertask sind dabei ohne Bedeutung und drfen nicht interpretiert +werden. + +Die Prozedur 'send' hat einen Rckmeldeparameter, der besagt, ob die Sendung +bermittelt wurde. Gibt es die Zieltask nicht oder steht sie nicht im 'wait', so kann +die Sendung nicht bermittelt werden. + + +Ein Entwicklungskriterium fr das EUMEL-Netz war es, mglichst wenig Unter- +sttzung von der virtuellen EUMEL-Maschine (EUMEL0) zu fordern, damit weit- +gehend in ELAN programmiert werden kann. Dadurch ist es mglich eine (privili- +gierte) Task mit der Netzabwicklung zu betrauen. + +Zunchst wird auf die EUMEL0-Untersttzung eingegangen: + +1.1. Es gibt die Prozedur 'define collector', mit der die fr das Netz verantwort- + liche Task der EUMEL0-Maschine bekannt gemacht wird. Diese Task wird im + folgenden Collector genannt. + +1.2. Es gibt die Prozedur 'define station', die fr den Rechner eine Stationsnum- + mer einstellt. Anhand dieser Nummer werden die Rechner eines Netzes un- + terschieden. Das Einstellen bewirkt, da fr alle Tasks die Stationsnummer in + ihre Task-Id eingetragen wird (Task-Id's sind die Werte, die der Typ TASK + annehmen kann). + +1.3. Der Befehl 'station (task)' liefert die Stationsnummer der 'task'. So liefert z.B. + 'station (myself)' die Stationsnummer des eigenen Rechners. + +1.4. Eine Sendung, deren Zieltask in einem anderen Rechner liegt (also station + (ziel) <> station (myself)), wird auf die Collectortask geleitet. + +1.5. Es gibt eine Prozedur 'collected destination', die es dem Collector erlaubt, die + eigentliche Zieltask einer auf ihn geleiteten Sendung zu erfahren. + +1.6. Es gibt eine Variante der Prozedur 'send', die es dem Collector gestattet, der + Zieltask eine beliebige andere Task als Absender vorzumachen. + +1.7. Es gibt eine spezielle Task-Id 'collector', durch die der augenblicklich ein- + gestellte Collector erreicht wird. Diese wird als Zieltask beim Aufruf der Ver- + mittlungsdienste angegeben (siehe 2.5). Eine Sendung an 'collector' wird von + EUMEL0 an den derzeitigen Collector geschickt. + +Ein Collector kann also auf drei Wegen von den brigen Tasks desselben Rechners +Sendungen erhalten: + + 1. ber ein normales Send (z.B. bei 'list (/"net port")', wenn "net port" der der- + zeitige Collector ist), + + 2. ber ein Send an die Task 'collector' (s.u.) und + + 3. als umgeleitete Sendung (z.B. bei 'list' an eine Task auf einem anderen + Rechner). + +Der Collector kann diese Flle anhand von 'collected destination' unterscheiden. + +Die Punkte 1.4...1.6 dienen dazu, den Collector fr ber Netz kommunizierende +Task unsichtbar zu machen: Der Collector taucht nicht als Ziel oder Quelle von +Sendungen auf. Das ist notwendig, damit normale Tasks sich nicht darum kmmern +mssen, ob eine Sendung bers Netz geht oder im eigenen Rechner bleibt. + +Wenn ein Datenraum an einen anderen Rechner geschickt wird, mu der gesamte +Inhalt (z. Zt. max. 1 MB) bertragen werden. Dies macht bei der blichen Netz- +hardware eine Zerlegung in Packete ntig (siehe Systemhandbuch 173, Teil 4, +Punkt 5). Fr Netze ber V24-Kanle stehen spezielle Blockbefehle zur verf- +gung: + +1.8. blockin / blockout (dr,seite,512+abstand,anzahl,rest) + + Es werden maximal 'anzahl' Bytes transferiert. In 'rest' wird zurckgemeldet, + wieviel Bytes nicht bearbeitet wurden (z.B. weil der Kanal nichts anliefert). + Bearbeitet werden die Bytes + + 'seite' * 512 + 'abstand' + + bis maximal + + 'seite' * 512 + 'abstand' + 'anzahl' - 1 + + Der Kanal, an den die Task gekoppelt ist, wird dabei ber Stream-IO (d.h. + 'incharety' bei 'blockin' bzw. 'out' bei 'blockout') angesprochen. + + Hinweis: Die Anforderung darf nicht ber Seitengrenze gehen, d.h. + + 'abstand' + 'anzahl' <= 512 + + mu erfllt sein. + + +Eine Netzsendung luft wie folgt ab: + +Die Task q auf Rechner rq mache ein 'send' an die Task z auf Rechner rz. + +1. Die Prozedur send ist ein EUMEL0-Befehl. Die EUMEL0-Ebene erkennt, da + die Sendung an die Station rz geht, da die Stationsnummer in der Task-Id + enthalten ist. Daher wird die Sendung zum Collector, den EUMEL0 wegen 'de- + fine collector' kennt, umgeleitet. + +2. Die Task Collector empfngt ber 'wait' den Datenraum, den Sendecode und + die Absendertask q. Die Zieltask z erfhrt sie durch 'collected destination'. + +3. Der Collector nimmt Kontakt mit dem Collector des Rechner rz, dessen Sta- + tionsnummer ja 'station(z)' ist, auf und bermittelt diesem Sendecode, Quelltask + (q), eigentliche Zieltask (z) und den Datenraum. Da die Collectoren in ELAN + geschrieben sind, knnen sie an beliebige Netzhardware und Protokolle ange- + pat werden. + +4. Der Collector auf Rechner rz verwendet das spezielle 'send', um der Zieltask die + Sendung zuzustellen. Dadurch erscheint nicht der Collector sondern die Task q + als Absender der Sendung. + +Zur Abwicklung der Vermittlungsebene (Teil 1: 2.4) mu der Collector noch +spezielle Funktionen beherrschen. Diese sind + + der /-Operator (Taskname in Task-Id wandeln) und + die name-Prozedur (Task-Id in Namen wandeln). + +Der /-Operator macht eine Sendung an den 'collector', wobei im Datenraum der +Name der Task steht und der Sendecode gleich der Stationsnummer ist (siehe +Quellcode 173, Packet tasks). Der Collector setzt sich mit dem Collector dieser Sta- +tion in Verbindung, damit dieser die Task-Id ermittelt und zurckschickt. Der +eigene Collector schickt dann dem /-Operator als Antwort einen Datenraum, der +die Task-Id enthlt. + +Umgekehrt luft 'name' ab: Wenn die Task-Id von einer fremden Station ist, +schickt 'name' eine Sendung an den 'collector', wobei im Datenraum die Task-Id +steht und Sendecode = 256 ist. Der Collector entnimmt die Stationnummer der +Task aus der Task-Id und lt sich vom entsprechenden Collector den Tasknamen +geben. Dieser wird der 'name'-Prozedur im Antwortdatenraum bergeben. + +#type ("triumb12")#2. Ebenen #type("trium8")# + +In diesem Kapitel werden die Protokollebenen fr das Netz beschrieben, wie +sie die ausgelieferte Netzsoftware benutzt und erwartet. Bei anderer +Netzhardware mssen die Ebenen 1 bis 3 ausgetauscht werden. Unter Einhaltung +der im vorigen Kapitel beschriebenen Randbedingungen knnen auch die hheren +Ebenen gendert werden. + + +2.1 Physikalische Ebene + + 2.1.1 Station <--> Box + + V24-Schnittstelle mit RTS/CTS-Handshake. Vollduplex. + + 2.1.2 Box <--> Box + + RS422 ber 2 verdrillte Leitungspaare (Takt und Daten). + +2.2 Verbindungsebene + + 2.2.1 Station <--> Box + + Asynchron + 8 Bit + Even Parity + 2400/4800/9600/19200 Baud (einstellbar ber Ltbrcken) + + 2.2.2 Box <--> Box + + SDLC + 400 KBaud + +2.3 Netzebene + + 2.3.1 Station <--> Box + + Telegrammformat: STX, , , , <(n-4) byte> + + ist Lngenangabe ( 8 <= n <= 160) + , sind Stationsnummern. Diese mssen an den je- + weiligen Boxen ber Ltbrcken eingestellt sein. + + Box --> Station: + + Ein Telegramm kommt nur bei der Station an, bei deren Box die + Nummer eingestellt ist. Dadurch ist ein Mithren fremder + bertragungen nicht mglich (Datenschutz). + + Zwischen Telegrammen knnen Fehlermeldungen der Box (Klartext) + bermittelt werden (z.B. 'skipped x', wenn ein STX von der Box er- + wartet wurde, aber 'x' von der Station ankommt). + + Station --> Box: + + Ein Telegramm wird nur abgeschickt, wenn mit der einge- + stellten Nummer bereinstimmt (Datenschutz: Man kann nicht eine + beliebige Station zu sein vorschwindeln, es sei denn man hat physi- + schen Zugriff zur Box und stellt dort die Stationsnummer um). + + 2.3.2 Box <--> Box + + Telegrammformat: FRAME, , , , + + + Eine Lngenangabe ist nicht ntig, da SDLC eine Rekonstruktion der + Lnge erlaubt. + + Telegramme mit falschen CRC-Code werden vernichtet. Auf hheren + Ebenen mu dies durch Zeitberwachung erkannt und behandelt + werden. + + +2.4 Transportebene + + Diese Ebene wickelt das Rendevous zwischen einer Task, die 'send' macht, + und einer Task, die im 'wait' steht, ab (siehe: EUMEL-Systemhandbuch). + + Der im 'send' angegebene Datenraum wird als Folge von Seiten (im + EUMEL-Sinne: Pagingeinheit und Allokiereinheit) bermittelt, wobei jede Seite + noch in 64 Byte groe Stcke zerlegt wird. Es werden nur echt allokierte Seiten + bermittelt. Um nicht jedes Telegramm voll qualifizieren zu mssen, wird + zunchst eine Art virtuelle Verbindung durch ein OPEN-Telegramm erffnet. + Danach folgen variable viele DATA-Telegramme. Beide Sorten werden durch + QUIT-Telegramme quittiert, um folgende Funktionen zu ermglichen: + + Flukontrolle (z.B. Zielrechner langsam) + Wiederaufsetzen (verlorene Telegramme) + Abbruch (z.B. weil Zieltask inzwischen beendet). + + Ein CLOSE-Telegramm ist nicht ntig, da das letzte DATA-Telegramm als + solches erkannt werden kann (siehe unten). + + 2.4.1 OPEN-Telegramm + + STX, 20, , , , , , + , , + + , siehe 2.3.1 + + Die Stromnummer identifiziert die virtuelle Verbindung. + Sie mu in den QUIT-Telegrammen angegeben wer- + den. + + -1 (Kennzeichen fr OPEN) + + Nummer der ersten echt allokierten Seite des Datenra- + ums (=-1, falls Nilspace) + + Taskid der sendenden Task + + Taskid der empfangenden Task + + Wert des im 'send' angegebenen Codes. + + 2.4.2 DATA-Telegramm + + STX, 74, , , , , <64 byte> + + wird von Telegramm zu Telegramm hochgezhlt. Dient + der berwachung gegen verlorengegangene Telegramme + bzw. durch Zeitberwachung verdoppelter Telegramme. + + Nummer der x.ten echt allokierten Seite des Datenra- + ums. (x = (+16) DIV 8). + + <64 byte> Nutzinformation. Diese gehrt zur Adresse a des Daten- + raums. + + a = N ( DIV 8 + 1) * 512 + + ( MOD 8) * 64 + + wobei N (x) die Nummer der x.ten Seite ist. + + Aus den Formeln ergibt sich, da diese Nummer schon in + einem vorhergehenden DATA/OPEN-Telegramm ber- + mittelt wurde (im Feld ). + + 2.4.3 QUIT-Telegramm + + STX, 8, , , , + + mu die Stromnummer sein, die in dem OPEN/DATA- + Telegramm stand, das quittiert wird. + + 0 : ok. Nchstes Telegramm schicken. + + -1: bertragung neu starten (mit OPEN), weil die + Empfangsstation das OPEN nicht erhalten hat. + + -2: bertragung ca. 20 Telegramme zurcksetzen. + + -3: bertragung abbrechen. + + +2.5 Vermittlungsebene + + Diese Ebene ist dafr zustndig, Tasknamen von Task auf anderen Stationen + in Taskids (Werte des Typs TASK) zu wandeln und umgekehrt. Hierzu wird im + entsprechenden OPEN-Telegramm der Code -6 (bzw. -7) als + eingetragen. Die Netzempfangstask erkennt diese Codes und wickelt die + Aufgaben selbst ab, soda es dabei nicht ntig ist, irgendeine Taskid der + Zielstation zu kennen. + + Dieses Verfahren ist mglich, weil im 'send' nur positive Codes erlaubt sind. + +2.6 Hhere Ebenen + + Hhere Ebenen sind nicht mehr netzspezifisch. Sie basieren alle auf dem + Send/Wait-Konzept des EUMEL. So gibt es z.B. den 'global manager', der + Aufbewahrung und Zugriff von Dateien in einer Task regelt. Dabei darf diese + Task (bei der Variante 'free global manager') auf einer beliebigen Station im + Netz liegen. Wegen des Rendevous-Konzepts knnen beliebige Sicherheit- + strategien benutzt werden (z.B.: Keine Dateien an Station 11 ausliefern). Von + groen Wert ist z.B., da man ohne weiteres das Archiv (Floppylaufwerk) einen + anderen Station anmelden und benuzten kann, wodurch eine einfache Kon- + vertierung von Floppyformaten mglich ist. Dies ist mglich, weil auch die Ar- + chiv-Task der Stationen sich an das Globalmanagerprotokoll halten. + + +#type("triumb12")# +Bemerkungen#type("trium8")# + +Fehlerbehandlung besteht bis Ebene 3 darin, fehlerhafte Telegramme einfach zu +entfernen. Die Ebene 4 berwacht den Netzverkehr sowieso ber Timeouts, die +eine Wiederhohlung eines Telegrammes bewirken, wenn die Quittung ausbleibt. + +Da bei der sendenden Station der ganze Datenraum zur Verfgung steht, ist eine +Fenstertechnik (wie bei HDLC) nicht ntig. Es kann zu jedem Zeitpunkt um beliebig +viele Telegramme zurckgesetzt werden. + +Da im EUMEL eine Textdatei ein Datenraum mit sehr komplexer Struktur ist (wegen +der Insert/Delete-Mglichkeiten, ohne den Rest der Datei zu schieben), ist es ein +hoher Aufwand, von einem fremden Betriebssytem her Textdateien ins EUMEL- +Netz zu senden. Fr solche Zwecke mu noch eine einfachere Dateistruktur defi- +niert werden und entsprechende Dateikonverter erstellt werden. + + + +#type("triumb12")#3. Stand der Netzsoftware #type("trium8")# + +Das EUMEL-System wickelt die Prozedur #on("bold")#send#off("bold")# ber das Netz ab, wenn die +Stationsnummer der Zieltask ungleich der eigenen Stationsnummer ist. Umge- +kehrt kann man der von der Prozedur #on("bold")#wait#off("bold")# gelieferten Absendertask die Absen- +derstation entnehmen (siehe Prozedur #on("bold")#station#off("bold")# in Abschnitt 3). + +Nicht untersttzt wird z.Zt. die Logik der Prozeduren #on("bold")#call#off("bold")# und #on("bold")#pingpong#off("bold")#. Diese +funktionieren nur in der gewohnten Weise, wenn die Zieltask in #on("bold")#wait#off("bold")# steht. Ist +die Zieltask lnger als ca. 10 Minuten #on("bold")#busy#off("bold")# oder nicht mehr vorhanden, geht die +Sendung einfach verloren (Gefordert ist: bei #on("bold")#call#off("bold")#: immer wieder versuchen; bei #on("bold")# +pingpong#off("bold")#: Rckmeldung -2). + +Wegen dieser Einschrnkung kann man z.B. ein sicheres Drucken von Station a +auf einen Drucker der Station b nur durch einen eigenen Spoolmanager auf +Station a verwirklichen. Die Einrichtung eines solchen Managers ist allerdings +sowieso sinnvoll, damit man + +- das normale 'print'-Kommando verwenden kann (statt z.B. save ("xxx", +4/printer);) und +- nicht zu warten braucht, bis die Datei bers Netz gesendet ist. + + + + + diff --git a/system/net/1.7.5/src/basic net b/system/net/1.7.5/src/basic net new file mode 100644 index 0000000..41c8402 --- /dev/null +++ b/system/net/1.7.5/src/basic net @@ -0,0 +1,840 @@ +PACKET basic net DEFINES (* D. Heinrichs *) + (* 02.10.85 *) + nam, + max verbindungsnummer, + neuer start, + packet eingang, + neue sendung, + zeitueberwachung, + verbindung, + loesche verbindung: + +TEXT PROC nam (TASK CONST t): + IF t = collector THEN name (t) + ELIF station (t) <> station (myself) + THEN "** fremd **" + ELSE name (t) + FI +END PROC nam; + +INT PROC tasknr (TASK CONST t): + IF t = collector THEN maxtasks + ELSE index (t) + FI +END PROC tasknr; + +LET + maxtasks = 127, + max strom = 20, + max strom 1 = 21, + stx = ""2"", + code stx = 2, + ack = 0, + nak = 1, + error nak = 2, + zeichen eingang = 4, + list code = 15, + fetch code = 11, + inspect code = 30, + continue code = 100, + erase code = 14, + report code = 99, + seiten groesse = 512, + dr verwaltungslaenge = 8, + dr verwaltungslaenge2=10, + nutzlaenge = 64, + openlaenge = 20, + vorspannlaenge = 10, + neue ack laenge = 10, + ack laenge = 8, + + (* Typen von Kommunikationsstrmen *) + + send wait = 0, + zustellung = 1, + call pingpong = 2, + call im wait = 3, + call im abbruch = 4, + call in zustellung = 5, + + (*quittungscodes*) + + ok = 0, + von vorne = 1, + wiederhole = 2, + loesche = 3, + beende = 4; + +LET STEUER = + STRUCT ( + INT head, + rechner nummern, + strom, + sequenz, + seitennummer, + TASK quelle,ziel, + INT sende code); + +BOUND STEUER VAR open block; + +BOUND STRUCT (STEUER steuer, INT typ) VAR info block; + +BOUND STRUCT ( + INT head, + rechner nummern, + strom, + sequenz, + seitennummer) VAR vorspann ; + +BOUND STRUCT ( + INT head, + rechner nummern, + strom, + code) VAR ack packet ; + +INT CONST max verbindungsnummer := max strom; + +BOOL PROC blockin (DATASPACE VAR ds, INT CONST seite, abstand, laenge): + INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512; + REAL VAR time out := clock (1) + 10.0; + REP + blockin (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge); + UNTIL hilfslaenge = 0 OR clock (1) > time out PER ; + hilfslaenge = 0 +END PROC blockin; + +PROC blockout (DATASPACE CONST ds, INT CONST seite, abstand, laenge): + INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512; + REP + blockout (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge); + UNTIL hilfslaenge = 0 PER +END PROC blockout; + + + + +DATASPACE VAR work space; + + +INT CONST packete pro seite:= seitengroesse DIV nutzlaenge, + packete pro seite minus 1 := packete pro seite -1, + datenpacketlaenge := vorspannlaenge + nutzlaenge; + +INT VAR err,strom; + +INT VAR own:=station (myself) , + quit max := 3, + quit zaehler := 3, + own256 := 256*own; +INT CONST stx open := code stx+256*openlaenge, + stx quit := code stx+256*acklaenge; + + ROW maxstrom1 STEUER VAR verbindungen; + ROW maxstrom1 DATASPACE VAR netz dr; + ROW maxstrom1 INT VAR zeit, typ; + FOR strom FROM 1 UPTO maxstrom1 REP vdr := nilspace; forget (vdr) PER; + ROW maxstrom INT VAR dr page ; + ROW maxtasks INT VAR alter call; + STEUER VAR opti; + +.vx : verbindungen (strom). + +vdr: netz dr (strom). + +falsche stromnummer: strom < 1 OR strom > maxstrom. + +call aufruf: typ(strom) >= call pingpong. + +alles raus: vx.seitennummer = -1 AND letztes packet der seite . + +letztes packet der seite : +(vx.sequenz AND packete pro seite minus 1) = packete pro seite minus 1. + +PROC neuer start (INT CONST empfangsstroeme): + workspace := nilspace; + open block := workspace; + info block := workspace; + vorspann := workspace; + ack packet := workspace; + FOR strom FROM 1 UPTO maxstrom1 REP + vx.strom := 0; forget (vdr) + PER; + INT VAR i; + FOR i FROM 1 UPTO maxtasks REP alter call (i) := 0 PER; + quitmax := empfangsstroeme; + own:=station (myself); + quit zaehler := quit max; + own256 := 256*own; + reset box. + +reset box: + out (90*""4""); + REP UNTIL incharety (1) = "" PER. + +END PROC neuer start; + +DATASPACE PROC verbindung (INT CONST nr): + infoblock.steuer := verbindungen (nr); + infoblock.typ := typ (nr); + workspace +END PROC verbindung; + +PROC neue sendung (TASK CONST q,z, INT CONST cod, DATASPACE CONST dr): + + naechste verbindung vorbereiten; + forget (vdr); vdr := dr; + IF z = collector + THEN + verbindungsebene + ELSE + sendung starten (q,z,cod) + FI. + +verbindungsebene: + IF cod = 256 THEN name von fremdstation + ELIF cod > 256 + THEN + taskinfo fremd + ELSE + task id von fremd + FI. + +taskinfo fremd: sendung starten (q, collector, cod-256, -8). + +task id von fremd: sendung starten (q,collector, zielstation,-6) . + +name von fremdstation: + BOUND TASK VAR tsk := vdr; + TASK VAR tsk1 := tsk; + forget (vdr); + vdr := nilspace; + sendung starten (q, tsk1, -7). + +zielstation: cod. + +END PROC neue sendung; + +PROC zeitueberwachung + (INT VAR snr, TASK VAR q, z, INT VAR ant,DATASPACE VAR dr): + snr INCR 1; + FOR strom FROM snr UPTO maxstrom REP zeitkontrolle PER; + snr := 0. + +zeitkontrolle: + IF vx.strom <> 0 AND zeit(strom) > 0 + THEN + zeit(strom) DECR 1; + IF sendung noch nicht zugestellt + THEN + IF zeit(strom) = 0 THEN + report ("Nicht zustellbar. """+nam (vx.ziel)+""". "+ + text (vx.rechnernummernDIV256)); + loesche verbindung (strom) + ELSE + snr := strom; + q := vx.quelle; + z := vx.ziel; + ant := vx.sendecode; + dr := vdr; + LEAVE zeitueberwachung + FI + ELIF zeit(strom) = 0 THEN wiederholen FI + FI. + +sendung noch nicht zugestellt: + typ (strom) = zustellung. + +wiederholen: + IF sendeeintrag + THEN + sendung wiederholen + ELSE + empfangseintrag freigeben + FI. + +sendeeintrag : vx.rechnernummern DIV 256 = own . + +sendung wiederholen: + IF wiederholung noch sinnvoll + THEN + IF frisch + THEN + time out bei open + ELSE + datenteil wiederholen + FI + ELSE + sendung loeschen + FI. + +wiederholung noch sinnvoll: + task noch da AND bei call noch im call. + +task noch da: vx.quelle = collector OR exists (vx.quelle). + +bei call noch im call: + IF call aufruf + THEN + callee (vx.quelle) = vx.ziel + ELSE + TRUE + FI. + +frisch: vx.sequenz = -1. + +time out bei open: + IF vx.sendecode > -4 THEN open wiederholen ELSE nak an quelle senden FI. + +nak an quelle senden: + forget (vdr); vdr := nilspace; + BOUND TEXT VAR erm := vdr; + erm := "Station "+text(vx.rechnernummernMOD256)+" antwortet nicht"; + snr := strom; + q := collector; + z := vx.quelle; + ant := error nak; + dr := vdr; + sendung loeschen; + LEAVE zeitueberwachung . + +open wiederholen: + sendereport ("wdh open"); + zeit(strom) := 20; + openblock := vx; + openblock.head := stx open; + ab die post. + +datenteil wiederholen: + sendereport ("wdh data. sqnr "+text (vx.sequenz)); + senden . + +empfangseintrag freigeben: + IF antwort auf call + THEN + weiter warten + ELSE + empfangsreport ("Empfangseintrag freigegeben"); + empfang loeschen + FI. +antwort auf call: callee (vx.ziel) = vx.quelle. + +weiter warten: zeit (strom) := 200. + +END PROC zeitueberwachung; + +PROC sendereport (TEXT CONST txt): + report (text (strom)+":"+txt+". Absender: """+nam (vx.quelle)+ + """. Ziel "+text(vx.rechnernummernMOD256)); +END PROC sendereport; + +PROC empfangsreport (TEXT CONST txt): + report (text (strom)+":"+txt+". Empfnger: """ + +nam (vx.ziel)+""". Quelle "+text (vx.rechnernummernDIV256)); +END PROC empfangsreport ; + +PROC sendung loeschen: + IF callaufruf CAND alter call (tasknr (vx.quelle)) = strom + THEN + alter call (tasknr (vx.quelle)) := 0 + FI; + vx.strom := 0; + forget (vdr) +END PROC sendung loeschen; + +PROC empfang loeschen: + quit zaehler INCR 1; + IF callaufruf AND alter call (tasknr (vx.ziel)) = strom + THEN + alter call (tasknr (vx.ziel)) := 0 + FI; + forget (vdr); + vx.strom := 0 +END PROC empfang loeschen; + +PROC loesche verbindung (INT CONST nr): + strom := nr; + IF sendeeintrag + THEN + sendung loeschen + ELSE + gegenstelle zum loeschen auffordern; + empfang loeschen + FI. + +gegenstelle zum loeschen auffordern: + IF verbindung aktiv THEN quittieren (-loesche) FI. + +verbindung aktiv: vx.strom > 0. + +sendeeintrag: vx.rechnernummern DIV 256 = own . + +END PROC loesche verbindung; + +PROC weiter senden: + IF NOT alles raus + THEN + sequenz zaehlung; + IF neue seite THEN seitennummer eintragen FI; + senden + FI. + +sequenz zaehlung: + vx.sequenz INCR 1. + +neue seite: + (vx.sequenz AND packete pro seite minus 1) = 0. + +seitennummer eintragen: + dr page (strom) := vx.seiten nummer; + vx.seitennummer := next ds page (vdr, dr page (strom)). + + +END PROC weiter senden; + +PROC senden: + zeit(strom) := 3; + vorspann senden; + daten senden. + +vorspann senden: + openblock := vx; + blockout (workspace, 1, dr verwaltungslaenge, vorspannlaenge). + +daten senden: + blockout (vdr,dr page (strom),distanz,nutzlaenge). + +distanz: nutzlaenge* (vx.sequenz AND (packete pro seite minus 1)). + +END PROC senden; + +PROC naechste verbindung vorbereiten: + FOR strom FROM 1 UPTO maxstrom REP + UNTIL vx.strom = 0 PER; + IF vx.strom <> 0 THEN errorstop ("Verbindungsengpass") FI. +END PROC naechste verbindung vorbereiten; + +PROC sendung starten (TASK CONST quelle, ziel, INT CONST code): + sendung starten (quelle,ziel, station(ziel), code) +END PROC sendung starten; + +PROC sendung starten (TASK CONST quelle, ziel, INT CONST ziel station,code): + IF ziel station = own + THEN + report ("Irrlufer: Sendung an eigene Station. Absender:"""+ + nam (quelle)+"""."); + vx.strom := 0; + forget (vdr) + ELSE + openblock.ziel := ziel; + openblock.quelle :=quelle; + openblock.sendecode := code; + openblock.rechnernummern:= ziel station + own256; + alten call loeschen (quelle); + IF call oder ping pong + THEN typ (strom) := call pingpong; call merken + ELSE typ (strom) := send wait FI; + sendung neu starten + FI. + +call oder pingpong: openblock.ziel = callee (openblock.quelle). + +call merken: alter call (tasknr (quelle)) := strom. + +END PROC sendung starten; + +PROC sendung neu starten: + openblock.head:= stx open; + openblock.sequenz := -1; + openblock.seitennummer:= next ds page (vdr,-1); + openblock.strom := strom; + vx := open block; + zeit(strom) := 3; + ab die post; + vx.head:=code stx+256*(vorspannlaenge+nutzlaenge). + +END PROC sendung neu starten; . + +ab die post: + block out (work space,1, dr verwaltungslaenge,open laenge). + +PROC alten call loeschen (TASK CONST quelle): + IF alter call aktiv + THEN + INT VAR lstrom := strom; + vx:=openblock; + strom := alter call (tasknr (quelle)); + IF in ausfuehrungsphase + THEN + sendereport ("Call-Lschung vorgemerkt"); + loeschung vormerken + ELSE + report ("Call gelscht."""+nam(quelle)+""". Strom "+text(strom)); + loesche verbindung (strom) + FI; + strom := lstrom; + openblock := vx + FI. + +in ausfuehrungsphase: + typ(strom) = call im wait OR typ (strom) = call in zustellung. + +loeschung vormerken: + typ(strom) := call im abbruch; + alter call (tasknr (quelle)) := 0. + + + alter call aktiv: + alter call (tasknr (quelle)) > 0. + +END PROC alten call loeschen; + +PROC packet eingang + (TEXT CONST ft, INT VAR snr, TASK VAR q, z, INT VAR ant,DATASPACE VAR dr): + snr := 0; + vorspann holen; + IF NOT ring logik THEN daten teil FI. + +ring logik: FALSE. +# IF selbst quelle THEN daten aus puffer entfernen ; TRUE + ELIF NOT selbst ziel THEN weitergeben; TRUE + ELSE FALSE + FI. + +selbst quelle: openblock.rechnernummern DIV 256 = station (myself). + +selbst ziel: (openblock.rechnernummern AND 255) = own. +# +daten aus puffer entfernen: + IF code (t) > nutzlaenge + THEN + BOOL VAR dummy :=blockin (workspace, 1, drverwaltungslaenge, nutzlaenge) + FI. +# +weitergeben: + IF code (t) > nutzlaenge + THEN + IF NOT blockin (workspace, 2, 0, nutzlaenge) + THEN LEAVE test auf packeteingang FI; + FI; + out (stx+t); + blockout (workspace, 1, drverwaltungslaenge2, blocklaenge); + IF code (t) > nutzlaenge + THEN + blockout (workspace, 2, 0, nutzlaenge) + FI. +# +vorspann holen: + sync; + IF NOT blockin (workspace, 1, dr verwaltungslaenge2, block laenge) + THEN LEAVE packeteingang + FI. + + +blocklaenge: IF code t > nutzlaenge + THEN + vorspannlaenge-2 + ELSE + code t -2 + FI. + +sync: + TEXT VAR skipped:=ft , t :=""; + REP + skipped CAT t; + t := incharety (1); + IF t = "" THEN + report ("skipped",skipped); + LEAVE packet eingang + FI ; + INT VAR codet := code (t); + UNTIL blockanfang PER; + IF skipped <> stx THEN report ("skipped bei sync:", skipped) FI. + +blockanfang: + (skipped SUB length(skipped)) = stx + AND + (codet = datenpacketlaenge + OR codet = ack laenge OR codet = neue ack laenge OR code t = openlaenge). + +daten teil: + IF neue verbindung + THEN + verbindung bereitstellen + ELIF quittung + THEN + strom := ack packet.strom; + IF falsche stromnummer THEN report ("Strom falsch in Quittung"); + LEAVE datenteil FI; + IF vx.strom = 0 THEN LEAVE datenteil FI; + IF ackpacket.code >= ok THEN weiter senden + ELIF ackpacket.code = -von vorne THEN + sendereport ("Neustart"); + openblock := vx; + sendung neu starten + ELIF ackpacket.code = -wiederhole THEN back 16 + ELIF ackpacket.code = -loesche THEN fremdloeschung + ELIF ackpacket.code = -beende AND alles raus THEN strom abschliessen + FI + ELIF verbindung festgestellt + THEN + zeit(strom) := 200; + opti := vx; + datenpacket + ELSE + strom := maxstrom1; + vx:=openblock; + report ("Daten ohne Eroeffnung von " +text(vx.rechnernummernDIV256) + +" Sequenznr "+text(openblock.sequenz)); + daten aus puffer entfernen; + IF alles raus THEN quittieren (-beende) ELSE quittieren(-von vorne) FI + FI. + +verbindung bereitstellen: + IF openblock.ziel = collector OR station (openblock.ziel) = own + THEN + freie verbindungsnummer; + vdr := nilspace; + vx := open block; + zeit(strom) := 10; + quittieren falls genug pufferplatz; + vx.sequenz := 0 ; + IF loeschung vorgemerkt + THEN + loesche verbindung (strom) + ELSE + opti := vx; + abschluss testen + FI; + FI. + +loeschung vorgemerkt: typ(strom) = call im abbruch. + +strom abschliessen: + IF call aufruf THEN zeit(strom) := 80; ausfuehrungsphase merken + ELSE + vx.strom := 0; + forget (vdr) + FI. + +ausfuehrungsphase merken: typ(strom) := call in zustellung. + +back16: + datenraum etwas rueckspulen; + nicht sofort senden (* wegen vagabundierender Quittungen *). + +nicht sofort senden: zeit(strom) := 2. + +datenraum etwas rueckspulen: + sendereport ("etwas rueckgespult"); + INT VAR sk , vs :=-1; + dr page (strom) := -1; + INT VAR i; + FOR i FROM 1 UPTO vx.sequenz DIV packete pro seite - etwas REP + vs INCR packete pro seite; + dr page (strom) := next ds page (vdr, dr page (strom)) + PER; + vx.seiten nummer := next ds page (vdr, dr page (strom)) ; + vx.sequenz := vs. + +etwas: 3. + +fremdloeschung: + IF fremdrechner ok und sendung + THEN + IF typ (strom) = call in zustellung + THEN + typ (strom) := call im wait + ELSE + sendereport ("Sendung von Gegenstelle geloescht"); + sendung loeschen + FI + FI. + +fremdrechner ok und sendung: + (ackpacket.rechnernummern DIV 256) = (vx.rechnernummern AND 255). + + +quittieren falls genug pufferplatz: + IF quit zaehler > 0 THEN + quit zaehler DECR 1; + open quittieren; + block vorab quittieren + FI. + +open quittieren: quittieren (ok). +block vorab quittieren: quittieren (ok). + +quittung: code t <= neue ack laenge. + +neue verbindung: code t = open laenge. + +verbindung festgestellt: + FOR strom FROM maxstrom DOWNTO 1 REP + IF bekannter strom + THEN LEAVE verbindung festgestellt WITH TRUE FI + PER; + FALSE. + +bekannter strom: + vx.strom = vorspann.strom AND vom selben rechner. + +vom selben rechner: + vx.rechnernummern = vorspann.rechnernummern. + +daten: + IF NOT blockin (vdr, opti.seiten nummer, distanz, nutzlaenge) + THEN quittieren (-wiederhole); LEAVE packeteingang + FI; + sequenz zaehlung; + IF neue seite kommt + THEN + vx.seiten nummer := vorspann.seiten nummer + FI. + +datenpacket: + IF sendung wartet auf zustellung THEN auffrischen ELSE daten holen FI. + +sendung wartet auf zustellung: typ (strom) = zustellung. + +auffrischen: zeit (strom) := 100; daten aus puffer entfernen. + +daten holen: + IF opti.sequenz >= vorspann.sequenz AND opti.sequenz < vorspann.sequenz+100 + THEN + IF opti.sequenz <> vorspann.sequenz + THEN empfangsreport ("Sequenzreset von "+text(opti.sequenz)+" auf "+ + text (vorspann.sequenz)); + vx.sequenz := vorspann.sequenz; + vorabquittung regenerieren + FI; + quittieren(ok); + daten ; + abschluss testen + ELSE + empfangsreport ("Sequenzfehler: soll "+text(vx.sequenz)+" ist "+ + text(vorspann.sequenz)); + quittieren (-wiederhole); + daten aus puffer entfernen + FI. + +vorabquittung regenerieren: quittieren (ok). + +distanz: (opti.sequenz AND packete pro seite minus 1 ) * nutzlaenge. + +sequenz zaehlung: + vx.sequenz INCR 1. + +neue seite kommt: +(vx.sequenz AND packete pro seite minus1) = 0. + +freie verbindungsnummer: + INT VAR h strom :=0; + FOR strom FROM 1 UPTO maxstrom REP + IF vx.strom = 0 THEN h strom := strom + ELIF bekannter strom + THEN empfangsreport ("Reopen"); + quit zaehler INCR 1; + forget (vdr); + LEAVE freie verbindungsnummer + ELIF antwort auf call + THEN + typ (strom) := call pingpong; + forget (vdr); + LEAVE freie verbindungsnummer + FI + PER; + strom := h strom; + IF strom = 0 THEN + error stop ("Zuviele simulatane Verbindungen") + FI; + typ(strom) := send wait. + +antwort auf call: + openblock.sendecode >= 0 AND + call aufruf AND vx.quelle = openblock.ziel AND vx.ziel = openblock.quelle. + +abschluss testen: + IF neue seite kommt AND vx.seiten nummer = -1 + THEN + quittieren (-beende); + an ziel weitergeben + FI. + +an ziel weitergeben: + IF tasknummerfrage THEN taskfrage beantworten ;pufferplatz freigeben; + ELIF tasknamenfrage THEN name senden ;pufferplatz freigeben; + ELIF taskinfofrage THEN task info senden;pufferplatz freigeben; + ELSE senden + FI. + +pufferplatz freigeben: quitzaehler INCR 1. + +senden: + max 100 versuche; + snr := strom; + IF NOT callaufruf THEN typ (strom) := zustellung FI; + q := vx.quelle; + z := vx.ziel; + ant := vx.sendecode; + dr := vdr; + LEAVE packet eingang. + +tasknummerfrage:opti.sendecode = -6. + +tasknamenfrage: opti.sendecode = -7. + +taskinfofrage: opti.sendecode = -8. + +max 100 versuche: zeit(strom) := 100. + +taskfrage beantworten: + BOUND TEXT VAR tsk := vdr; + TEXT VAR save tsk := tsk; + forget (vdr); vdr := nilspace; + BOUND TASK VAR task id := vdr; + disable stop; + task id := task(save tsk); + IF is error THEN + clear error; enable stop; + forget (vdr); vdr := nilspace; + BOUND TEXT VAR errtxt := vdr; + errtxt := text(station(myself))+"/"""+save tsk+""" gibt es nicht"; + sendung starten (collector, opti.quelle, 2) + ELSE + enable stop; + sendung starten (collector, opti.quelle, 0) + FI. + +name senden: + forget (vdr); vdr := nilspace; + tsk := vdr; + disable stop; + tsk := nam (opti.ziel); + clear error; enable stop; + sendung starten (collector, opti.quelle, 0). + +task info senden: + BOUND INT VAR ti code := vdr; + INT VAR ti cd := ti code; + forget (vdr); vdr := nilspace; + FILE VAR task inf := sequential file (output,vdr); + head line (task inf,"Station "+text(own)); + task info (ti cd, task inf); + sendung starten (collector,opti.quelle,0). + +END PROC packet eingang; + +PROC quittieren(INT CONST code) : + quellrechner wird zielrechner; + ackpacket.code := code; + ackpacket.head := stx quit; + ackpacket.strom := vx.strom; + blockout (workspace,1,dr verwaltungslaenge, ack laenge). + +quellrechner wird zielrechner: + ack packet.rechnernummern := vx.rechnernummern DIV 256 + + own256. + +END PROC quittieren; + +END PACKET basic net; diff --git a/system/net/1.7.5/src/callee b/system/net/1.7.5/src/callee new file mode 100644 index 0000000..42d80da --- /dev/null +++ b/system/net/1.7.5/src/callee @@ -0,0 +1,14 @@ +PACKET callee DEFINES callee: + +TASK PROC callee (TASK CONST t): + IF im wait THEN trick 1 (t); trick 2 ELSE niltask FI. +im wait: (status(t) AND 3) = 2. +END PROC callee; + +PROC trick 1 (TASK CONST t): + INT VAR x := pcb(t,11), y:=pcb(t,12); +END PROC trick1; + +TASK PROC trick 2: TASK VAR calle; calle END PROC trick2; + +END PACKET callee; diff --git a/system/net/1.7.5/src/net inserter b/system/net/1.7.5/src/net inserter new file mode 100644 index 0000000..8cccedd --- /dev/null +++ b/system/net/1.7.5/src/net inserter @@ -0,0 +1,50 @@ + +{ Inserter fr EUMEL - Netz - Software; 04.12.83 + bercksichtigt EUMEL - Versionen 1.7.3 und 1.7.5, sowie Multi / Single } + + +INT VAR version :: id (0), cy :: 4; +IF online THEN head FI; + +IF ich bin multi THEN insert multi net + ELSE meldung an single +FI. + +ich bin multi : (pcb (9) AND 255) > 1. + +insert multi net : + IF version >= 173 THEN IF version < 175 THEN insert and say ("callee") FI; + insert and say ("net report/M"); + insert and say ("basic net"); + insert and say ("net manager/M") + ELSE versionsnummer zu klein + FI. + +meldung an single : + cursor (1, cy); + putline + ("Das EUMEL - Netz ist zur Zeit nur auf Multi - User - Versionen"); + putline ("installierbar !"). + +head : + page; + putline (" E U M E L - Netz - Inserter"); + put ("---------------------------------"). + +versionsnummer zu klein : + cursor (1, cy); + putline ("Netzsoftware erst ab Version 1.7.3 insertierbar !"). + +PROC insert and say (TEXT CONST name of packet): + IF online THEN cl eop (1, cy); + put ("Paket '" + name of packet + "' wird insertiert"); + line (2); + cy INCR 1 + FI; + insert (name of packet); +END PROC insert and say; + +PROC cl eop (INT CONST cx, cy) : + cursor (cx, cy); + out (""4"") +END PROC cl eop; diff --git a/system/net/1.7.5/src/net manager-M b/system/net/1.7.5/src/net manager-M new file mode 100644 index 0000000..0383211 --- /dev/null +++ b/system/net/1.7.5/src/net manager-M @@ -0,0 +1,302 @@ +PACKET net manager DEFINES start,stop,net manager,frei: +TEXT VAR stand := "Netzsoftware vom 02.09.85"; + (*Heinrichs *) + +LET + ack = 0, + nak = 1, + error nak = 2, + zeichen eingang = 4, + list code = 15, + fetch code = 11, + freigabecode = 29, + continue code = 100, + erase code = 14, + report code = 99, + + (* Typen von Kommunikationsstrmen *) + + send wait = 0, + zustellung = 1, + call pingpong = 2, + call im wait = 3, + call im abbruch = 4, + call in zustellung = 5; + +LET STEUER = + STRUCT ( + INT head, + rechner nummern, + strom, + INT sequenz, + seiten nummer, + TASK quelle,ziel, + INT sende code); + +LET INFO = STRUCT (STEUER steuer, INT typ); + +TASK VAR sohn; +INT VAR strom,c. + +vx: v.steuer. + +PROC frei (INT CONST stat,lvl): + DATASPACE VAR ds := nilspace; + BOUND STRUCT (INT x,y) VAR msg := ds; + msg.x := stat; msg.y := lvl; + INT VAR return; + call (/"net port", freigabecode, ds, return) ; + forget (ds) +END PROC frei; + +PROC net manager (DATASPACE VAR ds, INT CONST order, phase, TASK CONST + ordertask): + + IF order = report code + THEN + forget ("report",quiet); + copy (ds,"report"); + forget (ds) + ELSE + IF ordertask < myself + OR order = list code + OR order > continue code + THEN + IF order = list code + THEN + enable stop; + forget (ds); ds := old ("report"); + FILE VAR ff := sequential file (output,ds); + putline (ff,stand); + putline (ff,"Rechner "+text(station(myself))+" um "+time of day); + send (ordertask, ack, ds) + ELSE + free manager (ds,order,phase,order task) + FI + ELSE + errorstop ("nur 'list' ist erlaubt") + FI + FI +END PROC net manager; + +TASK VAR cd,stask; +ROW 255 INT VAR erlaubt; +INT VAR i; +FOR i FROM 1 UPTO 255 REP erlaubt (i) := 0 PER; + +PROC communicate: + enable stop; + INT VAR scode; + DATASPACE VAR dr := nilspace; + neuer start (quit max); +REP + forget (dr); + wait (dr, scode, stask); + cd := collected destination; + IF zeichen da OR zeit abgelaufen + THEN + packet + ELIF cd = myself + THEN + netz info und steuerung + ELSE + neue sendung (stask, cd, scode, dr) + FI +PER. + +zeichen da: scode < 0 . + +zeit abgelaufen: scode = ack AND cd = myself. + +packet: + TEXT VAR t := incharety; + INT VAR snr, ant,err; + TASK VAR quelle, ziel; + snr := 0; + REP + IF t = "" + THEN + zeitueberwachung (snr, quelle, ziel, ant, dr); + ELSE + packet eingang (t, snr, quelle, ziel, ant, dr); + FI; + IF snr > 0 + THEN + IF ant > 5 AND erlaubt(station (quelle)) < 0 + THEN unerlaubt + ELSE + send (quelle,ziel,ant,dr,err); + fehlerbehandlung ; + FI + FI + UNTIL snr = 0 OR zeichen da PER. + +fehlerbehandlung: + IF ok oder ziel nicht da THEN loesche verbindung (snr) FI. + +ok oder ziel nicht da: err=0 OR err=-1. + +netz info und steuerung: + IF scode = list code THEN list status + ELIF scode = erase code THEN strom beenden + ELIF scode = freigabe code AND stask = father THEN freigabelevel + ELSE forget (dr); ablehnen ("nicht mglich") + FI. + +freigabelevel: + BOUND STRUCT (INT stat,lvl) VAR lv := dr; + IF lv.stat > 0 AND lv.stat < 256 THEN erlaubt (lv.stat) := lv.lvl FI; + send (stask,ack,dr). + +unerlaubt: + report ("Fremdzugriff von "+text(station (quelle))+" auf "+nam(ziel) + +" code "+text(ant)); + loesche verbindung (snr). + +strom beenden: + BOUND TEXT VAR stromtext := dr; + INT VAR erase strom := int (stromtext); + forget (dr); + strom := erase strom; + IF falsche stromnummer THEN ablehnen ("Strom gibt es nicht") + ELSE + BOUND INFO VAR v := verbindung (strom); + IF + stask = father OR stask = vx.quelle OR stask = vx.ziel + THEN + loeschen + ELSE ablehnen ("Nur Empfnger/Absender darf lschen") + FI + FI. + +loeschen: + IF sendeeintrag THEN + IF callee (vx.quelle) = vx.ziel THEN absender warnen FI; + loesche verbindung (strom) + ELSE + IF callee (vx.ziel) = vx.quelle THEN warnen FI; + loesche verbindung (strom) + FI; + dr := nilspace; + send (stask,ack,dr). + +absender warnen: + dr := nilspace; + send(vx.ziel,vx.quelle,1,dr,err) . + +warnen: + dr := nilspace; +BOUND TEXT VAR errtxt := dr; errtxt:= "Station antwortet nicht"; +send (vx.quelle,vx.ziel,error nak, dr, err). + +falsche stromnummer: strom < 1 OR strom > max verbindungsnummer. +sendeeintrag: vx.rechnernummern DIV256 = station (myself). +END PROC communicate; + +PROC ablehnen (TEXT CONST t): + DATASPACE VAR vdr := nilspace; + BOUND TEXT VAR errtxt := vdr; + errtxt := t; + send (stask, error nak, vdr). +END PROC ablehnen; + +PROC stop: + disable stop; + end (task ("net port")); + end (task ("net timer")); + clear error; +END PROC stop; + +PROC list status: + + DATASPACE VAR ds := nilspace; + FILE VAR f:=sequential file (output, ds); + FOR strom FROM 1 UPTO max verbindungsnummer REP + BOUND INFO VAR v := verbindung (strom); + IF vx.strom <> 0 THEN info FI + PER; + send (stask, ack, ds). + +info: + put (f,"Strom "+text(strom)+" (sqnr"+text(vx.sequenz)+")"); + IF sendeeintrag THEN sendeinfo ELSE empfangsinfo FI; + line (f). + +sendeeintrag: vx.rechnernummern DIV 256 = station(myself) . + +sendeinfo: + IF v.typ = call im wait THEN put (f,"erwartet Antwort von") + ELIF v.typ = call in zustellung THEN put (f,"Ziel busy. Zielstation:") + ELIF v.typ = call im abbruch THEN put (f,"wird gelscht bei Antwort von") + ELSE put (f,"sendet an") + FI; + put (f,vx.rechnernummernMOD256); + put (f,". Absender ist """+nam (vx.quelle)+"""."). + +empfangsinfo: + IF v.typ = zustellung THEN + put (f,"Sendung noch nicht zustellbar") + ELSE + put (f,"empfngt von"); + put (f,vx.rechnernummernDIV256); + FI; + put (f,". Empfaenger ist """+nam (vx.ziel)+"""."). +END PROC list status; + + +PROC start (INT CONST chan): + c:=chan; + start +END PROC start; +INT VAR quitmax := 3; +PROC start (INT CONST chan,quit): + quitmax := quit; + c:=chan; + start +END PROC start; + +PROC start: +stop; +IF exists ("report") THEN forget ("report") FI; +FILE VAR s := sequential file (output,"report"); +putline (s," N e u e r S t a r t "+time of day); +begin ("net port",PROC net io, sohn); +TASK VAR dummy; +begin ("net timer",PROC timer,dummy); +define collector (sohn) +END PROC start; + +PROC timer: + disable stop; + REP + clear error; + DATASPACE VAR ds := nilspace; + pause (100); + send (sohn, ack, ds) + PER; +END PROC timer; + +PROC net io: + disable stop; + fetch ("report"); + commanddialogue (FALSE); + continue (c); + communicate; + TEXT VAR emsg := "++++++ "+error message +" Zeile "+text(errorline); + clear error; + report (emsg); + save ("report"); + end (myself) +END PROC net io; + +put ("Netzkanalnummer:"); get (c);line; +IF yes ("Ist der Netzkanal mit Flukontrolle verdrahtet") THEN + quit max := 10 +ELSE + quit max := 3 +FI; +END PACKET net manager; + + +start; global manager (PROC (DATASPACE VAR,INT CONST,INT CONST, TASK +CONST) net manager ) diff --git a/system/net/1.7.5/src/net report-M b/system/net/1.7.5/src/net report-M new file mode 100644 index 0000000..3ce67ff --- /dev/null +++ b/system/net/1.7.5/src/net report-M @@ -0,0 +1,29 @@ +PACKET net report DEFINES report: + +LET reportcode = 99; + +PROC report (TEXT CONST x): + report(x,"") +END PROC report; + +PROC report (TEXT CONST txt, info): + IF storage (old("report")) > 20 THEN forget ("report",quiet) FI; + reportfile := sequential file (output, "report"); + put (reportfile, date); + put (reportfile, time of day); + put (reportfile, txt); + INT VAR i; + FOR i FROM 1 UPTO length (info) REP + INT VAR z := code (infoSUBi) ; + IF z < 32 OR z > 126 + THEN put (reportfile,"%"+text(z)) + ELSE put (reportfile,infoSUBi) + FI + PER; + line (reportfile); + DATASPACE VAR net report := old ("report"); + send (father, report code , net report) +END PROC report; +FILE VAR reportfile; + +END PACKET net report; diff --git a/system/net/1.8.7/doc/netzhandbuch b/system/net/1.8.7/doc/netzhandbuch new file mode 100644 index 0000000..7083462 --- /dev/null +++ b/system/net/1.8.7/doc/netzhandbuch @@ -0,0 +1,2045 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#Netzsoftware + + + + +#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# +#pagenr ("%",1)##setcount(1)##block##pageblock##count per page# +#headeven# +#center#EUMEL Netzbeschreibung +#center#____________________________________________________________ + +#end# +#headodd# +#center#Inhalt +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +Netz - % #right# GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#Netz - % +#end# + +#center#Inhalt + +#clear pos##lpos(1.0)##rpos(9.5)# +#table# + +1. Einleitung #topage("0")# + +Teil 1: Netz einrichten und benutzen #topage("1")# + + +1.1. Hardwarevoraussetzungen #topage("1.1")# +1.2. Einrichten des Netzes #topage("1.2")# +1.3. Benutzung des Netzes #topage("1.3")# +1.4. Informationsmöglichkeiten #topage("1.4")# +1.5. Eingriffsmöglichkeiten #topage("1.5")# +1.6. Fehlerbehebung im Netz #topage("1.6")# +1.7. Sicherheit im Netz #topage("1.7")# + + + +Teil 2: Arbeitsweise der Netzsoftware #topage("2")# + + +2.1. Die Netztask #topage("2.1")# +2.2. Protokollebenen #topage("2.2")# +2.3. Stand der Netzsoftware #topage("2.3")# + + + +Teil 3: Netz-Hardware-Interface #topage("3")# + + +3.1. Einführung #topage("3.1")# +3.2. Arbeitsweise des Netz-Hardware-Interfaces #topage("3.2")# +3.3. Netztreiber #topage("3.3")# +3.4. Prozedurschnittstelle des EUMEL-Netzes #topage("3.4")# + + + +Anhang #topage("A")# + + +1. Fehlermeldungen #topage("A.1")# +2. Literaturhinweise #topage("A.2")# +3. Index #topage("A.3")# + +#table end# +#clear pos# + +#page# +#pagenr ("%", 2)##setcount (1)##block##pageblock##count per page# +#headeven# +#center#EUMEL Netzbeschreibung +#center#____________________________________________________________ + +#end# +#headodd# +#center#Einleitung +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +Netz - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#Netz - % +#end# + +1. Einleitung + +#goalpage("0")# +Das EUMEL-Netz dient dazu, mehrere EUMEL-Rechner (sog. #ib#Station#ie#en) miteinan­ +der zu koppeln. Diese Kopplung wird vom Betriebssystem dazu benutzt, das Sen­ +dungskonzept [1] so auszudehnen, daß Tasks verschiedener Stationen einander +Datenräume zusenden können. Auf dem #ib#Sendungskonzept#ie# aufbauende Konzepte +nutzen daher automatisch das Netz aus: So ist es z.B. möglich + +- von einer Station aus auf einer anderen zu drucken, + +- in die Task PUBLIC einer anderen Station #ib#Datei#ie#en zu sichern (save), vorausge­ + setzt, daß PUBLIC dort ein #on("b")#free global manager#off("b")# ist, + +- auf einer anderen Station zu archivieren (z.B. wenn das eigene Archivlaufwerk + defekt ist oder ein anderes Format hat). + +Diese #ib#Netzversion#ie# kann ab EUMEL-Version 1.8.1 eingesetzt werden. + +Diese Netzbeschreibung besteht aus drei Teilen. In Teil 1 wird beschrieben, wie das +EUMEL-Netz benutzt und eingerichtet wird. Als Benutzer eines EUMEL- +Rechners, der vernetzt ist, ist nur dieser Teil der Netzbeschreibung für Sie wichtig. +Teil 2 erklärt die Funktionsweise der #ib#Netzsoftware#ie#, im dritten Teil wird die Schnitt­ +stelle für die Anpassung anderer #ib#Netzhardware#ie# definiert. + +Hinweis: + +Zur erstmaligen #ib#Installation#ie# des EUMEL-Netzes ist außer dieser Beschreibung noch +die Netzsoftware (auf Floppy) und die EUMEL-Netz-#ib#Installationsanleitung#ie#, die mit +der Software geliefert wird, notwendig. + +In der vorliegenden Netzbeschreibung wird das EUMEL-Netz möglichst "hardware +unabhängig" beschrieben. Wenn hardwareabhängige Beispiele gegeben werden, so +ist die dort beschriebene Hardware stets die #ib#Datenbox#ie#. +#pagenr ("%", 3)##setcount (1)##block##pageblock##count per page# +#headeven# +#center#EUMEL Netzbeschreibung +#cneter#____________________________________________________________ + +#end# +#headodd# +#center#Teil 1 : Netz einrichten und benutzen +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +Netz - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#Netz - % +#end# +#page# + +Teil 1: Netz einrichten und benutzen +#goalpage("1")# + + + +1.1. Hardwarevoraussetzungen +#goalpage("1.1")# + + +Zwei Stationen + +Sie können zwei #ib#Station#ie# miteinander vernetzen, wenn Sie dafür an jeder Station eine +#ib#V.24#ie#-#ib#Schnittstelle#ie# zur Verfügung stellen. + +Diese beiden Schnittstellen verbinden Sie mit einem Kabel zur #ib#Rechnerkopplung#ie# [2]. + + +Mehrere Stationen + +Wenn Sie mehr als zwei Stationen vernetzen wollen, stehen Ihnen zwei Konzepte zur +Verfügung: das Anlegen von #ib#Netzknoten#ie# bzw. das Verwenden eines #ib#Strang#ie#es. Die +Konzepte können gemischt eingesetzt werden. + +Ein Strang besteht aus einer Anzahl von #ib#Netzbox#ie#en (z.B. KHW-Box oder Ethernet­ +anschluß). + +Jede Box besitzt eine #ib#Schnittstelle#ie# (z.B. #ib#V.24#ie#) zum Anschluß an einen der Kanäle +1...15 der zugeordneten #ib#Station#ie# und eine weitere Schnittstelle zur #ib#Verbindung#ie# der +Boxen untereinander. + +Ein #ib#Knoten#ie# ist eine Station, bei der der Netzbetrieb über mehrere Kanäle läuft. + +Da die #ib#Netzsoftware#ie# pro #ib#Kanal#ie# eines Knotens eine Task generiert, ist das Knoten­ +konzept dem Strangkonzept hinsichtlich des #ib#Durchsatz#ie#es unterlegen. Preisgünstiger +ist jedoch das #ib#Knotenkonzept#ie#, weil dabei #ib#Netzbox#ie#en überflüssig werden. + +Beim Knotenkonzept wird eine #ib#Vermaschung#ie# nicht zur Optimierung benutzt (Ver­ +maschung heißt, daß eine #ib#Zielstation#ie# über verschiedene Knoten erreichbar ist). Daher +sollte man keine Vermaschung vorsehen. + +#ib#Nachbarn#ie# sind Stationen, die an denselben #ib#Netzstrang#ie# angeschlossen oder direkt +über ein #ib#V.24#ie#-Kabel verbunden sind. + +Bei der Entscheidung, welche Stationen man zu #ib#Knoten#ie# macht, sollte beachtet wer­ +den, daß (a) Stationen, zwischen denen hoher Verkehr besteht, Nachbarn werden und +daß (b) besonders leistungsfähige Rechner #ib#Knoten#ie#stationen sein sollten. +#page# + +1.2. Einrichten des Netzes +#goalpage("1.2")# + + +Hinweis: Dieses Kapitel ist nur für Systembetreuer wichtig. + +a) Legen Sie für die am Netz beteiligten Rechner #ib#Stationsnummer#ie#n fest (von 1 an + aufsteigend). + + Die Boxen haben ebenfalls Stationsnummern. Die Stationsnummern der Box und + des zugeordneten Rechners müssen übereinstimmen. + + +b) Holen Sie an jeder #ib#Station#ie# die Task #on("bold")#configurator#off("bold")# an ein Terminal und geben Sie + das Kommando #on("bold")##ib#define station#ie# (x)#off("bold")#, wobei #on("bold")#x#off("bold")# die gewählte Stationsnummer ist. + + Hinweis: Taskkommunikationen, die zu diesem Zeitpunkt laufen, führen zu feh­ + lerhaftem Verhalten. Dies liegt daran, daß durch #on("bold")#define station#off("bold")# alle + #ib#Task-Id#ie#'s geändert werden müssen, weil eine #ib#Task-Id#ie# u.a. die + Stationsnummer der eigenen Station enthält (siehe 1.3). TASK- + Variablen, die noch Task-Id's mit keiner oder falscher Stationsnum­ + mer enthalten, können nicht mehr zum Ansprechen einer Task ver­ + wendet werden. + + Beispiel: Der #ib#Spoolmanager#ie# [3] richtet beim Kommando #on("bold")#start#off("bold")# einen #ib#Worker#ie# ein + und merkt sich dessen #ib#Task-Id#ie# in einer TASK-Variablen, um sicher­ + zustellen, daß nur der Worker #ib#Datei#ie#en zum Drucken abholt. Wird jetzt + das Kommando #on("bold")# define station#off("bold")# gegeben, kann der Spoolmanager + seinen Worker nicht mehr identifizieren, weil der Worker eine neue + Task-Id erhalten hat. Man muß daher vor #on("b")#define station#off("b")# den Worker + löschen und ihn danach mit dem Kommando #on("bold")##ib#start#ie##off("bold")# im Spoolmanager + wieder neu einrichten. + + + Sinnvollerweise gibt man #on("bold")#define station#off("bold")# sofort nachdem man ein frisches System + vom Archiv geladen hat. + + Zum Anschluß einer #ib#Datenbox#ie# #ib#konfigurieren#ie# Sie mit dem Kommando #on("bold")##ib#configurate#ie##off("bold")# + den für das Netz vorgesehenen #ib#Kanal#ie# auf + + - transparent + - 9600 #ib#Baud#ie# (Standardeinstellung der Boxen) + - #ib#RTS/CTS#ie#-#ib#Protokoll#ie# + - großen Puffer + - 8 bit + - even parity + - 1 stopbit. + + Falls diese Einstellungen nicht alle angeboten werden, klären Sie mit Ihrem + Rechnerlieferanten, ob und wie diese Einstellungen erreicht werden können. + + Hinweis: Notfalls kann auf das #ib#RTS/CTS#ie#-Protokoll verzichtet werden, wenn der + Eingabepuffer der #ib#Station#ie# groß genug ist. Die Anzahl simultan laufen­ + der Netzkommunikationen ist dann auf + + puffergröße DIV 150 + + begrenzt (bei Z80, 8086: 3; bei M20: 10). + + Hinweis: Es können auch andere #ib#Baud#ie#raten (2400, 4800, 19200) an der Box + eingestellt werden. + + +c) Achten Sie bei der #ib#Verbindung#ie# von der Station zur #ib#Netzbox#ie# (bzw. zur Gegen­ + station bei einem Zweistationennetz ohne Boxen) darauf, daß neben den Emp­ + fangs- und Sendeleitungen auch die Leitungen RTS und CTS verdrahtet wer­ + den, also ein 5-poliges Kabel verwendet wird [2]. Die #ib#Pin-Belegung#ie# der Boxen + entspricht der eines Kabels zur Rechner-Rechner-Kopplung. + + Beispiel: + + Verbindung eines BICOS-Systems mit der Box: + + Stecker Stecker + Pin Pin + + 2 <---------> 3 + 3 <---------> 2 + 4 <---------> 5 + 5 <---------> 4 + 7 <---------> 7 + + +d) Richten Sie eine Task #on("bold")##ib#net#ie##off("bold")# unter #on("bold")#SYSUR#off("bold")# ein und legen Sie eine #ib#Datei#ie# #on("b")##ib#netz#ie##off("b")# an, die + Ihre #ib#Netzkonfiguration#ie# enthält, oder ändern Sie die mitgelieferte Datei ent­ + sprechend ab (siehe auch 1.5.).#goalpage("sperre")# + + + Dem bisherigen Netz entspricht eine Datei #on("b")#netz#off("b")# mit folgendem Inhalt: + + definiere netz; + routen (1,127,k); + starte kanal (k,1,x); + aktiviere netz. + + k: ihr netzkanal. + x: IF yes ("#ib#Flußkontrolle#ie#") THEN 10 ELSE 3 FI. + + + + Laden Sie die Datei #on("b")##ib#net install#ie##off("b")# vom Archiv #on("b")#net#off("b")# und übersetzen Sie diese. Je nach­ + dem, welche EUMEL-Version auf der Maschine installiert ist, werden die notwen­ + digen Programmdateien insertiert. + + Es sind dies + + net report + net hardware interface + basic net + net manager + + + Das Netz wird dabei gestartet. + + + Hinweis: Obwohl die Task #on("b")#net#off("b")# sich noch mit #on("bold")##ib#continue#ie##off ("bold")# an ein Terminal holen + läßt, sollte man dies nur kurzzeitig tun, da der Netzverkehr solange + blockiert ist. + + In der #ib#Datei#ie# #on("b")#netz#off("b")# sollte der #ib#Kanal#ie#, über den der meiste Verkehr erwar­ + tet wird, zuerst gestartet werden. Für ihn wird die Task #on("b")##ib#net port#ie##off("b")# gene­ + riert, für jeden weiteren Kanal wird eine Task #on("b")##ib#net port#ie# k#off("b")# (k=Kanal­ + nummer) generiert. +#page# + +1.3. Benutzung des Netzes +#goalpage("1.3")# + + +Zur Benutzung des Netzes stehen folgende Operatoren und Prozeduren zur Verfü­ +gung: + + + +TASK OP #ib#/#ie# (INT CONST station, TEXT CONST taskname) + +liefert die Task #on("bold")#taskname#off("bold")# von der #ib#Station#ie# #on("bold")#station#off("bold")#. + + +#ib#Fehlerfälle#ie#: + + - #ib(4)#Task "...." gibt es nicht#ie(4)# + + Die angeforderte Task gibt es auf der #ib#Zielstation#ie# nicht. + + - #ib(4)##ib#Collectortask#ie# fehlt#ie(4)# + + die Task #on("b")##ib#net port#ie##off("b")# existiert nicht (siehe 6). + + Hinweis: #on("b")#net port#off("b")# wird bei jedem Start des Netzes neu generiert und beim + Auftreten eines nicht vorhergesehenen #ib#Fehler#ie#s beendet. Die Feh­ + lermeldung steht im #on("b")##ib#report#ie##off("b")# (siehe 4). + + - #ib(4)#Station x antwortet nicht#ie(4)# + + Eine nicht vorhandene oder abgeschaltete Station wurde angesprochen. + + Hinweis: Dieser #ib#Fehler#ie# wird angenommen, wenn eine Überwachungszeit von + ca. 30 Sekunden verstrichen ist, ohne daß Station x die Taskidenti­ + fikation angeliefert hat. + + - #ib(4)#Station x gibt es nicht#ie(4)# + + #ib#Station#ie# x steht nicht in den #ib#Routentabelle#ie#n. + + Diese Meldung kann auch erscheinen, wenn Station x erst kürzlich an das Netz + angeschlossen wurde. Sie steht dann noch nicht in den Routentabellen (siehe + auch 5.3.). + + Beispiel: + + list (5/"PUBLIC") + + Die Dateiliste von PUBLIC der Station 5 wird angefordert. + + + +TASK OP #ib#/#ie# (INT CONST station, TASK CONST task) + +liefert + +station / name (task) + +Beispiel: + + list (4/public) + + +Fehlerfall: + + "......" #ib(4)#gibt es nicht#ie(4)# + + Auf der eigenen Station gibt es die Task #on("b")#task#off("b")# nicht. + Der Taskname wird auf der eigenen Station bestimmt, wenn es dort die Task + nicht gibt, führt dies zur obigen Fehlermeldung. + +Abhilfe: + + Statt list(4/public) das Kommando list (4/"PUBLIC") verwenden. + + + +INT PROC #ib#station#ie# (TASK CONST task) + +liefert die #ib#Stationsnummer#ie# der Task #on("bold")#task#off("bold")#. + +Beispiel: + + put (station (myself)) + + gibt die eigene Stationsnummer aus. + + + + +PROC #ib#reserve#ie# (TEXT CONST archivename, TASK CONST archivetask) + +dient dazu, das Archiv auf der #ib#Station#ie# #on("bold")#station#off("bold")# anzumelden. + +Beispiel: + + reserve ("std", 4/"ARCHIVE"); #ib#list#ie# (4/"ARCHIVE") + + gibt das Inhaltsverzeichnis der Archivfloppy im Laufwerk der Station 4 aus. + + Hinweis: Vergessen Sie bei solchen #ib#Querarchivierungen#ie# nicht die Stationsangabe + bei jedem einzelnen Archivkommando (z.B fetch ("xxx", #on("bold")#4/#off("bold")# + "ARCHIVE")). + + Hinweis: Querarchivieren ist langsam. Verwenden Sie es nur, wenn Sie Floppy­ + formate umsetzen wollen. + + + + +PROC #ib#free global manager#ie# + +dient dazu, die eigene Task über das Netz ansprechbar zu machen. Jede andere +Task im Netz kann dann die üblichen #ib#Manager#ie#aufrufe (#on("bold")##ib#save#ie##off ("bold")#, #on("bold")##ib#fetch#ie##off ("bold")#, usw.) an die +eigene Task machen, sofern diese nicht an ein Terminal gekoppelt ist. + +Die Task wird (wie bei #on("bold")#break#off ("bold")#) abgekoppelt und meldet sich in Zukunft mit #on("bold")#mainte­ +nance#off ("bold")# statt mit #on("bold")#gib kommando#off ("bold")#. + +Beispiel: + + An Station 4 ruft man in der Task "hugo" das Kommando #on("bold")#free global manager#off("bold")# + auf. Anschließend kann man von jeder Station aus z.B. #on("bold")#list (4/"hugo")#off ("bold")# usw. auf­ + rufen. + + + + +TEXT PROC #ib#name#ie# (TASK CONST t) + +Diese (schon immer vorhandene) Prozedur wurde dahingehend erweitert, daß der +Name einer auf einer anderen Station existierenden Task über Netz angefordert wird. + +Existiert die Task nicht, so wird #on("bold")##ib#niltext#ie##off ("bold")# geliefert. + +Hinweis: Die Prozedur #on("bold")##ib#exists#ie##off ("bold")# wurde nicht auf das Netz ausgedehnt, da sie in Situa­ + tionen eingesetzt wird, wo es auf eine sehr schnelle Antwort ankommt. + Daher liefert #on("bold")#exists#off ("bold")# für eine stationsfremde Task immer FALSE. Will man + wissen, ob eine solche Task existiert, verwende man die Abfrage + + #on("bold")#IF name (task) <> "" THEN ... #off ("bold")#. + +#ib#Fehlerfall#ie#: + + - #ib(4)#Station x antwortet nicht#ie(4)# + + - #ib(4)##ib#Station#ie# x gibt es nicht#ie(4)# + +#page# + +1.4. Informationsmöglichkeiten + +#goalpage("1.4")# + +In der Task #on("bold")#net#off("bold")# wird eine #ib#Datei#ie# #on("bold")##ib#report#ie##off("bold")# geführt, in der #ib#Fehlersituationen#ie# des Netzes +verzeichnet werden. Diese Datei kann in jeder anderen Task auf derselben Station mit +#on("bold")##ib#list#ie# (/"#ib#net#ie#")#off("bold")# angesehen werden. Eine Erklärung der wichtigsten Meldungen finden Sie +im Anhang. + +In jeder Task kann durch das Kommando #on("bold")##ib#list#ie# (/"#ib#net port#ie#")#off("bold")# eine Übersicht über die +momentan laufenden #ib#Netzübertragungen#ie# der eigenen #ib#Station#ie# erhalten werden (nur für +den #ib#Kanal#ie#, an dem #on("b")##ib#net port#ie##off("b")# hängt). Entsprechendes gilt für die weiteren Netports der +eigenen Station. + +Mit #on("bold")##ib#list#ie# (/"#ib#net list")#ie##off("bold")# erhält man die Informationen, die man mit #on("b")#list (/"net")#off("b")# und #on("b")##ib#list#ie##off("b")# auf +alle Netports bekommt, sofern #on("b")##ib#listoption#ie##off("b")# (siehe S. #topage("listop")#) beim Generieren des Netzes +aufgerufen wurde. Dieser Aufruf funktioniert auch bei fremden Stationen (z.B. #on("b")#list +(5/"net list")#off("b")#). + +#page# + +1.5. Eingriffsmöglichkeiten + +#goalpage("1.5")# + +- Jede Task kann #ib#Sende#ie(1,"ströme")#- und #ib#Empfangsströme#ie#, die bei #on("bold")#list (/"net port")#off("bold")# gemel­ + det worden sind und die eigene Task betreffen, abbrechen. Hierzu ist das Kom­ + mando #on("bold")##ib#erase#ie# ("x", /"#ib#net port#ie#")#off ("bold")# zu geben, wobei x die #ib#Stromnummer#ie# (aus dem #on("bold")#list#off ("bold")#) + ist. + Unberechtigte #ib#Löschversuche#ie# werden abgewiesen. + Von privilegierten Tasks aus können jedoch mit #on("b")##ib#erase#ie##off("b")# beliebige Ströme abge­ + brochen werden. + + +- Durch das Kommando #on("bold")##ib#start#ie##off("bold")# kann von der Task #on("b")##ib#net#ie##off("b")# aus das Netz neu gestartet + werden. Dies setzt eine gültige #ib#Datei#ie# #on("bold")#netz#off("bold")# voraus. Es wird ein #on("bold")##ib#run#ie##off("bold")# auf diese Datei + gegeben. Das Kommando #on("b")##ib#start#ie##off("b")# ist nur noch aus Kompatibilitätsgründen zum alten + Netz vorhanden. + + +- Durch das Kommando #on("bold")##ib#routen aufbauen#ie##off("bold")# in der Task #on("b")##ib#net#ie##off("b")# werden die #ib#Routentabelle#ie#n + neu aufgebaut. Dies kann notwendig werden, wenn eine neue #ib#Station#ie# ans Netz + angeschlossen wurde (#ib#Fehlermeldung#ie# '#ib(4)#Station x gibt es nicht#ie(4)#'). #on("bold")#routen aufbauen#off ("bold")# + muß zuvor auch an allen dazwischenliegenden #ib#Knotenstation#ie#en gegeben werden. + + #on("bold")#routen aufbauen#off ("bold")# erzeugt eine Task #on("b")##ib#router#ie##off("b")#, die sich an das Terminal koppelt (die + Task #on("b")#net#off("b")# koppelt sich ab) und ein #ib#Protokoll#ie# ausgibt. Sind die #ib#Route#ie#n aufgebaut, + beendet sich die Task #on("b")#router#off("b")# mit der Meldung #on("b")#fertig#off("b")#. Es werden nur Stationen + bearbeitet, die nicht #ib#gesperrt#ie# (siehe S. #topage("sperre")#), und für die keine festen Routen + vereinbart sind. Der Vorgang dauert ca. 5 Sek. pro nicht gesperrter Station und + #ib#Netzkanal#ie#. Die #ib#Route#ie#n werden in einem #ib#Datenraum#ie# #on("b")##ib#port intern#ie##off("b")# hinterlegt. + + +- Der Aufruf #on("bold")##ib#definiere netz#ie##off("bold")# leitet eine #ib#Netzdefinition#ie# in der #ib#Datei#ie# #on("bold")##ib#netz#ie##off("bold")# ein. Dabei + werden alle augenblicklichen Netzkommunikationen gelöscht. Die Tasks #on("b")##ib#net port#ie# + (k)#off("b")#, wobei #on("b")#k#off("b")# die #ib#Kanalnummer#ie# ist, und #on("b")##ib#net timer#ie##off("b")# werden gelöscht. + + Dieser Aufruf muß vor den Aufrufen von #on("bold")##ib#starte kanal#ie#, #ib#erlaube#ie#, #ib#sperre#ie#, #ib#routen#ie#, + #ib#aktiviere netz#ie# und #ib#list option#ie##off("bold")# erfolgen. + + +- PROC #ib#sperre#ie# (INT CONST a,z) + bewirkt, daß die Stationen #on("bold")#a#off("bold")# bis #on("bold")#z#off("bold")# keine Manageraufrufe an Tasks dieser Station + geben dürfen (Genauer gesagt werden sendecodes > 6 nicht weitergeleitet, son­ + dern ein errornak mit dem Text "#ib(4)#kein Zugriff auf Station#ie(4)#" zurückgeschickt). + + Dieser Aufruf muß vor dem ersten #on("bold")##ib#starte kanal#ie##off("bold")# erfolgen. + + +- PROC #ib#erlaube#ie# (INT CONST a,z) + bewirkt, daß die Stationen #on("bold")#a#off("bold")# bis #on("bold")#z#off("bold")# Manageraufrufe an Tasks dieser Station geben + dürfen. + + Dieser Aufruf muß vor dem ersten #on("bold")##ib#starte kanal#ie##off("bold")# erfolgen. + + Beispiel: Alle Stationen außer 8 und 10 sollen #ib#gesperrt#ie# sein: + + #ib#sperre#ie# (1,127); erlaube (8,8); erlaube (10,10) + + Hinweis: 127 ist z.Zt. die maximale #ib#Stationsnummer#ie(1," maximale")#. + + +- PROC #ib#routen#ie# (INT CONST a,z,k) + legt fest, daß die Stationen #on("bold")#a#off("bold")# bis #on("bold")#z#off("bold")# an #ib#Kanal#ie# #on("bold")#k#off("bold")# direkt angeschlossen sind. Sen­ + dungen dieser Stationen werden nur bearbeitet, wenn sie über diesen Kanal her­ + einkommen (siehe 1.7.). Fehlt für eine Station ein entsprechender Routenaufruf, so + darf sie über einen beliebigen #ib#Netzkanal#ie# angeschlossen sein. Dies wird dann von + #on("bold")##ib#routen aufbauen#ie##off("bold")# ermittelt. + + PROC routen (INT CONST a,z,k,zw) + legt fest, daß die Stationen #on("bold")#a#off("bold")# bis #on("bold")#z#off("bold")# indirekt über die #ib#Knotenstation#ie# #on("bold")#zw#off("bold")# angeschlos­ + sen sind, und #on("b")#zw#off("b")# am Kanal #on("bold")#k#off("bold")# hängt. + + +- PROC #ib#starte kanal#ie# (INT CONST k,m,q) + startet eine #ib#Netztask#ie# am #ib#Kanal#ie# #on("bold")#k#off("bold")# im Modus #on("bold")#m#off("bold")# [4]. Dabei wird mit #on("bold")#q#off("bold")# die Anzahl + paralleler #ib#Empfangsströme#ie# festgelegt. Dadurch kann erreicht werden, daß der + #ib#Empfangspuffer#ie# nicht überläuft, indem nicht mehr als #on("b")#q#off("b")# Ströme quittiert werden. + Bei #ib#V.24#ie#-#ib#Schnittstelle#ie#n gebe man 3 (ohne #ib#Flußkontrolle#ie#) bzw. 10 (mit Flußkon­ + trolle) an. + + +- PROC #ib#aktiviere netz#ie# + muß als Abschluß in der Datei #on("bold")##ib#netz#ie##off("bold")# aufgerufen werden. Dabei wird die Task vom + Terminal abgekoppelt. Falls es bei #on("bold")##ib#definere netz#ie##off("bold")# den #ib#Datenraum#ie# #on("b")##ib#port intern#ie##off("b")#, der + die #ib#Route#ie#n enthält, nicht gab, wird #on("bold")##ib#routen aufbauen#ie##off("bold")# aufgerufen. + + +- PROC #ib#listoption#ie##goalpage("listop")# + erzeugt eine Task #on("b")##ib#net list#ie##off("b")#, die bei #on("bold")#list#off("bold")# den #ib#Fehlermeldung#ie#sreport und den Zustand + aller Netports liefert. Diese Task ist auch über Netz ansprechbar. In der Regel + sollte man #on("b")#listoption#off("b")# in der Datei #on("b")#netz#off("b")# aufrufen, es sei denn, das System ist sehr + klein. + +#page# + +1.6. #ib#Fehlersuche#ie# im Netz + +#goalpage("1.6")# + +#ib#Fehler#ie# im Netz können sich verschiedenartig auswirken. Im folgenden wird auf einige +Beispiele eingegangen: + +Beispiel: + + Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung '#ib(4)#Station#ie(4, " x antwortet nicht")# 4 antwortet nicht'. + + +#ib#Fehler#ie#möglichkeiten: + + - #ib#Station#ie# 4 ist nicht eingeschaltet. + Abhilfe: Station 4 einschalten. Kommando erneut geben. + + + - #ib#Netztask#ie# an Station 4 ist nicht arbeitsfähig. + Abhilfe: Kommando #on("bold")##ib#start#ie##off ("bold")# in der Task "net" auf Station 4. + + + - Stationsnummern und Boxnummern stimmen nicht überein. + Abhilfe: Mit #on("bold")#define station#off ("bold")# #ib#Stationsnummer#ie#n korrigieren (siehe 3.2). + + + - #ib#Verbindung#ie# Rechner/Box am eigenen Rechner oder an Station 4 fehlt. + Abhilfe: Verbindungen überprüfen. Durch Ansprechen einer dritten Station + kann oft schnell geklärt werden, welche Rechner/Box-Verbindung + defekt sein muß. + + + - Verbindung der Boxen untereinander defekt. + Abhilfe: Fehlende Verbindung, #ib#Masseschluß#ie# und #ib#Dreher#ie# (keine 1:1 Verbin­ + dung) überprüfen und beheben. + + Hinweis: Liegt z.B. ein Masseschluß vor, so kann es durchaus sein, daß + Boxen, die nicht in der Nähe des Masseschlusses stehen, noch + miteinander arbeiten können. Man kann aus der Tatsache, daß zwei + Boxen miteinander arbeiten können, also nicht schließen, daß man + nicht nach diesem Fehler suchen muß. + + + +Beispiel: + + Auf #on("bold")#list (4/public)#off("bold")# erfolgt keine Reaktion. + + + - Station 4 ist während dieser Sendung zusammengebrochen. + Abhilfe: Station 4 wieder starten. Die Bearbeitung des #on("bold")##ib#list#ie##off ("bold")#-Kommandos wird + automatisch wieder aufgenommen. + + + - PUBLIC auf Station 4 ist nicht im Managerzustand. + Abhilfe: PUBLIC in den Managerzustand versetzen. + + + - #ib#Fehler#ie# in der #ib#Netzhardware#ie#. + Überprüfen Sie, ob + + - die Boxen eingeschaltet sind, + - die Bereitlampe blinkt (wenn nicht: #ib#RESET#ie# an der Box), + - die #ib#V.24#ie#-Kabel richtig stecken, + - die Boxen untereinander verbunden sind (1 zu 1 Verbindungen der 5 poli­ + gen Diodenbuchsen). + + + - Fehler bei der #ib#Netzinstallation#ie#. + Überprüfen Sie, ob + + - alle Stationen an einem #ib#Strang#ie# gleiche oder kompatible Netzmodi einge­ + stellt haben [4], + - alle Stationen an einem #ib#Netzstrang#ie# auf die gleiche #ib#Nutzdatenlänge#ie# einge­ + stellt sind, + - bei der #ib#Kommunikation#ie# über #ib#Knoten#ie# alle Stationen die gleiche Nutzdaten­ + länge bei indirekten Sendungen eingestellt haben, + - die #ib#Route#ie#n auf allen beteiligten Stationen korrekt eingestellt sind. + + + +Beispiel: + + Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung '#ib(4)##ib#Collectortask#ie# fehlt#ie(4)#'. + + - Das Kommando #on("b")##ib#start#ie##off("b")# (bzw #on("b")##ib#aktiviere netz#ie##off("b")# in der #ib#Datei#ie# #on("b")#netz#off("b")#) wurde nicht gege­ + ben. Somit existiert #on("b")##ib#net port#ie##off("b")# nicht. + Abhilfe: Kommando #on("bold")#start#off ("bold")# in der Task #on("b")#net#off("b")# geben. + + + - Die #ib#Netzsoftware#ie# ist auf einen nicht vorhergesehenen #ib#Fehler#ie# gelaufen. Dieser + wird im #ib#Report#ie# vermerkt. #on("b")##ib#net port#ie##off("b")# wird dabei gelöscht. + Abhilfe: Geben Sie in der Task #on("bold")#net#off("bold")# das Kommando #on("bold")#start#off("bold")#. Dadurch wird die + Netzsoftware neu gestartet. Alle Netzkommunikationen dieser Station + gehen verloren. + + + +Beispiel: + + Nach #on("bold")##ib#fetch#ie# ("hugo",4/public)#off("bold")# sind Teile der Datei "hugo" verfälscht. + + - Die #ib#V.24#ie#-#ib#Verbindung#ie# zur Box ist nicht in Ordnung. + Abhilfe: Abstand zwischen Rechner und Box verkürzen; #ib#Baud#ie#rate ernie­ + drigen; durch Wechseln der #ib#V.24#ie#-#ib#Schnittstelle#ie# feststellen, ob diese + defekt ist. + Hinweis: Die Verbindung zwischen den Boxen ist durch #ib#Prüfsummen#ie# abge­ + sichert (Hardware). + +#page# + +1.7. Sicherheit im Netz + +#goalpage("1.7")# + +Bei Benutzung eines Rechnernetzes tauchen neue #ib#Sicherheitsprobleme#ie# auf. Um sie +verstehen und eingrenzen zu können, muß man sich mit dem #ib#Sicherheitskonzept#ie# des +Betriebssystems EUMEL vertraut machen: + +Eine Task im EUMEL kann nur manipuliert werden, wenn man sie entweder an ein +Terminal koppelt oder ihr Sendungen zustellt. + +Das Ankoppeln kann über #ib#Paßwort#ie# abgesichert werden. Nach dem Ankoppeln kann +die Task außerdem selbst bestimmen, wie sie die dann möglichen Eingaben behan­ +delt. So kann z.B. noch ein komplizierter Paßalgorithmus zu durchlaufen sein, bis +man auf einer offenen Programmierumgebung landet. + +Sendungen können eine Task auch nur mit ihrem Einverständnis beeinflussen, da +eine Sendung nur zugestellt wird, wenn die Task in der Prozedur #on("b")##ib#wait#ie##off("b")# steht. Insbe­ +sondere kann die Task den Absender einer Sendung überprüfen und gewisse Opera­ +tionen nur bei gewissen Absendern zulassen. So lehnt ein #on("b")##ib#global manager#ie##off("b")# z.B. alle +Dateimanagerkommandos ab, die nicht von Nachkommen (z.B. Söhnen) der Task +kommt. #on("b")##ib#free global manager#ie##off("b")# hingegen läßt Operationen wie #on("b")##ib#save#ie##off("b")# oder #on("b")##ib#erase#ie##off("b")# von +beliebigen Tasks, auch von fremden #ib#Station#ie#en, zu. Will man nur bestimmte Fremd­ +stationen zulassen, kann man z.B. folgendes Schema verwenden: + + PROC my #ib#manager#ie# + (DATASPACE VAR ds, INT CONST code, phase, TASK CONST source): + + IF station (source) = station (myself) OR station (source) = 10 + THEN + free manager (ds, code, phase, source) + ELSE + errorstop ("kein Zugriff") + FI + + END PROC my manager; + + global manager (PROC my manager) +#page# +Hier werden nur #on("b")#save#off("b")# usw. von Tasks der eigenen Station und der Station 10 zuge­ +lassen. Der Rest erhält die #ib#Fehlermeldung#ie# "kein Zugriff". + +Dieses Verfahren gewährt nur dann Sicherheit, wenn es nicht möglich ist, daß eine +beliebige Station sich als Station 10 ausgibt. + +Damit das Netz diese Sicherheit garantieren kann, müssen natürlich gewisse phy­ +sische Voraussetzungen erfüllt sein. Wenn z.B. die Station 10 über eine #ib#V.24#ie# ange­ +schlossen ist, aber jeder die Möglichkeit hat, an diese #ib#Schnittstelle#ie# seinen eigenen +Rechner anzuschliessen, dann kann das Netz natürlich nicht erkennen, ob es mit der +echten Station 10 verkehrt. + +Es muß also sichergestellt sein, daß an Kanälen für das Netz nicht manipuliert werden +kann. Bei einem #ib#Strang#ie# (Anschluß über #ib#Netzbox#ie#en) heißt das für die Boxen, daß sie +nur #ib#Telegramm#ie#e weitervermitteln, die die eingestellte #ib#Quellstationsnummer#ie# enthalten. +Sonst könnte jemand, der an denselben Strang wie #ib#Station#ie# 10 angeschlossen ist, +#ib#Telegramm#ie#e erzeugen, die so aussehen, als kämen sie von 10. + +Die #ib#Netzsoftware#ie# ihrerseits darf nur Telegramme auswerten, die über die richtige +#ib#Route#ie# (#ib#Kanal#ie# und #ib#Knotenstation#ie#) einlaufen. + +Leider hat dies die unangenehme Konsequenz, daß man automatisches Aufbauen und +Ändern von Routen verbieten muß, wodurch die Wartung der #ib#Netzkonfiguration#ie# +erschwert wird. + +Diese Version der #ib#Netzsoftware#ie# bietet den folgenden Kompromiß an: Nur für sicher­ +heitsrelevante #ib#Stationen#ie(1,", sicherheitsrelevante")# (im Beispiel Station 10) muß in der #ib#Datei#ie# #on("b")##ib#netz#ie##off("b")# die Route +angegeben werden. Dies muß in allen Stationen geschehen, für die die Station +sicherheitsrelevant ist, und in allen #ib#Knoten#ie# dazwischen. + +Für nicht sicherheitsrelevante Stationen werden #ib#Routeninformationen#ie# automatisch +aufgebaut und geändert. + +Hinweis: +Man wird oft ohne sicherheitsrelevante Stationen auskommen, indem man auf Ebenen +oberhalb der Netzebene Paßwortkontrollen einführt. So ist es z.B. ja möglich, Dateien +durch Paßworte zu schützen. Ein weiteres Beispiel ist ein #ib#Printerserver#ie#, der nur +ausdruckt, wenn eine mitgegebene Abrechnungskennung stimmt. Dabei ist es sogar +wünschenswert, daß die #ib#Station#ie# irrelevant ist, die den Druckauftrag gibt. +#pagenr ("%",21)##setcount (1)##block##pageblock##count per page# +#headeven# +#center#EUMEL Netzbeschreibung +#center#____________________________________________________________ + +#end# +#headodd# +#center#Teil 2 : Arbeitsweise der Netzsoftware +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +Netz - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#Netz - % +#end# +#page# + +Teil 2: Arbeitsweise der Netzsoftware +#goalpage("2")# + + + +2.1. Die Netztask +#goalpage("2.1")# + + +In diesem Kapitel wird beschrieben, wie eine #ib#Netztask#ie# in das System eingebettet ist +und welche Aufgaben sie hat. Unter Einhaltung dieser Konzepte kann die ausgeliefer­ +te Netzsoftware so geändert werden, daß sie beliebige andere #ib#Netzhardware#ie# unter­ +stützt. Die Netzsoftware ist so gegliedert, daß i.allg. nur eine hardwareabhängige +Komponente ausgetauscht werden muß (siehe Teil 3). + +Die Kommunikation zwischen Tasks im EUMEL-Betriebssystem basiert auf einem +#ib#Rendezvouskonzept#ie#: Die #ib#Zieltask#ie# einer Sendung muß empfangsbereit sein, wenn die +#ib#Quelltask#ie# sendet. + +Die Kommunikationsprozeduren auf der niedrigsten Ebene sind #on("bold")##ib#send#ie##off ("bold")# (Senden) und +#on("bold")##ib#wait#ie##off ("bold")# (Warten auf Empfang). Bei der Kommunikation werden ein Integer #on("bold")#code#off ("bold")# und ein +#ib#Datenraum#ie# #on("bold")#dr#off ("bold")# übergeben. #on("bold")#code#off ("bold")# muß >= 0 sein, da negative Codes systemintern ver­ +wandt werden. Ist die empfangende Task an einen #ib#Kanal#ie# gekoppelt (#on("bold")##ib#continue#ie##off ("bold")#), so +führt eine Zeicheneingabe auf diesem Kanal dazu, daß eine Sendung mit dem Code +-4 ankommt. Die Eingabedaten müssen mit den üblichen #ib#Eingabeprozeduren#ie# (#on("bold")##ib#inchar#ie##off ("bold")# +usw.) abgeholt werden. Der übermittelte #ib#Datenraum#ie# und die Absendertask sind dabei +ohne Bedeutung und dürfen nicht interpretiert werden. + +Die Prozedur #on("bold")#send#off ("bold")# hat einen #ib#Rückmeldeparameter#ie#, der besagt, ob die Sendung +übermittelt wurde. Gibt es die Zieltask nicht oder steht sie nicht im #on("bold")#wait#off ("bold")#, so kann die +Sendung nicht übermittelt werden. + +Ein Entwicklungskriterium für das EUMEL-Netz war es, möglichst wenig Unterstüt­ +zung von der virtuellen EUMEL-Maschine (#ib#EUMEL0#ie#) zu fordern, damit weitgehend in +ELAN programmiert werden kann. Dadurch ist es möglich, eine (privilegierte) Task mit +der Netzabwicklung zu betrauen. +#page# +Zunächst wird auf die #ib#EUMEL0#ie#-Unterstützung eingegangen: + +a) Es gibt die Prozedur #on("bold")##ib#define collector#ie##off ("bold")#, mit der die für das Netz verantwortliche + Task der EUMEL0-Maschine bekannt gemacht wird. Diese Task wird im fol­ + genden #ib#Collector#ie# genannt. + +b) Es gibt die Prozedur #on("bold")##ib#define station#ie##off ("bold")#, die für den Rechner eine #ib#Stationsnummer#ie# + einstellt. Anhand dieser Nummer werden die Rechner eines Netzes unterschie­ + den. Das Einstellen bewirkt, daß für alle Tasks die Stationsnummer in ihre + #ib#Task-Id#ie# eingetragen wird (Task-Id's sind die Werte, die der Typ TASK anneh­ + men kann). + +c) Der Befehl #on("bold")##ib#station#ie# (task)#off ("bold")# liefert die Stationsnummer der #on("bold")#task#off ("bold")#. So liefert z.B. + #on("bold")##ib#station#ie# (myself)#off ("bold")# die #ib#Stationsnummer#ie# des eigenen Rechners. + +d) Eine Sendung, deren #ib#Zieltask#ie# auf einem anderen Rechner liegt (also station (ziel) + <> station (myself)), wird auf die #ib#Collectortask#ie# geleitet. + +e) Es gibt eine Prozedur #on("bold")##ib#collected destination#ie##off ("bold")#, die es dem Collector erlaubt, die + eigentliche Zieltask einer auf ihn geleiteten Sendung zu erfahren. + +f) Es gibt eine Variante der Prozedur #on("bold")##ib#send#ie##off ("bold")#, die es dem Collector gestattet, der + #ib#Zieltask#ie# eine andere Task als Absender vorzutäuschen. + +g) Es gibt eine spezielle #ib#Task-Id#ie# #on("bold")##ib#collector#ie##off ("bold")#, durch die der augenblicklich eingestell­ + te #ib#Collector#ie# erreicht wird. Diese wird als Zieltask beim Aufruf der Vermittlungs­ + dienste angegeben (siehe S. #topage("collector")#). Eine Sendung an #on("bold")#collector#off ("bold")# wird von EUMEL0 + an den derzeitig eingestellten Collector geschickt. + +Ein Collector kann also auf drei Wegen von den übrigen Tasks desselben Rechners +Sendungen erhalten: + + 1. Über ein normales #on("b")#send#off("b")# (z.B. bei #on("bold")#list (/"net port")#off ("bold")#, wenn #on("b")#net port#off("b")# der derzeitige + #ib#Collector#ie# ist), + + 2. über ein #on("b")#send#off("b")# an die Task #on("bold")#collector#off ("bold")# (s.u.) und + + 3. als umgeleitete Sendung (z.B. bei #on("bold")#list#off ("bold")# an eine Task auf einem anderen + Rechner). + +Der Collector kann diese Fälle anhand von #on("bold")#collected destination#off ("bold")# unterscheiden. + +Die Punkte d) bis f) dienen dazu, den Collector für über Netz kommunizierende Tasks +unsichtbar zu machen: Der Collector taucht nicht als Ziel oder #ib#Quelle#ie# von Sendungen +auf. Das ist notwendig, damit normale Tasks sich nicht darum kümmern müssen, ob +eine Sendung übers Netz geht oder im eigenen Rechner bleibt. + +Wenn ein #ib#Datenraum#ie# an einen anderen Rechner geschickt wird, muß der gesamte +Inhalt (z. Zt. max. 1 MB) übertragen werden. Dies macht bei der üblichen Netzhard­ +ware eine Zerlegung in #ib#Paket#ie#e nötig [5]. Bei der Zerlegung eines Datenraumes in +Pakete (#ib#Telegramm#ie#e) gelten folgende Einschränkungen: + + - Ein Paket kann maximal eine #ib#Datenraumseite#ie# als #ib#Nutzdaten#ie# enthalten. + + - Die #ib#Nutzdatenlänge#ie# ist für einen #ib#Übertragungsweg#ie# konstant. + + - Alle Stationen eines #ib#Netzstrang#ie#s senden mit gleicher Nutzdatenlänge (#on("b")##ib#data + length#ie##off("b")#). + + - Bei indirekter #ib#Kommunikation#ie(1,"indirekte")# (über #ib#Knoten#ie#) muß die Nutzdatenlänge für in­ + direkte Verbindungen (#on("b")##ib#data length via node#ie##off("b")#) auf allen beteiligten Stationen + gleich eingestellt sein. + + +Für Netze stehen spezielle Blockbefehle zur Verfügung: + + +g) #ib#blockin#ie# / #ib#blockout#ie# (dr,seite,512+abstand,anzahl,rest) + + Es werden maximal #on("bold")#anzahl#off ("bold")# Bytes transferiert. In #on("bold")#rest#off ("bold")# wird zurückgemeldet, wie + viele Bytes nicht bearbeitet wurden (z.B. weil der #ib#Kanal#ie# nichts anliefert). Bear­ + beitet werden die Bytes + + #on("bold")#seite#off ("bold")# * 512 + #on("bold")#abstand#off ("bold")# + + bis maximal + + #on("bold")#seite#off ("bold")# * 512 + #on("bold")#abstand#off ("bold")# + #on("bold")#anzahl#off ("bold")# - 1 + + Der Kanal, an den die Task gekoppelt ist, wird dabei über #ib#Stream-IO#ie# (d.h. + #on("bold")##ib#incharety#ie##off ("bold")#, bei #on("bold")#blockin#off ("bold")# bzw. #on("bold")#out#off ("bold")# bei #on("bold")#blockout#off ("bold")#) angesprochen. + + Hinweis: Die Anforderung darf nicht über #ib#Seitengrenze#ie# gehen, d.h. + + #on("bold")#abstand#off ("bold")# + #on("bold")#anzahl#off ("bold")# <= 512 + + muß erfüllt sein. + + +Eine Netzsendung läuft wie folgt ab: + +Die Task q auf Rechner rq mache ein #on("bold")##ib#send#ie##off ("bold")# an die Task z auf Rechner rz. + +1. Die Prozedur #on("bold")#send#off ("bold")# ist ein #ib#EUMEL0#ie#-Befehl. Die EUMEL0-Ebene erkennt, daß die + Sendung an die #ib#Station#ie# rz geht, da die #ib#Stationsnummer#ie# in der #ib#Task-Id#ie# enthalten + ist. Daher wird die Sendung zum #ib#Collector#ie# umgeleitet, den EUMEL0 wegen der + Einstellung durch #on("bold")##ib#define collector#ie##off ("bold")# kennt, umgeleitet. + +2. Die Task Collector empfängt über #on("bold")##ib#wait#ie##off ("bold")# den #ib#Datenraum#ie#, den #ib#Sendecode#ie# und die + Absendertask q. Die #ib#Zieltask#ie# z erfährt sie durch #on("bold")##ib#collected destination#ie##off ("bold")#. + +3. Der Collector nimmt Kontakt mit dem Collector des Rechners #on("b")#rz#off("b")# auf, dessen Sta­ + tionsnummer ja #on("bold")##ib#station#ie#(z)#off ("bold")# ist, und übermittelt diesem Sendecode, #ib#Quelltask#ie# (q), + eigentliche Zieltask (z) und den #ib#Datenraum#ie#. Da die Collectoren in ELAN geschrie­ + ben sind, können sie an beliebige #ib#Netzhardware#ie# und #ib#Protokoll#ie#e angepaßt werden. + +4. Der #ib#Collector#ie# auf Rechner #on("b")#rz#off("b")# verwendet das spezielle #on("bold")#send#off ("bold")#, um der Zieltask die + Sendung zuzustellen. Dadurch erscheint nicht der Collector, sondern die Task #on("b")#q#off("b")# + als Absender der Sendung. + +Zur Abwicklung der #ib#Vermittlungsebene#ie# (siehe S. #topage("vermittlung")#) muß der Collector noch spe­ +zielle Funktionen beherrschen. Diese sind + + der #on("b")##ib#/#ie#-Operator#off("b")# (Taskname in #ib#Task-Id#ie# wandeln) und + die #on("b")##ib#name#ie##off("b")#-Prozedur (Task-Id in Namen wandeln). + +Der #on("b")#/#off("b")#-Operator macht eine Sendung an den #on("bold")##ib#collector#ie##off ("bold")#, wobei im #ib#Datenraum#ie# der Name +der Task steht und der #ib#Sendecode#ie# gleich der Stationsnummer ist (siehe [6] ). Der +#ib#Collector#ie# setzt sich mit dem Collector dieser Station in Verbindung, damit dieser die +Task-Id ermittelt und zurückschickt. Der eigene Collector schickt dann dem #on("b")#/#off("b")#-Oper­ +ator als Antwort einen Datenraum, der die #ib#Task-Id#ie# enthält. + +Umgekehrt läuft #on("bold")##ib#name#ie##off ("bold")# ab: Wenn die Task-Id von einer fremden Station ist, schickt +#on("bold")#name#off ("bold")# eine Sendung an den #on("bold")##ib#collector#ie##off ("bold")#, wobei im Datenraum die Task-Id steht und +Sendecode = 256 ist. Der Collector entnimmt die #ib#Stationsnummer#ie# der Task aus der +Task-Id und läßt sich vom entsprechenden Collector den Tasknamen geben. Dieser +wird der #on("bold")#name#off ("bold")#-Prozedur im Antwortdatenraum übergeben. + +Netztasks bauen sich #ib#Routentabellen#ie# auf (#ib#Datei#ie#name #on("b")##ib#port intern#ie##off("b")#). Aufgrund dieser +Tabellen weiß jede #ib#Netztask#ie#, über welchen #ib#Kanal#ie# und welche #ib#Nachbarstation#ie# eine +#ib#Zielstation#ie# erreichbar ist. Wenn der #ib#Collector#ie# einen Sendeauftrag erhält, prüft er, ob +die Zielstation über seinen Kanal erreichbar ist. Wenn nicht, leitet er Parameter und +#ib#Datenraum#ie# der Sendung an die geeignete Netztask weiter. +#page# + +2.2. Ebenen + +#goalpage("2.2")# + +In diesem Kapitel werden die #ib#Protokollebenen#ie# für das Netz beschrieben, wie sie die +ausgelieferte Netzsoftware benutzt und erwartet. Bei anderer Netzhardware als Daten­ +boxen müssen die Ebenen a) bis c) ausgetauscht werden [4]. Unter Einhaltung der im +vorigen Kapitel beschriebenen Randbedingungen können auch die höheren Ebenen +geändert werden. + + +a) Physikalische Ebene + + - #ib#Station#ie# <--> Box + + #ib#V.24#ie#-#ib#Schnittstelle#ie# mit #ib#RTS/CTS#ie#-Handshake. Vollduplex. + + - Box <--> Box + + #ib#RS422#ie# über 2 verdrillte Leitungspaare (Takt und Daten). + + +b) Verbindungsebene + + - Station <--> Box + + Asynchron + 8 Bit + Even Parity + 2400/4800/9600/19200 #ib#Baud#ie# einstellbar über Lötbrücken) + + - Box <--> Box + + #ib#SDLC#ie# + 400 KBaud +#page# +c) #ib#Netzebene#ie# +#goalpage("quelle")# + + - Station <--> Box + + #ib#Telegrammformat#ie#: #ib#STX#ie#, , , <#ib#quelle#ie#>, <(n-4) byte> + + ist #ib#Längenangabe#ie# ( 8 <= n <= 160) + , sind #ib#Stationsnummer#ie#n. Diese müssen an den jeweiligen + Boxen eingestellt sein. + + Box --> Station: + + Ein #ib#Telegramm#ie# kommt nur bei der #ib#Station#ie# an, bei deren Box die Nummer + eingestellt ist. Dadurch ist ein Mithören fremder #ib#Übertragung#ie# nicht + möglich (Datenschutz). + + Zwischen Telegrammen können #ib#Fehlermeldung#ie#en der Box (Klartext) übermittelt + werden (z.B. 'skipped x', wenn ein #ib#STX#ie# von der Box erwartet wurde, aber 'x' + von der Station ankommt). + + Station --> Box: + + Ein Telegramm wird nur abgeschickt, wenn <#ib#quelle#ie#> mit der eingestellten + Nummer übereinstimmt (Datenschutz: Man kann nicht vorschwindeln, eine + beliebige Station zu sein, es sei denn, man hat physischen Zugriff zur Box und + stellt dort die Stationsnummer um). + + - Box <--> Box + + #ib#Telegrammformat#ie#: + FRAME, , <#ib#quelle#ie#>, , + + Eine #ib#Längenangabe#ie# ist nicht nötig, da #ib#SDLC#ie# eine Rekonstruktion der Länge + erlaubt. + + Telegramme mit falschen #ib#CRC-Code#ie# werden vernichtet. Auf höheren Ebenen + muß dies durch #ib#Zeitüberwachung#ie# erkannt und behandelt werden. + +#page# +d) Transportebene + + Diese Ebene wickelt das Rendezvous zwischen einer Task, die #on("bold")##ib#send#ie##off ("bold")# macht, und + einer Task, die im #on("bold")##ib#wait#ie##off ("bold")# steht, ab [1]. + + Der im #on("bold")#send#off ("bold")# angegebene #ib#Datenraum#ie# wird als Folge von #ib#Seiten#ie# (im EUMEL- + Sinne: Pagingeinheit und Allokiereinheit) übermittelt, wobei jede Seite ggf. noch in + n Byte große Stücke zerlegt wird. Es werden nur echt allokierte Seiten übermit­ + telt. Um nicht jedes #ib#Telegramm#ie# voll qualifizieren zu müssen, wird zunächst eine + Art virtuelle #ib#Verbindung#ie# durch ein #ib#OPEN#ie#-Telegramm eröffnet. Danach folgen + variabel viele #ib#DATA#ie#-Telegramme. Beide Sorten werden durch #ib#QUIT#ie#-Tele­ + gramme quittiert, um folgende Funktionen zu ermöglichen: + + #ib#Flußkontrolle#ie# (z.B. Zielrechner langsam), + Wiederaufsetzen (verlorene Telegramme), + Abbruch (z.B. weil Zieltask inzwischen beendet). + + Ein #ib#CLOSE#ie#-Telegramm ist nicht nötig, da das letzte DATA-Telegramm als + solches erkannt werden kann (siehe unten). +#page# + - #ib#OPEN#ie#-Telegramm + +#clear pos# + 0 1 2 3 4 5 6 7 8 9. Byte ++------+------+------+------+-------------+-------------+-------------------+ +I STX I 24 I Ziel IQuelleI Endziel I Endquelle I Strom I ++------+------+------+------+-------------+-------------+-------------------+ + + 10 11 12 13 14 15 16 17 ++-------------+-------------+---------------------------+ +I Sequenz I Seite I Quelltask I ++-------------+-------------+---------------------------+ + + 18 19 20 21 22 23 ++---------------------------+-------------+ +I Zieltask I Code I ++---------------------------+-------------+ + + + + <#ib#ziel#ie#>, <#ib#quelle#ie#> siehe S. #topage("quelle")# + + <#ib#endziel#ie#> Eigentliche #ib#Zielstation#ie#. Ist = , so ist + das #ib#Telegramm#ie# angekommen. Andernfalls muß die Station + den #ib#Nachbarn#ie# zum Erreichen des als + neues einsetzen und das Telegramm an diesen + Nachbarn weiterleiten. + + <#ib#endquelle#ie#> Eigentliche #ib#Absenderstation#ie#. ist dagegen immer + die Nummer der sendenden #ib#Nachbarstation#ie#. + + <#ib#strom#ie#> Die #ib#Stromnummer#ie# identifiziert die virtuelle #ib#Verbindung#ie#. Sie + muß in den #ib#QUIT#ie#-Telegrammen angegeben werden. + + <#ib#sequenz#ie#> -1 (Kennzeichen für OPEN) + + <#ib#seite#ie#> Nummer der ersten echt allokierten #ib#Seite#ie# des #ib#Datenraum#ie#s + (=-1, falls Nilspace) + + <#ib#quelltask#ie#> #ib#Task-Id#ie# der sendenden Task + + <#ib#zieltask#ie#> Task-Id der empfangenden Task + + Wert des im #on("bold")##ib#send#ie##off ("bold")# angegebenen Codes +#page# + - #ib#DATA#ie#-Telegramm + + + + + + 0 1 2 3 4 5 6 7 8 9. Byte ++------+------+------+------+-------------+-------------+-------------------+ +I STX I LängeI Ziel IQuelleI Endziel I Endquelle I Strom I ++------+------+------+------+-------------+-------------+-------------------+ + + 10 11 12 13 14 ++-------------+-------------+-----------------------------------------------+ +I Sequenz I Seite I n Byte Daten (Länge = 14 + n) I ++-------------+-------------+-----------------------------------------------+ + + + <#ib#laenge#ie#> Gesamtlänge des Telegramms. + #on("b")#laenge#off("b")# = #on("b")##ib#nutzlaenge#ie##off("b")# + 14. + Für #on("b")#nutzlaenge#off("b")# sind nur die Werte 64,128,256 und 512 + zugelassen (siehe 1). #on("b")#laenge#off("b")# wird codiert dargestellt (siehe + Teil 3). + + + <#ib#sequenz#ie#> wird von Telegramm zu Telegramm hochgezählt. Sie dient + der Überwachung bzgl. verlorengegangener Telegramme + bzw. durch #ib#Zeitüberwachung#ie# verdoppelter Telegramme. + + <#ib#seite#ie#> Nummer der x-ten echt allokierten Seite des #ib#Datenraum#ie#s + (x = (( DIV anzahl pakete pro seite) + 2) + + #ib#Nutzinformation#ie#. Diese gehört zur #ib#Adresse#ie# a des Daten­ + raums. + + a = + N ( DIV anzahl pakete pro seite + 1) * 512 + + ( MOD anzahl pakete pro seite) * n + + wobei N (x) die Nummer der x-ten Seite und + n die #ib#Nutzdatenlänge#ie# ist. + + Aus den Formeln ergibt sich, daß diese Nummer schon in + einem vorhergehenden DATA/OPEN-Telegramm über­ + mittelt wurde (im Feld ). + + - #ib#QUIT#ie#-Telegramm + + + 0 1 2 3 4 5 6 7 8 9. Byte ++------+------+------+------+-------------+-------------+-------------------+ +I STX I 12 I Ziel IQuelleI Endziel I Endquelle I Strom I ++------+------+------+------+-------------+-------------+-------------------+ + + 10 11 ++-------------+ +I Quit I ++-------------+ + + + + <#ib#strom#ie#> muß die #ib#Stromnummer#ie# sein, die in dem #ib#OPEN#ie#/#ib#DATA#ie#­ + Telegramm stand, das quittiert wird. + + 0 : ok. Nächstes Telegramm schicken. + + -1: #ib#Übertragung#ie# neu starten (mit #ib#OPEN#ie#), weil die Emp­ + fangsstation das OPEN nicht erhalten hat. + + -2: Übertragung ca. 20 Telegramme zurücksetzen. + + -3: Übertragung abbrechen. + + -4: #ib#Quittung#ie# für letztes Telegramm einer Sendung. + + +e) #ib#Vermittlungsebene#ie##goalpage("vermittlung")# #goalpage("collector")# + + Diese Ebene ist dafür zuständig, Namen von Tasks auf anderen Stationen in + #ib#Task-Id#ie#'s (Werte des Typs TASK) zu wandeln und umgekehrt. Hierzu wird im + entsprechenden #ib#OPEN#ie#-Telegramm der Code -6 (bzw. -7) als ein­ + getragen. Die #ib#Netzempfangstask#ie# erkennt diese #ib#Codes#ie# und wickelt die Aufgaben + selbst ab, so daß es dabei nicht nötig ist, irgendeine Task-Id der #ib#Zielstation#ie# zu + kennen. + + Dieses Verfahren ist möglich, weil im #on("bold")##ib#send#ie##off ("bold")# nur positive Codes erlaubt sind. +#page# +f) #ib#Höhere Ebenen#ie# + + Höhere Ebenen sind nicht mehr netzspezifisch. Sie basieren alle auf dem Send/ + Wait-Konzept des EUMEL. So gibt es z.B. den #on("bold")##ib#global manager#ie##off ("bold")#, der Aufbewah­ + rung und Zugriff von #ib#Datei#ie#en in einer Task regelt. Dabei darf diese Task (bei der + Variante #on("bold")##ib#free global manager#ie##off ("bold")#) auf einer beliebigen #ib#Station#ie# im Netz liegen. Wegen + des #ib#Rendezvous-Konzept#ie#s können beliebige Sicherheitsstrategien benutzt werden + (z.B.: keine Dateien an Station 11 ausliefern). Von großem Wert ist z.B., daß + man ohne weiteres das Archiv (Floppylaufwerk) einer anderen Station anmelden + und benutzen kann, wodurch eine einfache Konvertierung von Floppyformaten + möglich ist. Dies ist möglich, weil auch die Archiv-Task der Stationen sich an + das Globalmanagerprotokoll halten. + + + + + +Bemerkungen + +#ib#Fehlerbehandlung#ie# besteht bis Ebene c) darin, fehlerhafte #ib#Telegramm#ie#e einfach zu +entfernen. Die Ebene d) überwacht den Netzverkehr sowieso über #ib#Timeout#ie#s, die eine +Wiederholung eines Telegrammes bewirken, wenn die #ib#Quittung#ie# ausbleibt. + +Da bei der sendenden #ib#Station#ie# der ganze #ib#Datenraum#ie# zur Verfügung steht, ist eine +#ib#Fenstertechnik#ie# (wie bei #ib#HDLC#ie#) nicht nötig. Es kann zu jedem Zeitpunkt um beliebig +viele Telegramme zurückgesetzt werden. + +Da im EUMEL eine #ib#Textdatei#ie# ein #ib#Datenraum#ie# mit sehr komplexer Struktur ist (wegen +der Insert/Delete-Möglichkeiten, ohne den Rest der #ib#Datei#ie# zu verschieben), ist es ein +hoher Aufwand, von einem fremden Betriebssytem aus eine Textdatei in das +EUMEL-Netz zu senden. Für solche Zwecke muß noch eine einfachere Dateistruktur +definiert und entsprechende Dateikonverter erstellt werden. +#page# + +2.3. Stand der Netzsoftware + +#goalpage("2.3")# + +Das EUMEL-System wickelt die Prozedur #on("bold")##ib#send#ie##off("bold")# über das Netz ab, wenn die Sta­ +tionsnummer der #ib#Zieltask#ie# ungleich der eigenen #ib#Stationsnummer#ie# ist. Umgekehrt kann +man der von der Prozedur #on("bold")##ib#wait#ie##off("bold")# gelieferten Absendertask die #ib#Absenderstation#ie# entneh­ +men (siehe Prozedur #on("bold")##ib#station#ie##off("bold")# in Teil 1). + +Anders als bei einem #on("bold")##ib#send#ie##off("bold")# innerhalb einer Station meldet ein #on("bold")#send#off("bold")# an eine Task einer +fremden Station immer 0 zurück (Task gibt es und Task war im wait), obwohl dies +nicht der Fall sein muß. Ist die Sendung vollständig zur Zielstation übertragen, so +versucht der dortige #ib#Collector#ie# diese hundertmal im Sekundenabstand zuzustellen. +Bleibt das erfolglos, wird die Sendung vernichtet. +#pagenr ("%", 33)##setcount (1)##block##pageblock##count per page# +#headeven# +#center#EUMEL Netzbeschreibung +#center#____________________________________________________________ + +#end# +#headodd# +#center#Teil 3 : Netz Hardware Interface +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +Netz - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#Netz - % +#end# +#page# + +Teil 3: Netz-Hardware-Interface + + +#goalpage("3")# + + +3.1. Einführung + + #goalpage("3.1")# + +In diesem Teil der Netzbeschreibung wird die #ib#Schnittstelle#ie# beschrieben, über die +#ib#Netzhardware#ie# (also #ib#Datenbox#ie#en, #ib#Netzbox#ie#en oder Netzkarten) an die EUMEL-Netz­ +Software angepaßt werden kann. Dieser Teil der Beschreibung ist also nur für Netz­ +implementatoren wichtig. + +Das EUMEL-Netz wurde dazu konzipiert, zwei oder mehr EUMEL-Rechner über +#ib#V.24#ie#-Leitungen oder Datenboxen miteinander zu vernetzen. Dem heutigen Stand der +Technik entsprechend, werden auf dem Markt eine Reihe von Möglichkeiten ange­ +boten, um PC's zu vernetzen. Diese Netze unterscheiden sich auch dadurch, daß +unterschiedliche Medien zur Datenübertragung benutzt werden. Das #ib#EUMEL- +Datenboxen-Netz#ie# benutzt Telefonkabel, #ib#Ethernet#ie# beispielsweise Koax-Kabel. Auch +Lichtleiter werden zur Datenübertragung benutzt. Entsprechend gibt es eine ganze +Menge Hardware (#ib#Treiber#ie#, Netzzugangsgeräte, Datenboxen, Anschlußkarten), die die +Kopplung zwischen einem #ib#I/O-Kanal#ie# eines Rechners und dem Übertragungsmedium +(Kabel) übernimmt. Das Netz-Hardware-Interface soll als #ib#Schnittstelle#ie# zwischen der +Netz­Software und dem Treiber dienen. Damit wird es möglich, mehrere EUMEL- +Rechner über verschiedene (Teil-) Netze (in dieser Beschreibung Stränge genannt) +und unterschiedliche #ib#Netzhardware#ie# (Treiber) miteinander zu verbinden. Für den +EUMEL-Benutzer soll dabei kein Unterschied in der Benutzung des EUMEL-Netzes +feststellbar sein. +#page# +Neben unterschliedlichen Übertragungsmedien und Treibern gibt es weitere Unter­ +schiede zwischen Netzen: + + - in der Netztopologie (Bus-, Ring- oder Sternnetze), + + - in den Netzzugangsverfahren (Token passing, time slice token, slotting oder + CSMA/CD), + + - in der #ib#Übertragungsgeschwindigkeit#ie#, + + - im Aufbau der einzelnen #ib#Pakete#ie(1,", Aufbau der")# (#ib#Netztelegramm#ie#e). + +Alles, was mit den ersten drei Punkten zusammenhängt, wird von den Netzzugangs­ +geräten behandelt. + +Der Paketaufbau aber muß zumeist im Rechner geschehen und kann in den seltens­ +ten Fällen ganz vom Treiber übernommen werden. Ebenso kann der Treiber aus den +empfangenen Paketen nicht immer die Teile herausfiltern, die von der EUMEL- +#ib#Netzsoftware#ie# gebraucht werden. Diese Aufgaben übernimmt das #ib#Netz-Hardware- +Interface#ie#. Das Netz-Hardware-Interface stellt die #ib#Verbindung#ie# zwischen EUMEL- +#ib#Netzsoftware#ie# und den verschiedenen Netzhardwarearten dar. Ähnlich wie bei den +Drucker- und Terminal-Anpassungen wurde ein hardwareabhängiger Teil aus der +Netzsoftware abgetrennt und in einem eigenen #ib#Paket#ie# zusammengefaßt. Beim Start +des Netzes wird durch Angabe des entsprechenden #ib#Netzmodus#ie# für den jeweiligen +#ib#Kanal#ie# die entsprechende Anpassung für den benutzten Treiber ausgewählt. Wenn +andere, neue Treiber angepaßt werden sollen, so müssen lediglich in dem Paket #on("b")##ib#net +hardware interface#ie##off("b")# die entsprechenden Prozeduren hinzugefügt und die #ib#Sprungleisten#ie# +(#ib#SELECT#ie#-Statements) erweitert werden. + +Durch das #ib#Knotenkonzept#ie# in der #ib#Netzsoftware#ie# ist es möglich, über einen #ib#Knoten­ +rechner#ie# Teilnetze (Stränge), die mit unterschiedlicher #ib#Netzhardware#ie# arbeiten, mitein­ +ander zu verbinden. Es sind dann beispielsweise Verbindungen zwischen Rechnern, +die über #ib#Ethernet#ie# vernetzt sind, und Rechnern auf dem EUMEL-Datenboxen-Netz +möglich. Es ist auch möglich, mit einem Rechner Zugang zu einem Netz zu erhalten, +für das spezielle #ib#Netzhardware#ie# erforderlich ist (Datenboxen, Ethernet-Anschluß). Man +kann den Rechner über eine Rechner-Rechner-Kopplung (#ib#V.24#ie#) mit einem Rechner +verbinden, der bereits ans Netz angeschlossen ist, und so (allerdings auf Kosten der +Leistung des #ib#Knotenrechner#ie#s) Netzhardware einsparen. +#page# + +3.2. Arbeitsweise des + Netz-Hardware-Interfaces + + + + + + #goalpage("3.2")# + +Grob vereinfacht kann man sich die Arbeitsweise der #ib#EUMEL-Netz-Software#ie# so vor­ +stellen: + + reset box; + REP + IF zeichen da THEN lies telegramm ein + ELIF telegramm auszugeben THEN gib telegramm aus + FI + PER . + +(Es ist nur der Teil der Software beschrieben, der die Kanalbehandlung betrifft). + + +Das Zusammenspiel zwischen EUMEL-Netz und Netz-Hardware-Interface ge­ +schieht auf folgende Weise: + + + #on("b")#reset box;#off("b")# + REP + IF zeichen da THEN #on("b")#next packet start#off("b")#; + lies telegramm ein + ELIF telegramm auszugeben THEN gib telegramm aus + FI + PER. + + gib telegramm aus: + #on("b")#transmit header#off("b")#; + gib eumelnetztelegramm aus; + #on("b")#transmit trailer #off("b")#. + +Die fett gedruckten Programmteile werden im Netz-Hardware-Interface realisiert, die +anderen Teile stecken in den darüberliegenden Teilen der EUMEL-Netz-Software. +#page# +Beim Senden eines #ib#Telegramm#ie#s wird von der #ib#Netzsoftware#ie# zuerst der #ib#Vorspann#ie# in +einem #ib#Datenraum#ie# an das Hardware-Interface übergeben (#on("b")##ib#transmit header#ie##off("b")#). Im Hard­ +ware-Interface können aus dem Vorspann die entsprechenden Informationen (Tele­ +grammlänge, #ib#Zielstation#ie# usw.) entnommen werden. Dann wird von der Netzsoftware +das Telegramm (inklusive Vorspann) per #on("b")##ib#blockout#ie##off("b")# übergeben. Danach wird #on("b")##ib#transmit +trailer#ie##off("b")# aufgerufen, um dem Hardware-Interface das Ende des Telegramms zu mel­ +den. Beim Empfang ruft die Netzsoftware zuerst die #ib#I/O Control#ie# #ib#Telegrammfreigabe#ie# +auf [7]. Danach wird das erste #ib#Zeichen#ie# des Telegramms angefordert (#on("b")##ib#next packet +start#ie##off("b")#). Falls ein #ib#STX#ie# geliefert wurde, wird das Telegramm per #on("b")##ib#blockin#ie##off("b")# eingelesen. Falls +#ib#Niltext#ie# zurückgeliefert wird, wird von der Netzsoftware #ib#Timeout#ie# angenommen. Alle +anderen Zeichen werden so interpretiert, als ob Störungen aufgetreten wären. Die +Netzsoftware übernimmt die #ib#Fehlerbehandlung#ie#. Dazu wird u. U. ein Leerlesen des +Puffers vom Hardware-Interface verlangt (#on("b")##ib#flush buffers#ie##off("b")#). + +Bei der Einstellung der #ib#Nutzdatenlänge#ie# (#on("b")##ib#data length#ie##off("b")#) ist zu beachten, daß + +a) alle #ib#Station#ie#en, die an einem #ib#Strang#ie# hängen, auf die gleiche Nutzdatenlänge + eingestellt sein müssen. + +b) Wenn mehrere Stränge über #ib#Knoten#ie# miteinander verbunden sind, muß die Nutz­ + länge für Sendungen über Knoten (#on("b")##ib#data length via node#ie##off("b")#) auf allen Stationen des + gesamten Netzes gleich eingestellt sein. Die Zusammenfassung oder Aufteilung + von #ib#Telegramm#ie#en in Knoten ist nicht möglich. + +c) Als mögliche Nutzdatenlänge sind folgende Werte erlaubt: + + 64, 128, 256 und 512 Byte. + + Größere Nutzdatenlängen sind zur Zeit nicht möglich. + +d) Je größer die #ib#Nutzdatenlänge#ie# ist, desto geringer ist der Overhead an #ib#Zeichen#ie#, + die auf den Rechnern verarbeitet werden müssen. Allerdings muß der Rechner + leistungsfähig genug sein, die ankommenden Blöcke schnell genung zu verarbei­ + ten, und die Netztreiber müssen entsprechend große Puffer haben. + + +Alle implementierten Netzanpassungen sollen in einem Netz-Hardware-Interface +zusammengefaßt werden. Dies ist notwendig, um über #ib#Knotenrechner#ie# Netzstränge +verbinden zu können, die mit unterschiedlicher #ib#Netzhardware#ie# arbeiten. So können +zum Beispiel ein #ib#Strang#ie#, der mit Datenboxen aufgebaut ist, und ein #ib#Ethernet#ie#-#ib#Strang#ie# +über einen Knotenrechner miteinander verkoppelt werden. +#page# +Aus diesem Grund wurden #on("b")#Netzmodi#off("b")# eingeführt. Man kann dadurch, daß die Netz­ +modi, genau wie die #ib#Kanal#ie#angaben, in der #ib#Datei#ie# #on("b")##ib#netz#ie##off("b")# niedergelegt sind, ohne Aus­ +tausch einer Softwarekomponente die Netzhardware wechseln. Es gibt auch die +Möglichkeit, durch verschiedene Netzmodi unterschiedliche Treiber an ein und das­ +selbe Netz anzuschließen. Beispielsweise gibt es für einige Rechnertypen Steckkarten, +mit denen der Rechner an das Ethernet angeschlossen werden kann. Man kann, +wenn diese Karten angepaßt sind, den #ib#Ethernet#ie#-Zugang über verschiedene Netz­ +anschlußkarten realisieren. + +Das Netz-Hardware-Interface muß folgende Aufgaben übernehmen: + + Bei der Ausgabe an den Treiber: + + - Generieren und Ausgeben des #ib#Paket#ie#headers, + - Umsetzen von logischen Stationsadressen (#ib#Stationsnummer#ie#n) in phy­ + sische #ib#Adresse#ie#n, + - Ausgeben der Daten (EUMEL-Netz-#ib#Telegramm#ie#e), + - Generieren und Ausgeben des Trailers und evtl. Auffüllen des Pakets mit + #ib#Füllzeichen#ie#, falls auf dem Netz eine Mindestlänge für Pakete gefordert + wird. + + Bei der Eingabe vom Treiber: + + - Weglesen von #ib#Füllzeichen#ie#, + - Prüfen der #ib#Adresse#ie#n, + - Weglesen von #ib#Paket#ie#teilen, die in der EUMEL-Netz-Software nicht + gebraucht werden. + + Weiterhin können Funktionen wie + + - Reset des Treibers, + - Prüfung, ob Stationsadresse und #ib#Adresse#ie# im Treiber übereinstimmen, + - Statistik und Service + + durch das Netz-Hardware-Interface übernommen werden. + +Dazu wird ein Satz von Prozeduren über die #ib#DEFINES#ie#-#ib#Schnittstelle#ie# des Netz- +Hardware-Interfaces zur Verfügung gestellt. Wenn neue Treiber oder Netzarten +implementiert werden sollen, so muß an diesem Interface nichts geändert werden. Die +herausgereichten Prozeduren realisieren #ib#Sprungleisten#ie# (#ib#SELECT#ie#-Statements), über +die durch Erweiterung (#ib#CASE#ie#) die Prozeduren erreicht werden können, die den ent­ +sprechenden #ib#Netzmodus#ie# realisieren. Außerdem werden Informationsprozeduren für die +darüberliegenden Programmteile zur Verfügung gestellt. +#page# + +3.3. Netztreiber + + #goalpage("3.3")# +Unter #ib#Netztreiber#ie#n versteht man die Einheiten, die den Anschluß des Rechners an ein +Netz realisieren. Das können #ib#Netzbox#ie#en sein, die mit dem Rechner über eine #ib#V.24#ie#- +Leitung verbunden sind, aber auch Anschlußkarten, die direkt auf den Datenbus des +Rechners gehen. Falls die #ib#Schnittstelle#ie# der Treiber-Hardware eine andere als die +serielle #ib#V.24#ie# ist, muß in der Regel eine Anpassung für die Hardware im #ib#SHard#ie# vorge­ +nommen werden. + +Falls der Treiber über eine serielle #ib#V.24#ie#-#ib#Schnittstelle#ie# mit dem Rechner verbunden +ist, wie das auch bei der direkten Kopplung oder dem Datenboxennetz der Fall ist, +wird die hohe #ib#Übertragungsgeschwindigkeit#ie# auf dem eigentlichen Netz durch die +relativ geringe Übertragungsgeschwindigkeit auf der #ib#V.24#ie#-#ib#Schnittstelle#ie# zwischen +Rechner und Treiber (Box) gebremst. Über andere Schnittstellen im Rechner, wenn +sie mit #ib#Stream I/O#ie# [7] betrieben werden, kann man dies vermeiden. Diese Schnitt­ +stellen müssen vom SHard bedient werden. + +Wenn in den Rechner integrierte Netztreiber (Netzanschlußkarten) benutzt werden +sollen, so muß in der Regel die Behandlung dieser Netzanschlußkarte im SHard +durchgeführt werden. + +Um effizient implementieren zu können, sollte darauf geachtet werden, daß möglichst +wenig zusätzliche #ib#Zeichen#ie# von der #ib#Netzsoftware#ie# bzw. dem Netz-Hardware-Inter­ +face bearbeitet werden müssen. Das Auffüllen von Paketen auf eine Mindestlänge +sollte möglichst vom Treiber gemacht werden, ebenso wie das Weglesen dieser +Zeichen. + +Um einen sicheren und effektiven Netzbetrieb zu garantieren, sollten die Treiber +folgende Eigenschaften haben: + + - Die #ib#Stationsadresse#ie# ist im Treiber festgelegt, sie soll nicht ohne weiteres + verändert werden können (Datenschutz). + - Der Treiber reicht nur #ib#Paket#ie#e mit richtiger #ib#Zieladresse#ie#, keine #ib#Broad- oder + Multicasts#ie# an die Netzsoftware weiter. + - Der Treiber sendet nur #ib#Paket#ie#e mit richtiger #ib#Absenderadresse#ie# bzw. setzt die + Absenderadresse selbst ein. + - Die am Treiber eingestellte #ib#Adresse#ie# kann abgefragt werden, oder es wird, + wenn ein Paket mit falscher #ib#Absenderadresse#ie# vom Rechner kommt, eine + #ib#Fehlermeldung#ie# an den Rechner gegeben. Die Fehlermeldung muß durch das + Netz-Hardware-Interface in den #on("b")##ib#report#ie##off("b")# eingetragen werden. + - Falls Pakete mit #ib#Füllzeichen#ie# aufgefüllt werden müssen, sollten die Füll­ + zeichen durch den Treiber generiert und beim Empfang wieder entfernt + werden. + - Falls mehrere Betriebsmodi möglich sind, so sollten sie softwaremäßig + einstellbar sein. + - Falls die Treiber über eine serielle #ib#Schnittstelle#ie# an den Rechner angeschlos­ + sen werden, so sollte der Treiber konfigurierbar sein. In jedem Fall sollte die + serielle Schnittstelle mit #ib#Flußkontrolle#ie# (#ib#RTS/CTS#ie#) implementiert werden. + +Zusätzlich ist ein Transparent-Modus als #ib#Netzmodus#ie# von Vorteil: + + - Der Modus (transparent) kann zu Testzwecken benutzt werden. Beispiels­ + weise um auch mit Rechnern kommunizieren zu können, die über Netz + erreichbar sind, aber kein EUMEL-Netz-#ib#Protokoll#ie# benutzen. + + Modus n: transparent. + + Ausgabeseitig: Das #ib#Paket#ie# wird unverändert ausgegeben. + #ib#Adresse#ie#n usw. müssen schon im Paket vor­ + handen sein. Es wird nicht mit #ib#Füllzeichen#ie# + aufgefüllt. + Eingabeseitig: Das Paket wird unverändert an die Netzsoft­ + ware weitergegeben. + +#page# + +3.4. Prozedurschnittstelle + des EUMEL-Netzes + + + + + + #goalpage("3.4")# +Im PACKET #on("b")##ib#net hardware interface#ie##off("b")# sind folgende Prozeduren untergebracht: + + + + BOOL PROC #ib#blockin#ie# + (DATASPACE VAR ds, INT CONST seite, abstand, länge): + + Versucht, #on("b")#länge#off("b")# Zeichen vom #ib#Kanal#ie# einzulesen. Liefert TRUE, wenn alle + Zeichen eingelesen wurden, FALSE, wenn innerhalb einer bestimmten + Zeit nicht alle #on("b")#länge#off("b")# Zeichen eingelesen werden konnten (z.B. weil der + Kanal nicht mehr Zeichen anliefert). Die eingelesenen Zeichen werden im + #ib#Datenraum#ie# #on("b")#ds#off("b")# in #ib#Seite#ie# #on("b")#seite#off("b")# ab #on("b")#abstand#off("b")# bis #on("b")#abstand#off("b")# + #on("b")#länge#off("b")# - 1 abge­ + legt. + + #ib#Fehlerfall#ie#: + + #on("b")#blockin Abbruch#off("b")# + + Es werden weniger #ib#Zeichen#ie# innerhalb einer festgelegten Zeitspanne über + den Kanal angeliefert, als mit #on("b")#länge#off("b")# gefordert. + + Passiert z.B., wenn die Kabel während einer Netzübertragung unter­ + brochen werden, oder wenn die Gegenstelle abgeschaltet wird. Das + #ib#Telegramm#ie# wird vernichtet, die Prozedur liefert FALSE, es wird eine + entsprechende Meldung im #on("b")##ib#report#ie##off("b")# erzeugt. + + PROC #ib#blockout#ie# + (DATASPACE CONST ds, INT CONST seite, abstand, länge): + + Der Inhalt von Seite #on("b")#seite#off("b")# des #ib#Datenraum#ie#s #on("b")#ds#off("b")# wird von #on("b")#abstand#off("b")# bis + #on("b")#abstand#off("b")# + #on("b")#länge#off("b")# - 1 ausgegeben. +#page# + PROC #ib#set net mode#ie# (INT CONST mode): + + Es wird der #ib#Netzmodus#ie# #on("b")#mode#off("b")# eingestellt. Im Netz-Hardware-Interface + müssen alle Initialisierungen und Einstellungen vorgenommen werden, + damit die mit #on("b")#mode#off("b")# geforderte #ib#Netzhardware#ie# unterstützt wird. Diese + Prozedur wird bei jedem #on("b")##ib#start#ie##off("b")#-Kommando in der Netztask aufgerufen. + Kann als Initialisierungsprozedur für dieses PACKET verwendet werden. + Übergibt den in der #ib#Datei#ie# #on("b")##ib#netz#ie##off("b")# für diesen #ib#Kanal#ie# verlangten Netzmodus an + das Netz-Hardware-Interface. Nach Aufruf dieser Prozedur müssen die + wertliefernden Prozeduren #on("b")##ib#net mode#ie#, #ib#mode text#ie#, #ib#data length#ie##off("b")# und #on("b")##ib#data + length via node#ie##off("b")# korrekt initialisiert sein. Der Aufruf von #on("b")##ib#net addess#ie##off("b")# muß + die korrekten (physikalischen) #ib#Adresse#ie# der #ib#Station#ie#en liefern. + + TEXT PROC net address (INT CONST stationsnummer): + + Liefert die (Hardware-) Netz-#ib#Adresse#ie#, über die der EUMEL-Rechner + mit der Stationsnummer #on("b")##ib#stationsnummer#ie##off("b")# beim aktuell für diesen Kanal + eingestellten #ib#Netzmodus#ie# erreichbar ist. Auf diese #ib#Adresse#ie# muß der Treiber + des entsprechenden Rechners eingestellt sein. Auch die eigene Netz- + Adresse muß mit der im Treiber eingestellten #ib#Adresse#ie# übereinstimmen. + Insbesondere müssen alle Stationen, die auf dem Netz arbeiten, dieselbe + Netz-Adresse für eine #ib#Stationsnummer#ie# errechnen. + + TEXT PROC #ib#mode text#ie#: + + Liefert den Text (Namen) des eingestellten #ib#Netzmodus#ie#. Wird in #on("b")##ib#net + manager#ie##off("b")# benutzt, um den Netzmodus im #on("b")##ib#report#ie##off("b")# anzugeben. + + TEXT PROC mode text (INT CONST mode): + + Liefert den Text (Namen) zu dem #ib#Netzmodus#ie# #on("b")#mode#off("b")#. + + INT PROC #ib#data length#ie# (INT CONST mode): + + Liefert die #ib#Nutzdatenlänge#ie# (#ib#Länge#ie# der Nettodaten des Eumel- + Telegramms) im Netz. Wird von #on("b")##ib#basic net#ie##off("b")# beim Neustart aufgerufen. Muß + in einem Netz auf allen Stationen eines #ib#Strang#ie#s denselben Wert liefern. + + Erlaubte Werte: 64, 128, 256 und 512. +#page# + INT CONST #ib#data length via node#ie#: + + Liefert die #ib#Nutzdatenlänge#ie# für Sendungen, die über #ib#Knoten#ie# gehen. + Muß auf allen Stationen des Netzes gleich sein. + + Erlaubte Werte: 64, 128, 256 und 512. + + PROC #ib#decode packet length#ie# (INT VAR value): + + Die #ib#Länge#ie# eines Netztelegramms ist im #ib#Telegramm#ie# codiert enthalten. Mit + dieser Prozedur wird aus dem Telegrammkopf die Telegrammlänge ermit­ + telt: + + Falls beim Aufruf dieser Prozedur in #on("b")#value#off("b")# der Wert des Feldes #on("b")#head#off("b")# aus + der Struktur #on("b")#vorspann#off("b")#, die in #on("b")#ds#off("b")# per #on("b")##ib#transmit header#ie##off("b")# übergeben wurde, + enthalten ist, so wird in #on("b")#value#off("b")# die Länge des EUMEL-Netztelegramms + zurückgeliefert. + + PROC #ib#flush buffers#ie#: + + Liest den Eingabepuffer des #ib#Netzkanal#ie#s leer. Die eingelesenen Zeichen + werden vernichtet. Wird nach Erkennen von #ib#Übertragungsfehler#ie#n aufge­ + rufen. + + TEXT PROC #ib#next packet start#ie#: + + Liefert genau ein #ib#Zeichen#ie# (in der Regel das erste Zeichen des EUMEL- + Netztelegramms). Wird von der Netzsoftware immer dann aufgerufen, + wenn ein neues #ib#Paket#ie# erwartet wird. + + Bedeutung des gelieferten Zeichens für die #ib#Netzsoftware#ie#: + + #ib#STX#ie#: korrekter #ib#Telegrammanfang#ie# (ist das erste Zeichen des + EUMEL-Netztelegramms). Der Rest des EUMEL-Netztele­ + gramms steht im Eingabepuffer, ist also über #ib#blockin#ie# lesbar. + Vorher wurden nur Zeichen eingelesen, die zum verwendeten + #ib#Netzprotokoll#ie# gehören (z.B. #ib#Ethernet#ie#-#ib#Adresse#ie#n, #ib#Füllzeichen#ie# + usw.). + niltext: kein neues Telegramm da + + jedes andere Zeichen: + Fehler. Entweder wurden Störzeichen eingelesen oder es + gingen Zeichen verloren. #ib#Fehlerbehandlung#ie# erfolgt durch die + Netzsoftware. +#page# + PROC #ib#transmit header#ie# (DATASPACE CONST ds): + + Wird vor Ausgabe eines jeden #ib#Telegramm#ie#s aufgerufen. In dem #ib#Datenraum#ie# + #on("b")#ds#off("b")# wird von der EUMEL-Netz-Software der #on("b")##ib#Vorspann#ie##off("b")# übergeben. Über + den jeweiligs eingestellten #ib#Netzmodus#ie# kann für jede implementierte Netz­ + art über eine #ib#Sprungleiste#ie# (#ib#SELECT#ie#) die Prozedur angesprungen werden, + die den #ib#Header#ie# für den eingestellten Netzmodus erstellt und ausgibt. + Struktur des von der EUMEL-Netz-Software benutzten Headers: + + BOUND STRUCT + (INT head, + zwischenziel, + zielrechner, + quellrechner, + strom, + sequenz, + seitennummer ) VAR vorspann. + + Aus dem Inhalt des Feldes #on("b")#head#off("b")# kann mittels #on("b")##ib#decode packet length#ie##off("b")# die + Gesamtlänge des EUMEL-Netztelegramms errechnet werden. + + PROC #ib#transmit trailer#ie#: + + Wird nach Ausgabe eines jeden Telegramms aufgerufen. Evtl. notwendige + Nachspänne können ausgegeben werden. Die notwenigen Informationen + wurden in #on("b")##ib#transmit header#ie##off("b")# übergeben und müssen aufbewahrt werden, + falls sie im Trailer mitgeliefert werden müssen. Kann auch dazu benutzt + werden, den unter diesem Packet liegenden Schichten (#ib#SHard#ie# oder Hard­ + ware) das Ende des Telegramms mitzuteilen. Notwendige #ib#Füllzeichen#ie# + können in dieser Prozedur in das #ib#Paket#ie# eingebaut werden. + + PROC #ib#reset box#ie# (INT CONST net mode): + + Kann zur Initialisierung der #ib#Netzhardware#ie# benutzt werden. Wird von #on("b")##ib#basic + net#ie##off("b")# beim jedem Neustart aufgerufen. + + INT PROC #ib#max mode#ie#: + + Liefert den Wert des größten erlaubten (implementierten) #ib#Netzmodus#ie#. + + INT PROC #ib#net mode#ie#: + + Liefert den eingestellten Netzmodus. +#page# +#pagenr ("%", 45)##setcount (1)##block##pageblock##count per page# +#headeven# +#center#EUMEL Netzbeschreibung +#center#____________________________________________________________ + +#end# +#headodd# +#center#Anhang +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +Netz - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#Netz - % +#end# +#clear pos##lpos(1.0)##rpos(9.5)##goalpage("A")# + +Anhang: Netz-Meldungen#goalpage("A.1")# + +Mit dem Kommando #on("b")##ib#list#ie# (/"net list")#off("b")# (siehe Teil 1) erhalten Sie eine temporäre #ib#Datei#ie# +auf den Bildschirm. Diese Datei könnte ungefähr so aussehen: + +____________________________________________________________________________ + + N e u e r S t a r t 12:44 Stationsnummer : 38 + 01.06.87 12:55 net port 8:20:Nicht zustellbar. . Empfänger: "net dok". Quelle 34 Taskindex: 255 + 02.06.87 06:30 net port 8:1:wdh data. sqnr 7. Absender: "net dok". Ziel 34 Taskindex: 255 + 02.06.87 07:03 net port:20:Sequenzfehler: soll 13 ist 14. Empfänger: "POST". Quelle 33 Taskindex: + 02.06.87 07:03 net port:blockin abbruch + 02.06.87 07:03 net port:20:Sequenzreset von 13 auf 10. Empfänger: "POST". Quelle 33 Taskindex: 29 + 02.06.87 07:36 net port:Call gelöscht."net dok". Strom 1 + 02.06.87 07:43 net port 8:verbotene Route: 34 + 02.06.87 07:50 net port:Header inkorret eingelesen: %0 %2 + 02.06.87 07:50 net port:buffers flushed + 02.06.87 07:52 net port:Weiterleitung nicht möglich für 34 + 02.06.87 07:53 net port 8:skipped0 6 G O 1 0 . 0 %13 %10 2 8 0 6 0 6 G O 1 0 . 0 %13 %10 2 8 0 + 02.06.87 08:14 net port 8:skipped%13 %10 S p e c . R e c e i v e E r r o r C 2 + 02.06.87 08:21 net port:20:Reopen. Empfänger: "WÜFE". Quelle 40 Taskindex: 22 + 02.06.87 09:25 net port:1:etwas rueckgespult. Absender: "-". Ziel 33 Taskindex: 51 + 02.06.87 09:25 net port:1:wdh data. sqnr 20. Absender: "-". Ziel 33 Taskindex: 51 + 02.06.87 09:54 net port:20:Blocknummer falsch, neu: 192, alt : -1. Empfänger: "WÜFE". Quelle 44 + 02.06.87 10:12 net port:Daten ohne Eroeffnung von 40 Sequenznr 7 + 02.06.87 10:23 net port:Header inkorret eingelesen: O X 0 3 8 B O X 0 4 4 E U %2 + 02.06.87 10:23 net port:buffers flushed + 02.06.87 10:49 net port:1:wdh open. Absender: "-". Ziel 33 Taskindex: 255 + 02.06.87 10:49 net port:2:wdh open. Absender: "net dok". Ziel 33 Taskindex: 255 + 02.06.87 10:53 net port:1:Sequenzfehler: soll 2 ist 3. Empfänger: "net dok". Quelle 33 Taskindex: + 02.06.87 10:54 net port:1:Sequenzreset von 8 auf 5. Empfänger: "net dok". Quelle 33 Taskindex: 11 + 02.06.87 10:56 net port:2:etwas rueckgespult. Absender: "-". Ziel 33 Taskindex: 51 + bekannte Stationen: + 1(8,1) 2(8,2) 3(8,3) 4(8,4) 5(8,5) 6(8,6) 7(8,7) 8(8,8) 9(8,9) 10(8,10) + 11(8,11) 12(8,12) 13(8,13) 14(8,14) 15(8,15) 16(8,16) 17(8,17) 18(8,18) + 19(8,19) 20(8,20) 21(8,21) 22(8,22) 23(8,23) 24(8,24) 25(8,25) 26(8,26) + 27(8,27) 28(8,28) 29(8,29) 30(8,30) 31(8,31) 32(8,32) 33(9,33) 34(8,34) + 35(9,35) 36(9,36) 37(9,37) 39(9,39) 40(9,40) 41(9,41) 42(9,42) 43(9,43) + 44(9,44) 45(9,45) 46(9,46) 47(9,47) 48(9,48) + -------- + Eingestellte Netzmodi: + net port 8 haengt an Kanal 8, Modus: (1) EUMEL-Netz 64 Byte + net port haengt an Kanal 9, MODUS: (11) ETHERNET via V.24 512 Byte + + Nutzdatenlänge 512 Byte + Nutzdatenlänge bei indirekter Verbindung: 64 Byte + ******** + Netz-Software vom 23.05.87 + Rechner 38 um 11:11 + net port 8 + + Strom 1 (sqnr7/8) sendet an 34 . Absender ist "net dok". + net port + + Strom 1 (sqnr45/45) empfaengt von 40 . Empfaenger ist "PUBLIC". + +____________________________________________________________________________ +#page# +Die Datei enthält den aktuellen #on("b")##ib#report#ie##off("b")#, in dem #ib#Fehlermeldung#ie#en der einzelnen Tasks +gesammelt werden. Außerdem wird der Zustand aller Verbindungen (Ströme) von allen +#on("b")##ib#net port#ie##off("b")#'s angezeigt. Im #on("b")#report#off("b")#-Teil kann man drei Informationsblöcke unterscheiden: + +a) den Block mit den Fehlermeldungen. Es werden jeweils Datum, Uhrzeit, der Name + des betroffenen #on("b")#net port#off("b")# und, wenn notwendig, die #ib#Stromnummer#ie# angegeben. + Darauf folgt der Meldungstext, der auch Informationen über Absender und Emp­ + fänger enthalten kann. + + : [<#ib#Stromnummer#ie#> : ] + + +b) den Block mit der Liste der bekannten #ib#Station#ie#en. Ein Eintrag in dieser Liste ent­ + hält jeweils die Stationsnummer der bekannten Station und in Klammern dahin­ + ter die Nummer des Kanals auf diesem Rechner, über den die Station erreichbar + ist und die Nummer der nächsten #ib#Zwischenstation#ie#. + + (,) + + Bei direkt erreichbaren Stationen ist Zwischenstation gleich #ib#Zielstation#ie#. + + Hinweis: Auch #ib#gesperrt#ie#e Stationen erscheinen in dieser Liste. + + +c) den Block, der Auskunft über die Netzinstallation gibt. Es werden für jeden Netz­ + kanal die eingestellten Netzmodi angegeben. Des weiteren werden die beiden + Größen #on("b")##ib#data length#ie##off("b")# (#ib#Nutzdatenlänge#ie#) und #on("b")##ib#data length via node#ie##off("b")# (Nutzdatenlänge bei + indirekter Verbindung) angegeben. Zusätzlich erscheinen noch die #ib#Netzversion#ie# und + die genaue Uhrzeit, zu der dieser #on("b")#report#off("b")# erstellt wurde. + +#page# +Für jeden #on("b")##ib#net port#ie##off("b")# wird pro aktivem #ib#Strom#ie# folgende Meldung generiert: + +Strom (sqnr/) + + + #ib#Stromnummer#ie# + + #ib#Sequenznummer#ie# des gerade bearbeiteten #ib#Telegramm#ie#s + + Bei #ib#Sendeströme#ie#n die Nummer der letzten zu übertragenden + #ib#Sequenz#ie#, bei Empfangsströmen in der Regel die Nummer der + letzten Sequenz der gerade übertragenen #ib#Datenraumseite#ie#. + +<#ib#Zustand#ie#> Hier wird die Aktion (senden, empfangen usw.) und die Partner­ + station angegeben. + +<#ib#Partner#ie#> Der Name der Task mit der kommuniziert wird. + + +Die Meldungen, die in der #ib#Datei#ie# #on("b")##ib#report#ie##off("b")# protokolliert werden, kann man in verschiedene +Gruppen einordnen. Die eine Gruppe beschreibt Störungen durch #ib#Zeichenverluste#ie# +oder ­verfälschungen, eine andere Gruppe protokolliert besondere Situationen, bei­ +spielsweise den Abbruch von #ib#Übertragung#ie#en, und die letzte Gruppe befasst sich mit +#ib#Fehlermeldung#ie#en, die ein Eingreifen von aussen notwendig machen. Je nachdem, ob +die Station, auf der die Meldung protokolliert wird, Empfänger oder Absender ist, wird +bei den Meldungen #ib#Stationsnummer#ie# und Taskname des Kommunikationspartners mit +angegeben. + +Zur ersten Gruppe gehören: + +#ib(4)##ib#skipped#ie##ie(4)# + 'skipped' oder skipped mit einem Zusatztext erscheint, wenn Zei­ + chen eingelesen wurden, die zu keinem gültigen #ib#Telegramm#ie# ge­ + hören. Dies kann passieren, wenn auf der Leitung zwischen + Rechner und Box #ib#Zeichen#ie# verlorengegangen sind. Auch nach dem + Einschalten oder nach einem Reset auf Box oder Rechner kann + diese Meldung kommen. Mindestens ein Teil der eingelesenen + Daten wird mit ausgegeben, wobei Steuerzeichen durch % und den + Code des Steuerzeichens dargestellt werden. Die einzelnen Zeichen + werden durch ein Blank voneinander getrennt. +#page# +#ib(4)##ib#Sequenzfehler#ie##ie(4)# + Die #ib#Sequenznummer#ie# ist zu groß, es fehlen also Telegramme. Die + Gegenstation wird aufgefordert, ab einem früheren Telegramm zu + wiederholen. + +#ib(4)#wdh data#ie(4)# + Das letzte Telegramm wird erneut geschickt. Passiert, wenn die + #ib#Quittung#ie# für dieses Telegramm nach einer bestimmten Zeit nicht + angekommen ist. + +#ib(4)##ib#Sequenzreset#ie##ie(4)# + Die #ib#Sequenznummer#ie# des empfangenen Telegramms ist kleiner als + die Sequenznummer des vorher empfangenen Telegramms. Die + Verbindung wird bei der zuletzt empfangenen Sequenznummer + fortgesetzt. + +#ib(4)#Blocknummer falsch#ie(4)# + Die #ib#Seitennummer#ie# in dem #ib#Telegramm#ie# ist falsch. + +#ib(4)#etwas rueckgespult#ie(4)# + Auf Anforderung der Gegenseite werden die letzten drei #ib#Datenraum­ + seite#ie#n erneut übertragen. + +#ib(4)#Daten ohne Eroeffnung#ie(4)# + Es werden Telegramme mit einer #ib#Stromnummer#ie# empfangen, zu der + vorher kein OPEN-Telegramm empfangen wurde. In diesem Fall + wird die Gegenstation aufgefordert, die #ib#Übertragung#ie# von vorn zu + beginnen. Diese Meldung kann auch kommen, wenn das Netz neu + gestartet wurde. + +#ib(4)#wdh open#ie(4)# + Die Übertragung wird mit dem #ib#OPEN#ie#-Telegramm von vorn begon­ + nen. Passiert auf Aufforderung durch die Gegenstation oder wenn + das erste OPEN-Telegramm nicht quittiert wurde. + +#ib(4)##ib#buffers flushed#ie##ie(4)# + Alle bereits eingelesenen, aber noch nicht bearbeiteten Zeichen + wurden gelöscht (der #ib#Eingabepuffer#ie# wurde komplett gelöscht). Verur­ + sacht durch schwere Störungen (#ib#Zeichenverluste#ie# oder -verfäl­ + schungen). +#page# +#ib(4)#blockin abbruch#ie(4)# + Es wurden nicht alle Zeichen eines Telegramms innerhalb eines + bestimmten Zeitraums angeliefert. + +#ib(4)#Header inkorrekt eingelesen#ie(4)# + Es wurde ein Fehler in dem Teil des Netztelegramms gefunden, der + nicht zum EUMEL-Netz gehört. + +#ib(4)#Strom falsch in Quittung#ie(4)#: + In der #ib#Quittung#ie# wurde eine nicht zulässige #ib#Stromnummer#ie# festge­ + stellt. Zulässig sind Stromnummern zwischen 1 und 20. + +#ib(4)#Neustart#ie(4)# + Die Gegenstation hat die #ib#Verbindung#ie# von vorne begonnen. + +#ib(4)#Falsche Seitennummer#ie(4)# + Die #ib#Seitennummer#ie# in dem empfangenen Telegramm ist falsch. + Einige Telegramme werden wiederholt. + +#ib(4)#Absteigende Seitennummern#ie(4)# + Die Seitennummer in dem empfangenen Telegramm ist kleiner als + die Seitennummer im vorigen #ib#Telegramm#ie#. Es müssen einige Tele­ + gramme wiederholt werden. + + +Die folgenden Meldungen beschreiben Situationen, die nicht durch #ib#Zeichenverluste#ie# +entstehen, mit denen die #ib#Netzsoftware#ie# selbst fertig wird: + + +#ib(4)#Sendung von Gegenstelle gelöscht#ie(4)# + Die Verbindung wurde von der Gegenstelle abgebrochen. + +#ib(4)#Empfangseintrag freigegeben#ie(4)# + Die Verbindung wurde von der empfangenden #ib#Station#ie# gelöscht, weil + seit dem Eintreffen des letzten Telegramms zuviel Zeit vergangen ist + (#ib#Timeout#ie#). + +#ib(4)#Irrläufer#ie(4)# + Eine #ib#Intertaskkommunikation#ie# innerhalb der eigenen Station wurde + fälschlicherweise über den #on("b")##ib#Collector#ie##off("b")# abgewickelt. Dieser Vorgang + wird abgebrochen. +#page# +#ib(4)#Call-Löschung vorgemerkt#ie(4)# + Sobald der Call abgewickelt ist, wird diese Verbindung gelöscht. + Beispielsweise führt ein vom Benutzer abgebrochenes #on("b")##ib#name#ie##off("b")# zu + dieser Meldung. + +#ib(4)#Call gelöscht#ie(4)# + Die #ib#Verbindung#ie# wurde auf Anforderung durch den Auftraggeber + gelöscht. + +#ib(4)#Quellrechner#ie(4)# + Als #ib#Quellrechnernummer#ie# wurde ein unzulässiger Wert festgestellt. + Zulässig sind Zahlen zwischen 1 und 127. + +#ib(4)#Nicht zustellbar#ie(4)# + Innerhalb eines bestimmten Zeitraums war die #ib#Zieltask#ie# nicht emp­ + fangsbereit. Die Verbindung wird abgebrochen. + +Bei diesen Meldungen sollten die #ib#Routenanweisungen#ie# überprüft werden: + +#ib(4)#Verbotene Route bei Quittung#ie(4)# + Die #ib#Quittung#ie# kommt auf einer nicht erlaubten #ib#Route#ie# an. Dies kann + bei #ib#Vermaschung#ie# passieren, oder aber, wenn eine Station versucht, + sich für eine andere Station auszugeben. + +#ib(4)#Verbotene Route#ie(4)# + Die danach bezeichnete Station versucht, auf einer anderen Route + mit diesem Rechner zu kommunizieren, als auf der Route, die für + diesen Rechner in der Datei #on("b")##ib#netz#ie##off("b")# festgelegt wurde. + + Abhilfe: + #ib#Routentabellen#ie# der beiden (oder, falls die Meldung auf einer + #ib#Knotenstation#ie# erscheint, auf allen beteiligten) Stationen abgleichen. + +#ib(4)#Weiterleitung nicht möglich#ie(4)# + Die #ib#Routeninformationen#ie# auf dem #ib#Knotenrechner#ie#, wo diese Meldung + erscheint, und der sendenden #ib#Station#ie# stimmen nicht überein. Die + angegebene Station ist von dieser Station aus nicht erreichbar. + + Abhilfe: + #ib#Routentabellen#ie# der Stationen überprüfen. + +#ib(4)#Fremdzugriff#ie(4)# + Eine #ib#gesperrt#ie#e Station hat versucht, auf diesen Rechner mit #ib#Sende­ + codes#ie# > 6 zuzugreifen. + + +Folgende Meldungen betreffen '#ib#harte Fehler#ie#'. Diese Fehler werden von der Netzsoft­ +ware nicht abgefangen. In jedem Fall muß das Netz nach einer solchen #ib#Fehler­ +meldung#ie# neu gestartet werden. + +#ib(4)#++++++#ie(4)# + Meldungen dieser Form sind 'harte' Fehler. Der aufgetretene Fehler + wird mit angegeben. Das Netz muß neu gestartet werden, da die + Task, in welcher der Fehler aufgetreten ist, gelöscht wird. + +#ib(4)#Verbindungsengpaß#ie(4)# + Es sind mehr Verbindungen festgestellt worden, als zulässig sind. + Nach dieser Meldung wurde der entsprechende Netport gelöscht. + + +Literaturverzeichnis + + +#goalpage("A.2")# + +#clear pos# +#lpos(1.0)##lpos(2.5)# +#table# +[1] EUMEL-Systemhandbuch, Teil 5, Intertaskkommunikation + GMD St. Augustin, 1986 +[2] EUMEL-Systemhandbuch, Teil 2, Hardware und ihre Steuerung +[3] EUMEL-Systemhandbuch, Teil 8, Spooler +[4] EUMEL-Netz Installationsanweisung + GMD St. Augustin, 1987 +[5] EUMEL-Systemhandbuch, Teil 4, Blockorientierte Ein/Ausgabe +[6] EUMEL-Quellcode, Packet #on("b")#tasks#off("b")# + GMD St. Augustin, 1986 +[7] EUMEL-Portierungshandbuch 8086, Version 8 + GMD St. Augustin, 1987 + +#table end# + + diff --git a/system/net/1.8.7/doc/netzhandbuch.anhang b/system/net/1.8.7/doc/netzhandbuch.anhang new file mode 100644 index 0000000..17d1ece --- /dev/null +++ b/system/net/1.8.7/doc/netzhandbuch.anhang @@ -0,0 +1,58 @@ +#pagenr ("%", 51)##setcount##block##pageblock##count per page# +#headeven# +#center#EUMEL Netzbeschreibung +#center#____________________________________________________________ + +#end# +#headodd# +#center#Anhang +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +Netz - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#Netz - % +#end# +#clear pos##lpos(0.0)##rpos(11.0)##fillchar(".")# +Anhang: Netz-Fehlermeldungen + +#table# +++++++ 50 +Absteigende Seitennummern 48 +blockin abbruch 48 +Blocknummer falsch 47 +buffers flushed 47 +Call gelöscht 49 +Call-Löschung vorgemerkt 49 +Collectortask fehlt 8, 18 +Daten ohne Eroeffnung 47 +Empfangseintrag freigegeben 48 +etwas rueckgespult 47 +Falsche Seitennummer 48 +Fremdzugriff 50 +Header inkorrekt eingelesen 48 +Irrläufer 48 +kein Zugriff auf Station 14 +Neustart 48 +Nicht zustellbar 49 +Quellrechner 49 +Sendung von Gegenstelle gelöscht 48 +Sequenzfehler 47 +Sequenzreset 47 +skipped 46 +Station x antwortet nicht 8, 11, 16 +Station x gibt es nicht 9, 11, 13 +Strom falsch in Quittung 48 +Task "..." gibt es nicht 8 +Verbindungsengpaß 50 +Verbotene Route 49 +Verbotene Route bei Quittung 49 +wdh data 47 +wdh open 47 +Weiterleitung nicht möglich 49 +#table end# + diff --git a/system/net/1.8.7/doc/netzhandbuch.index b/system/net/1.8.7/doc/netzhandbuch.index new file mode 100644 index 0000000..01d8a0f --- /dev/null +++ b/system/net/1.8.7/doc/netzhandbuch.index @@ -0,0 +1,259 @@ +#pagenr ("%", 52)##setcount (1)##block##pageblock##count per page# +#headeven# +#center#EUMEL Netzbeschreibung +#center#____________________________________________________________ + +#end# +#headodd# +#center#Anhang +#center#____________________________________________________________ + +#end# +#bottomeven# +#center#____________________________________________________________ +Netz - % #right#GMD +#end# +#bottomodd# +#center#____________________________________________________________ +GMD #right#Netz - % +#end# +#clear pos##lpos(0.0)##rpos(11.0)##fillchar(".")# +Anhang: Index + +#table# +/ 8, 9, 24 +Absenderadresse 39 +Absenderstation 28, 32 +Adresse 29, 37, 39, 41, 42 +aktiviere netz 14, 15, 18 +basic net 41, 43 +Baud 6, 18, 25 +blockin 23, 36, 40, 42 +blockout 23, 36, 40 +Broad- oder Multicasts 38 +buffers flushed 47 +CASE 37 +CLOSE 27 +collected destination 22, 24 +Collector 22, 24, 32, 48 +Collectortask 8, 18, 22 +configurate 6 +continue 7, 21 +CRC-Code 26 +DATA 27, 29, 30 +data length 23, 36, 41, 45 +data length via node 23, 36, 41, 42, 45 +Datei 2, 5, 7, 12, 13, 14, 18, 20, 24, 31, 37, 41, 44, 46 +Datenbox 2, 6, 33 +Datenraum 13, 15, 21, 23, 24, 27, 28, 29, 31, 36, 40, 43 +Datenraumseite 23, 46, 47 +decode packet length 42, 43 +define collector 22, 24 +definere netz 15 +DEFINES 37 +define station 5, 22 +definiere netz 14 +Dreher 16 +Durchsatz 3 +Eingabeprozeduren 21 +Eingabepuffer 47 +Empfangspuffer 15 +Empfangsströme 13, 15 +endquelle 28 +endziel 28 +erase 13, 19 +erlaube 14 +Ethernet 33, 34, 36, 37, 42 +EUMEL0 21, 22, 24 +EUMEL-Datenboxen-Netz 33 +EUMEL-Netz-Software 35 +exists 11 +Fehler 8, 16, 17, 18 +Fehlerbehandlung 31, 36, 42 +Fehlerfälle 8 +Fehlerfall 11, 40 +Fehlermeldung 13, 15, 20, 26, 39, 45, 46, 50 +Fehlersituationen 12 +Fehlersuche 16 +Fenstertechnik 31 +fetch 10, 18 +flush buffers 36, 42 +Flußkontrolle 7, 15, 27, 39 +free global manager 10, 19, 31 +Füllzeichen 37, 39, 42, 43 +gesperrt 13, 14, 45, 50 +global manager 19, 31 +harte Fehler 50 +HDLC 31 +Header 43 +Höhere Ebenen 31 +inchar 21 +incharety 23 +Installation 2 +Installationsanleitung 2 +Intertaskkommunikation 48 +I/O Control 36 +I/O-Kanal 33 +Kanal 3, 6, 7, 12, 14, 15, 20, 21, 23, 24, 34, 37, 40, 41 +Kanalnummer 14 +Kanaltask 45 +Knoten 3, 4, 17, 20, 23, 36, 42 +Knotenkonzept 3, 34 +Knotenrechner 34, 36, 49 +Knotenstation 13, 14, 20, 49 +Kommunikation 17 +Kommunikationindirekte 23 +konfigurieren 6 +Länge 29, 41, 42 +Längenangabe 26 +list 10, 12, 17, 44 +listoption 12, 14, 15 +Löschversuche 13 +Manager 10, 19 +Masseschluß 16 +max mode 43 +mode text 41 +Nachbarn 4, 28 +Nachbarstation 24, 28 +name 11, 24, 49 +net 7, 12, 13 +net addess 41 +net hardware interface 34, 40 +net install 7 +net list 12, 15 +net manager 41 +net mode 41, 43 +net port 7, 8, 12, 13, 18, 45, 46 +net timer 14 +netz 7, 14, 15, 20, 37, 41, 49 +Netzbox 3, 6, 20, 33, 38 +Netzdefinition 14 +Netzebene 26 +Netzempfangstask 30 +Netzhardware 2, 17, 21, 24, 33, 34, 36, 41, 43 +Netz-Hardware-Interface 34 +Netzinstallation 17 +Netzkanal 13, 14, 42 +Netzknoten 3 +Netzkonfiguration 7, 20 +Netzmodus 34, 37, 39, 41, 43 +Netzprotokoll 42 +Netzsoftware 2, 3, 18, 20, 34, 36, 38, 42, 48 +Netzstrang 4, 17, 23 +Netztask 15, 16, 21, 24 +Netztelegramm 34 +Netztreiber 38 +Netzübertragungen 12 +Netzversion 2, 45 +next packet start 36, 42 +niltext 11, 36 +Nutzdaten 23 +Nutzdatenlänge 17, 23, 29, 36, 41, 42, 45 +Nutzinformation 29 +nutzlaenge 29 +OPEN 27, 28, 30, 47 +Paket 23, 34, 37, 38, 39, 42, 43 +Pakete, Aufbau der 34 +Partner 46 +Paßwort 19 +Pin-Belegung 6 +port intern 13, 15, 24 +Printerserver 20 +Protokoll 6, 13, 24, 39 +Protokollebenen 25 +Prüfsummen 18 +Quelle 23, 26, 28 +Quellrechnernummer 49 +Quellstationsnummer 20 +quelltask 21, 24, 28 +Querarchivierungen 10 +QUIT 27, 28, 30 +Quittung 30, 31, 47, 48, 49 +Rechnerkopplung 3 +Rendezvouskonzept 21, 31 +report 8, 12, 18, 39, 40, 41, 45, 46 +reserve 10 +RESET 17 +reset box 43 +Route 13, 15, 17, 20, 49 +routen 14 +Routenanweisungen 49 +routen aufbauen 13, 14, 15 +Routeninformationen 20, 49 +Routentabelle 9, 13 +Routentabellen 24, 49 +router 13 +RS422 25 +RTS/CTS 6, 25, 39 +Rückmeldeparameter 21 +run 13 +save 10, 19 +Schnittstelle 3, 15, 18, 20, 25, 33, 37, 38, 39 +SDLC 25, 26 +seite 28, 29, 40 +Seiten 27 +Seitengrenze 23 +Seitennummer 47, 48 +SELECT 34, 37, 43 +send 21, 22, 24, 27, 28, 30, 32 +Sendecode 24 +Sendecodes 50 +Sendeströme 13, 46 +Sendungskonzept 2 +sequenz 28, 29, 46 +Sequenzfehler 47 +Sequenznummer 46, 47 +Sequenzreset 47 +set net mode 41 +SHard 38, 43 +Sicherheitskonzept 19 +Sicherheitsprobleme 19 +skipped 46 +sperre 14 +Spoolmanager 5 +Sprungleiste 43 +Sprungleisten 34, 37 +start 5, 13, 16, 18, 41 +starte kanal 14, 15 +station 2, 5, 8, 10, 12, 13, 16, 19, 20, 22, 24, 26, 31, 32, 36, 41, 45, 48, 49 +Stationen, sicherheitsrelevante 20 +Stationsadresse 38 +Stationsnummer 5, 10, 16, 22, 24, 26, 32, 37, 41, 46 +Stationsnummer maximale 14 +Strang 3, 17, 20, 36, 41 +Stream I/O 23, 38 +strom 28, 30, 46 +Stromnummer 13, 28, 30, 45, 46, 47, 48 +STX 26, 36, 42 +Task-Id 5, 22, 24, 28, 30 +Telegramm 20, 23, 26, 27, 28, 31, 36, 37, 40, 42, 43, 46, 47, 48 +Telegrammanfang 42 +Telegrammformat 26 +Telegrammfreigabe 36 +Textdatei 31 +Timeout 31, 36, 48 +transmit header 36, 42, 43 +transmit trailer 36, 43 +Treiber 33 +Übertragung 26, 30, 46, 47 +Übertragungsfehler 42 +Übertragungsgeschwindigkeit 34, 38 +Übertragungsweg 23 +V24 3, 4, 15, 17, 18, 20, 25, 33, 34, 38 +Verbindung 3, 6, 16, 18, 27, 28, 34, 48, 49 +Vermaschung 4, 49 +Vermittlungsebene 24, 30 +Vorspann 36, 43 +wait 19, 21, 24, 27, 32 +Worker 5 +Zeichen 36, 38, 40, 42, 46 +Zeichenverluste 46, 47, 48 +Zeitüberwachung 26, 29 +ziel 28 +Zieladresse 38 +Zielstation 4, 8, 24, 28, 30, 36, 45 +Zieltask 21, 22, 24, 28, 32, 49 +Zustand 46 +Zwischenstation 45 +#table end# + diff --git a/system/net/1.8.7/source-disk b/system/net/1.8.7/source-disk new file mode 100644 index 0000000..5a39f6c --- /dev/null +++ b/system/net/1.8.7/source-disk @@ -0,0 +1 @@ +grundpaket/11_austausch.img diff --git a/system/net/1.8.7/src/basic net b/system/net/1.8.7/src/basic net new file mode 100644 index 0000000..c5e9278 --- /dev/null +++ b/system/net/1.8.7/src/basic net @@ -0,0 +1,1148 @@ +PACKET basic net DEFINES (* D. Heinrichs *) + (* Version 10 (!) *) (* 18.02.87 *) + nam, (* 03.06.87 *) + max verbindungsnummer, (* *) + neuer start, + neue routen, + packet eingang, + neue sendung, + zeitueberwachung, + verbindung, + loesche verbindung: + +TEXT PROC nam (TASK CONST t): + IF t = collector THEN name (t) + ELIF station (t) <> station (myself) + THEN "** fremd "+text(station(t))+" **" + ELSE name (t) + FI +END PROC nam; + +INT PROC tasknr (TASK CONST t): + IF t = collector THEN maxtasks + ELSE index (t) + FI +END PROC tasknr; + +LET + maxtasks = 127, + maxstat = 127, + max strom = 20, + max strom 1 = 21, + stx = ""2"", + code stx = 2, + error nak = 2, + seiten groesse = 512, + dr verwaltungslaenge = 8, + dr verwaltungslaenge2=10, + openlaenge = 24, + vorspannlaenge = 14, + ack laenge = 12, + min data length = 64, + (* Codes der Verbindungsebene *) + + task id code = 6, + name code = 7, + task info code = 8, + routen liefern code = 9, + + (* Typen von Kommunikationsströmen *) + + send wait = 0, + zustellung = 1, + call pingpong = 2, + call im wait = 3, + call im abbruch = 4, + call in zustellung = 5, + + (*quittungscodes*) + + ok = 0, + von vorne = 1, + wiederhole = 2, + loesche = 3, + beende = 4; + +LET STEUER = + STRUCT ( + INT head, + zwischenziel, + zielrechner, + quellrechner, + strom, + sequenz, + seitennummer, + TASK quelle,ziel, + INT sende code); + +BOUND STEUER VAR open block; + +BOUND STRUCT (STEUER steuer, INT typ, maxseq) VAR info block; + +BOUND STRUCT ( + INT head, + zwischenziel, + zielrechner, + quellrechner, + strom, + sequenz, + seitennummer) VAR vorspann ; + +LET ACK = STRUCT ( + INT head, + zwischenziel, + zielrechner, + quellrechner, + strom, + code); +BOUND ACK VAR ack packet ; +BOUND ACK VAR transmitted ack packet; + +BOUND STRUCT (ROW maxstat INT port, + ROW maxstat INT zwischen) VAR route; + +INT CONST max verbindungsnummer := max strom; +INT VAR codet,net mode, nutzlaenge := data length, + data len via node := data length via node; + +TEXT VAR buffer first; + +DATASPACE VAR work space := nilspace; +DATASPACE VAR transmitted ack space := nilspace; + + +INT VAR pakete pro seite, + pakete pro seite minus 1, + packets per page via node, + packets per page via node minus 1, + datenpacketlaenge via node, + datenpacketlaenge ; + +INT VAR strom; +INT VAR last data := -1; +INT VAR own:=station (myself) , + quit max := 3, + quit zaehler := 3, + own256 := 256*own; +INT CONST stx open := code stx+256*openlaenge, + stx quit := code stx+256*acklaenge; + + STEUER VAR opti; + ROW maxstrom1 STEUER VAR verbindungen; + ROW maxstrom1 DATASPACE VAR netz dr; + ROW maxstrom1 INT VAR zeit, typ, open try; + FOR strom FROM 1 UPTO maxstrom1 REP vdr := nilspace; forget (vdr) PER; + ROW maxstrom INT VAR dr page ; + ROW maxtasks INT VAR alter call; + +.vx : verbindungen (strom). + +vdr: netz dr (strom). + + via node: + vx.zielrechner <= 0 OR vx.quellrechner <= 0 OR + transmit via node OR receive via node. + + transmit via node: + route.zwischen (vx.zielrechner) <> vx.zielrechner AND vx.zielrechner <> own. + + receive via node: + route.zwischen (vx.quellrechner) <> vx.quellrechner AND vx.quellrechner <> own. + +falsche stromnummer: strom < 1 OR strom > maxstrom. + +zielrechner ok: vorspann.zielrechner > 0 AND vorspann.zielrechner <= maxstat. + +quellrechner ok: vorspann.quellrechner > 0 + AND vorspann.quellrechner <= maxstat. + +call aufruf: typ(strom) >= call pingpong. + +alles raus: vx.seitennummer = -1 AND letztes packet der seite . + +letztes packet der seite : +(vx.sequenz AND packets per page minus 1) = packets per page minus 1. + +neue verbindung: code t = open laenge. + +PROC neue routen: + route := old ("port intern"); +END PROC neue routen; + +PROC neuer start (INT CONST empfangsstroeme, mode): + net mode := mode; + strom := 1; + neue routen; + transmitted ack space := nilspace; + workspace := nilspace; + open block := workspace; + info block := workspace; + nutzlaenge := data length; + data len via node := data length via node; + pakete pro seite:= seitengroesse DIV nutzlaenge; + pakete pro seite minus 1 := pakete pro seite -1; + packets per page via node := seitengroesse DIV data len via node; + packets per page via node minus 1 := packets per page via node - 1; + datenpacketlaenge := vorspannlaenge + nutzlaenge; + datenpacketlaenge via node := vorspannlaenge + data len via node; + vorspann := workspace; + ack packet := workspace; + transmitted ack packet := transmitted ack space; + FOR strom FROM 1 UPTO maxstrom1 REP + vx.strom := 0; forget (vdr) + PER; + INT VAR i; + FOR i FROM 1 UPTO maxtasks REP alter call (i) := 0 PER; + quitmax := empfangsstroeme; + own:=station (myself); + quit zaehler := quit max; + own256 := 256*own; + reset box (net mode); + buffer first := ""; + flush buffers; + INT VAR err; + fehlermeldung ruecksetzen. + + fehlermeldung ruecksetzen: + control (12,0,0,err). + +END PROC neuer start; + +DATASPACE PROC verbindung (INT CONST nr): + INT VAR memory := strom; + strom := nr; + infoblock.steuer := verbindungen (nr); + infoblock.typ := typ (nr); + infoblock.maxseq := dspages (netzdr(nr)) * packets per page; + strom := memory; + workspace +END PROC verbindung; + +PROC neue sendung (TASK CONST q,z, INT CONST cod,z stat, DATASPACE CONST dr): + + naechste verbindung vorbereiten; + forget (vdr); vdr := dr; + sendung starten (q, z, z stat, cod) +END PROC neue sendung; + +PROC zeitueberwachung + (INT VAR snr, TASK VAR q, z, INT VAR ant,DATASPACE VAR dr): + snr INCR 1; + FOR strom FROM snr UPTO maxstrom REP zeitkontrolle PER; + snr := 0. + +zeitkontrolle: + IF vx.strom <> 0 AND zeit(strom) > 0 + THEN + zeit(strom) DECR 1; + IF sendung noch nicht zugestellt + THEN + IF zeit(strom) = 0 + THEN + empfangsreport ("Nicht zustellbar. "); + loesche verbindung (strom) + ELSE + snr := strom; + q := vx.quelle; + z := vx.ziel; + ant := vx.sendecode; + dr := vdr; + LEAVE zeitueberwachung + FI + ELIF zeit(strom) = 0 + THEN wiederholen + FI + FI. + +sendung noch nicht zugestellt: + typ (strom) = zustellung. + +wiederholen: + IF sendeeintrag + THEN + sendung wiederholen + ELSE + empfangseintrag freigeben + FI. + +sendeeintrag : vx.quellrechner = own . + +sendung wiederholen: + IF wiederholung noch sinnvoll + THEN + IF frisch + THEN + time out bei open + ELSE + datenteil wiederholen + FI + ELSE + sendung loeschen + FI. + +wiederholung noch sinnvoll: + task noch da AND bei call noch im call. + +task noch da: vx.quelle = collector OR exists (vx.quelle). + +bei call noch im call: + IF call aufruf + THEN + callee (vx.quelle) = vx.ziel + ELSE + TRUE + FI. + +frisch: vx.sequenz = -1. + +time out bei open: + IF vx.sendecode > -4 OR opentry (strom) > 0 + THEN + open wiederholen ; + opentry (strom) DECR 1 + ELSE + nak an quelle senden + FI. + +nak an quelle senden: + dr := nilspace; + BOUND TEXT VAR erm := dr; + erm := "Station "+text(vx.zielrechner)+" antwortet nicht"; + snr := strom; + q := vx.ziel; + z := vx.quelle; + ant := error nak; + sendung loeschen; + LEAVE zeitueberwachung . + +open wiederholen: + sendereport ("wdh open"); + IF opentry (strom) > 0 THEN zeit(strom) := 4 ELSE zeit(strom) := 40 FI; + openblock := vx; + openblock.head := stx open; + ab die post. + +datenteil wiederholen: + sendereport ("wdh data. sqnr "+text (vx.sequenz)); + senden . + +empfangseintrag freigeben: + IF antwort auf call + THEN + weiter warten + ELSE + empfangsreport ("Empfangseintrag freigegeben"); + loesche verbindung (strom) + FI. +antwort auf call: callee (vx.ziel) = vx.quelle. + +weiter warten: zeit (strom) := 400. + +END PROC zeitueberwachung; + +PROC sendereport (TEXT CONST txt): + report (text (strom)+":"+txt+". Absender: """+nam (vx.quelle)+ + """. Ziel "+text(vx.zielrechner) + " Taskindex: " + + text (index (vx.ziel))); +END PROC sendereport; + +PROC empfangsreport (TEXT CONST txt): + report (text (strom)+":"+txt+". Empfänger: """ + +nam (vx.ziel)+""". Quelle "+text (vx.quellrechner) + + " Taskindex: " + text (index (vx.quelle))); +END PROC empfangsreport ; + +PROC sendung loeschen: + strom loeschen (tasknr (vx.quelle)) +END PROC sendung loeschen; + +PROC strom loeschen (INT CONST tasknr): + IF callaufruf CAND alter call (tasknr ) = strom + THEN + alter call (tasknr ) := 0 + FI; + vx.strom := 0; + forget (vdr) +END PROC strom loeschen; + +PROC empfang loeschen: + quit zaehler INCR 1; + strom loeschen (tasknr (vx.ziel)) +END PROC empfang loeschen; + +PROC loesche verbindung (INT CONST nr): + strom := nr; + IF sendeeintrag + THEN + sendung loeschen + ELSE + gegenstelle zum loeschen auffordern; + empfang loeschen + FI. + +gegenstelle zum loeschen auffordern: + IF verbindung aktiv THEN quittieren (-loesche) FI. + +verbindung aktiv: vx.strom > 0. + +sendeeintrag: vx.quellrechner = own . + +END PROC loesche verbindung; + +PROC weiter senden: + IF NOT alles raus + THEN + sequenz zaehlung; + IF neue seite THEN seitennummer eintragen FI; + senden + FI. + +sequenz zaehlung: + vx.sequenz INCR 1. + +neue seite: + IF via node THEN (vx.sequenz AND packets per page via node minus 1) = 0 + ELSE (vx.sequenz AND pakete pro seite minus 1) = 0 + FI. + +seitennummer eintragen: + dr page (strom) := vx.seiten nummer; + vx.seitennummer := next ds page (vdr, dr page (strom)). + + +END PROC weiter senden; + +.packets per page: + + IF via node THEN packets per page via node + ELSE pakete pro seite + FI. + +packets per page minus 1: + IF via node THEN packets per page via node minus 1 + ELSE pakete pro seite minus 1 + FI. + +used length: + + IF via node THEN data len via node + ELSE nutzlaenge + FI. + +PROC senden: + INT VAR nl; + zeit(strom) := 6; + openblock := vx; + nl := used length; + transmit header (workspace); + vorspann senden; + daten senden; + transmit trailer. + +vorspann senden: + blockout (workspace, 1, dr verwaltungslaenge, vorspannlaenge). + +daten senden: + blockout (vdr,dr page (strom),distanz,nl). + +distanz: nl* (vx.sequenz AND packets per page minus 1). + +END PROC senden; + +PROC naechste verbindung vorbereiten: + FOR strom FROM 1 UPTO maxstrom REP + UNTIL vx.strom = 0 PER; + IF vx.strom <> 0 THEN errorstop ("Verbindungsengpass") FI. +END PROC naechste verbindung vorbereiten; + +PROC sendung starten (TASK CONST quelle, ziel, INT CONST code): + sendung starten (quelle,ziel, station(ziel), code) +END PROC sendung starten; + +PROC sendung starten (TASK CONST quelle, ziel, INT CONST ziel station,code): + IF ziel station = own + THEN + report ("Irrläufer: Sendung an eigene Station. Absender:"""+ + nam (quelle)+"""."); + vx.strom := 0; + forget (vdr) + ELSE + openblock.ziel := ziel; + openblock.quelle :=quelle; + openblock.sendecode := code; + openblock.zielrechner:= ziel station; + openblock.quellrechner :=own; + openblock.zwischenziel := route.zwischen (ziel station)+own256; + alten call loeschen (quelle); + IF call oder ping pong + THEN typ (strom) := call pingpong; call merken + ELSE typ (strom) := send wait FI; + sendung neu starten + FI. + +call oder pingpong: openblock.ziel = callee (openblock.quelle). + +call merken: alter call (tasknr (quelle)) := strom. + +END PROC sendung starten; + +PROC encode packet length (INT VAR val): + + IF val < 96 THEN + ELIF val < 160 THEN val DECR 32 + ELIF val < 288 THEN val DECR 128 + ELIF val < 544 THEN val DECR 352 + ELIF val < 1056 THEN val DECR 832 + ELIF val < 2080 THEN val DECR 1824 + FI; + rotate (val, 8) + +ENDPROC encode packet length; + +PROC sendung neu starten: + INT VAR value; + openblock.head:= stx open; + openblock.sequenz := -1; + openblock.seitennummer:= next ds page (vdr,-1); + openblock.strom := strom; + vx := open block; + schnelles nak bei routen liefern; + ab die post; + value := vorspannlaenge + used length; + encode packet length (value); + vx.head:=code stx+value. + +schnelles nak bei routen liefern: + IF openblock.sendecode = -routen liefern code + THEN + openblock.zwischenziel := openblock.zielrechner+own256; + zeit(strom) := 2; + opentry (strom) := 0 + ELSE + zeit (strom) :=8; + opentry (strom) := 2 + FI. + +END PROC sendung neu starten; . + +ab die post: + transmit header (workspace); + block out (work space,1, dr verwaltungslaenge,open laenge); + transmit trailer. + +PROC alten call loeschen (TASK CONST quelle): + IF alter call aktiv + THEN + INT VAR lstrom := strom; + vx:=openblock; + strom := alter call (tasknr (quelle)); + IF in ausfuehrungsphase + THEN + sendereport ("Call-Löschung vorgemerkt"); + loeschung vormerken + ELSE + report ("Call gelöscht."""+nam(quelle)+""". Strom "+text(strom)); + loesche verbindung (strom) + FI; + strom := lstrom; + openblock := vx + FI. + +in ausfuehrungsphase: + typ(strom) = call im wait OR typ (strom) = call in zustellung. + +loeschung vormerken: + typ(strom) := call im abbruch; + alter call (tasknr (quelle)) := 0. + + + alter call aktiv: + alter call (tasknr (quelle)) > 0. + +END PROC alten call loeschen; + +PROC packet eingang + ( INT VAR snr, TASK VAR q, z, INT VAR ant,DATASPACE VAR dr): + snr := 0; + fehlertest; + vorspann holen; + IF NOT ring logik THEN daten teil FI. + +ring logik: FALSE. + +fehlertest: +# + INT VAR c12; + control (12,0,0,c12); + IF c12 <> 0 + THEN + flush buffers; + report ("E/A-Fehler "+text (c12)); + control (12,0,0,c12); + LEAVE packet eingang + FI. + + #. + +vorspann holen: + sync; + IF NOT blockin (workspace, 1, dr verwaltungslaenge2, block laenge) + THEN LEAVE packeteingang + FI. + + +blocklaenge: IF code t > min data length + THEN + vorspannlaenge-2 + ELSE + code t -2 + FI. + +sync: + IF NOT packet start already inspected + THEN + TEXT VAR skipped, t:= ""; + skipped := next packet start; + IF skipped = "" THEN LEAVE packet eingang FI; + t := incharety (1); + code t := code (t); + ELSE + skipped := buffer first; + buffer first := ""; + t := incharety (1); + code t := code (t); + FI; + decode packet length; +IF skipped=stx AND laenge ok THEN LEAVE sync FI; + REP + skipped CAT t; + t := incharety (1); (* next character *) + IF t = "" THEN + report ("skipped",skipped); + LEAVE packet eingang + FI ; + codet := code (t); + UNTIL blockanfang OR length (skipped) > 200 PER; + decode packet length; + IF skipped <> stx THEN report ("skipped bei sync:", skipped) FI. + +decode packet length: + +IF code t < 96 THEN + ELIF code t < 128 THEN code t INCR 32 + ELIF code t < 160 THEN code t INCR 128 + ELIF code t < 192 THEN code t INCR 352 + ELIF code t < 224 THEN code t INCR 832 + ELIF code t < 256 THEN code t INCR 1824 +FI. + +packet start already inspected: buffer first <> "". + +blockanfang: + (skipped SUB length(skipped)) = stx AND laenge ok. + +laenge ok: + (codet = datenpacketlaenge OR codet = datenpacketlaenge via node + OR codet = ack laenge OR code t = openlaenge). + +zielnummer: vorspann.zielrechner. + +daten teil: + IF zielnummer = own + THEN + ziel erreicht (openblock,snr,q,z,ant,dr) + ELSE + weiter faedeln + FI. + +weiter faedeln: + INT VAR value; + IF zielrechner ok + THEN + IF neue verbindung + THEN + IF (openblock.sendecode = -routenlieferncode) OR NOT route ok + THEN LEAVE packet eingang + FI + FI; + value := code t; + encode packet length (value); + vorspann.head := code stx + value; + vorspann.zwischenziel := own256 + route.zwischen (vorspann.zielrechner); + nutzdaten einlesen; + dr := workspace; + snr := 1000; + ant := zielnummer + FI. + +nutzdaten einlesen: + IF code t > data len via node + THEN + IF NOT blockin (workspace, 1, drverwaltungslaenge+vorspannlaenge, data len via node) + THEN + LEAVE packeteingang + FI; + IF NOT next packet ok THEN LEAVE packeteingang FI + FI. + +END PROC packet eingang; + +PROC ziel erreicht (STEUER CONST prefix, + INT VAR snr, TASK VAR q, z, INT VAR ant,DATASPACE VAR dr): + last data := -1; + IF NOT quellrechner ok + THEN + report ("Quellrechner "+text(prefix.quellrechner)); + LEAVE ziel erreicht + FI; + IF neue verbindung + THEN + IF NOT route ok OR NOT quelltask ok + THEN report ("verbotene Route: " + text (prefix.quellrechner)); + LEAVE ziel erreicht + FI; + verbindung bereitstellen + ELIF quittung + THEN + strom := ack packet.strom; + IF falsche stromnummer THEN report ("Strom falsch in Quittung"); + LEAVE ziel erreicht FI; + IF vx.strom = 0 THEN LEAVE ziel erreicht FI; + IF ackpacket.code >= ok THEN weiter senden + ELIF NOT route ok THEN + sendereport ("verbotene Route bei Quittung"); + LEAVE ziel erreicht + ELIF ackpacket.code = -von vorne THEN + sendereport ("Neustart"); + openblock := vx; + sendung neu starten + ELIF ackpacket.code = -wiederhole THEN back 16 + ELIF ackpacket.code = -loesche THEN fremdloeschung + ELIF ackpacket.code = -beende AND alles raus THEN strom abschliessen + FI + ELIF verbindung festgestellt + THEN + zeit(strom) := 400; + opti := vx; + datenpacket + ELSE + strom := maxstrom1; + vx:=prefix; + report ("Daten ohne Eroeffnung von " +text(prefix.quellrechner) + +" Sequenznr "+text(prefix.sequenz)); + daten entfernen (used length); + IF alles raus THEN quittieren (-beende) ELSE quittieren(-von vorne) FI + FI. + +quelltask ok: + prefix.quelle = collector OR antwort auf routen liefern + OR station (prefix.quelle) = prefix.quellrechner. + +antwort auf routen liefern: prefix.quelle = myself. + +verbindung bereitstellen: + IF (prefix.sendecode < 0 OR station (prefix.ziel) = own) + AND quellrechner ok + THEN + freie verbindungsnummer; + vdr := nilspace; + vx := open block; + zeit(strom) := 30; + quittieren falls genug pufferplatz; + vx.sequenz := 0 ; + opti := vx; + dr page (strom) :=-2; + IF abschluss THEN rueckmeldung FI + FI. + +loeschung vorgemerkt: typ(strom) = call im abbruch. + +strom abschliessen: + IF call aufruf + THEN + wdh data vor ablauf der zustellversuche bei der gegenstation; + ausfuehrungsphase merken + ELSE + wdh data sperren + FI. + +wdh data sperren: + zeit (strom) := 12000. + +wdh data vor ablauf der zustellversuche bei der gegenstation: + zeit (strom) := 80. + +ausfuehrungsphase merken: typ(strom) := call in zustellung. + +back16: + datenraum etwas rueckspulen; + opentry (strom) := 2; + nicht sofort senden (* wegen vagabundierender Quittungen *). + +nicht sofort senden: zeit(strom) := 2. + +datenraum etwas rueckspulen: + INT VAR pps := packets per page ; + sendereport ("etwas rueckgespult"); + INT VAR vs :=-1; + dr page (strom) := -1; + INT VAR i; + FOR i FROM 1 UPTO vx.sequenz DIV pps - etwas REP + vs INCR pps; + dr page (strom) := next ds page (vdr, dr page (strom)) + PER; + vx.seiten nummer := next ds page (vdr, dr page (strom)) ; + vx.sequenz := vs. + +etwas: 3. + +fremdloeschung: + IF fremdrechner ok und sendung + THEN + IF typ (strom) = call in zustellung + THEN + typ (strom) := call im wait + ELSE + IF NOT alles raus + THEN + sendereport ("Sendung von Gegenstelle geloescht") + FI; + sendung loeschen + FI + FI. + +fremdrechner ok und sendung: + ackpacket.quellrechner = vx.zielrechner . + + +quittieren falls genug pufferplatz: + IF quit zaehler > 0 THEN + quit zaehler DECR 1; + open quittieren; + block vorab quittieren + ELSE + quittieren (-wiederhole) + FI. + +open quittieren: quittieren (ok). +block vorab quittieren: + IF prio (myself) < 3 THEN quittieren (ok) FI. + +quittung: code t <= ack laenge. + + +verbindung festgestellt: + FOR strom FROM maxstrom DOWNTO 1 REP + IF bekannter strom + THEN LEAVE verbindung festgestellt WITH TRUE FI + PER; + FALSE. + +bekannter strom: + vx.strom = prefix.strom AND vom selben rechner. + +vom selben rechner: + vx.quellrechner = prefix.quellrechner. + +daten: + IF neue seite da THEN check for valid pagenr; + dr page(strom) := prefix.seitennummer; + ELIF prefix.seitennummer < dr page(strom) + THEN empfangsreport ("Falsche Seitennummer, Soll: " + + text(drpage(strom)) + " ist: " + + text (prefix.seitennummer) + + " bei Sequenznr: " + + text(prefix.sequenz)); + flush buffers; + quittieren (- wiederhole); + LEAVE ziel erreicht + FI; + sequenz zaehlung; + IF neue seite kommt + THEN + vx.seiten nummer := prefix.seiten nummer; + dr page(strom) := prefix.seitennummer; + FI; + quittieren(ok); + IF NOT blockin (vdr, opti.seiten nummer, distanz, nl) + COR NOT next packet ok + THEN quittieren (-wiederhole); + LEAVE ziel erreicht + FI; + last data := strom. + +check for valid pagenr: + IF prefix.seitennummer < dr page(strom) AND prefix.seitennummer > -1 + THEN report ("Absteigende Seitennummern, alt: " + text(drpage(strom))+ + " neu: "+ text(prefix.seitennummer) + " Seq.nr: " + + text(vx.sequenz) ) ; + flush buffers; + quittieren (- von vorne); + LEAVE ziel erreicht; + FI. + +datenpacket: + INT VAR nl := used length; + INT VAR pps1 := packets per page minus 1; + IF sendung wartet auf zustellung THEN auffrischen ELSE daten holen FI. + +sendung wartet auf zustellung: typ (strom) = zustellung. + +auffrischen: zeit (strom) := 200; daten entfernen (nl). + +daten holen: + IF opti.sequenz >= prefix.sequenz AND opti.sequenz < prefix.sequenz+100 + AND prefix.sequenz >= 0 + THEN + IF opti.sequenz <> prefix.sequenz + THEN empfangsreport ("Sequenzreset von "+text(opti.sequenz)+" auf "+ + text (prefix.sequenz)); + vx.sequenz := prefix.sequenz; + IF pagenumber ok + THEN dr page (strom) := prefix.seitennummer + ELSE empfangsreport ("Blocknummer falsch, neu: "+ + text (prefix.seitennummer) + ", alt : " + + text (drpage(strom)) ); + FI; + vorabquittung regenerieren + FI; + daten ; + IF abschluss THEN rueckmeldung FI; + ELSE + empfangsreport ("Sequenzfehler: soll "+text(vx.sequenz)+" ist "+ + text(prefix.sequenz)); + quittieren (-wiederhole); + daten entfernen (nl) + FI. + +pagenumber ok: + dr page (strom) >= prefix.seitennummer . + +rueckmeldung: + snr := strom; + q := vx.quelle; + z := vx.ziel; + ant := vx.sendecode; + dr := vdr; + LEAVE ziel erreicht. + +vorabquittung regenerieren: + IF prio (myself) < 3 + THEN + quittieren (ok) + FI. + +distanz: (opti.sequenz AND pps1 ) * nl. + +sequenz zaehlung: + vx.sequenz INCR 1. + +neue seite da: + neue seite kommt. + +neue seite kommt: +(vx.sequenz AND pps1) = 0. + +freie verbindungsnummer: + INT VAR h strom :=maxstrom1, cstrom := 0; + FOR strom FROM 1 UPTO maxstrom REP + IF vx.strom = 0 THEN h strom := strom ; + typ(strom) := send wait + ELIF bekannter strom + THEN empfangsreport ("Reopen"); + quit zaehler INCR 1; + IF typ (strom) = zustellung THEN typ (strom) := send wait FI; + forget (vdr); + LEAVE freie verbindungsnummer + ELIF antwort auf call + THEN + IF loeschung vorgemerkt + THEN + vx := prefix; + loesche verbindung (strom); + LEAVE ziel erreicht + FI; + cstrom := strom; + typ (strom) := call pingpong; + forget (vdr); + FI + PER; + IF cstrom > 0 THEN strom := cstrom ELSE strom := h strom FI; + IF strom = maxstrom1 THEN + vx:=prefix; + empfangsreport ("Verbindungsengpass"); + quittieren (-wiederhole); + LEAVE ziel erreicht + FI. + +antwort auf call: + prefix.sendecode >= 0 AND + call aufruf AND vx.quelle = prefix.ziel AND vx.ziel = prefix.quelle. + +END PROC ziel erreicht; + +PROC daten entfernen (INT CONST wieviel): + BOOL VAR dummy ; + dummy:=blockin (workspace, 2, 0, wieviel) +END PROC daten entfernen; + +BOOL PROC route ok: + INT VAR zwischenquelle := vorspann.zwischenziel DIV 256, + endquelle := vorspann.quellrechner; + zwischenquelle abgleichen; + endquelle abgleichen; + TRUE. + +zwischenquelle abgleichen: + IF NOT zwischenroute gleich + THEN + IF NOT zwischenabgleich erlaubt THEN LEAVE route ok WITH FALSE FI; + route.port (zwischenquelle) := channel; + route.zwischen (zwischenquelle) := zwischenquelle; + abgleich (zwischenquelle, zwischenquelle) + FI. + +zwischenabgleich erlaubt: route.port (zwischenquelle) < 256. + +endquelle abgleichen: + IF NOT endroute gleich + THEN + IF NOT endabgleich erlaubt THEN LEAVE route ok WITH FALSE FI; + route.port (endquelle) := channel; + route.zwischen (endquelle) := zwischenquelle; + abgleich (endquelle, zwischenquelle) + FI. + +endabgleich erlaubt: route.port (endquelle) < 256. + +zwischenroute gleich: + (route.port (zwischenquelle) AND 255) = channel + AND + route.zwischen (zwischenquelle) = zwischenquelle. + +endroute gleich: + (route.port (endquelle) AND 255) = channel + AND + route.zwischen (endquelle) = zwischenquelle. + +END PROC route ok; + +BOOL PROC abschluss: + + last data := -1; + IF neue seite kommt AND vx.seiten nummer = -1 + THEN + quittieren (-beende); + an ziel weitergeben + ELSE + FALSE + FI. +neue seite kommt: +(vx.sequenz AND packets per page minus 1) = 0. + +an ziel weitergeben: + IF tasknummerfrage THEN taskfrage beantworten ;pufferplatz ; FALSE + ELIF tasknamenfrage THEN name senden ;pufferplatz ; FALSE + ELIF taskinfofrage THEN task info senden;pufferplatz ; FALSE + ELIF routenfrage THEN routen senden; pufferplatz; FALSE + ELSE senden ; TRUE + FI. + +pufferplatz : quitzaehler INCR 1 . + +senden: + IF callaufruf + THEN + ein versuch (* bei Antwort auf Call muß ein Zustellversuch reichen *) + ELSE + max 100 versuche; + typ (strom) := zustellung + FI. + +tasknummerfrage:opti.sendecode = -taskid code. + +tasknamenfrage: opti.sendecode = -name code. + +taskinfofrage: opti.sendecode = -task info code. + +routenfrage: opti.sendecode = -routen liefern code. + +max 100 versuche: zeit(strom) := 100. + +ein versuch: zeit (strom) := 1. + +taskfrage beantworten: + disable stop; + BOUND TEXT VAR tsk := vdr; + TEXT VAR save tsk := tsk; + forget (vdr); vdr := nilspace; + BOUND TASK VAR task id := vdr; + task id := task(save tsk); + IF is error THEN + clear error; enable stop; + forget (vdr); vdr := nilspace; + BOUND TEXT VAR errtxt := vdr; + errtxt := text(own)+"/"""+save tsk+""" gibt es nicht"; + sendung starten (collector, opti.quelle, 2) + ELSE + enable stop; + sendung starten (collector, opti.quelle, 0) + FI. + +name senden: + quittieren (-loesche); + forget (vdr); vdr := nilspace; + tsk := vdr; + tsk := nam (opti.ziel); + sendung starten (collector, opti.quelle, 0). + +routen senden: + forget (vdr); vdr := old ("port intern"); + sendung starten (opti.ziel, opti.quelle, 0). + +task info senden: + disable stop; + BOUND INT VAR ti code := vdr; + INT VAR ti cd := ti code; + forget (vdr); vdr := nilspace; + FILE VAR task inf := sequential file (output,vdr); + head line (task inf,"Station "+text(own)); + task info (ti cd, task inf); + IF is error + THEN + forget (vdr); vdr := nilspace; + errtxt := vdr; + errtxt := errormessage; + clear error; + sendung starten (collector, opti.quelle, 2) + ELSE + sendung starten (collector,opti.quelle,0) + FI; + enable stop +END PROC abschluss ; + +PROC quittieren(INT CONST code) : + INT VAR quell := vx.quellrechner ; + transmitted ackpacket := ACK:(stx quit, route.zwischen (quell)+own256, quell, own, + vx.strom, code); + transmit header (transmitted ack space); + blockout (transmitted ack space,1,dr verwaltungslaenge, ack laenge); + transmit trailer; +END PROC quittieren; + +BOOL PROC next packet ok: + buffer first := next packet start; + buffer first = "" COR normal packet start. + +normal packet start: + IF buffer first = stx + THEN + TRUE + ELSE + buffer first := ""; flush buffers; FALSE + FI. + +END PROC next packet ok; +END PACKET basic net; + + diff --git a/system/net/1.8.7/src/net files-M b/system/net/1.8.7/src/net files-M new file mode 100644 index 0000000..ae6f9f3 --- /dev/null +++ b/system/net/1.8.7/src/net files-M @@ -0,0 +1,5 @@ +net report +net hardware interface +basic net +net manager + diff --git a/system/net/1.8.7/src/net hardware interface b/system/net/1.8.7/src/net hardware interface new file mode 100644 index 0000000..4e3466a --- /dev/null +++ b/system/net/1.8.7/src/net hardware interface @@ -0,0 +1,389 @@ +PACKET net hardware + +(************************************************************************) +(**** Netzprotokoll Anpassung *) +(**** Komplette Version mit BUS Anpassung 10.06.87 *) +(**** mit I/0 Controls fuer integrierte Karten *) +(**** Verschiedene Nutztelegrammgrössen *) +(**** Version: GMD 2.0 A.Reichpietsch *) +(************************************************************************) + + DEFINES + blockin, + blockout, + set net mode, + net address, + mode text, + data length, + data length via node, + decode packet length, + next packet start, + flush buffers, + transmit header, + transmit trailer, + version, + reset box, + max mode, + net mode: + + + + + LET eak prefix laenge = 6, + packet length before stx = 14 (*eth header =14 *), + maximum mode nr = 12, + stx = ""2"", + niltext = "", + null = "0", + hex null = ""0"", + blank = " ", + eak prefix = ""0""0""0""0"", + typefield = "EU", + prefix adresse = "BOX", + second prefix adresse = ""0"BOX", + second address type bound = 90; + + INT CONST data length via node :: 64; + TEXT CONST version :: "GMD 2.0 (10.6.87)"; + + + TEXT VAR own address; + INT VAR paketlaenge, eumel paket laenge, mode, rahmenlaenge, actual data length; + +BOOL PROC blockin (DATASPACE VAR ds, INT CONST seite, abstand, laenge): + INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512; + REAL VAR time out := clock (1) + 10.0; + REP + blockin (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge); + UNTIL hilfslaenge = 0 OR clock (1) > time out PER ; + IF hilfslaenge <> 0 + THEN report ("blockin abbruch, fehlende Zeichen: "+text(hilfslaenge)); + FI; + hilfslaenge = 0 +END PROC blockin; + +PROC blockout (DATASPACE CONST ds, INT CONST seite, abstand, laenge): + INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512; + REP + blockout (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge); + UNTIL hilfslaenge = 0 PER +END PROC blockout; + +PROC set net mode (INT CONST new mode): + mode := new mode ; + own address := net address (station(myself)); + SELECT mode OF + CASE 1,3 : set data length (64); + CASE 2 : std framelength; set data length (64) + CASE 4,6 : set data length (128) + CASE 5 : std framelength; set data length (128) + CASE 7,9 : set data length (256) + CASE 8 : std framelength; set data length (256) + CASE 10,12 : set data length (512) + CASE 11 : std framelength; set data length (512); + + OTHERWISE + END SELECT. + + std framelength: + rahmenlaenge := eak prefix laenge + packet length before stx. + +ENDPROC set net mode; + +INT PROC max mode: + maximum mode nr +ENDPROC max mode; + +INT PROC net mode: + mode +ENDPROC net mode; + +TEXT PROC mode text: + mode text (mode) +ENDPROC mode text; + +TEXT PROC mode text (INT CONST act mode): + SELECT act mode OF + CASE 1: "Modus: (1) EUMEL-Netz 64 Byte" + CASE 2: "Modus: (2) ETHERNET via V.24 64 Byte" + CASE 3: "Modus: (3) ETHERNET integrated 64 Byte" + CASE 4: "Modus: (4) EUMEL-Netz 128 Byte" + CASE 5: "Modus: (5) ETHERNET via V.24 128 Byte" + CASE 6: "Modus: (6) ETHERNET integrated 128 Byte" + CASE 7: "MODUS: (7) EUMEL-Netz 256 Byte" + CASE 8: "MODUS: (8) ETHERNET via V.24 256 Byte" + CASE 9: "MODUS: (9) ETHERNET integrated 256 Byte" + CASE 10: "MODUS: (10) EUMEL-Netz 512 Byte" + CASE 11: "MODUS: (11) ETHERNET via V.24 512 Byte" + CASE 12: "MODUS: (12) ETHERNET integrated 512 Byte" + OTHERWISE errorstop ("Modus " + text(mode) + " gibt es nicht"); + error message + END SELECT + +ENDPROC mode text; + +PROC set data length (INT CONST new data length): + actual data length := new data length +ENDPROC set data length; + +INT PROC data length: + actual data length +ENDPROC data length; + +PROC reset box (INT CONST net mode): + SELECT net mode OF + CASE 1,4,7,10 : eumel net box reset + CASE 2,5,8,11 : eak reset + OTHERWISE controler reset + END SELECT. + + eumel net box reset: + out (90*""4""); + REP UNTIL incharety (1) = niltext PER. + + eak reset: + out ("E0"13"E0"13""). + + controler reset: + INT VAR dummy; + control (-35, 0,0,dummy); + control (22,0,0,dummy). + +ENDPROC reset box; + +PROC remove frame + (TEXT VAR erstes zeichen vom eumel telegramm, BOOL VAR kein telegramm da): + kein telegramm da := FALSE; + SELECT net mode OF + CASE 2,5,8,11 : remove ethernet frame + (erstes zeichen vom eumel telegramm, kein telegramm da) + OTHERWISE + END SELECT; +ENDPROC remove frame; + +PROC remove ethernet frame (TEXT VAR string, BOOL VAR schrott): + TEXT VAR speicher, t; + INT VAR lg; + + t := string; + speicher := niltext; + WHILE kein stx da REP + lies zeichen ein; + teste auf timeout; + UNTIL textoverflow PER; + melde eingelesene zeichen. + + lies zeichen ein: + speicher CAT t; + t := incharety (1). + + teste auf timeout: + IF t = niltext THEN schrott := (speicher <> niltext) + CAND not only fill characters; + string := niltext; + LEAVE remove ethernet frame + FI. + + not only fill characters: + pos (speicher, ""1"", ""254"",1) <> 0. + + kein stx da : + t <> stx. + + textoverflow: + length (speicher) > 1000. + + melde eingelesene zeichen: + IF kein stx da + THEN kein eumeltelegrammanfang + ELSE untersuche ethernet header + FI. + + kein eumeltelegrammanfang: + report ("skipped ,fehlendes ,letztes Zeichen:", t); + string := t; + schrott := TRUE. + + untersuche ethernet header: + string := t; + IF ethernet header inkorrekt + THEN melde fehler + FI. + + ethernet header inkorrekt: + lg := length (speicher); + packet zu kurz COR adresse falsch. + + packet zu kurz: + lg < packet length before stx. + + adresse falsch: + INT VAR adrpos := pos (speicher, own address); + zieladresse falsch COR adresse nicht an der richtigen pos . + + zieladresse falsch: + adrpos < 1. + + adresse nicht an der richtigen pos: + adrpos <> lg - packet length before stx + 1. + + melde fehler: + report ("Header inkorrekt eingelesen: ", speicher + t); + string := t; + schrott := TRUE. + +ENDPROC remove ethernet frame; + +TEXT PROC next packet start: + + TEXT VAR t := niltext; + BOOL VAR schrott := FALSE; + + t:= incharety (1); + IF t = niltext THEN LEAVE next packet start WITH niltext + ELSE remove frame (t, schrott) + FI; + IF schrott THEN no stx or niltext + ELSE t + FI. + + no stx or niltext: + IF t = stx THEN "2" + ELIF t = niltext THEN "0" + ELSE t + FI. + +ENDPROC next packet start; + +PROC flush buffers: + REP UNTIL incharety (5) = niltext PER; + report ("buffers flushed"); +ENDPROC flush buffers; + +PROC transmit header (DATASPACE CONST w): + BOUND INT VAR laengeninformation := w; + eumel paket laenge := laengeninformation ; + decode packet length (eumel paket laenge); + SELECT net mode OF + CASE 1,4,7,10 : + CASE 2,5,8,11 : eak und eth header senden (w) + OTHERWISE : telegrammanfang melden; + std ethernet header senden (w) + END SELECT; + +ENDPROC transmit header; + +PROC decode packet length (INT VAR decoded length): + + decoded length DECR 2; + rotate (decoded length, 8); + + IF decoded length < 96 THEN + ELIF decoded length < 128 THEN decoded length INCR 32 + ELIF decoded length < 160 THEN decoded length INCR 128 + ELIF decoded length < 192 THEN decoded length INCR 352 + ELIF decoded length < 224 THEN decoded length INCR 832 + ELIF decoded length < 256 THEN decoded length INCR 1824 + FI; + +ENDPROC decode packet length; + +PROC transmit trailer: + INT VAR dummy; + SELECT net mode OF + CASE 3,6,9,12 : control (21,0,0,dummy) + OTHERWISE + END SELECT. + +ENDPROC transmit trailer; + +PROC std ethernet header senden (DATASPACE CONST x): + TEXT VAR eth adresse, ethernet kopf := niltext; + INT VAR adresse; + BOUND STRUCT (INT head, zwischennummern) VAR header := x; + zieladresse holen; + zieladresse senden; + quelladresse senden; + typfeld senden; + ausgeben. + + zieladresse holen: + adresse := header.zwischennummern AND 255; + eth adresse := net address (adresse). + + zieladresse senden: + ethernetkopf CAT eth adresse. + + quelladresse senden: + ethernetkopf CAT own address. + + typfeld senden: + ethernetkopf CAT typefield. + + ausgeben: + out (ethernetkopf). + +ENDPROC std ethernet header senden; + +PROC telegrammanfang melden: + INT VAR dummy; + control (20,eumel paket laenge + packet length before stx,0, dummy). + +ENDPROC telegrammanfang melden; + +PROC eak und eth header senden (DATASPACE CONST x): + TEXT VAR res:= niltext; + + neue laenge berechnen; + eak kopf senden; + std ethernet header senden (x). + + neue laenge berechnen: + paket laenge := rahmenlaenge + eumel paket laenge. + + eak kopf senden: + res := code (paket laenge DIV 256); + res CAT (code (paket laenge AND 255)); + res CAT eak prefix; + out(res). + +ENDPROC eak und eth header senden; + +TEXT PROC net address (INT CONST eumel address): + TEXT VAR res ; + INT VAR low byte; + +SELECT mode OF + CASE 1,4,7,10 : eumel net address + OTHERWISE ethernet address +END SELECT. + +eumel net address: + text(eumel address). + +ethernet address: + IF second adress kind THEN second eth header + ELSE first eth header + FI; + res. + + second adress kind: + eumel address = 34 COR + eumel address > second address type bound. + + second eth header: + low byte := eumel address AND 255; + res := second prefix adresse + code (low byte); + res CAT hex null. + + first eth header: + res := prefix adresse + text (eumel address, 3); + changeall (res, blank, null). + +ENDPROC net address; + +ENDPACKET net hardware; + + + + diff --git a/system/net/1.8.7/src/net inserter b/system/net/1.8.7/src/net inserter new file mode 100644 index 0000000..c89d0f0 --- /dev/null +++ b/system/net/1.8.7/src/net inserter @@ -0,0 +1,145 @@ +(*************************************************************************) +(*** Insertiert alle notwendigen Pakete, die zum Betrieb des Netzes ***) +(*** notwendig sind. ***) +(*** Berücksichtigt nur EUMEL - Versionen ab 1.8.1, sowie ***) +(*** Multi-User-Version ***) +(*** ***) +(*** ***) +(*** 23.05.87 ar ***) +(*************************************************************************) + +LET netfile = "netz", + multi files = "net files/M"; + + +INT CONST version :: id (0); +THESAURUS VAR tesa; + +head; +IF no privileged task + THEN errorstop (name (myself) + " ist nicht privilegiert!") + ELIF station number wrong + THEN errorstop ("'define station' vergessen ") +FI; + +IF version < 181 THEN versionsnummer zu klein + ELSE install net +FI. + +no privileged task: + NOT (myself < supervisor). + +station number wrong: + station (myself) < 1. + +install net : + IF NOT exists (netfile) + THEN errorstop ("Datei " + netfile +" existiert nicht") + FI; + IF is multi THEN insert multi net + ELSE errorstop ("Diese Netzversion ist nur für Multi-user Versionen freigegeben") + FI; + forget ("net install", quiet); + net start. + +net start : + say line (" "); + do ("start"); + do ("global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) + net manager)"). + +is multi : + (pcb(9) AND 255) > 1. + +insert multi net : + hole dateien vom archiv; + insert say and forget (tesa). + +hole dateien vom archiv : + fetch if necessary (multi files); + tesa := ALL (multi files); + forget (multi files, quiet); + fetch if necessary (tesa - all); + say line (" "); + say line ("Archiv-Floppy kann entnommen werden."); + release (archive). + + +head : + IF online THEN page; + put center (" E U M E L - Netz wird installiert."); + line; + put center ("----------------------------------------"); + line (2) + FI. + +versionsnummer zu klein : + errorstop ("Netzsoftware erst ab Version 1.8.1 insertierbar !"). + +PROC fetch if necessary (TEXT CONST datei) : + IF NOT exists (datei) THEN say line ("Loading """ + datei + """..."); + fetch (datei, archive) + FI. +END PROC fetch if necessary; + +PROC fetch if necessary (THESAURUS CONST tes) : + do (PROC (TEXT CONST) fetch if necessary, tes) +END PROC fetch if necessary; + +PROC insert say and forget (TEXT CONST name of packet): + IF online THEN INT VAR cx, cy; + put ("Inserting """ + name of packet + """..."); + get cursor (cx, cy) + FI; + insert (name of packet); + IF online THEN cl eop (cx, cy); line FI; + forget (name of packet, quiet) +END PROC insert say and forget; + +PROC insert say and forget (THESAURUS CONST tes): + do (PROC (TEXT CONST) insert say and forget, tes) +END PROC insert say and forget; + +PROC put center (TEXT CONST t): + put center (t, xsize); +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t): + put center (zeile, t, xsize); +END PROC put center; + +PROC put center (TEXT CONST t, INT CONST gesamtbreite): + INT VAR cy; + get cursor (cy, cy); + put center (cy, t, gesamtbreite) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite): + cursor ((gesamtbreite - length (t)) DIV 2, zeile); + put (t). +END PROC put center; + +PROC cl eol: + out (""5"") +END PROC cl eol; + +PROC cl eop: + out (""4"") +END PROC cl eop; + +PROC cl eol (INT CONST cx, cy): + cursor (cx, cy); + cl eol +END PROC cl eol; + +PROC cl eop (INT CONST cx, cy): + cursor (cx, cy); + cl eop +END PROC cl eop; + +PROC say line (TEXT CONST t): + IF online THEN put line (t) FI +ENDPROC say line; + + + diff --git a/system/net/1.8.7/src/net manager b/system/net/1.8.7/src/net manager new file mode 100644 index 0000000..05f530e --- /dev/null +++ b/system/net/1.8.7/src/net manager @@ -0,0 +1,797 @@ +PACKET net manager DEFINES stop,net manager,frei, routen aufbauen, + (* 175 net manager 8 (!) *) + start, + definiere netz, + aktiviere netz, + list option, + erlaube, sperre, starte kanal, routen: + +TEXT VAR stand := "Netzsoftware vom 10.06.87 "; + (*Heinrichs *) +LET + maxstat = 127, + ack = 0, +(* nak = 1, *) + error nak = 2, +(* zeichen eingang = 4, *) + list code = 15, +(* fetch code = 11, *) + freigabecode = 29, + tabellencode = 500, + continue code = 100, + erase code = 14, + report code = 99, + abgleichcode = 98, + neue routen code = 97, + dr verwaltungslaenge = 8, + + (* Codes der Verbindungsebene *) + + task id code = 6, + name code = 7, + task info code = 8, + routen liefern code = 9, + + (* Weitergabecodes für Netzknoten *) + + route code = 1001, + out code = 1003, + + (* Typen von Kommunikationsströmen *) + + zustellung = 1, + call im wait = 3, + call im abbruch = 4, + call in zustellung = 5; + +LET STEUER = + STRUCT ( + INT head, + zwischenziel, + zielrechner, + quellrechner, + strom, + INT sequenz, + seiten nummer, + TASK quelle,ziel, + INT sende code); + +LET INFO = STRUCT (STEUER steuer, INT typ,maxseq); + +LET PARA = STRUCT (TASK quelle, ziel, INT sendecode, zielstation); + + +TASK VAR sohn; +INT VAR strom,c,kanalmode, rzaehler := 20; +BOUND STRUCT (ROW maxstat INT port, + ROW maxstat INT zwischen) VAR route; + + +TASK PROC netport (INT CONST ziel): + INT VAR kan := route.port (ziel) AND 255; + IF kan < 1 OR kan > 15 + THEN + niltask + ELSE + IF NOT exists (nettask (kan)) + THEN + access catalogue; + nettask (kan) := task (kan); + IF NOT (nettask (kan) < father) THEN nettask (kan) := niltask FI; + FI; + nettask (kan) + FI +END PROC netport; + +PROC frei (INT CONST stat,lvl): + DATASPACE VAR ds := nilspace; + BOUND STRUCT (INT x,y) VAR msg := ds; + msg.x := stat; msg.y := lvl; + INT VAR return; + call (netport (stat), freigabecode, ds, return) ; + forget (ds) +END PROC frei; + +PROC net manager (DATASPACE VAR ds, INT CONST order, phase, TASK CONST + ordertask): + + IF order = report code AND ordertask < myself + THEN + IF storage (old("report")) > 20 THEN forget ("report", quiet) FI; + FILE VAR rp := sequential file (output, "report"); + BOUND TEXT VAR rpt := ds; + putline (rp, rpt); + send (ordertask, ack, ds) + ELIF order = abgleichcode AND ordertask < myself + THEN + BOUND STRUCT (INT ende, zwischen) VAR x := ds; + route.port (x.ende) := channel (ordertask); + route.zwischen (x.ende) := x.zwischen; + send (ordertask, ack, ds) + ELIF order = neue routen code AND ordertask < myself + THEN + forget ("port intern"); + copy (ds,"port intern"); + route := old ("port intern"); + send (ordertask, ack, ds) + ELIF station (ordertask) = station (myself) + THEN + IF ordertask < myself + OR order = list code + OR order > continue code + THEN + IF order = list code + THEN + enable stop; + forget (ds); ds := old ("report"); + FILE VAR ff := sequential file (output,ds); + putline (ff,"bekannte Stationen:"); + stationen; line (ff); putline (ff,"--------"); + putline (ff,"Eingestellte Netzmodi:"); + kanaele ; + paketgroessen; + line (ff); putline (ff,"********"); + putline (ff,stand); + putline (ff,"Rechner "+text(station(myself))+" um "+time of day); + send (ordertask, ack, ds) + ELSE + free manager (ds,order,phase,order task) + FI + ELSE + errorstop ("nur 'list' ist erlaubt") + FI + FI . + +stationen: +INT VAR stat; +INT VAR mystation := station (myself); +FOR stat FROM 1 UPTO maxstat REP + IF route.port (stat) > 0 AND stat <> mystation + THEN + put (ff,text(stat)+"("+text (route.port (stat) AND 255)+","+ + text(route.zwischen(stat))+")") + FI +PER. + +paketgroessen: + + line(ff); + put (ff, "Nutzlaenge bei indirekter Verbindung "+ + text (data length via node) + " Byte "); line (ff). + +kanaele: + INT VAR portnummer; + TASK VAR tsk; + FOR portnummer FROM 1 UPTO 15 REP + tsk := task (portnummer); + IF tsk < myself THEN beschreibe kanal FI; + PER. + +beschreibe kanal: + putline (ff, name (tsk) + " haengt an Kanal " + text (channel (tsk)) + + ", " + mode text (netz mode (portnummer))). + +END PROC net manager; + +TASK VAR cd,stask; +ROW maxstat INT VAR erlaubt; + +PROC communicate: + enable stop; + INT VAR scode, merken :=0; + DATASPACE VAR dr := nilspace; + neuer start (quit max, kanalmode); +REP + forget (dr); + telegrammfreigabe; + wait (dr, scode, stask); + cd := collected destination; + IF weiterleitung steht noch aus + THEN + send (netport (merken), out code, mds, reply); + IF reply <> -2 THEN forget (mds); merken := 0 FI + FI; + IF zeichen da OR zeit abgelaufen + THEN + packet + ELIF cd = myself + THEN + netz info und steuerung + ELSE + sendung untersuchen (stask, cd, scode, dr) + FI +PER. + +telegrammfreigabe: + INT VAR dummy; + control (22,0,0,dummy). + +zeichen da: scode < 0 . + +zeit abgelaufen: scode = ack AND cd = myself. + +packet: + INT VAR snr, ant,err; + TASK VAR quelle, ziel; + snr := 0; + IF NOT zeichen da THEN routen erneuern FI; + REP + IF NOT zeichen da + THEN + forget (dr); + zeitueberwachung (snr, quelle, ziel, ant, dr); + ELIF NOT weiterleitung steht noch aus + THEN + packet eingang (snr, quelle, ziel, ant, dr); + FI; + IF snr = 1000 + THEN + packet weiterleiten + ELIF snr > 0 + THEN + IF ant > 6 AND erlaubt(station (quelle)) < 0 + THEN unerlaubt + ELSE + send (quelle,ziel,ant,dr,err); + fehlerbehandlung ; + FI + FI + UNTIL snr = 0 OR zeichen da PER. + +routen erneuern: + rzaehler DECR 1; + IF rzaehler = 0 + THEN + rzaehler := 20; + neue routen holen + FI. + +weiterleitung steht noch aus: merken <> 0. + +packet weiterleiten: + INT VAR reply; + IF NOT ((route.port (ant) AND 255) = channel OR route.port (ant) < 0) + THEN + send (netport (ant), out code, dr, reply); + IF reply = -2 + THEN + merken := ant; + DATASPACE VAR mds := dr + FI + ELSE + report ("Weiterleitung nicht möglich für "+text(ant)) + FI. + +fehlerbehandlung: + IF ok oder ziel nicht da THEN loesche verbindung (snr) FI. + +ok oder ziel nicht da: err=0 OR err=-1. + +netz info und steuerung: + IF scode = list code THEN list status + ELIF scode = erase code THEN strom beenden + ELIF scode = freigabe code AND stask = father THEN freigabelevel + ELIF scode >= route code THEN weitergaben + ELIF scode > tabellencode THEN routen ausliefern + ELSE forget (dr); ablehnen ("nicht möglich") + FI. + +weitergaben: + IF stask < father + THEN + IF scode = out code + THEN + BOUND INT VAR stx lng := dr; + INT VAR decoded lng := stx lng; + decode packet length (decoded lng); + transmit header (dr); + blockout (dr,1,drverwaltungslaenge,decoded lng); + transmit trailer + ELIF scode = route code + THEN + BOUND PARA VAR parah := dr; + PARA VAR para := parah; + pingpong (stask, ack, dr, reply); + neue sendung (para.quelle, para.ziel, para.sendecode, + para.zielstation, dr); + forget (dr); dr := nilspace; + send (stask, ack, dr) + FI + ELSE + forget (dr); + ablehnen ("nicht Sohn von "+name(father)) + FI. + +routen ausliefern: + neue sendung (stask, myself, -routen liefern code, scode-tabellencode,dr). + +freigabelevel: + BOUND STRUCT (INT stat,lvl) VAR lv := dr; + IF lv.stat > 0 AND lv.stat <= maxstat THEN erlaubt (lv.stat) := lv.lvl FI; + send (stask,ack,dr). + +unerlaubt: + report ("Fremdzugriff von "+text(station (quelle))+" auf "+nam(ziel) + +" code "+text(ant)); + loesche verbindung (snr); + forget (dr); dr := nilspace; + BOUND TEXT VAR errtxt := dr; + errtxt:="Kein Zugriff auf Station "+text (station (myself)); + neue sendung (ziel, quelle, error nak, station (quelle), dr). + +strom beenden: + BOUND TEXT VAR stromtext := dr; + INT VAR erase strom := int (stromtext); + forget (dr); + strom := erase strom; + IF falsche stromnummer THEN ablehnen ("Strom gibt es nicht") + ELSE + BOUND INFO VAR v := verbindung (strom); + IF + stask < supervisor OR stask = vx.quelle OR stask = vx.ziel + THEN + loeschen + ELSE ablehnen ("Nur Empfänger/Absender darf löschen") + FI + FI. + +loeschen: + IF sendeeintrag THEN + IF callee (vx.quelle) = vx.ziel THEN absender warnen FI; + loesche verbindung (strom) + ELSE + IF callee (vx.ziel) = vx.quelle THEN warnen FI; + loesche verbindung (strom) + FI; + dr := nilspace; + send (stask,ack,dr). + +absender warnen: + dr := nilspace; + send(vx.ziel,vx.quelle,1,dr,err) . + +warnen: + dr := nilspace; +errtxt := dr; errtxt:= "Station antwortet nicht"; +send (vx.quelle,vx.ziel,error nak, dr, err). + +falsche stromnummer: strom < 1 OR strom > max verbindungsnummer. +sendeeintrag: vx.quellrechner = station (myself). +vx: v.steuer. +END PROC communicate; + +PROC list option: + begin ("net list",PROC list net, sohn) +END PROC list option; + +PROC list net: + disable stop; + DATASPACE VAR ds ; + INT VAR scode; + REP + wait (ds, scode, stask); + forget (ds); ds := nilspace; + FILE VAR f := sequential file (output, ds); + list (f, father); + list netports; + IF is error THEN clear error; + forget(ds); + ds := nilspace; + f := sequential file (output, ds); + output (f); putline (f,errormessage); + clear error + FI; + send (stask, ack, ds) + PER. + +list netports: + INT VAR k; + FOR k FROM 1 UPTO 15 REP + TASK VAR tsk := task (k); + IF tsk < father + THEN + putline (f, name (tsk)); + list (f,tsk) + FI + PER. + +END PROC list net; + +PROC neue routen holen: + forget ("port intern", quiet); + fetch ("port intern"); + route := old ("port intern"); + neue routen +END PROC neue routen holen; + +PROC sendung untersuchen (TASK CONST q, z, INT CONST cod, DATASPACE VAR dr): + IF z = collector + THEN + verbindungsebene + ELIF station (z) <> 0 + THEN + sendung (q,z,cod,station (z),dr) + ELSE + ablehnen ("Station 0") + FI. + +verbindungsebene: + IF cod = 256 THEN name von fremdstation + ELIF cod > 256 + THEN + taskinfo fremd + ELIF callee (q) = z (* gegen errornak an collector *) + THEN + task id von fremd + FI. + +taskinfo fremd: sendung (q, collector, -task info code,cod-256,dr). + +task id von fremd: sendung (q, collector, -task id code, zielstation, dr) . + +name von fremdstation: + BOUND TASK VAR tsk := dr; + TASK VAR tsk1 := tsk; + forget (dr); + dr := nilspace; + sendung (q, tsk1, -name code, station (tsk1), dr). + +zielstation: cod. +END PROC sendung untersuchen; + +PROC sendung (TASK CONST q, z, INT CONST code, z stat, DATASPACE VAR dr): + IF z stat < 1 OR z stat > maxstat + THEN + ablehnen ("ungültige Stationsnummer"); + LEAVE sendung + FI; + INT VAR reply; + INT VAR rp := route.port (z stat) AND 255; + IF rp = 255 THEN neue routen holen ;rp := route.port (z stat) AND 255 FI; + IF rp = channel + THEN + sendung selbst betreiben + ELIF rp > 0 AND rp < 16 + THEN + sendung weitergeben + ELSE + ablehnen ("Station "+text(z stat)+" gibt es nicht") + FI. + +sendung selbst betreiben: + neue sendung (q, z, code, z stat, dr). + +sendung weitergeben: + DATASPACE VAR ds := nilspace; + BOUND PARA VAR p := ds; + p.quelle := q; + p.ziel := z; + p.zielstation := z stat; + p.sendecode := code; + call (netport (z stat), route code, ds, reply); + forget (ds); + pingpong (netport (z stat), 0, dr, reply); + forget (dr); + IF reply < 0 THEN ablehnen ("netport "+text(route.port(zstat)AND255) + + " fehlt") FI +END PROC sendung; + +PROC ablehnen (TEXT CONST t): + DATASPACE VAR vdr := nilspace; + BOUND TEXT VAR errtxt := vdr; + INT VAR err; + errtxt := t; + send (cd,stask, error nak, vdr,err); + forget (vdr). +END PROC ablehnen; + +PROC stop: + access catalogue; + IF exists task ("net timer") + THEN + TASK VAR nets := father (/"net timer"); + ELSE + nets := myself + FI; + nets := son (nets); + WHILE NOT (nets = niltask) REP + IF text (name (nets),3) = "net" OR name (nets) = "router" + THEN + end (nets) + FI; + nets := brother (nets) + PER +END PROC stop; + +PROC list status: + + DATASPACE VAR ds := nilspace; + FILE VAR f:=sequential file (output, ds); + line(f); + FOR strom FROM 1 UPTO max verbindungsnummer REP + IF strom > 0 THEN + BOUND INFO VAR v := verbindung (strom); + IF vx.strom <> 0 THEN info FI + FI; + PER; + send (stask, ack, ds). + +info: + put (f,"Strom "+text(strom)); + put (f,"(sqnr"+text(vx.sequenz)+"/"+text (v.maxseq)+")"); + IF sendeeintrag THEN sendeinfo ELSE empfangsinfo FI; + line (f). + +sendeeintrag: vx.quellrechner = station(myself) . + +sendeinfo: + IF v.typ = call im wait THEN put (f,"erwartet Antwort von") + ELIF v.typ = call in zustellung THEN put (f,"Ziel busy. Zielstation:") + ELIF v.typ = call im abbruch THEN put (f,"wird gelöscht bei Antwort von") + ELSE put (f,"sendet an") + FI; + put (f,vx.zielrechner); + put (f,". Absender ist """+nam (vx.quelle)+"""."). + +empfangsinfo: + IF v.typ = zustellung THEN + put (f,"Sendung noch nicht zustellbar") + ELSE + put (f,"empfängt von"); + put (f,vx.quellrechner); + FI; + put (f,". Empfaenger ist """+nam (vx.ziel)+"""."). + +vx: v.steuer. +END PROC list status; + +INT VAR quitmax := 3; + +ROW 15 TASK VAR net task; +ROW 15 INT VAR netz mode; + +PROC erlaube (INT CONST von, bis): + IF ein kanal gestartet + THEN + putline ("Warnung: 'erlaube' muß vor 'starte kanal'") + FI; + test (von); test (bis); + INT VAR i; + FOR i FROM von UPTO bis REP erlaubt (i) := 0 PER +END PROC erlaube; + +PROC sperre (INT CONST von, bis): + IF ein kanal gestartet + THEN + putline ("Warnung: 'sperre' muß vor 'starte kanal'") + FI; + test (von); test (bis); + INT VAR i; + FOR i FROM von UPTO bis REP erlaubt (i) :=-1 PER +END PROC sperre ; + +BOOL VAR alte routen, ein kanal gestartet; + +PROC definiere netz: + stop; + INT VAR i; + FOR i FROM 1 UPTO 15 REP net task (i) := niltask PER; + ein kanal gestartet := FALSE; + FILE VAR s := sequential file (output,"report"); + putline (s," N e u e r S t a r t " + date + " " + time of day ); + alte routen := exists ("port intern"); + IF alte routen + THEN + route := old ("port intern") + ELSE + route := new ("port intern"); + initialize routes + FI. + + initialize routes: + FOR i FROM 1 UPTO maxstat REP + route.zwischen(i) := i + PER. + +END PROC definiere netz; + +PROC starte kanal (INT CONST k,modus,stroeme): + ein kanal gestartet := TRUE; + IF exists (canal (k)) THEN end (canal (k)) FI; + IF stroeme <= 0 THEN errorstop ("3.Parameter negativ") FI; + quitmax := stroeme; + c := k; + IF c < 1 OR c > 15 THEN errorstop ("unzulässiger Kanal:"+text(c)) FI; + kanalmode := modus; + IF kanalmode < 1 OR kanalmode > max mode + THEN errorstop ("unzulässiger Netzbetriebsmodus:"+text(kanalmode)) + ELSE netz mode (c) := kanalmode + FI; + IF NOT exists task ("net port") + THEN + begin ("net port",PROC net io, net task (c)); + define collector (/"net port") + ELSE + begin ("net port "+text (c),PROC net io, net task (c)) + FI. +END PROC starte kanal; + +PROC routen (INT CONST von, bis, kanal, zw): + INT VAR i; + IF kanal < 0 OR kanal > 15 THEN errorstop ("Kanal unzulässig") FI; + test (von); test (bis); + FOR i FROM von UPTO bis REP + route.port (i) := kanal+256; + IF zw=0 + THEN + route.zwischen (i) := i + ELSE + test (zw); + route.zwischen (i) := zw + FI + PER. +END PROC routen; + +PROC routen (INT CONST von, bis, kanal): + routen (von, bis, kanal, 0) +END PROC routen; + +PROC test (INT CONST station): + IF station < 1 OR station > maxstat + THEN + errorstop (text (station) + " als Stationsnummer unzulässig") + FI +END PROC test; + +PROC aktiviere netz: +vorgegebene routen pruefen; +IF existstask ("net timer") THEN end (/"net timer") FI; +begin ("net timer",PROC timer,sohn); +IF NOT alte routen +THEN + routen aufbauen +ELSE + IF online THEN break FI +FI. + +vorgegebene routen pruefen: + INT VAR i; + FOR i FROM 1 UPTO maxstat REP + INT VAR s := route.port (i) AND 255; + IF s > 0 AND s <= 15 CAND nettask (s) = niltask + THEN + errorstop ("Kanal "+text(s)+" nicht gestartet, steht aber in Routen") + FI + PER. +END PROC aktiviere netz; + + +PROC routen aufbauen: + alte routen := TRUE; + c := channel; + break (quiet); + begin ("router", PROC rout0, sohn). +END PROC routen aufbauen; + +PROC rout0: + disable stop; + rout; + IF is error + THEN + put error + FI; + end (myself) +END PROC rout0; + +PROC rout: + IF c>0 THEN continue (c) FI; + clear error; enable stop; + fetch ("port intern"); + route := old ("port intern"); + routen aufbauen; + ds := old ("port intern"); + call (father, neue routen code, ds, reply). + +routen aufbauen: + access catalogue; + TASK VAR port := brother (myself); + WHILE NOT (port = niltask) REP + IF text (name (port),8) = "net port" THEN nachbarn FI; + port := brother (port) + PER; + IF online THEN putline ("Fertig. Weiter mit SV !") FI. + +aenderbar: route.port (st) < 256. + +nachbarn: + INT VAR st,reply; + FOR st FROM 1 UPTO maxstat REP + IF erlaubt (st) >= 0 AND st <> station (myself) AND aenderbar + THEN + IF online THEN put (name (port)); put (st) FI; + DATASPACE VAR ds := nilspace; + call (port, tabellencode+st, ds, reply); + IF reply = ack + THEN + BOUND STRUCT (ROW maxstat INT port, + ROW maxstat INT zwischen) VAR fremd := ds; + route.port (st) := channel(port); + route.zwischen (st) := st; + indirekte ziele + ELIF reply < 0 + THEN + errorstop ("netz läuft nicht (Kanalnummer falsch)") + ELSE + BOUND TEXT VAR xt := ds; + IF online THEN put (xt) FI; + FI; + IF online THEN line FI; + forget (ds) + FI + PER. + +indirekte ziele: + INT VAR kanal := fremd.port (station (myself)) AND 255; + INT VAR ind; + FOR ind FROM 1 UPTO maxstat REP + IF ind bei st bekannt AND NOT ((fremd.port (ind) AND 255) = kanal) + AND route.port (ind) < 256 + THEN + route.port (ind) := channel (port); + route.zwischen (ind) := st + FI + PER. + +ind bei st bekannt: NOT (fremd.port (ind) = -1). + +END PROC rout; + + +PROC timer: + disable stop; + access catalogue; + INT VAR old session := 1; + REP + IF session <> old session + THEN + define collector (/"net port"); + old session := session + FI; + clear error; + pause (30); + sende tick an alle ports + PER. + +sende tick an alle ports : + TASK VAR fb := son (father); + REP + IF NOT exists (fb) THEN access catalogue;LEAVE sende tick an alle portsFI; + IF channel (fb) > 0 + THEN + DATASPACE VAR ds := nilspace; + send (fb, ack, ds); + pause (10) + FI; + fb := brother (fb) + UNTIL fb = niltask PER. + +END PROC timer; + +PROC net io: + disable stop; + set net mode (kanalmode); + fetch ("port intern"); + route := old ("port intern"); + commanddialogue (FALSE); + continue (c); + communicate; + TEXT VAR emsg := "++++++ "+error message +" Zeile "+text(errorline); + clear error; + report (emsg); + end (myself) +END PROC net io; + +PROC start: run ("netz") END PROC start; + +END PACKET net manager; + diff --git a/system/net/1.8.7/src/net report b/system/net/1.8.7/src/net report new file mode 100644 index 0000000..ddc19d2 --- /dev/null +++ b/system/net/1.8.7/src/net report @@ -0,0 +1,41 @@ +PACKET net report DEFINES report, abgleich: +(* Version 3 (!) *) + +LET reportcode = 99, abgleichcode = 98; + +PROC abgleich (INT CONST ende, zwischen): + DATASPACE VAR ds := nilspace; + BOUND STRUCT (INT ende, zwischen) VAR x := ds; + x.ende := ende; + x.zwischen := zwischen; + call (father, abgleichcode, ds, rep); + INT VAR rep; + forget (ds) +END PROC abgleich; + +PROC report (TEXT CONST x): + report(x,"") +END PROC report; + +PROC report (TEXT CONST txt, info): + DATASPACE VAR net report := nilspace; + BOUND TEXT VAR rinfo := net report; + rinfo := date; + rinfo CAT " "+time of day +" "; + rinfo CAT name(myself)+":"; + rinfo CAT txt; + INT VAR i; + FOR i FROM 1 UPTO length (info) REP + INT VAR z := code (infoSUBi) ; + IF z < 32 OR z > 126 + THEN rinfo CAT "%"+text(z)+" " + ELSE rinfo CAT (infoSUBi)+" " + FI + PER; + call (father, report code , net report, reply); + INT VAR reply; + forget (net report); +END PROC report; + +END PACKET net report; + diff --git a/system/net/1.8.7/src/netz b/system/net/1.8.7/src/netz new file mode 100644 index 0000000..c237ba2 --- /dev/null +++ b/system/net/1.8.7/src/netz @@ -0,0 +1,20 @@ +IF exists ("port intern") THEN forget ("port intern") FI; +definiere netz; +list option; +erlaube(1,127); +sperre (1,9); +sperre (15,32); +sperre (37,37); +sperre (42,42); +sperre (46,47); +sperre (49,127); +routen (1, 32,8); +routen (33,43, 9); +routen (34,34,8); +routen (35,48,9); +starte kanal (9,11,10); +starte kanal (8,1,10); +aktiviere netz; + + + diff --git a/system/net/1.8.7/src/port server b/system/net/1.8.7/src/port server new file mode 100644 index 0000000..46c647f --- /dev/null +++ b/system/net/1.8.7/src/port server @@ -0,0 +1,164 @@ +PACKET port server: (* Autor : R. Ruland *) + (* Stand : 21.03.86 *) + +INT VAR port station; +TEXT VAR port := "PRINTER"; + +put ("gib Name des Zielspools : "); editget (port); line; +put ("gib Stationsnummer des Zielspools : "); get (port station); + +server channel (15); +spool duty ("Verwalter fuer Task """ + port + + """ auf Station " + text (port station)); + +LET max counter = 10 , + time slice = 300 , + + ack = 0 , + fetch code = 11 , + param fetch code = 21 , + file save code = 22 , + file type = 1003 , + + begin char = ""0"", + end char = ""1""; + + +INT VAR reply, old heap size; +TEXT VAR file name, write pass, read pass, sendername, buffer; +FILE VAR file; + +DATASPACE VAR ds, file ds, send ds; + +BOUND STRUCT (TEXT file name, write pass, read pass, sendername, INT station) VAR msg; +BOUND TEXT VAR error msg ; + +spool manager (PROC save file); + +PROC save file : + + disable stop ; + command dialogue (FALSE); + ds := nilspace; file ds := nilspace; send ds := nil space; + old heap size := heap size; + + REP + execute save file; + + IF is error THEN save error (error message) FI; + + IF heap size > old heap size + 4 + THEN collect heap garbage ; + old heap size := heap size + FI; + + PER + +ENDPROC save file; + + +PROC execute save file : + +enable stop; +forget (file ds) ; file ds := nilspace; +call (father, fetch code, file ds, reply); +IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE save file ds +FI; + +. save file ds : + IF type (file ds) = file type + THEN get file params; + insert file params; + call station (port station, port, file save code, file ds); + ELSE errorstop ("Datenraum hat falschen Typ") + FI; + +. get file params : + forget (ds); ds := nilspace; + call (father, param fetch code, ds, reply); + IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE msg := ds; + file name := msg. file name; + write pass := msg. write pass; + read pass := msg. read pass; + sendername := msg. sender name; + FI; + +. insert file params : + buffer := ""; + in headline (filename); + in headline (write pass); + in headline (read pass); + in headline (sendername); + file := sequential file (input, file ds) ; + headline (file, buffer); + +END PROC execute save file; + + +PROC call station (INT CONST order task station, TEXT CONST order task name, + INT CONST order code, DATASPACE VAR order ds) : + + INT VAR counter := 0; + TASK VAR order task; + disable stop; + REP order task := order task station // order task name; + IF is error CAND pos (error message, "antwortet nicht") > 0 + THEN clear error; + counter := min (max counter, counter + 1); + pause (counter * time slice); + ELSE enable stop; + forget (send ds); send ds := order ds; + call (order task, order code, send ds, reply); + disable stop; + IF reply = ack + THEN forget (order ds); order ds := send ds; + forget (send ds); + LEAVE call station + ELSE error msg := send ds; + errorstop (error msg); + FI; + FI; + PER; + +END PROC call station; + + +TASK OP // (INT CONST station, TEXT CONST name) : + + enable stop; + station / name + +END OP //; + + +PROC in headline (TEXT CONST information) : + IF pos (information, begin char) <> 0 + OR pos (information, end char) <> 0 + THEN errorstop ("Name darf nicht Code 0 oder Code 1 enthalten") FI; + buffer CAT begin char; + buffer CAT information; + buffer CAT end char; +END PROC in headline; + + +PROC save error (TEXT CONST message) : + clear error; + file name CAT "."; + file name CAT sender name; + file name CAT ".ERROR"; + file := sequential file (output, file name); + putline (file, " "); + putline (file, "Uebertragung nicht korrekt beendet "); + putline (file, " "); + put (file, "ERROR :"); put (file, message); + save (file name, public); + clear error; + forget(file name, quiet); +END PROC save error; + +ENDPACKET port server; + diff --git a/system/net/1.8.7/src/printer server b/system/net/1.8.7/src/printer server new file mode 100644 index 0000000..b1a30bc --- /dev/null +++ b/system/net/1.8.7/src/printer server @@ -0,0 +1,99 @@ +PACKET multi user printer : (* Autor : Rudolf Ruland *) + (* Stand : 24.03.86 *) + +INT VAR c; +put ("gib Druckerkanal : "); get (c); + + server channel (c); + station only (FALSE) ; + spool duty ("Ausgabe mit dem Drucker"); + spool control task (myself); + +LET ack = 0 , + + fetch code = 11 , + param fetch code = 21 , + file type = 1003 ; + +INT VAR reply, old heap size, sender station; +TEXT VAR file name, userid, password, sendername; +FILE VAR file ; + +DATASPACE VAR ds, file ds; + +BOUND STRUCT (TEXT file name, userid, password, sendername, INT station) VAR msg; +BOUND TEXT VAR error msg ; + +spool manager (PROC printer); + +PROC printer : + + disable stop ; + command dialogue (FALSE); + ds := nilspace; file ds := nilspace; + continue (server channel) ; + check error ("Kanal belegt"); + + old heap size := heap size ; + REP + execute print ; + + IF is error + THEN put error; + clear error; + FI ; + + IF heap size > old heap size + 4 + THEN collect heap garbage ; + old heap size := heap size + FI + PER + +ENDPROC printer ; + + +PROC execute print : + + enable stop ; + forget (file ds) ; file ds := nilspace ; + call (father, fetch code, file ds, reply) ; + IF reply = ack CAND type (file ds) = file type + THEN get file params; + print file + FI ; + +. get file params : + forget (ds); ds := nilspace; + call (father, param fetch code, ds, reply); + IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE msg := ds; + file name := msg. file name; + userid := msg. userid; + password := msg. password; + sendername := msg. sender name; + sender station := msg. station; + FI; + +. print file : + file := sequential file (input, file ds); + print (file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC execute print ; + + +PROC check error (TEXT CONST message) : + IF is error + THEN clear error; + rename myself (message); + IF is error THEN clear error; end (myself) FI; + pause (18000); + end (myself); + FI; +END PROC check error; + +ENDPACKET multi user printer ; + diff --git a/system/net/1.8.7/src/spool cmd b/system/net/1.8.7/src/spool cmd new file mode 100644 index 0000000..b44e799 --- /dev/null +++ b/system/net/1.8.7/src/spool cmd @@ -0,0 +1,112 @@ +PACKET spool cmd (* Autor: R. Ruland *) + (* Stand: 01.04.86 *) + DEFINES killer, + first, + 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) + + . 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/system/net/1.8.7/src/spool manager b/system/net/1.8.7/src/spool manager new file mode 100644 index 0000000..e711ab4 --- /dev/null +++ b/system/net/1.8.7/src/spool manager @@ -0,0 +1,915 @@ +PACKET spool manager DEFINES (* Autor: J. Liedtke *) + (* R. Nolting *) + (* R. Ruland *) + (* Stand: 22.07.86 *) + + spool manager , + + server channel , + spool duty, + station only, + spool control task : + +LET que size = 101 , + + ack = 0 , + nak = 1 , + error nak = 2 , + message ack = 3 , + question ack = 4 , + second phase ack = 5 , + false code = 6 , + + fetch code = 11 , + save code = 12 , + exists code = 13 , + erase code = 14 , + list code = 15 , + all code = 17 , + param fetch code = 21 , + file save code = 22 , + entry line code = 23 , + killer code = 24 , + first code = 25 , + start code = 26 , + stop code = 27 , + halt code = 28 , + wait for halt code = 29 , + + continue code = 100 , + + file type = 1003 ; + +LET begin char = ""0"", + end char = ""1""; + +LET PARAMS = STRUCT (TEXT name, userid, password, sendername, INT station), + ENTRY = STRUCT (PARAMS ds params, TEXT entry line, DATASPACE space); + +ROW que size ENTRY VAR que ; + +PARAMS CONST empty params := PARAMS : ("", "", "", "", -1); + +PARAMS VAR save params, file save params; + +ENTRY VAR fetch entry; + +FILE VAR file; + +INT VAR order, last order, phase, reply, old heap size, first, last, list index, + begin pos, end pos, order task station, sp channel, counter; + +TEXT VAR order task name, buffer, sp duty, start time; + +BOOL VAR server is waiting, stop command pending, stat only, valid fetch entry; + +TASK VAR order task, last order task, server, calling parent, task in control; + +INITFLAG VAR in this task := FALSE; + +DATASPACE VAR ds; + +BOUND STRUCT (TEXT name, userid, password) VAR msg; +BOUND STRUCT (TEXT entry line, INT index) VAR control msg; +BOUND PARAMS VAR fetch msg; +BOUND THESAURUS VAR all msg; +BOUND TEXT VAR error msg ; + + +. first entry : que (first) +. list entry : que (list index) +. last entry : que (last) + +. que is empty : first = last +. que is full : first = next (last) +.; + +sp channel := 0; +sp duty := ""; +stat only := FALSE; +task in control := myself; + +PROC server channel (INT CONST channel nr) : + IF channel nr <= 0 OR channel nr >= 33 + THEN errorstop ("falsche Kanalangabe") FI; + sp channel := channel nr; +END PROC server channel; + +INT PROC server channel : + sp channel +END PROC server channel; + + +PROC station only (BOOL CONST flag) : + stat only := flag +END PROC station only; + +BOOL PROC station only : + stat only +END PROC station only; + + +PROC spool duty (TEXT CONST duty) : + sp duty := duty; +END PROC spool duty; + +TEXT PROC spool duty : + sp duty +END PROC spool duty; + + +PROC spool control task (TASK CONST task id): + task in control := task id; +END PROC spool control task; + +TASK PROC spool control task : + task in control +END PROC spool control task; + + +PROC spool manager (PROC server start) : + + spool manager (PROC server start, TRUE) + +END PROC spool manager; + + +PROC spool manager (PROC server start, BOOL CONST with start) : + + set autonom ; + break ; + disable stop ; + initialize spool manager ; + REP forget (ds) ; + wait (ds, order, order task) ; + IF order <> second phase ack + THEN prepare first phase ; + spool (PROC server start); + ELIF order task = last order task + THEN prepare second phase ; + spool (PROC server start); + ELSE send nak + FI ; + send error if necessary ; + collect heap garbage if necessary + PER + + . initialize spool manager : + initialize if necessary; + stop; + erase fetch entry; + IF with start THEN start (PROC server start) FI; + + . initialize if necessary : + IF NOT initialized (in this task) + THEN FOR list index FROM 1 UPTO que size + REP list entry. space := nilspace PER; + fetch entry. space := nilspace; + ds := nilspace; + last order task := niltask; + server := niltask; + calling parent := niltask; + server is waiting := FALSE; + stop command pending := FALSE; + old heap size := 0; + clear spool; + FI; + + . prepare first phase : + IF order = save code OR order = erase code OR order = stop code + THEN phase := 1 ; + last order := order ; + last order task := order task ; + FI; + + . prepare second phase : + phase INCR 1 ; + order := last order + + . send nak : + forget (ds) ; + ds := nilspace ; + send (order task, nak, ds); + + . send error if necessary : + IF is error + THEN forget (ds) ; + ds := nilspace ; + error msg := ds ; + CONCR (error msg) := error message; + clear error; + send (order task, error nak, ds) + FI; + + . collect heap garbage if necessary : + IF heap size > old heap size + 2 + THEN collect heap garbage; + old heap size := heap size; + FI; + +END PROC spool manager; + + +PROC spool (PROC server start): + + command dialogue (FALSE); + enable stop; + IF station only CAND station (ordertask) <> station (myself) + THEN errorstop ("kein Zugriffsrecht auf Task " + text (station(myself)) + + "/""" + name(myself) + """") + FI; + + SELECT order OF + + CASE fetch code : out of que + CASE param fetch code : send fetch params + CASE save code : new que entry + CASE file save code : new file que entry + CASE exists code : exists que entry + CASE erase code : erase que entry + CASE list code : send spool list + CASE all code : send owners ds names + + OTHERWISE : + + IF order >= continue code AND order task = supervisor + THEN forget (ds); + spool command (PROC server start) + + ELIF spool control allowed by order task + THEN SELECT order OF + CASE entry line code : send next entry line + CASE killer code : kill entry + CASE first code : make to first + CASE start code : start server + CASE stop code : stop server + CASE halt code : halt server + CASE wait for halt code : wait for halt + OTHERWISE : errorstop ("falscher Auftrag fuer Task """ + + name(myself) + """") + END SELECT + + ELSE errorstop ("falscher Auftrag fuer Task """ + + name(myself) + """") + FI; + END SELECT; + + +. spool control allowed by order task : + (order task = spool control task OR order task < spool control task + OR spool control task = supervisor) + AND station (order task) = station (myself) +. + out of que : + IF NOT (order task = server) + THEN errorstop ("keine Servertask") + ELIF stop command pending + THEN forget (ds); + stop; + erase fetch entry; + ELIF que is empty + THEN forget (ds) ; + erase fetch entry; + server is waiting := TRUE; + ELSE send first entry; + FI; + +. + send fetch params : + IF order task = server + THEN send params + ELSE errorstop ("keine Servertask") + FI; + + . send params : + forget(ds); ds := nilspace; fetch msg := ds; + fetch msg := fetch entry. ds params; + send (order task, ack, ds); + +. + new que entry : + IF phase = 1 + THEN prepare into que + ELSE into que + FI; + +. + prepare into que : + msg := ds ; + save params. name := msg.name; + save params. userid := msg.userid; + save params. password := msg.password; + save params. sendername := name (order task); + save params. station := station (order task); + forget (ds); ds := nilspace; + send (order task, second phase ack, ds); + +. + new file que entry : + IF type (ds) <> file type + THEN errorstop ("Datenraum hat falschen Typ"); + ELSE get file params; + into que; + FI; + + . get file params : + file := sequential file (input, ds); + end pos := 0; + next headline information (file save params. name); + next headline information (file save params. userid); + next headline information (file save params. password); + next headline information (file save params. sendername); + next headline information (buffer); + file save params. station := int (buffer); + IF NOT last conversion ok + THEN file save params. station := station (order task) FI; + IF file save params. sendername = "" + THEN file save params. sendername := name (order task) FI; + IF file save params. name = "" + THEN IF headline (file) <> "" + THEN file save params. name := headline (file); + ELSE errorstop ("Name unzulaessig") + FI; + ELSE headline (file, file save params. name); + FI; + +. + exists que entry : + msg := ds ; + order task name := name (order task); + order task station := station (order task); + to first que entry; + WHILE next que entry found + REP IF is entry from order task (msg. name) + THEN send ack; + LEAVE exists que entry + FI; + PER ; + forget (ds); ds := nilspace; + send (order task, false code, ds) + +. + erase que entry : + msg := ds ; + order task name := name (order task); + order task station := station (order task); + IF phase = 1 + THEN ask for erase + ELSE erase entry from order task + FI; + + . ask for erase : + to first que entry; + WHILE next que entry found + REP IF is entry from order task (msg. name) + THEN manager question ("""" + msg.name + """ loeschen"); + LEAVE erase que entry + FI; + PER ; + manager message ("""" + msg.name + """ existiert nicht"); + + . erase entry from order task : + IF is entry from order task (msg. name) + THEN delete que entry; + LEAVE erase que entry + ELSE to first que entry; + WHILE next que entry found + REP IF is entry from order task (msg. name) + THEN delete que entry; + LEAVE erase que entry + FI ; + PER ; + manager message ("""" + msg.name + """ existiert nicht"); + FI; + + . delete que entry : + erase entry (list index) ; + send ack; + +. + send owners ds names: + order task name := name (order task); + order task station := station (order task); + forget (ds); ds := nilspace; all msg := ds; + all msg := empty thesaurus; + to first que entry; + WHILE next que entry found + REP IF is entry from order task ("") + THEN insert (all msg, list entry. ds params. name) + FI; + PER; + send (order task, ack, ds) + +. + send spool list : + list spool; + send (order task, ack, ds); + +. + send next entry line : + control msg := ds; + get next entry line (control msg. entry line, control msg. index); + send (order task, ack, ds); + +. + kill entry : + control msg := ds; + list index := control msg. index; + IF is valid que entry (list index) + THEN erase entry (list index) + FI; + send (order task, ack, ds); + +. + make to first : + control msg := ds; + list index := control msg. index; + IF is valid que entry (list index) + THEN new first (list entry); + erase entry (list index); + FI; + send (order task, ack, ds); + +. + start server : + IF exists (server) THEN errorstop ("Spool muß zuerst gestoppt werden") FI; + start (PROC server start); + IF server channel <= 0 OR server channel >= 33 + THEN manager message ("WARNUNG : Serverkanal nicht eingestellt"); + ELSE send ack + FI; + +. + stop server: + IF phase = 1 + THEN stop; + IF valid fetch entry + THEN valid fetch entry := FALSE; + manager question (""13""10"" + + fetch entry. entry line + " neu eintragen"); + ELSE erase fetch entry; + send ack; + FI; + ELSE IF fetch entry. entry line <> "" THEN new first (fetch entry) FI; + erase fetch entry; + send ack; + FI; + +. + halt server : + stop command pending := TRUE; + IF NOT exists (server) OR server is waiting + THEN stop; + erase fetch entry; + FI; + send ack; + +. + wait for halt : + IF exists (calling parent) + THEN errorstop ("Task """ + name (calling parent) + """ wartet schon auf halt") + ELSE calling parent := order task; + stop command pending := TRUE; + forget (ds); + IF NOT exists (server) OR server is waiting + THEN stop; + erase fetch entry; + FI; + FI; + +END PROC spool; + + +PROC send first entry : + + forget (ds); ds := first entry. space; + send (server, ack, ds, reply) ; + IF reply = ack + THEN server is waiting := FALSE; + start time := time of day; + start time CAT " am "; + start time CAT date; + erase fetch entry; + fetch entry := first entry; + erase entry (first); + valid fetch entry := TRUE; + ELSE forget (ds); + FI; + +END PROC send first entry; + + +PROC into que : + + IF que is full + THEN errorstop ("Spool ist voll") + ELSE make new entry; + send ack; + awake server if necessary + FI; + + . make new entry : + IF order = save code + THEN last entry. ds params := save params; + save params := empty params; + ELSE last entry. ds params := file save params; + file save params := empty params; + FI; + last entry. space := ds; + counter INCR 1; + build entry line; + last := next (last) ; + + . build entry line : + IF LENGTH last entry. ds params. sender name > 16 + THEN buffer := subtext (last entry. ds params. sender name, 1, 13); + buffer CAT "..."""; + ELSE buffer := last entry. ds params. sender name; + buffer CAT """"; + buffer := text (buffer, 17); + FI; + last entry. entry line := entry station text; + last entry. entry line CAT "/"""; + last entry. entry line CAT buffer; + last entry. entry line CAT " : """ ; + last entry. entry line CAT last entry. ds params. name; + last entry. entry line CAT """ (" ; + last entry. entry line CAT text (storage (last entry. space)); + last entry. entry line CAT " K)"; + + . entry station text : + IF last entry. ds params. station = 0 + THEN " " + ELSE text (last entry. ds params. station, 3) + FI + + . awake server if necessary : + IF server is waiting THEN send first entry FI; + +END PROC into que; + + +PROC list spool : + + forget (ds); ds := nilspace; + file := sequential file (output, ds) ; + max line length (file, 1000); + headline(file, station text + "/""" + name (myself) + """"); + put spool duty; + put current job; + put spool que; + + . station text : + IF station(myself) = 0 + THEN "" + ELSE text (station(myself)) + FI + + . put spool duty : + IF spool duty <> "" + THEN write (file, "Aufgabe: "); + write (file, spool duty ); + line (file, 2); + FI; + + . put current job : + IF valid fetch entry AND exists (server) + THEN write (file, "In Bearbeitung seit "); + write (file, start time); + write (file, ":"); + line (file, 2); + putline (file, fetch entry. entry line); + IF stop command pending + THEN putline (file, "Spool wird nach diesem Auftrag deaktiviert"); + FI; + line (file); + ELSE write (file, "kein Auftrag in Bearbeitung"); + IF NOT exists (server) + THEN write (file, ", da Spool deaktiviert"); + ELIF que is empty + THEN write (file, ", da Warteschlange leer"); + LEAVE list spool; + FI; + line (file, 2); + FI; + + . put spool que : + IF que is empty + THEN putline (file, "Warteschlange ist leer"); + ELSE write (file, "Warteschlange ("); + write (file, text (counter)); + write (file, " Auftraege):"); + line (file, 2); + to first que entry ; + WHILE next que entry found + REP putline (file, list entry. entry line) PER; + FI; + +END PROC list spool ; + + +PROC clear spool : + + first := 1; + last := 1; + counter := 0; + FOR list index FROM 1 UPTO que size + REP list entry. ds params := empty params; + list entry. entry line := ""; + forget (list entry. space) + PER; + +END PROC clear spool; + +(*********************************************************************) +(* Hilfsprozeduren zum Spoolmanager *) + +BOOL PROC is valid que entry (INT CONST index) : + + que (index). entry line <> "" + +END PROC is valid que entry; + + +INT PROC next (INT CONST index) : + + IF index < que size + THEN index + 1 + ELSE 1 + FI + +END PROC next; + + +PROC to first que entry : + + list index := first - 1; + +ENDPROC to first que entry ; + + +BOOL PROC next que entry found : + + list index := next (list index); + WHILE is not last que entry + REP IF is valid que entry (list index) + THEN LEAVE next que entry found WITH TRUE FI; + list index := next (list index); + PER; + FALSE + + . is not last que entry : + list index <> last + +ENDPROC next que entry found ; + + +PROC get next entry line (TEXT VAR entry line, INT VAR index) : + + IF index = 0 + THEN list index := first - 1 + ELSE list index := index + FI; + IF next que entry found + THEN entry line := list entry. entry line; + index := list index; + ELSE entry line := ""; + index := 0; + FI; + +END PROC get next entry line; + + +PROC new first (ENTRY VAR new first entry) : + + IF que is full + THEN errorstop ("Spool ist voll") + ELSE first DECR 1 ; + IF first = 0 THEN first := que size FI; + first entry := new first entry; + counter INCR 1; + FI; + +END PROC new first; + + +PROC erase entry (INT CONST index) : + + entry. ds params := empty params; + entry. entry line := ""; + forget (entry.space) ; + counter DECR 1; + IF index = first + THEN inc first + FI ; + + . entry : que (index) + + . inc first : + REP first := next (first) + UNTIL que is empty OR is valid que entry (first) PER + +END PROC erase entry; + + +PROC erase fetch entry : + + fetch entry. ds params := empty params; + fetch entry. entry line := ""; + forget (fetch entry. space); + valid fetch entry := FALSE; + +END PROC erase fetch entry; + + +BOOL PROC is entry from order task (TEXT CONST file name) : + + correct order task CAND correct filename + + . correct order task : + order task name = list entry. ds params. sendername + AND order task station = list entry. ds params. station + + . correct file name : + file name = "" OR file name = list entry. ds params. name + +END PROC is entry from order task; + + +PROC start (PROC server start): + + begin (PROC server start, server); + +END PROC start; + + +PROC stop : + + stop server; + send calling parent reply if necessary; + + . stop server: + IF exists (server) THEN end (server) FI; + server := niltask; + server is waiting := FALSE; + stop command pending := FALSE; + + . send calling parent reply if necessary : + IF exists (calling parent) + THEN forget (ds); ds := nilspace; + send (calling parent, ack, ds); + calling parent := niltask; + FI; + +END PROC stop; + + +PROC next headline information (TEXT VAR t): + + begin pos := pos (headline (file), begin char, end pos + 1); + IF begin pos = 0 + THEN begin pos := LENGTH headline (file) + 1; + t := ""; + ELSE end pos := pos (headline (file), end char, begin pos + 1); + IF end pos = 0 + THEN end pos := LENGTH headline (file) + 1; + t := ""; + ELSE t := subtext (headline (file), begin pos+1, end pos-1) + FI + FI + +END PROC next headline information; + + +PROC send ack : + + forget (ds); ds := nilspace; + send (order task, ack, ds) + +END PROC send ack; + + +PROC manager question (TEXT CONST question) : + + forget (ds); ds := nilspace; error msg := ds ; + error msg := question ; + send (order task, question ack, ds) + +ENDPROC manager question ; + + +PROC manager message (TEXT CONST message) : + + forget (ds); ds := nilspace; error msg := ds ; + error msg := message ; + send (order task, message ack, ds) + +ENDPROC manager message ; + +(*********************************************************************) +(* Spool - Kommandos *) + +INT VAR command index , params ; +TEXT VAR command line, param 1, param 2 ; + +LET spool command list = +"break:1.0start:2.01stop:4.0halt:5.0first:6.0killer:7.0listspool:8.0 +clearspool:9.0spoolcontrolby:10.1"; + +PROC spool command (PROC server start) : + + enable stop ; + continue (order - continue code) ; + disable stop ; + REP command dialogue (TRUE) ; + get command ("gib Spool-Kommando:", command line); + analyze command (spool command list, command line, 3, command index, + params, param1, param2); + execute command (PROC server start); + UNTIL NOT online PER; + command dialogue (FALSE); + break (quiet); + set autonom; + +END PROC spool command; + + +PROC execute command (PROC server start) : + + enable stop; + SELECT command index OF + CASE 1 : break + CASE 2 : start server + CASE 3 : start server with new channel + CASE 4 : stop server + CASE 5 : halt server + CASE 6 : first cmd + CASE 7 : killer cmd + CASE 8 : show spool list + CASE 9 : clear spool + CASE 10 : spool control task (task (param1)) + OTHERWISE do (command line) + END SELECT; + + . start server : + IF server channel <= 0 OR server channel >= 33 + THEN line; + putline ("WARNUNG : Serverkanal nicht eingestellt"); + FI; + stop server; + start (PROC server start); + + . start server with new channel: + INT VAR i := int (param1); + IF last conversion ok + THEN server channel (i); + start server; + ELSE errorstop ("falsche Kanalangabe") + FI; + + . stop server : + disable stop; + stop; + IF valid fetch entry CAND + yes (""13""10"" + fetch entry. entry line + " neu eintragen") + THEN new first (fetch entry) FI; + erase fetch entry; + enable stop; + + . halt server : + stop command pending := TRUE; + IF NOT exists (server) OR server is waiting + THEN stop server; + erase fetch entry; + FI; + + . first cmd : + line ; + to first que entry ; + WHILE next que entry found + REP say (list entry. entry line) ; + IF yes (" als erstes") + THEN new first (list entry); + erase entry (list index); + LEAVE first cmd + FI ; + PER; + + . killer cmd : + line ; + to first que entry ; + WHILE next que entry found + REP say (list entry. entry line) ; + IF yes (" loeschen") THEN erase entry (list index) FI ; + PER; + + . show spool list : + list spool; + disable stop; + show (file); + forget (ds); + +ENDPROC execute command ; + +ENDPACKET spool manager; + diff --git a/system/net/unknown/doc/EUMEL Netz b/system/net/unknown/doc/EUMEL Netz new file mode 100644 index 0000000..941e2ea --- /dev/null +++ b/system/net/unknown/doc/EUMEL Netz @@ -0,0 +1,829 @@ +#type ("trium8")##limit (11.0)# +#start(2.5,1.5)##pagelength (17.4)# +#block# +#headeven# + +% EUMEL-Netzbeschreibung + + +#end# +#headodd# + +#center#Inhalt#right#% + + +#end# + +#type ("triumb12")# +1. Einleitung + + +Teil 1: Netz einrichten und benutzen +#type ("trium8")# + +1. Benutzung des Netzes + +2. Hardwarevoraussetzungen + +3. Einrichten des Netzes + +4. Informationsmöglichkeiten + +5. Eingriffsmöglichkeiten + +6. Fehlerbehebung im Netz + +#type ("triumb12")# + +Teil 2: Arbeitsweise der Netzsoftware +#type ("trium8")# + +1. Die Netztask + +2. Protokollebenen + +3. Stand der Netzsoftware + +#page# +#headodd# + +#center#Einleitung#right#% + + +#end# + +#type("triumb12")# +1. Einleitung #type("trium8")# + + +Das EUMEL-Netz dient dazu mehrere EUMEL-Rechner (sog. Stationen) mit­ +einander zu koppeln. Diese Kopplung wird von Betriebsystem dazu benutzt, das +Sendungskonzept (siehe Systemhandbuch 1.7, Intertaskkommunikation) so auszu­ +dehnen, daß Tasks verschiedener Stationen einander Datenräume zusenden +können. Auf dem Sendungskonzept aufbauende Konzepte nutzen daher automa­ +tisch das Netz aus: So ist es z.B. möglich + +- von einer Station aus auf einer anderen zu Drucken, + +- in PUBLIC einer anderen Station Dateien zu sichern (save), vorausgesetzt, daß + PUBLIC dort ein free global manager ist, + +- auf einer anderen Station zu archivieren (z.B. wenn das eigene Archivlaufwerk + defekt ist oder ein anderes Format hat). + +Das Netz kann ab EUMEL-Version 1.7.3 eingesetzt werden. + + +#type("triumb12")# +Teil 1: Netz einrichten und benutzen + +1. Benutzung des Netzes #type("trium8")# +#headodd# + +#center#Teil 1: Netz einrichten und benutzen#right#% + + +#end# + + Zur Benutzung des Netzes stehen folgende Operatoren und Prozeduren zur + Verfügung: + + +1.1 + + TASK OP / (INT CONST station, TEXT CONST taskname) + + liefert die Task #on("bold")#taskname#off("bold")# von der Station #on("bold")#station#off("bold")#. + + Wenn die Station #on("bold")#station#off("bold")# nicht am Netz ist oder nicht eingeschaltet ist, wird + solange gewartet, bis das der Fall ist. + + Fehlerfälle: + + - task "..." gibt es nicht + + Die angeforderte Task gibt es in der Zielstation nicht. + + - Collectortask fehlt + + Das Kommando #on("bold")#define collector#off("bold")# wurde nicht gegeben (siehe 4.2). + + - Station x antwortet nicht + + Eine nicht vorhandene oder abgeschaltete Station wurde angesprochen. + Hinweis: Dieser Fehler wird angenommen, wenn eine Überwachungszeit + von ca. 30 Sekunden verschrichen ist, ohne daß Station x die + Taskidentifikation angeliefert hat. + + Beispiel: + + list (5/"PUBLIC") + + Dateiliste von PUBLIC auf Station 5 wird angefordert. + +1.2 + + TASK OP / (INT CONST station, TASK CONST task) + + liefert + + station / name (task) . + + + Beispiel: + + list (4/archive) + + +1.3 + + INT PROC station (TASK CONST task) + + liefert die Stationsnummer der Task #on("bold")#task#off("bold")#. + + Beispiel: + + put (station (myself)) + + gibt die eigene Stationsnummer aus. + + +1.4 + + PROC archive (TEXT CONST archivename, INT CONST station) + + dient dazu das Archiv auf der Station #on("bold")#station#off("bold")# anzumelden. + + Beispiel: + + archive ("std", 4); list (4/archive) + + gibt das Inhaltsverzeichnis der Archivfloppy im Laufwerk der Station 4 aus. + Hinweis: Vergessen Sie bei solchen Querarchivierungen nicht die Stations­ + angabe bei jedem einzelnen Archivkommando (z.B fetch ("xxx", #on("bold")#4/#off("bold")# + archive). + Hinweis: Querarchivieren ist langsam. Verwenden Sie es nur, wenn Sie Flop­ + pyformate umsetzen wollen. + + +1.5 + + PROC free global manager + + dient dazu, die eigene Task über das Netz ansprechbar zu machen. Jede + andere Task im Netz kann dann die üblichen Manageraufrufe ('save', 'fetch', + u.s.w.) an die eigene Task machen, sofern diese nicht an ein Terminal gekop­ + pelt ist. + + Die Task wird (wie bei 'break') abgekoppelt und meldet sich in Zukunft mit + 'maintenance' statt mit 'gib kommando'. + + Beispiel: + + An Station 4 ruft man in der Task 'hugo' das Kommando #on("bold")#free global manager#off("bold")# + auf. Anschließend kann man von jeder Station aus z.B. 'list (4/"hugo")' u.s.w. + machen. + + +1.6 + + TEXT PROC name (TASK CONST t) + + Diese (schon immer vorhandene) Prozedur wurde dahingehend erweitert, daß der + Name einer Task einer anderen Station über Netz angefordert wird. + + Fehlerfall: + + Station x antwortet nicht + + + + +#type("triumb12")#2. Hardwarevoraussetzungen#type("trium8")# + +2.1 Zwei Stationen + + Sie können zwei Stationen miteinander Vernetzen, wenn Sie dafür an jeder + Station eine V24-Schnittstelle zur Verfügung stellen. + + Diese beiden Schnittstellen verbinden Sie mit einem Kabel zur Rechner­ + kopplung (siehe Systemhandbuch 1.7 Teil 2). + +2.2 Mehrere Stationen + + Wenn Sie mehr als zwei Stationen vernetzen wollen, brauchen neben je + einer V24 an jeder Station noch je eine Netzanschlußbox. + + Jede Box besitzt eine V24-Schnittstelle zum Anschluß an die V24- + Schnittstelle der zugeorneten Station und eine weitere Schnittstelle zur + Verbindung der Boxen untereinander. + + +#type("triumb12")#3. Einrichten des Netzes #type("trium8")# + +Hinweis: Dieses Kapitel ist nur für Systembetreuer wichtig. + +3.1 Legen Sie Stationsnummern für die am Netz beteiligten Rechner fest (von 1 an + aufsteigend). + + Die Boxen haben ebenfalls Stationsnummern. Die Stationsnummern der Box + und des zugeordneten Rechners müssen übereinstimmen. + + +3.2 Holen Sie an jeder Station die Task #on("bold")#configurator#off("bold")# an ein Terminal und geben Sie + das Kommando #on("bold")#define collector ("net port")#off("bold")#. Geben Sie außerdem das + Kommando #on("bold")#define station (x)#off("bold")#, wobei #on("bold")#x#off("bold")# die gewählte Stationsnummer ist. + + Hinweis: Taskkommunikationen, die zu dem Zeitpunkt laufen, führen zu feh­ + lerhaften Verhalten. Dies liegt daran, daß durch #on("bold")#define station#off("bold")# alle + Task-Id's geändert werden müssen, weil eine Task-Id u.a. die + Stationsnummer der eigenen Station enthält (siehe 2.3). TASK- + Variable, die noch Task-Id's mit keiner oder falscher Stationsnum­ + mer enthalten, können nicht mehr zum Ansprechen einer Task + verwendet werden. + + Beispiel: Der Spoolmanager (siehe Benutzerhandbuch 1.7 Teil 12) richtet + beim Kommando #on("bold")#start#off("bold")# einen Worker ein und merkt sich dessen + Task-Id in einer TASK-Variablen, um sicherzustellen, daß nur der + Worker Dateien zum Drucken abholt. Wird jetzt das Kommando #on("bold")# + define station#off("bold")# gegeben, kann der Spoolmanager seinen Worker + nicht mehr identifizieren, weil der Worker eine neue Task-Id er­ + halten hat. Man muß daher den Worker löschen und mit dem + Kommando #on("bold")#start#off("bold")# im Spoolmanager wieder neu einrichten. + + + Sinnvollerweise gibt man #on("bold")#define station#off("bold")# sofort nach den Laden eines + frischen Systems von Archiv. + + Konfigurieren Sie mit dem Kommando #on("bold")#configurate#off("bold")# den für das Netz vorgese­ + henen Kanal auf + + - transparent + - 9600 Baud (Standardeinstellung der Boxen) + - RTS/CTS-Protokoll + - großen Puffer + - 8 bit + - even parity + - 1 stopbit. + + Falls diese Einstellungen nicht alle angeboten werden, klären Sie mit Ihrem + Rechnerlieferanten, ob und wie diese Einstellungen erreicht werden können. + Hinweis: Notfalls kann auf das RTS/CTS-Protokoll verzichtet werden, wenn + der Eingabepuffer der Station groß genug ist. Die Anzahl simultan + laufender Netzkommunikationen ist dann auf + + puffergröße DIV 150 + + begrenzt (bei Z80, 8086: 3; bei M20: 10). + Hinweis: Es können auch andere Baudraten (2400, 4800, 19200) an der Box + eingestellt werden. + +3.3 Achten Sie bei der Verbindung von der Station zur Netzbox (bzw. zur Gegen­ + station bei einem Zweistationennetz ohne Boxen) darauf, daß neben den + Empfangs- und Sendeleitungen auch die Leitungen RTS und CTS verdrahtet + werden, also ein 5 poliges Kabel verwendet wird (siehe Systemhandbuch 1.7 + Teil 2). Die Pin-Belegung der Boxen entspricht den dortigen Angaben. + + Beispiel: + + Verbindung eines CSK-Systems mit der Box: + + Stecker Stecker + Pin Pin + + 2 <---------> 3 + 3 <---------> 2 + 4 <---------> 5 + 5 <---------> 4 + 7 <---------> 7 + + +3.4 Richten Sie eine Task #on("bold")#net#off("bold")# unter #on("bold")#SYSUR#off("bold")# ein und insertieren Sie dort die Datei­ +en + + net report/M + basic net + net manager/M. + + Beantworten Sie die Frage nach dem Kanal für das Netz und nach der Fluß­ + kontrolle (RTS/CTS). + + +#type("triumb12")#4. Informationsmöglichkeiten #type("trium8")# + + In der Task #on("bold")#net#off("bold")# wird eine Datei #on("bold")#report#off("bold")# geführt in der Fehlersituationen des + Netzes verzeichnet werden. Diese Datei kann in jeder anderen Task mit #on("bold")#list + (/"net")#off("bold")# angezeigt werden. + + In jeder Task kann durch das Kommando #on("bold")#list (/"net port")#off("bold")# eine Übersicht über + die momentan laufenden Netzübertragungen der eigenen Station erhalten + werden. + + +#type("triumb12")#5. Eingriffsmöglichkeiten #type("trium8")# +#headodd# + +#center#Eingriffsmöglichkeiten#right#% + + +#end# + +5.1 Jede Task kann Sende- und Empfangsströme, die bei #on("bold")#list (/"net port")#off("bold")# gemel­ + det worden sind und die eigene Task betreffen, abbrechen. Hierzu ist das + Kommando #on("bold")#erase ("x",/"net port")#off ("bold")# zu geben, wobei x die Stromnummer (aus + dem 'list') ist. + + Unberechtigte Löschversuche werden abgewiesen. + + Von der Task 'net' aus können jedoch damit beliebige Ströme abgebrochen + werden. + +5.2 Durch das Kommando #on("bold")#start#off("bold")# kann von der Task 'net' aus das Netz neu gestartet + werden. Dabei werden alle augenblicklichen Netzkommunikationen gelöscht. + Die Tasks 'net port' und 'net timer' werden dabei gelöscht und neu eingerich­ + tet. + + #on("bold")#start (kanal, quit)#off("bold")# wirkt wie #on("bold")#start#off("bold")#. Zustzlich wird als Netzkanal 'kanal' eingestellt + und maximal 'quit' Empfangsströme zugelassen. 'quit' ist auf 3 zu setzen, + wenn der Kanal ohne RTS/CTS angeschlossen ist (siehe 3.2). + + +#type("triumb12")#6. Fehlersuche im Netz #type("trium8")# + + Fehler im Netz können sich verschiedenartig auswirken. Im Folgenden wird auf + einige Beispiele eingegangen: + + Beispiel: + + Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Station 4 antwortet nicht'. + + Fehlermöglichkeiten: + + - Station 4 gibt es nicht am Netz. + Abhilfe: Richtige Station angeben. + + - Station 4 ist nicht eingeschaltet. + Abhilfe: Station 4 einschalten. Kommando erneut geben. + + - Netztask an Station 4 ist nicht arbeitsfähig. + Abhilfe: Kommando 'start' in der Task 'net'. + + - Stationsnummern und Boxnummern stimmen nicht überein. + Abhilfe: Mit 'define station' Stationsnummern korrigieren (siehe 3.2). + + - Verbindung Rechner/Box am eigenen Rechner oder an Station 4 fehlt. + Abhilfe: Verbindungen überprüfen. Durch Ansprechen einer dritten Station + kann oft schnell geklärt werden, welche Rechner/Box-Verbindung + defekt sein muß. + + - Verbindung der Boxen untereinander defekt. + Abhilfe: Fehlende Verbindung, Masseschluß und Dreher (keine 1:1 Ver­ + bindung) überprüfen und beheben. + Hinweis: Liegt z.B. ein Masseschluß vor, so kann es durchaus sein, daß + Boxen, die nicht in der Nähe des Masseschluß stehen noch mitei­ + nander arbeiten können. Man kann aus der Tatsache, daß zwei + Boxen miteinander arbeiten können, also nicht schließen, daß man + nicht nach diesem Fehler suchen muß. + + + Beispiel: + + Auf #on("bold")#list (4/public)#off("bold")# erfolgt keine Reaktion. + + + - Station 4 ist während dieser Sendung zusammengebrochen. + Abhilfe: Station 4 wieder starten. Die Bearbeitung des 'list'-Kommandos + wird automatisch wieder aufgenommen. + + - PUBLIC auf Station 4 ist nicht im Managerzustand. + Abhilfe: PUBLIC in den Managerzustand versetzen. + + + Hinweis: Das Netz hat nocht nicht die volle Sendungslogik des EUMEL. So + wird nur ca. 10 Minuten lang versucht, eine Sendung zuzustellen. + Danach wird die Sendung gelöscht. Ist dies eingetreten, so muß + das list-Kommando erneut gegeben werden. + + - Fehler in der Netzhardware. + Überprüfen Sie, ob + + - die Boxen eingeschaltet sind, + - die Bereitlampe blinkt (wenn nicht: RESET an der Box) + - die V24-Kabel richtig stecken, + - die Boxen untereinander verbunden sind (1 zu 1 Verbindungen der 5 + poligen Diodenbuchsen). + + + - Die Netzsoftware ist auf einen nicht vorhergesehenen Fehler gelaufen. + Dieser wird im Report vermerkt. + Abhilfe: Geben Sie in der Task #on("bold")#net#off("bold")# das Kommando #on("bold")#start#off("bold")#. Dadurch wird die + Netzsoftware neu gestartet. Alle Netzkommunikationen dieser + Station gehen verloren. + + + Beispiel: + + Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Collectortask fehlt'. + + - In der Task 'configurator' wurde das Kommando 'define collector' (siehe 3.2) + nicht gegeben. + + - Die Task 'net port' existiert nicht mehr. + Abhilfe: Kommando 'start' in der Task 'net'. + + + Beispiel: + + Nach #on("bold")#fetch ("hugo",4/public)#off("bold")# sind Teile von der Datei "hugo" verfälscht. + + - Die V24-Verbindung zur Box ist nicht in Ordnung. + Abhilfe: Abstand zwischen Rechner und Box verkürzen; Baudrate ernie­ + drigen; Durch Wechseln der V24-Schnittstelle feststellen, ob + diese defekt ist. + Hinweis: Die Verbindung zwischen den Boxen ist durch Prüfsummen abge­ + sichert (Hardware). + +#headodd# + +#center#Teil 2: Arbeitsweise der Netzsoftware#right#% + + +#end# +#page# +#type("triumb12")# + +Teil 2: Arbeitsweise der Netzsoftware + + +1. Die Netztask #type ("trium8")# + +In diesem Kapitel wird beschrieben, wie eine Netztask in das System +eingebettet ist und welche Aufgaben sie hat. Unter Einhaltung dieser +Konzepte kann die ausgelieferte Netztask so geändert werden, daß sie +beliebige andere Netzhardware unterstützt. Z.Zt. ist die Netzsoftware noch +nicht so gegliedert, daß nur eine hardwareabhängige Komponente ausgetauscht +werden muß. + +Die Kommunikation zwischen Tasks im EUMEL-Betriebssystem basiert auf einem +Rendevouskonzept: Die Zieltask einer Sendung muß empfangsbereit sein, wenn die +Quelltask sendet. + +Die Kommunikationsprozeduren auf der niedrigsten Ebene sind 'send' (Senden) +und 'wait' (Warten auf Empfang). Bei der Kommunikation werden eine Integer +'code' und ein Datenraum 'dr' übergeben. 'code' muß >= 0 sein, da negative +Codes systemintern verwandt werden. Ist die empfangende Task an einen Kanal +gekoppelt ('continue'), so führt eine Zeicheneingabe auf diesem Kanal dazu, +daß eine +Sendung mit dem Code -4 ankommt. Die Eingabedaten müssen mit den üblichen +Eingabeprozeduren ('inchar' u.s.w.) abgeholt werden. Der übermittelte Datenraum +und die Absendertask sind dabei ohne Bedeutung und dürfen nicht interpretiert +werden. + +Die Prozedur 'send' hat einen Rückmeldeparameter, der besagt, ob die Sendung +übermittelt wurde. Gibt es die Zieltask nicht oder steht sie nicht im 'wait', so kann +die Sendung nicht übermittelt werden. + + +Ein Entwicklungskriterium für das EUMEL-Netz war es, möglichst wenig Unter­ +stützung von der virtuellen EUMEL-Maschine (EUMEL0) zu fordern, damit weit­ +gehend in ELAN programmiert werden kann. Dadurch ist es möglich eine (privili­ +gierte) Task mit der Netzabwicklung zu betrauen. + +Zunächst wird auf die EUMEL0-Unterstützung eingegangen: + +1.1. Es gibt die Prozedur 'define collector', mit der die für das Netz verantwort­ + liche Task der EUMEL0-Maschine bekannt gemacht wird. Diese Task wird im + folgenden Collector genannt. + +1.2. Es gibt die Prozedur 'define station', die für den Rechner eine Stationsnum­ + mer einstellt. Anhand dieser Nummer werden die Rechner eines Netzes un­ + terschieden. Das Einstellen bewirkt, daß für alle Tasks die Stationsnummer in + ihre Task-Id eingetragen wird (Task-Id's sind die Werte, die der Typ TASK + annehmen kann). + +1.3. Der Befehl 'station (task)' liefert die Stationsnummer der 'task'. So liefert z.B. + 'station (myself)' die Stationsnummer des eigenen Rechners. + +1.4. Eine Sendung, deren Zieltask in einem anderen Rechner liegt (also station + (ziel) <> station (myself)), wird auf die Collectortask geleitet. + +1.5. Es gibt eine Prozedur 'collected destination', die es dem Collector erlaubt, die + eigentliche Zieltask einer auf ihn geleiteten Sendung zu erfahren. + +1.6. Es gibt eine Variante der Prozedur 'send', die es dem Collector gestattet, der + Zieltask eine beliebige andere Task als Absender vorzumachen. + +1.7. Es gibt eine spezielle Task-Id 'collector', durch die der augenblicklich ein­ + gestellte Collector erreicht wird. Diese wird als Zieltask beim Aufruf der Ver­ + mittlungsdienste angegeben (siehe 2.5). Eine Sendung an 'collector' wird von + EUMEL0 an den derzeitigen Collector geschickt. + +Ein Collector kann also auf drei Wegen von den übrigen Tasks desselben Rechners +Sendungen erhalten: + + 1. Über ein normales Send (z.B. bei 'list (/"net port")', wenn "net port" der der­ + zeitige Collector ist), + + 2. über ein Send an die Task 'collector' (s.u.) und + + 3. als umgeleitete Sendung (z.B. bei 'list' an eine Task auf einem anderen + Rechner). + +Der Collector kann diese Fälle anhand von 'collected destination' unterscheiden. + +Die Punkte 1.4...1.6 dienen dazu, den Collector für über Netz kommunizierende +Task unsichtbar zu machen: Der Collector taucht nicht als Ziel oder Quelle von +Sendungen auf. Das ist notwendig, damit normale Tasks sich nicht darum kümmern +müssen, ob eine Sendung übers Netz geht oder im eigenen Rechner bleibt. + +Wenn ein Datenraum an einen anderen Rechner geschickt wird, muß der gesamte +Inhalt (z. Zt. max. 1 MB) übertragen werden. Dies macht bei der üblichen Netz­ +hardware eine Zerlegung in Packete nötig (siehe Systemhandbuch 173, Teil 4, +Punkt 5). Für Netze über V24-Kanäle stehen spezielle Blockbefehle zur verfü­ +gung: + +1.8. blockin / blockout (dr,seite,512+abstand,anzahl,rest) + + Es werden maximal 'anzahl' Bytes transferiert. In 'rest' wird zurückgemeldet, + wieviel Bytes nicht bearbeitet wurden (z.B. weil der Kanal nichts anliefert). + Bearbeitet werden die Bytes + + 'seite' * 512 + 'abstand' + + bis maximal + + 'seite' * 512 + 'abstand' + 'anzahl' - 1 + + Der Kanal, an den die Task gekoppelt ist, wird dabei über Stream-IO (d.h. + 'incharety' bei 'blockin' bzw. 'out' bei 'blockout') angesprochen. + + Hinweis: Die Anforderung darf nicht über Seitengrenze gehen, d.h. + + 'abstand' + 'anzahl' <= 512 + + muß erfüllt sein. + + +Eine Netzsendung läuft wie folgt ab: + +Die Task q auf Rechner rq mache ein 'send' an die Task z auf Rechner rz. + +1. Die Prozedur send ist ein EUMEL0-Befehl. Die EUMEL0-Ebene erkennt, daß + die Sendung an die Station rz geht, da die Stationsnummer in der Task-Id + enthalten ist. Daher wird die Sendung zum Collector, den EUMEL0 wegen 'de­ + fine collector' kennt, umgeleitet. + +2. Die Task Collector empfängt über 'wait' den Datenraum, den Sendecode und + die Absendertask q. Die Zieltask z erfährt sie durch 'collected destination'. + +3. Der Collector nimmt Kontakt mit dem Collector des Rechner rz, dessen Sta­ + tionsnummer ja 'station(z)' ist, auf und Übermittelt diesem Sendecode, Quelltask + (q), eigentliche Zieltask (z) und den Datenraum. Da die Collectoren in ELAN + geschrieben sind, können sie an beliebige Netzhardware und Protokolle ange­ + paßt werden. + +4. Der Collector auf Rechner rz verwendet das spezielle 'send', um der Zieltask die + Sendung zuzustellen. Dadurch erscheint nicht der Collector sondern die Task q + als Absender der Sendung. + +Zur Abwicklung der Vermittlungsebene (Teil 1: 2.4) muß der Collector noch +spezielle Funktionen beherrschen. Diese sind + + der /-Operator (Taskname in Task-Id wandeln) und + die name-Prozedur (Task-Id in Namen wandeln). + +Der /-Operator macht eine Sendung an den 'collector', wobei im Datenraum der +Name der Task steht und der Sendecode gleich der Stationsnummer ist (siehe +Quellcode 173, Packet tasks). Der Collector setzt sich mit dem Collector dieser Sta­ +tion in Verbindung, damit dieser die Task-Id ermittelt und zurückschickt. Der +eigene Collector schickt dann dem /-Operator als Antwort einen Datenraum, der +die Task-Id enthält. + +Umgekehrt läuft 'name' ab: Wenn die Task-Id von einer fremden Station ist, +schickt 'name' eine Sendung an den 'collector', wobei im Datenraum die Task-Id +steht und Sendecode = 256 ist. Der Collector entnimmt die Stationnummer der +Task aus der Task-Id und läßt sich vom entsprechenden Collector den Tasknamen +geben. Dieser wird der 'name'-Prozedur im Antwortdatenraum übergeben. + +#type ("triumb12")#2. Ebenen #type("trium8")# + +In diesem Kapitel werden die Protokollebenen für das Netz beschrieben, wie +sie die ausgelieferte Netzsoftware benutzt und erwartet. Bei anderer +Netzhardware müssen die Ebenen 1 bis 3 ausgetauscht werden. Unter Einhaltung +der im vorigen Kapitel beschriebenen Randbedingungen können auch die höheren +Ebenen geändert werden. + + +2.1 Physikalische Ebene + + 2.1.1 Station <--> Box + + V24-Schnittstelle mit RTS/CTS-Handshake. Vollduplex. + + 2.1.2 Box <--> Box + + RS422 über 2 verdrillte Leitungspaare (Takt und Daten). + +2.2 Verbindungsebene + + 2.2.1 Station <--> Box + + Asynchron + 8 Bit + Even Parity + 2400/4800/9600/19200 Baud (einstellbar über Lötbrücken) + + 2.2.2 Box <--> Box + + SDLC + 400 KBaud + +2.3 Netzebene + + 2.3.1 Station <--> Box + + Telegrammformat: STX, , , , <(n-4) byte> + + ist Längenangabe ( 8 <= n <= 160) + , sind Stationsnummern. Diese müssen an den je­ + weiligen Boxen über Lötbrücken eingestellt sein. + + Box --> Station: + + Ein Telegramm kommt nur bei der Station an, bei deren Box die + Nummer eingestellt ist. Dadurch ist ein Mithören fremder + Übertragungen nicht möglich (Datenschutz). + + Zwischen Telegrammen können Fehlermeldungen der Box (Klartext) + übermittelt werden (z.B. 'skipped x', wenn ein STX von der Box er­ + wartet wurde, aber 'x' von der Station ankommt). + + Station --> Box: + + Ein Telegramm wird nur abgeschickt, wenn mit der einge­ + stellten Nummer übereinstimmt (Datenschutz: Man kann nicht eine + beliebige Station zu sein vorschwindeln, es sei denn man hat physi­ + schen Zugriff zur Box und stellt dort die Stationsnummer um). + + 2.3.2 Box <--> Box + + Telegrammformat: FRAME, , , , + + + Eine Längenangabe ist nicht nötig, da SDLC eine Rekonstruktion der + Länge erlaubt. + + Telegramme mit falschen CRC-Code werden vernichtet. Auf höheren + Ebenen muß dies durch Zeitüberwachung erkannt und behandelt + werden. + + +2.4 Transportebene + + Diese Ebene wickelt das Rendevous zwischen einer Task, die 'send' macht, + und einer Task, die im 'wait' steht, ab (siehe: EUMEL-Systemhandbuch). + + Der im 'send' angegebene Datenraum wird als Folge von Seiten (im + EUMEL-Sinne: Pagingeinheit und Allokiereinheit) übermittelt, wobei jede Seite + noch in 64 Byte große Stücke zerlegt wird. Es werden nur echt allokierte Seiten + übermittelt. Um nicht jedes Telegramm voll qualifizieren zu müssen, wird + zunächst eine Art virtuelle Verbindung durch ein OPEN-Telegramm eröffnet. + Danach folgen variable viele DATA-Telegramme. Beide Sorten werden durch + QUIT-Telegramme quittiert, um folgende Funktionen zu ermöglichen: + + Flußkontrolle (z.B. Zielrechner langsam) + Wiederaufsetzen (verlorene Telegramme) + Abbruch (z.B. weil Zieltask inzwischen beendet). + + Ein CLOSE-Telegramm ist nicht nötig, da das letzte DATA-Telegramm als + solches erkannt werden kann (siehe unten). + + 2.4.1 OPEN-Telegramm + + STX, 20, , , , , , + , , + + , siehe 2.3.1 + + Die Stromnummer identifiziert die virtuelle Verbindung. + Sie muß in den QUIT-Telegrammen angegeben wer­ + den. + + -1 (Kennzeichen für OPEN) + + Nummer der ersten echt allokierten Seite des Datenra­ + ums (=-1, falls Nilspace) + + Taskid der sendenden Task + + Taskid der empfangenden Task + + Wert des im 'send' angegebenen Codes. + + 2.4.2 DATA-Telegramm + + STX, 74, , , , , <64 byte> + + wird von Telegramm zu Telegramm hochgezählt. Dient + der Überwachung gegen verlorengegangene Telegramme + bzw. durch Zeitüberwachung verdoppelter Telegramme. + + Nummer der x.ten echt allokierten Seite des Datenra­ + ums. (x = (+16) DIV 8). + + <64 byte> Nutzinformation. Diese gehört zur Adresse a des Daten­ + raums. + + a = N ( DIV 8 + 1) * 512 + + ( MOD 8) * 64 + + wobei N (x) die Nummer der x.ten Seite ist. + + Aus den Formeln ergibt sich, daß diese Nummer schon in + einem vorhergehenden DATA/OPEN-Telegramm über­ + mittelt wurde (im Feld ). + + 2.4.3 QUIT-Telegramm + + STX, 8, , , , + + muß die Stromnummer sein, die in dem OPEN/DATA- + Telegramm stand, das quittiert wird. + + 0 : ok. Nächstes Telegramm schicken. + + -1: Übertragung neu starten (mit OPEN), weil die + Empfangsstation das OPEN nicht erhalten hat. + + -2: Übertragung ca. 20 Telegramme zurücksetzen. + + -3: Übertragung abbrechen. + + +2.5 Vermittlungsebene + + Diese Ebene ist dafür zuständig, Tasknamen von Task auf anderen Stationen + in Taskids (Werte des Typs TASK) zu wandeln und umgekehrt. Hierzu wird im + entsprechenden OPEN-Telegramm der Code -6 (bzw. -7) als + eingetragen. Die Netzempfangstask erkennt diese Codes und wickelt die + Aufgaben selbst ab, sodaß es dabei nicht nötig ist, irgendeine Taskid der + Zielstation zu kennen. + + Dieses Verfahren ist möglich, weil im 'send' nur positive Codes erlaubt sind. + +2.6 Höhere Ebenen + + Höhere Ebenen sind nicht mehr netzspezifisch. Sie basieren alle auf dem + Send/Wait-Konzept des EUMEL. So gibt es z.B. den 'global manager', der + Aufbewahrung und Zugriff von Dateien in einer Task regelt. Dabei darf diese + Task (bei der Variante 'free global manager') auf einer beliebigen Station im + Netz liegen. Wegen des Rendevous-Konzepts können beliebige Sicherheit­ + strategien benutzt werden (z.B.: Keine Dateien an Station 11 ausliefern). Von + großen Wert ist z.B., daß man ohne weiteres das Archiv (Floppylaufwerk) einen + anderen Station anmelden und benuzten kann, wodurch eine einfache Kon­ + vertierung von Floppyformaten möglich ist. Dies ist möglich, weil auch die Ar­ + chiv-Task der Stationen sich an das Globalmanagerprotokoll halten. + + +#type("triumb12")# +Bemerkungen#type("trium8")# + +Fehlerbehandlung besteht bis Ebene 3 darin, fehlerhafte Telegramme einfach zu +entfernen. Die Ebene 4 überwacht den Netzverkehr sowieso über Timeouts, die +eine Wiederhohlung eines Telegrammes bewirken, wenn die Quittung ausbleibt. + +Da bei der sendenden Station der ganze Datenraum zur Verfügung steht, ist eine +Fenstertechnik (wie bei HDLC) nicht nötig. Es kann zu jedem Zeitpunkt um beliebig +viele Telegramme zurückgesetzt werden. + +Da im EUMEL eine Textdatei ein Datenraum mit sehr komplexer Struktur ist (wegen +der Insert/Delete-Möglichkeiten, ohne den Rest der Datei zu schieben), ist es ein +hoher Aufwand, von einem fremden Betriebssytem her Textdateien ins EUMEL- +Netz zu senden. Für solche Zwecke muß noch eine einfachere Dateistruktur defi­ +niert werden und entsprechende Dateikonverter erstellt werden. + + + +#type("triumb12")#3. Stand der Netzsoftware #type("trium8")# + +Das EUMEL-System wickelt die Prozedur #on("bold")#send#off("bold")# über das Netz ab, wenn die +Stationsnummer der Zieltask ungleich der eigenen Stationsnummer ist. Umge­ +kehrt kann man der von der Prozedur #on("bold")#wait#off("bold")# gelieferten Absendertask die Absen­ +derstation entnehmen (siehe Prozedur #on("bold")#station#off("bold")# in Abschnitt 3). + +Nicht unterstützt wird z.Zt. die Logik der Prozeduren #on("bold")#call#off("bold")# und #on("bold")#pingpong#off("bold")#. Diese +funktionieren nur in der gewohnten Weise, wenn die Zieltask in #on("bold")#wait#off("bold")# steht. Ist +die Zieltask länger als ca. 10 Minuten #on("bold")#busy#off("bold")# oder nicht mehr vorhanden, geht die +Sendung einfach verloren (Gefordert ist: bei #on("bold")#call#off("bold")#: immer wieder versuchen; bei #on("bold")# +pingpong#off("bold")#: Rückmeldung -2). + +Wegen dieser Einschränkung kann man z.B. ein sicheres Drucken von Station a +auf einen Drucker der Station b nur durch einen eigenen Spoolmanager auf +Station a verwirklichen. Die Einrichtung eines solchen Managers ist allerdings +sowieso sinnvoll, damit man + +- das normale 'print'-Kommando verwenden kann (statt z.B. save ("xxx", +4/printer);) und +- nicht zu warten braucht, bis die Datei übers Netz gesendet ist. + + diff --git a/system/printer-24nadel/0.9/doc/readme b/system/printer-24nadel/0.9/doc/readme new file mode 100644 index 0000000..d526aa3 --- /dev/null +++ b/system/printer-24nadel/0.9/doc/readme @@ -0,0 +1,320 @@ +#type("nlq10")##limit(18.0)##start(1.5,1.0)# +#head# +Treiber-Installations-Programm #right#Seite % +für 24-Nadel-Matrixdrucker #right#23.12.1988 + + +#end# +#on("u")#Dokumentation zum Treiber-Installations-Programm für 24-Nadel- +Matrixdrucker#off("u")# + +#on("u")#Inhalt:#off("u")# + +1. Installations- und Gebrauchsanleitung +2. Druckertreiber-Auswahl +3. Steuerungsmöglichkeiten und Spezialfeatures +4. Weitere Hinweise + + +#on("b")#1. Installations- und Gebrauchsanleitung#off("b")# + +#on("u")#Einrichten#off("u")# +So wird das Treiber-Installationsprogramm eingerichtet: + + SV drücken + + nach 'gib supervisor kommando:' + + begin("PRINTER","SYSUR") + + in der Task "PRINTER" (nach 'gib kommando'): + + archive ("std.printer") + fetch ("printer.24.nadel",archive) + check off + insert ("printer.24.nadel") + +Das Programm wird dann insertiert. + +#on("u")#Druckerkanal#off("u")# +Hiernach wird die Kanalnummer des Druckers erfragt. Wenn der Drucker +über Parallelschnittstelle betrieben wird, ist die Kanalnummer +meistens 15. + +#on("u")#Menüsystem#off("u")# +Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern. +Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste +der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier +den passenden Typ aus! +Das Installationsprogramm zeigt nun einige Informationen zu dem ange­ +wählten Drucker. Besonders zu beachten sind hierbei #on("u")#Angaben zur Konfi­ +guration des Druckers#off("u")# (z.B. DIP-Schalter). Der Drucker muß unbedingt +wie angegeben konfiguriert werden, wenn er mit dem ausgewählten Trei­ +ber betrieben werden soll. + +Hinweise zu Konfigurationsangaben: +1. Die Angabe 'egal' bedeutet, daß die Einstellung für die Funktion + des Treibers keine Bedeutung hat. Dennoch solte der Anwender darauf + achten, welche Funktion die Schalter haben (Druckerhandbuch!). So + ist es zum Beispiel immer empfehlenswert, den Papierende-Sensor zu + aktivieren, damit der Drucker nach Papierende nicht auf der Walze + weiterdruckt. +2. Die Konfigurationsangaben beziehen sich immer auf genau den ausge­ + wählten Druckertyp. Wenn Sie den Treiber mit einem anderen Drucker + als den ausgewählten verwenden, dann beachten Sie folgende Regeln + für die Konfiguration: + - Der Drucker muß auf eine passende Emulation konfiguriert werden. + - Der Drucker darf bei einem Carriage Return (Code 13) keinen Zei­ + lenvorschub durchführen. + - Der Drucker darf die Perforation #on("u")#nicht#off("u")# automatisch überspringen. + + - Auf Seitenlängen und internationale Zeichensätze müssen Sie nicht + achten. + +(Hinweise zur Auswahl des richtigen Treibers gibt Abschnitt 2) + +Nach den Konfigurationsangaben werden Steuerungsmöglichkeiten des +ausgewählten Treibers angezeigt. (Siehe hierzu Abschnitt 3) + +Falls der Treiber bestimmte grundsätzliche Betriebsmöglichkeiten er­ +laubt (z.B. DRAFT/NLQ, Einzelblatteinzug), werden Sie danach gefragt, +welche Möglichkeit standardmäßig gewählt werden soll. diese Vorein­ +stellungen können nachträglich in der Task "PRINTER" mit den entspre­ +chenden Steuerprozeduren neu gesetzt werden. Außerdem können bestimmte +Einstellungen noch für jedes einzelne Dokument (d.h. für jede Druck­ +datei) gewählt ('material'-Anweisung) oder sogar innerhalb eines Doku­ +ments verändert werden (direkte Druckeranweisung \#"..."\#). +Über die Steuerungsmöglichkeiten informiert Abschnitt 3 ausführlicher. + + +#on("b")#2. Druckertreiber-Auswahl#off("b")# + +#on("u")#Verwendung nicht im Menü enthaltener Drucker#off("u")# +Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden, soll­ +ten Sie zunächst versuchen, ob ein Treiber für einen anderen Drucker +des gleichen Herstellers mit Ihrem Drucker korrekt arbeitet. +Falls dies nicht funktioniert oder der Hersteller überhaupt nicht im +Menü erscheint, müssen Sie herausfinden (Druckerhandbuch, -händler!), +welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist. +(Viele Drucker verfügen über EPSON LQ-1000 oder IBM Grafikdrucker bzw. +Proprinter-Eumulationen.) +Eine der beiden Anpassungen 'EPSON LQ-1050' oder 'OKI ML-393 +IBM-kompatibel' müßte immer einen (Minimal-) Betrieb ermöglichen (wobei die +Verwendung der Proportionalschrift bzw. der doppelt hohen Schriften u. U. +nicht funktioniert). + + +#on("b")#3. Steuerungsmöglichkeiten und Spezialfeatures#off("b")# + +Einige Treiber bieten bestimmte Einstellungsmöglichkeiten (z.B. +DRAFT/NLQ) und/oder Spezialfeatures (z.B. Farbdruck). +Die Einstellungen können über +- Steuerprozeduren +- Materialanweisungen bzw. +- direkte Druckeranweisungen +vorgenommen werden. + +#on("u")#Steuerprozeduren#off("u")# +setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten +sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER") +aufgerufen werden. #on("b")#Gültig werden die Änderungen erst, wenn danach in +der Druckspooltask das Kommando 'start' gegeben wird!#off("b")# + +PROC papersize (REAL CONST breite, länge) + Dient zur Einstellung der Größe der physikalisch beschreibbaren + Fläche. + Beispiel: papersize (20.32, 30.48) + (Standardeinstellung für Endlospapier 8 Zoll breit und + 12 Zoll lang) + +PROC papersize + Informationsprozedur + +PROC top margin (REAL CONST margin) + Falls der Drucker es nicht erlaubt, direkt am Blattanfang zu druk­ + ken (zum Beispiel wegen eines Einzelblatteinzugs), muß mit dieser + Prozedur die Länge des oberen Randes, den der Drucker nicht be­ + drucken kann, in cm angegeben werden. + Beispiel: top margin (2.0) + (Teilt dem Druckertreiber mit, daß die ersten 2 cm + nicht bedruckbar sind.) + +REAL PROC top margin + Informationsprozedur + +PROC std speed (TEXT CONST speed) + Parameter: slow, fast + Wahl zwischen Positionierung in Mikroschritten (slow) oder in + Blanks (fast). + Beispiel: std speed ("slow") + +TEXR PROC std speed + Informationsprozedur + +PROC std quality (TEXT CONST quality) + übliche Parameter: draft, nlq + Wahl zwischen Datenverarbeitungs-Qualität und Schönschrift- + Qualität + Beispiel: std quality ("draft") + +TEXT PROC std quality + Informationsprozedur + +PROC std typeface (TEXT CONST typeface) + übliche Parameter: roman, sansserif, courier + Wahl zwischen verschiedenen NLQ-Schriftarten (nur sichtbar im + NLQ-Modus, das heißt 'std typeface' schaltet nicht auf NLQ). + Beispiel: std typeface ("roman") + +TEXT PROC std typeface + Informationsprozedur + +PROC paper feed (TEXT CONST name) + übliche Parameter: tractor, sheet, schacht1, schacht2 + Wählt Endlospapier oder Einzelblatteinzug und ggf. Schachtnummer. + Beispiel: paper feed ("sheet") + +TEXT PROC paper feed + Informationsprozedur + + +#on("u")#Materialanweisungen \#material("...")\##off("u")# +müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und +setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben +für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge­ +stellten Standardwerten. Diese werden durch die Materialanweisung aber +nicht geändert.) + +Beispiel: \#material("nlq")\# + sorgt bei entsprechendem Treiber dafür, daß das gesamte + Dokument in Schönschrift-Qualität ausgedruckt wird, egal + wie 'std quality' eingestellt ist. + +#on("b")#Es darf in einer Datei nur eine Materialanweisung stehen!#off("b")# Sollen meh­ +rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung +erscheinen. Beispiel: \#material("sheet;draft")\# + + +#on("u")#direkte Druckeranweisungen \#"..."\##off("u")# +gelten ab der Position, an der sie in der Datei auftreten. Sie haben +(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und +Materialeinstellungen. + +Beispiel: \#"draft"\# + schaltet (bei entsprechendem Treiber) auf Datenverar­ + beitungs-Qualität, egal welche Standardeinstellung vorliegt + und welche Materialanweisung gegeben wurde. + +#on("b")#In einer Druckeranweisung darf nur eine Einstellung vorgenommen +werden.#off("b")# Also: \#"nlq"\#\#"sansserif"\# + + +#on("u")#Wichtig#off("u")# +- Achten Sie bei Materialanweisungen und direkten Druckeranweisungen + besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben + berücksichtigt! Also: \#"nlq"\# und keinesfalls \#"NLQ"\#!!! +- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und + nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann + daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse + erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen + Reihenfolge an den Drucker sendet, als er in der Datei steht, die + mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B. + für beide Spalten) unerwünscht erhalten bleibt. + + +#on("u")#Tabelle#off("u")# +Die Tabelle soll einen Anhaltspunkt dafür geben, wie welche Einstel­ +lungen erfolgen können. + +#type("17")# + Steuerprozeduren Materialanweisungen direkte Druckeranweisungen + +#on("u")#                                                                                          #off("u")# + +Positionierung std speed slow, fast ------ + slow, fast + +Qualität std quality z.B. draft, nlq z.B. draft, nlq + z.B. draft, nlq + +Schriftart std typeface z.B. roman, z.B. roman, +(nur bei NLQ) z.B. roman, sansserif, courier sansserif, courier + sansserif, courier + +Einzelblatt- paper feed z.B. schacht1, z.B. schacht1, +einzug z.B. tractor, schacht2 schacht2 + sheet, + schacht1, schacht2 + +Farbdruck ------ ------ z.B. schwarz, + rot, blau, + violett, gelb + orange, grün + + + +#type("nlq10")##on("b")#4. Weitere Hinweise#off("b")# + +#on("u")#Zeichensatzänderungen gegenüber früheren Versionen#off("u")# +In den Fonttabellen früherer Druckertreiber-Versionen wurden oberhalb +des Codes 127 einige internationale Zeichen zur Verfügung gestellt +(und zwar in Anlehnung an den Agfa-Laserdrucker-Zeichensatz). +Bei den Treibern der vorliegenden Version gilt folgendes: +- Wie bisher wird der volle im Benutzerhandbuch festgelegte EUMEL- + Zeichensatz (sofern möglich) unterstützt. +- Der Code 252 liefert das Paragraphzeichen. +- Alle übrigen (vom EUMEL-Zeichensatz nicht definierten) Zeichencodes + oberhalb 127 liefern, sofern möglich, die entsprechenden Zeichen des + IBM-Grafikzeichensatzes. + + +#on("u")#Hinweis zu Proportionalschriften#off("u")# +Bei Proportionalschriften kann die Modifikation \#on("i")\# zu Problemen +führen (z.B. beim Blocksatz), wenn die kursiven Zeichen andere +Proportionalbreiten haben. + +#on("u")#Hinweis zur Modifikation on/off("b") bzw. on/off("r")#off("u")# +Die meisten 24-Nadel Drucker verfügen sowohl über einen horizontalen als +auch über einen vertikalen Schattendruck. Diese beiden Druckarten können +mit der Modifikation on("b") (bold) bzw. on("r") (eigentlich für reverse +gedacht) eingeschaltet werden. + +#on("u")#Hinweis zur Benutzung von Einzelblatteinzügen#off("u")# +Bei der Benutzung von Einzelblatteinzügen müssen folgende Einstel­ +lungen vorgenommen werden (vgl. auch Abschnitt 3!): + + Am Drucker: +1. Sie müssen Ihren Drucker auf die Option Einzelblatteinzug + schalten (siehe Druckerhandbuch!). + + In der Druckspooltask (meist 'PRINTER'): +2. Falls der Druckertreiber die Steuerprozedur 'paper feed' zur Verfü­ + gung stellt, müssen Sie mit 'paperfeed ("sheet")' oder (für + 2-Schacht-Einzüge) mit 'paperfeed ("schacht1")' bzw. 'paperfeed + ("schacht2")' den Druckertreiber auf Einzelblatteinzug umschalten. +3. Falls Sie eine andere Papierlänge als 12 Zoll (=30.48 cm) verwen­ + den, müssen Sie die neuen Papiermaße mit 'papersize' in cm einstel­ + len. + Beispiel: papersize (21.0, 29.7) + (für DIN A4-Blätter) +4. Falls der Drucker mit dem Einzelblatteinzug nicht direkt am Blatt­ + anfang drucken kann, sondern ein gewisser oberer Rand bleibt, muß + mit 'top margin' die Länge des nicht bedruckbaren Randes in cm dem + Druckertreiber mitgeteilt werden. + Beispiel: top margin (1.5) + (Wie groß der obere Rand ist, kann festgestellt werden, indem eine + Datei mit \#start(0.0,0.0)\# ausgedruckt wird.) + + Wurde mit 'top margin' dem Treiber die Größe der nicht bedruckbaren + Fläche mitgeteilt, so ist darauf zu achten, daß in den Druckdateien + ein genügend großer y-Wert für die Startposition eingestellt wird + ('start'-Anweisung). Andernfalls kommt es bei der Ausgabe in der + ersten Zeile zu Überschreibungen. + + +#on("b")#5. Die Änderungen, die Sie in der Druckspooltask vorgenommen haben + werden erst wirksam, wenn das Spool-Kommando 'start' gegeben wird.#off("b")# + + + + diff --git a/system/printer-24nadel/0.9/source-disk b/system/printer-24nadel/0.9/source-disk new file mode 100644 index 0000000..2ed06c0 --- /dev/null +++ b/system/printer-24nadel/0.9/source-disk @@ -0,0 +1,3 @@ +grundpaket/07_std.printer_24_nadel.img +187_ergos/05_std.printer_24nadel.img +187_ergos/06_std.printer_24nadel.img diff --git a/system/printer-24nadel/0.9/src/beschreibungen24 b/system/printer-24nadel/0.9/src/beschreibungen24 new file mode 100644 index 0000000..e3d2fa9 --- /dev/null +++ b/system/printer-24nadel/0.9/src/beschreibungen24 @@ -0,0 +1,62 @@ + +(*************************************************************************) +(* Stand : 3. 1.89 *) +(* Beschreibungen-Datei für 24-Nadel-Drucker Version : 0.9 *) +(* Autor : hjh *) +(*************************************************************************) + +$necp5p7$ +begin;headnecp5p7;declarations;feed; +open;opendoch;opendocp5p7;openpagep5-7;close;closepage; +execute;cmdp5-7;crs;move;movep5-7;onoff;typep5-7;end + +$necp6$ +begin;headnecp6;declarations;feed; +open;opendoch;opendocp6;openpagep5-7;close;closepage; +execute;cmdp5-7;crs;move;movep5-7;onoff;typep5-7;end + +$necp6+$ +begin;headnecp6+;declarations;speed;topmargin;typefacep6+;feed; +open;opendoch;initspeed;opendocp6+;openpage;close;closepage; +execute;cmdp6+;crs;move;stdmove;onoff;typep6+;end + +$epsonlq850$ +begin;headlq850;declarations;speed;topmargin;typefacelq850;feed; +open;opendoch;initspeed;opendoclq850;openpage;close;closepage; +execute;cmdlq850;crs;move;stdmove;onoff;typeplq850;end + +$epsonlq1500$ +printerlq1500;end + +$oki390/391$ +begin;headoki390/391;declarations;speed;topmargin;typefaceoki;feedschacht; +open;opendoch;initspeed;opendocokieps;openpage;close;closepage; +execute;cmdoki;crs;move;stdmove;onoff;typeokieps;end + +$oki393/393Ceps$ +begin;headoki393/393Ceps;declarations;speed;topmargin;typefaceoki;feedschacht; +open;opendoch;initspeed;opendocokieps;openpage;close;closepage; +execute;cmdoki;crs;move;stdmove;onoff;typeokieps;end + +$oki393/393Cibm$ +begin;headoki393/393Cibm;declarations;speed;topmargin;typefaceoki;feedschacht; +open;opendoch;initspeed;opendocokiibm;openpage;close;closepage; +execute;cmdoki;crs;move;stdmove;onoff;typeokiibm;end + +$toshp321$ +begin;headtoshp321;declarations;speed;feed; +open;opendochtosh;initspeed;opendoctosh;openpagetosh;close;closepagetosh; +execute;cmdtosh;crs;move;stdmove;onoff;typetosh;end + +$starnb24$ +begin;headstarnb24;declarations;speed;topmargin;typefacestar;feedschacht; +open;opendoch;initspeed;opendocstar;openpage;close;closepage; +execute;cmdstar;crs;move;stdmove;onoff;typestar;end + +$brotherm1724l$ +begin;headbrotherm1724l;declarations;speed;topmargin;feed; +open;opendoch;initspeed;opendocbrother;openpage;close;closepage; +execute;cmdtosh;crs;move;stdmove;onoff;typebrother;end + + + diff --git a/system/printer-24nadel/0.9/src/fonttab.brother b/system/printer-24nadel/0.9/src/fonttab.brother new file mode 100644 index 0000000..2251e18 Binary files /dev/null and b/system/printer-24nadel/0.9/src/fonttab.brother differ diff --git a/system/printer-24nadel/0.9/src/fonttab.epson.lq1500 b/system/printer-24nadel/0.9/src/fonttab.epson.lq1500 new file mode 100644 index 0000000..1b4c6a6 Binary files /dev/null and b/system/printer-24nadel/0.9/src/fonttab.epson.lq1500 differ diff --git a/system/printer-24nadel/0.9/src/fonttab.epson.lq850 b/system/printer-24nadel/0.9/src/fonttab.epson.lq850 new file mode 100644 index 0000000..7a6d2f0 Binary files /dev/null and b/system/printer-24nadel/0.9/src/fonttab.epson.lq850 differ diff --git a/system/printer-24nadel/0.9/src/fonttab.nec.p5 b/system/printer-24nadel/0.9/src/fonttab.nec.p5 new file mode 100644 index 0000000..9910da6 Binary files /dev/null and b/system/printer-24nadel/0.9/src/fonttab.nec.p5 differ diff --git a/system/printer-24nadel/0.9/src/fonttab.nec.p5.new b/system/printer-24nadel/0.9/src/fonttab.nec.p5.new new file mode 100644 index 0000000..9804bd5 Binary files /dev/null and b/system/printer-24nadel/0.9/src/fonttab.nec.p5.new differ diff --git a/system/printer-24nadel/0.9/src/fonttab.nec.p6+ b/system/printer-24nadel/0.9/src/fonttab.nec.p6+ new file mode 100644 index 0000000..b209e81 Binary files /dev/null and b/system/printer-24nadel/0.9/src/fonttab.nec.p6+ differ diff --git a/system/printer-24nadel/0.9/src/fonttab.oki b/system/printer-24nadel/0.9/src/fonttab.oki new file mode 100644 index 0000000..2251e18 Binary files /dev/null and b/system/printer-24nadel/0.9/src/fonttab.oki differ diff --git a/system/printer-24nadel/0.9/src/fonttab.toshiba.p321 b/system/printer-24nadel/0.9/src/fonttab.toshiba.p321 new file mode 100644 index 0000000..452afca Binary files /dev/null and b/system/printer-24nadel/0.9/src/fonttab.toshiba.p321 differ diff --git a/system/printer-24nadel/0.9/src/inserter b/system/printer-24nadel/0.9/src/inserter new file mode 100644 index 0000000..442075d --- /dev/null +++ b/system/printer-24nadel/0.9/src/inserter @@ -0,0 +1,793 @@ + +(*************************************************************************) +(* Installationsprogramm für Stand : 3. 1.89 *) +(* 24-Nadel Drucker Version : 0.9 *) +(* Autor : hjh *) +(*************************************************************************) + +PACKET driver inst 24 + + + DEFINES treiber einrichten: + + +LET up = ""3""13""5"", + + generator name = "printer.24.nadel", + + description file name = "beschreibungen24", + module file name = "module24"; + + +INT VAR pr channel, + quality, + paper format number, + service option; +TEXT VAR fonttab name :: "", + driver name :: ""; +TEXT VAR inp; +BOOL VAR was esc; + +treiber einrichten + +PROC treiber einrichten: + + treiber einrichten (0) +END PROC treiber einrichten; + +PROC treiber einrichten (INT CONST service opt): + + ask for print channel; + main menu; + IF installed + THEN generate printer spool + ELSE inform about restart + FI. + + ask for printchannel: + inits; + page; + headline ("Druckerkanal - Einstellung"); + cursor (1, 15); + putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); + putline (" 'serverchannel (Kanalnummer)' in der Task """ + + name (myself) + """"); + putline (" verändert werden."); + REP + cursor (1, 10); + put (""5"EUMEL-Kanalnummer des Druckerkanals:"); + get (pr channel); + disable stop; + serverchannel (pr channel); + BOOL VAR no error :: NOT is error; + clear error; + no error := no error CAND + (pr channel <> channel (myself)) CAND + (pr channel > 1) CAND + (pr channel < 17); + + IF NOT no error + THEN cursor (1, 7); + put error; + putline ("Eingabe korrigiert wiederholen!") + FI; + enable stop + UNTIL no error PER; + IF exists task ("canal " + text (pr channel)) + THEN end (/ ("canal " + text (pr channel))); + FI; + +. inits: + line; + IF single task + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") + FI; + command dialogue (TRUE); + IF name (myself) <> "PRINTER" + THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + + name (myself) + """ !"); + IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") + THEN rename myself ("PRINTER") + FI + FI; + INT VAR choice; + service option := service opt. + + single task: (pcb (9) AND 255) = 1. + + main menu: + BOOL VAR installed :: FALSE; + REP + show main menu; + get choice; + treat choice + UNTIL was esc OR installed PER. + + show main menu: + page; + headline("Hauptmenü 24-Nadel-Drucker"); + putline (" 1. Brother"); + putline (" 2. Epson"); + putline (" 3. NEC"); + putline (" 4. OKI"); + putline (" 5. Toshiba"). + + get choice: + cursor (1,24); + put ("CR: Eingabe ESC: Installation abbrechen"); + ask user (5). + + treat choice: + SELECT int (inp) OF + CASE 1: brother menu + CASE 2: epson menu + CASE 3: nec menu + CASE 4: oki menu + CASE 5: toshiba menu + END SELECT. + + + brother menu: + page; + headline ("brother - Menü"); + putline (" 1. M-1724 L"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (1); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + brother m1724l inst + FI. + + brother m1724l inst: + putline ("brother M-1724 L"); + line; + putline ("Wählen Sie folgende DIP-Schalter Optionen:"); + putline ("Emulationsmodus IBM Proprinter XL "); + putline ("Automatischer Zeilenvorschub Nein "); + show control options ("paperfeed, std speed, top margin"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.brother"); + generate ("brotherm1724l"); + adjust papersize; + adjust quality; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + + toshiba menu: + page; + headline ("TOSHIBA - Menü"); + putline (" 1. P 321"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (1); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + toshiba p321 inst + FI. + + toshiba p321 inst: + putline ("TOSHIBA P 321"); + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("S3-8 S3-7 S3-5 übrige Schalter"); + putline ("OFF OFF *) egal "); + putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); + show control options ("std speed, paper feed"); + show material options("slow, fast"); + show command options ("nlq, draft"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.toshiba.p321"); + generate ("toshp321"); + adjust papersize; + adjust quality; + do ("papersize(21.0,30.48)"); + installed := TRUE; + FI. + + + epson menu: + page; + headline ("Epson - Menü"); + putline (" 1. LQ 850"); + putline (" 2. LQ 1050"); + putline (" 3. LQ 1500"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (3); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : lq850 inst + CASE 2 : lq850 inst + CASE 3 : lq1500 inst + END SELECT + FI. + + lq850 inst: + IF choice = 1 + THEN putline ("Epson LQ 850") + ELSE putline ("Epson LQ 1050") + FI; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8"); + putline ("egal egal egal egal egal egal *1) OFF "); + putline ("*1) ON: Einzelblatteinzug, OFF: kein Einzug"); line; + putline ("SW2-1 SW2-2 SW2-3 SW2-4 SW2-5 SW2-6 SW2-7 SW2-8"); + putline ("egal egal *2) OFF OFF"); + putline ("*2) SW2-2 bis SW2-6 müssen je nach Art der Schnittstelle "); + putline (" gesetzt werden (Druckerhandbuch)"); + show control options ("std speed, top margin, std typeface, paperfeed"); + show material options ("slow, fast, draft, nlq, roman, sansserif"); + show command options ("draft, nlq, roman, sansserif"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.epson.lq850"); + generate ("epsonlq850"); + adjust quality; + adjust papersize; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + lq1500 inst: + putline ("EPSON LQ-1500"); + show control options (""); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + IF all right + THEN get fonttable ("fonttab.epson.lq1500"); + generate ("epsonlq1500"); + adjust quality; + installed := TRUE + FI. + + nec menu: + page; + headline ("NEC - Menü"); + putline (" 1. PINWRITER P5 "); + putline (" 2. PINWRITER P6 "); + putline (" 3. PINWRITER P7 "); + putline (" 4. PINWRITER P6 PLUS"); + putline (" 5. PINWRITER P7 PLUS"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (5); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : necp5p7 inst + CASE 2 : necp6 inst + CASE 3 : necp5p7 inst + CASE 4 : necp6plus inst + CASE 5 : necp6plus inst + END SELECT + FI. + + necp5p7 inst: + IF choice = 1 + THEN putline ("NEC PINWRITER P5") + ELSE putline ("NEC PINWRITER P7") + FI; + show control options ("paper feed"); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.nec.p5.new"); + generate ("necp5p7"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + necp6 inst: + putline ("NEC PINWRITER P6 "); + show control options ("paper feed"); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.nec.p5.new"); + generate ("necp6"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + necp6plus inst: + IF choice = 4 + THEN putline ("NEC PINWRITER P6 PLUS") + ELSE putline ("NEC PINWRITER P7 PLUS") + FI; + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("CR FUNCTION CR ONLY "); + show control options ("std speed, top margin, std typeface, paperfeed"); + show material options ("slow, fast, draft, nlq, courier, souvenir"); + show command options ("draft, nlq, courier, souvenir"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.nec.p6+"); + generate ("necp6+"); + adjust papersize; + adjust quality; + installed := TRUE; + IF choice = 5 THEN do ("papersize (34.544, 30.48)") FI; + FI. + + oki menu: + page; + headline ("OKI - Menü"); + putline (" 1. MICROLINE 390 IBM-/EPSON-kompatibel"); + putline (" 2. MICROLINE 391 IBM-/EPSON-kompatibel"); + putline (" 3. MICROLINE 393/393C EPSON-kompatibel"); + putline (" 4. MICROLINE 393/393C IBM-kompatibel"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (4); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : oki ml390 inst + CASE 2 : oki ml390 inst + CASE 3 : oki ml393eps inst + CASE 4 : oki ml393ibm inst + END SELECT + FI. + + oki ml390 inst: + IF choice = 1 + THEN putline ("OKI Microline 390") ; + ELSE putline ("OKI Microline 391") ; + FI; + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("EMULATION MODE EPSON LQ "); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki390/391"); + adjust papersize; + adjust quality; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + + oki ml393eps inst: + putline ("OKI Microline 393 EPSON-kompatibel"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin, std typeface"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki393/393Ceps"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + oki ml393ibm inst: + putline ("OKI Microline 393 IBM-kompatibel"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("EMULATION MODE ASCII "); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin, std typeface"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki393/393Cibm"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + + +generate printer spool: + IF service opt = 0 + THEN forget (generator name, quiet); + forget (driver name, quiet) + FI; + eumel must advertise; + cursor (1, 10); +(* putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (2); + putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); + putline (" mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); + putline (" Drucker eingesetzt werden soll."); + line (2); +*) +(* put ("Generierung beendet, weiter mit 'SV'"); + break (quiet); +*) + putline (" Generierung beendet."); + putline (" Weiter: Bitte Taste drücken"); + WHILE incharety <> "" REP ENDREP; + REP UNTIL incharety <> "" ENDREP; + break; + do ("spool manager (PROC printer)"). + + inform about restart: + page; + putline ("Es ist kein Druckertreiber installiert worden!"); + line; + putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); + putline ("mit 'treiber einrichten' erneut aufgerufen werden."); + line; + pause(50); + break. + +END PROC treiber einrichten; + +PROC headline (TEXT CONST header): + + cursor (13,1); + putline ("E U M E L - Druckertreiber - Installations - Programm"); + cursor (40 - LENGTH header DIV 2, 2); + put (header); + line (2) +END PROC headline; + +PROC ask user (INT CONST max choice): + + TEXT VAR exit; + inp := ""; + REP + cursor (1,23); + IF inp = "" + THEN put ("Ihre Wahl (Nummer eingeben):") + ELSE put ("FEHLER! Eingabe korrigieren:") + FI; + editget (inp, ""27"", "", exit); + was esc := exit = ""27""; + UNTIL was esc OR ok PER. + + ok: + int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. +END PROC ask user; + +PROC show control options (TEXT CONST options): + + line; + putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); + write ("papersize, std quality"); + IF options <> "" + THEN put (","); + putline (options) + FI +END PROC show control options; + +PROC show material options (TEXT CONST options): + + line; + putline ("Mögliche Materialwerte (#material(""..."")#):"); + putline (options) +END PROC show material options; + +PROC show command options (TEXT CONST options): + + line; + putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); + putline (options) +END PROC show command options; + +PROC ask for quality: + + line (1); + putline ("Standard - Druckqualität:"); + line; + REP out (up); + IF yes ("Draft Quality (schneller, aber nicht so schön)") + THEN quality := 1; LEAVE ask for quality + FI; + out (up); + IF yes ("Near Letter Quality (schöner, aber langsamer)") + THEN quality := 2; LEAVE ask for quality + FI; + PER +END PROC ask for quality; + +PROC adjust quality: + + IF quality = 1 + THEN do ("std quality (""draft"")") + ELSE do ("std quality (""nlq"")") + FI +END PROC adjust quality; + +PROC ask for papersize : +LET up = ""3""13""5""; + + paper format number := paper format ; + + . paper format : + line (1); + putline ("Papierformat:"); + line; + REP out (up); + IF yes ("Endlospapier, 8 Zoll breit") + THEN LEAVE paper format WITH 1 FI; + out (up); + IF yes ("Endlospapier, 13.2 Zoll breit") + THEN LEAVE paper format WITH 2 FI; + out (up); + IF yes ("Einzelblatteinzug, DINA 4") + THEN LEAVE paper format WITH 3 FI; + PER; + 0 +END PROC ask for papersize; + + +PROC adjust papersize: + + SELECT paper format number OF + CASE 1 : do("papersize ( 8.0 * 2.54, 12.0 * 2.54)"); + do ("paper feed (""tractor"")") + CASE 2 : do("papersize (13.2 * 2.54, 12.0 * 2.54)"); + do ("paper feed (""tractor"")") + CASE 3 : do("papersize (21.0, 29.7)"); + do ("paper feed (""sheet"")") + END SELECT + +END PROC adjust papersize; + +BOOL PROC all right: + + line (3); + cursor (1,23); + yes ("Soll der ausgewählte Druckertreiber installiert werden") +END PROC all right; + +PROC get fonttable (TEXT CONST name): + + fonttab name := name; + from archive ((description file name & module file name & fonttab name) + - all); + fonttable (fonttab name); + command dialogue (FALSE); + save (fonttab name, /"configurator"); + IF service option = 0 + THEN forget (fonttab name) + FI; + command dialogue (TRUE); +END PROC get fonttable; + +PROC from archive (THESAURUS CONST files): + + IF highest entry (files) > 0 + THEN fetch from archive; + release (archive); + putline ("Archiv abgemeldet !") + FI. + + fetch from archive: + THESAURUS VAR thes :: files; + REP + ask for archive; + reserve archive; + fetch (thes / ALL archive, archive); + thes := thes - all + UNTIL highest entry (thes) = 0 PER. + +ask for archive: + TEXT VAR buffer; +(*line; + putline ("Bitte Archiv mit den Dateien"); + INT VAR index :: 0; + REP + get (thes, buffer, index); + putline (" " + buffer) + UNTIL index = 0 PER; + putline ("einlegen !"); + line; + putline ("Wenn eingelegt: Taste drücken !"); + inchar (buffer)*). + +reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop. + +END PROC from archive; + +THESAURUS OP & (TEXT CONST left, right): + THESAURUS VAR result := empty thesaurus; + insert (result, left); + insert (result, right); + result +END OP &; + +THESAURUS OP & (THESAURUS CONST left, TEXT CONST right): + THESAURUS VAR result := left; + insert (result, right); + result +END OP &; + +PROC generate (TEXT CONST name): + + open files; + read description; + build programme; + insert programme; + forget files. + + open files: + line (5); + cursor (1, 20); + putline (""4"Bitte warten !"); + putline (" - Der Treiber wird generiert."); + driver name := "printer." + name + "(generiert)"; + IF exists (driver name) + THEN forget (driver name, quiet) + FI; + FILE VAR des file :: sequential file (modify, description file name), + mod file :: sequential file (modify, module file name), + driver file :: sequential file (output, driver name). + + read description: + to line (des file, 1); + col (des file, 1); + downety (des file, "$" + name + "$"); + IF eof (des file) + THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + + "Descriptions-File enthalten") + FI; + TEXT VAR description :: "", + record; + BOOL VAR done :: FALSE; + read record (des file, record); + record := subtext (record, col (des file) + LENGTH name + 2); + WHILE NOT eof (des file) AND NOT done REP + treat record + PER. + + treat record: + INT VAR dollar pos :: pos (record, "$"); + IF dollar pos = 0 + THEN description CAT compress (record); + down (des file); + read record (des file, record) + ELSE description CAT compress (subtext (record, 1, dollar pos - 1)); + col (des file, dollar pos); + done := TRUE; + FI. + + build programme: + get module name; + WHILE still modules REP + find module; + transfer module; + get module name + PER. + + get module name: + INT VAR semicol pos :: pos (description, ";"); + TEXT VAR module name; + IF semicol pos > 0 + THEN module name := subtext (description, 1, semicol pos - 1); + description := subtext (description, semicol pos + 1) + ELSE module name := description; + description := "" + FI. + + still modules: + module name <> "" OR description <> "". + + find module: + to line (mod file, 1); + col (mod file, 1); + downety (mod file, "$" + module name + "$"); + IF eof (mod file) + THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + + "Modul-File enthalten") + FI. + + transfer module: + done := FALSE; + read record (mod file, record); + record := subtext (record, col (mod file) + LENGTH module name + 2); + WHILE NOT eof (mod file) AND NOT done REP + transfer record + PER. + + transfer record: + dollar pos := pos (record, "$"); + IF dollar pos = 0 + THEN write (driver file, compress (record)); + line (driver file); + down (mod file); + read record (mod file, record) + ELSE write (driver file, compress (subtext (record, 1, + dollar pos - 1))); + col (mod file, dollar pos); + done := TRUE; + cout (line no (mod file)) + FI. + + insert programme: + IF online + THEN putline (" - Der Treiber wird insertiert.") + FI; + check off; + insert (driver name). + + forget files: + IF service option = 0 + THEN forget (description file name, quiet); + forget (module file name, quiet) + FI . +END PROC generate; + +END PACKET driver inst 24 + diff --git a/system/printer-24nadel/0.9/src/module24 b/system/printer-24nadel/0.9/src/module24 new file mode 100644 index 0000000..a4957c2 --- /dev/null +++ b/system/printer-24nadel/0.9/src/module24 @@ -0,0 +1,1554 @@ + +(*************************************************************************) +(* Stand : 03. 1.89 *) +(* Module-Datei für 24-Nadel-Drucker Version : 0.9 *) +(* Autor : hjh *) +(*************************************************************************) + +$begin$ +PACKET printer driver + + DEFINES printer, + open, + close, + execute, + paper size, + std quality, + +$headnecp6$ paper feed: +(* Treiber fuer NEC P6, automatisch generiert *) +LET underline linetype = 1; +INT VAR factor 1, factor 2, draft factor 1, draft factor 2; + +$headnecp5p7$ paper feed: +(* Treiber fuer NEC P5, P7 , automatisch generiert *) +LET underline linetype = 1; +INT VAR factor 1, factor 2, draft factor 1, draft factor 2; + +$headnecp6+$ std speed, + top margin, + paper feed, + std typeface: +(* Treiber für NEC P6 plus/P7 plus ,automatisch generiert *) + + +$headlq850$ std speed, + top margin, + paper feed, + std typeface: +(* Treiber für EPSON LQ-850/1050 ,automatisch generiert *) + +$headbrotherm1724l$ + std speed, + top margin, + paper feed: +INT VAR vertical factor := 1; +(* Treiber für BROTHER M-1724L in IBM-Emulation, automatisch generiert *) + +$headoki390/391$ + std speed, + top margin, + paper feed, + std typeface: +INT VAR vertical factor := 1; +(* Treiber für OKI MIKROLINE 390/391 ,automatisch generiert *) + +$headoki393/393Ceps$ + std speed, + top margin, + paper feed, + std typeface: +INT VAR vertical factor := 1; +(* Treiber für OKI MIKROLINE 393/393C EPSON-kompatibel, automatisch generiert *) + +$headoki393/393Cibm$ + std speed, + top margin, + paper feed, + std typeface: +INT VAR vertical factor := 1; +(* Treiber für OKI MIKROLINE 393/393C IBM-kompatibel, automatisch generiert *) + +$headtoshp321$ std speed, + paper feed: +(* Treiber für TOSHIBA P321, automatisch generiert *) + +$headstarnb24$ + std speed, + top margin, + paper feed, + std typeface: +(* Treiber für STAR NB 24-10/15 in Standard Betriebsart automatisch generiert *) + +$declarations$ +INT VAR font nr, font bits, modification bits, + blankbreite, x rest, high, low, steps; +REAL VAR x size, y size; +TEXT VAR buffer :: ""; +BOOL VAR is nlq ; +TEXT VAR font text :: ""; +TEXT VAR std quality name :: "draft"; + +. is pica : font bits = 0 +. is elite : font bits = 1 +.; + + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; +END PROC paper size; + +papersize (20.32, 30.48); + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); +END PROC paper size; + + + +PROC std quality (TEXT CONST quality) : + + IF quality = "nlq" OR quality = "draft" + THEN std quality name := quality + ELSE errorstop ("unzulässige Qualitätsbezeichnung") + FI +END PROC std quality; + +TEXT PROC std quality : + + std quality name +END PROC std quality; + + +$topmargin$ +REAL VAR y margin := 0.0 ; + +PROC top margin (REAL CONST margin): + + y margin := margin +END PROC top margin; + +REAL PROC top margin: + + y margin +END PROC top margin; + + +$speed$ +BOOL VAR is slow :: TRUE; +TEXT VAR std speed name :: "slow"; + +PROC std speed (TEXT CONST speed) : + + IF speed = "fast" OR speed = "slow" + THEN std speed name := speed + ELSE errorstop ("unzulässige Geschwindigkeit") + FI +END PROC std speed; + +TEXT PROC std speed : + +std speed name +END PROC std speed; + + +$typefacelq850$ +TEXT VAR act typeface name :: ""; +TEXT VAR std typeface name :: ""; + +. is roman: + act typeface name = "roman". +. is sansserif: + act typeface name = "sansserif" +.; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "roman" OR typeface = "sansserif" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : + + std typeface name +END PROC std typeface; + + + +$typefacep6+$ +BOOL VAR is courier :: TRUE; +TEXT VAR std typeface name :: "courier"; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "courier" OR typeface = "souvenir" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : + + std typeface name +END PROC std typeface; + +$typefaceoki$ +BOOL VAR is courier ; +TEXT VAR std typeface name :: ""; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "courier" OR typeface = "kassette" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : + + std typeface name +END PROC std typeface; + +$typefacestar$ +BOOL VAR is roman ; +TEXT VAR std typeface name :: ""; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "roman" OR typeface = "font1" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : + + std typeface name +END PROC std typeface; + +$feed$ +BOOL VAR is sheet feed :: FALSE; + +PROC paper feed (TEXT CONST feeder) : + + IF feeder = "sheet" + THEN is sheet feed := TRUE + ELIF feeder = "tractor" + THEN is sheet feed := FALSE + ELSE errorstop ("unzulässige Einzugsart") + FI +END PROC paper feed; + +TEXT PROC paper feed: + IF is sheet feed + THEN "sheet" + ELSE "tractor" + FI +END PROC paper feed; + +$feedschacht$ +BOOL VAR is sheet feed :: FALSE; +TEXT VAR feeder name :: "tractor"; + +PROC paper feed (TEXT CONST feeder) : + + IF feeder = "tractor" + THEN feeder name := "tractor"; + is sheet feed := FALSE + ELIF feeder = "sheet" OR feeder = "schacht1" + THEN feeder name := "schacht1" ; + is sheet feed := TRUE + ELIF feeder = "schacht2" + THEN feeder name := "schacht2" ; + is sheet feed := TRUE + ELSE errorstop ("unzulässige Einzugsart") + FI +END PROC paper feed; + +TEXT PROC paper feed: feeder name END PROC paper feed; + +$open$ +PROC open (INT CONST op code, INT VAR param1, param2): + + SELECT op code OF + CASE 1: open document(param1,param2) + CASE 2: open page (param1,param2) + END SELECT. +END PROC open ; + + +$opendoch$ +PROC open document (INT VAR x steps,y steps): + modification bits := 0; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 30) * 30; + +$opendochtosh$ +PROC open document (INT VAR x steps,y steps): + modification bits := 0; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 36) * 36; + +$initspeed$ + IF pos (material, "slow") <> 0 + THEN is slow := TRUE; + ELIF pos (material, "fast") <> 0 + THEN is slow := FALSE; + ELSE is slow := std speed name = "slow" + FI; + +$opendocp6+$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"27"R"0""); (* Zeichentabelle 4 (Grafik) *) + out (""27"O"); + out (""27"2" + ""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF is sheet feed + THEN out (""27""25"4"); (* Sheetmode ein *) + FI; + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF pos (material, "courier") <> 0 + THEN is courier := TRUE ; + ELIF pos (material, "souvenir") <> 0 + THEN is courier := FALSE ; + ELSE is courier := std typeface name = "courier" + FI; +END PROC open document ; + +$opendocp5p7$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF is sheet feed + THEN out (""27""25"4"); (* Sheetmode ein *) + center paper ; + FI; + + . center paper : + INT CONST x steps in chars := x steps DIV x step conversion (2.54 / 10.0), + left margin := (136 - x steps in chars) DIV 2; + out (""27"P"); + out (""27"l"); out (code (left margin + 1)); +END PROC open document ; + +$opendocp6$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF is sheet feed + THEN out (""27""25"4"); (* Sheetmode ein *) + FI; +END PROC open document ; + +$opendoclq850$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"27"R"0""); (* Zeichentabelle 4 (Grafik) *) + out (""27"O"); + out (""27"2" + ""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF is sheet feed + THEN out (""27""25"4"); (* Sheetmode ein *) + FI; + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF pos (material, "roman") <> 0 + THEN act typeface name := "roman" + ELIF pos (material, "sansserif") <> 0 + THEN act typeface name := "sansserif" + ELSE act typeface name := std typeface name + FI; +END PROC open document ; + +$opendocokieps$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"27"R"0""); (* Zeichentabelle 4 (Grafik) *) + out (""27"O"); + out (""27"2" + ""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF is sheet feed + THEN IF feeder name = "schacht2" + THEN out (""27""25"2") + ELSE out (""27""25"1") + FI + FI; (* Sheetmode ein *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF pos (material, "courier") <> 0 + THEN is courier := TRUE ; + ELIF pos (material, "kassette") <> 0 + THEN is courier := FALSE ; + ELSE is courier := std typeface name = "courier" + FI; +END PROC open document ; + +$opendoctosh$ + out (""24""27"5"0""27"4"27"O"); (* Reset des Druckers *) + out (""27"6"); (* Zeichensatz *) + out (""27"A"12""27"2") ; + out (""27"C" + code (y steps DIV 36)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; +END PROC open document ; + +$opendocbrother$ + out (""24""27"5"0""27"4"27"O"); (* Reset des Druckers *) + out (""27"6" + ""27"R"0""); (* Zeichensatz II ascii *) + out (""27"A"10""27"2") ; (* Zeilenabstand *) + out (""27"C" + code (y steps DIV 36)); (* Formularlaenge *) + IF is sheet feed + THEN out (""27""25"4") + FI; (* Sheetmode ein *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; +END PROC open document ; + +$opendocokiibm$ + out (""24""27"5"0""27"4"27"O"); (* Reset des Druckers *) + out (""27"6" + ""27"!"64""); (* Zeichensatz II ascii *) + out (""27""91""92""4""0""0""0""180""); (* 1/180 *) + out (""27"A"12""27"2") ; (* Zeilenabstand *) + out (""27"C" + code (y steps DIV 36)); (* Formularlaenge *) + IF is sheet feed + THEN IF feeder name = "schacht2" + THEN out (""27""25"2") + ELSE out (""27""25"1") + FI + FI; (* Sheetmode ein *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF pos (material, "courier") <> 0 + THEN is courier := TRUE ; + ELIF pos (material, "kassette") <> 0 + THEN is courier := FALSE ; + ELSE is courier := std typeface name = "courier" + FI; +END PROC open document ; + +$opendocstar$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* amerikanischer Zeichensatz *) + out (""27"O"); + out (""27"2" + ""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF is sheet feed + THEN IF feeder name = "schacht2" + THEN out (""27""25"2") + ELSE out (""27""25"1") + FI + FI; (* Sheetmode ein *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF pos (material, "roman") <> 0 + THEN is roman := TRUE ; + ELIF pos (material, "font1") <> 0 + THEN is roman := FALSE ; + ELSE is roman := std typeface name = "roman" + FI; +END PROC open document ; + +$openpagetosh$ +PROC open page (INT VAR x start , y start): + + x start := 0; + IF is sheet feed + THEN y start := y step conversion (2.54) (* 1 Inch *) + ELSE y start := 0; + FI; + x rest := 0; + out (""13""); +END PROC open page; + +$openpage$ +PROC open page (INT VAR x start , y start): + + x start := 0 ; + y start := y step conversion (y margin) ; + x rest := 0; + out (""13""). +END PROC open page; + +$openpagep5-7$ +PROC open page (INT VAR x start , y start): + + x start := 0; + IF is sheet feed + THEN y start := y step conversion (8.466667e-1) (* 2/6 Inch *) + ELSE y start := 0; + FI; + x rest := 0; + out (""13""); +END PROC open page; + +$close$ + +PROC close (INT CONST op code, INT CONST param1) : + + SELECT op code OF + CASE 1: close document + CASE 2: close page (param1) + END SELECT. + +close document : +. +END PROC close ; + +$closepage$ +PROC close page (INT CONST remaining y steps) : + IF remaining y steps > 0 + THEN out (""12"") + ELIF is sheet feed + THEN out (""27""25"R") + FI; +END PROC close page; + +$closepagetosh$ +PROC close page (INT CONST remaining y steps) : + IF is sheet feed + THEN out (""12"") + ELIF remaining y steps > 0 + THEN out (""12"") + FI; +END PROC close page; + +$execute$ +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE 1: write text + CASE 2: write cmd + CASE 3: carriage return + CASE 4: move + CASE 5: draw + CASE 6: on + CASE 7: off + CASE 8: type +END SELECT. + +from : param1. +to : param2. + + write text : + out subtext (string, from, to). + +$cmdp6+$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI; + ELIF buffer = "draft" + THEN IF is nlq THEN is nlq := FALSE; switch to draft FI; + ELIF buffer = "courier" + THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI; + ELIF buffer = "souvenir" + THEN IF is courier THEN is courier := FALSE; switch to souvenir FI; + ELIF buffer = "schwarz" + THEN out (""27"r0") + ELIF buffer = "rot" + THEN out (""27"r1") + ELIF buffer = "blau" + THEN out (""27"r2") + ELIF buffer = "violett" + THEN out (""27"r3") + ELIF buffer = "gelb" + THEN out (""27"r4") + ELIF buffer = "orange" + THEN out (""27"r5") + ELIF buffer = "grün" + THEN out (""27"r6") + ELSE out (buffer) + FI. + +$cmdp5-7$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN switch to nlq FI; + is nlq := TRUE; + ELIF buffer = "draft" + THEN IF is nlq THEN switch to draft FI; + is nlq := FALSE; + ELSE out (buffer); + FI;. + +$cmdlq850$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI; + ELIF buffer = "draft" + THEN IF is nlq THEN is nlq := FALSE; switch to draft FI; + ELIF buffer = "roman" + THEN IF NOT is roman THEN act typeface name := "roman" ; + switch to roman FI; + ELIF buffer = "sansserif" + THEN IF NOT is sansserif THEN act typeface name := "sansserif"; + switch to sansserif FI; + ELSE out (buffer) + FI. + +$cmdoki$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI; + ELIF buffer = "draft" + THEN IF is nlq THEN is nlq := FALSE; switch to draft FI; + ELIF buffer = "courier" + THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI; + ELIF buffer = "kassette" + THEN IF is courier THEN is courier := FALSE; switch to kassette FI; + ELIF buffer = "schwarz" + THEN out (""27"r0") + ELIF buffer = "rot" + THEN out (""27"r1") + ELIF buffer = "blau" + THEN out (""27"r2") + ELIF buffer = "violett" + THEN out (""27"r3") + ELIF buffer = "gelb" + THEN out (""27"r4") + ELIF buffer = "orange" + THEN out (""27"r5") + ELIF buffer = "grün" + THEN out (""27"r6") + ELSE out (buffer) + FI. + +$cmdtosh$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI; + ELIF buffer = "draft" + THEN IF is nlq THEN is nlq := FALSE; switch to draft FI; + ELSE out (buffer); + FI;. + +$cmdstar$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI; + ELIF buffer = "draft" + THEN IF is nlq THEN is nlq := FALSE; switch to draft FI; + ELIF buffer = "roman" + THEN IF NOT is roman THEN is roman := TRUE; switch to roman FI; + ELIF buffer = "font1" + THEN IF is roman THEN is roman := FALSE; switch to font1 FI; + FI. + +$crs$ + carriage return : + x rest := 0; + out (""13""). + +$move$ +x steps : param1. +y steps : param2. + +move : + IF x steps < 0 OR y steps < 0 THEN stop FI; + IF x steps > 0 THEN x move FI; + IF y steps > 0 THEN y move FI. + +$stdmove$ +x move : + x rest INCR x steps; + high := (x rest) DIV blankbreite; + x rest := (x rest) MOD blankbreite; + steps := x rest DIV 3; + IF high > 0 THEN high TIMESOUT " " FI; + IF steps > 0 AND is slow + THEN IF is underline THEN out (" "8"") FI; + out (""27"Y" + code (steps) + ""0""); (* 1/360 *) + steps TIMESOUT ""0""; + x rest := x rest MOD 3 + FI. + +is underline: + bit (modification bits,7). + +y move : + IF y steps > 0 + THEN high := y steps DIV 255; + low := y steps MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; (* 1/180 *) + IF low > 0 THEN out (""27"J" + code (low)) FI; + FI. + +draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> 1 + THEN stop + ELIF x steps > 0 + THEN x draw + FI. + +x draw : + x rest INCR x steps ; + steps := x steps DIV 3 ; + IF steps > 0 THEN + x rest := x steps MOD 3 ; + out (""27"Y"); + out (code (steps MOD 256)); + out (code (steps DIV 256)); + steps TIMESOUT ""1""; + FI. + +$movep5-7$ + x move : + x rest INCR x steps; + IF not is underline + THEN simple x move + ELSE underline x move + FI; + + . not is underline : + NOT bit (modification bits, 7) + + . simple x move : + high := x rest DIV factor 1; + x rest := x rest MOD factor 1; + out (""27"\"); + out (code (high MOD 256)); + out (code (high DIV 256)); + + . underline x move : + high := x rest DIV factor 2; + x rest := x rest MOD factor 2; + IF high < blankbreite + THEN stop + ELSE low := high MOD 127; + high := high DIV 127; + IF low >= blankbreite + THEN low DECR blankbreite; + ELSE high DECR 1; + low DECR (blankbreite - 127); + FI; + IF high > 0 + THEN out (""27" "); + out (code (127 - blankbreite)); + high TIMESOUT " "; + FI; + out (""27" "); + out (code (low)); + out (" "27" "0""); + FI; +. y move: + + low := y steps MOD 255; + high := y steps DIV 255; + IF high > 0 THEN high TIMESOUT (""27"J"255"") FI; + IF low > 0 THEN out (""27"J" + code (low)) FI; + +. draw : + IF x steps < 0 OR y steps <> 0 + THEN stop + ELIF x steps > 0 + THEN x draw + FI; + + . x draw : + x rest INCR x steps; + steps := x rest DIV 4; + x rest := x rest MOD 4; + IF steps > 0 + THEN low := steps MOD 256; + high := steps DIV 256; + out (""27"*"39""); + out (code (low)); + out (code (high)); + steps TIMESOUT dot; + FI; + + . dot : + IF linetype = underline linetype + THEN ""000""000""001"" + ELSE ""000""000""048"" + FI. + + +$onoff$ + modification : param1 +. + on : + buffer := on string (modification); + IF buffer <> "" + THEN modification bits := modification bits OR code (buffer); + switch to font; + ELSE stop + FI + +. + off : + buffer := off string (modification); + IF buffer <> "" + THEN modification bits := modification bits XOR code (buffer); + switch to font; + ELSE stop + FI. + +$typep6+$ + type : + font nr := param1 ; + buffer := font string (font nr); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is courier + THEN switch to courier + ELSE switch to souvenir + FI ; + switch to font; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + +. switch to font : + out (""27"!"); + out (code (font bits OR modification bits)); + out (font text); + +. switch to nlq : + out (""27"x"1""); + +. switch to draft : + out (""27"x"0""); + +. switch to courier : + out (""27"k"0"") ; + +. switch to souvenir : + out (""27"k"15"") ; +END PROC execute; + +$typeplq850$ + type : + font nr := param1 ; + buffer := font string (font nr); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is roman + THEN switch to roman + ELSE switch to sansserif + FI ; + switch to font; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + +. switch to font : + out (""27"!"); + out (code (font bits OR modification bits)); + out (font text); + +. switch to nlq : + out (""27"x"1""); + +. switch to draft : + out (""27"x"0""); + +. switch to roman : + out (""27"k"0"") ; + +. switch to sansserif : + out (""27"k"1"") ; +END PROC execute; + +$typeokieps$ + type : + font nr := param1 ; + buffer := font string (font nr); + font bits := code (buffer SUB 3); + vertical factor := code (buffer SUB 1); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is courier + THEN switch to courier + ELSE switch to kassette + FI ; + switch to font; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + +. switch to font : + out (""27"!"); + out (code (font bits OR modification bits)); + IF vertical factor = 2 + THEN out (""27"w"1"") + ELSE out (""27"w"0"") + FI; + out (font text); + +. switch to nlq : + out (""27"x"1""); + +. switch to draft : + out (""27"x"0""); + +. switch to courier : + out (""27"k"0"") ; + +. switch to kassette : + out (""27"k"127"") ; +END PROC execute; + +$typep5-7$ + type : + font nr := param1; + buffer := font string (font nr); + factor 1 := code (buffer SUB 1); (* 720 / Mikroschritte pro Inch mit ESC \ *) + factor 2 := code (buffer SUB 2); (* 720 / Mikroschritte pro Inch mit ESC Blank *) + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") DIV factor 2; + switch to font; + IF is nlq THEN switch to nlq FI; + +END PROC execute; + + +PROC switch to font : + + out (""27"!"); + out (code (font bits OR modification bits)); + out (font text); + +END PROC switch to font; + + +PROC switch to nlq : + + IF is pica OR is elite + THEN draft factor 1 := factor 1; + factor 1 := 4; + draft factor 2 := factor 2; + IF is pica + THEN factor 2 := 4 * factor 2 DIV 6; + blankbreite := char pitch (font nr, " ") DIV factor 2; + FI; + out (""27"x"1""); + ELSE out (""27"x"0""); + FI; + +END PROC switch to nlq; + + +PROC switch to draft : + + IF is pica OR is elite + THEN factor 1 := draft factor 1; + factor 2 := draft factor 2; + out (""27"x"0""); + FI; + +END PROC switch to draft; + +$typetosh$ + type : + font nr := param1 ; + buffer := font string (font nr); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + switch to font; + +. switch to font : + INT VAR master select bits := font bits OR modification bits ; + IF bit (master select bits,0) + THEN out (""27":") + ELSE out (""18"") + FI; + IF bit (master select bits,1) + THEN out (""27"I"2""27"P"1"") + ELSE out (""27"P"0"") + FI; + IF bit (master select bits,2) + THEN out (""27""15"") + FI; + IF bit (master select bits,3) + THEN out (""27"E") + ELSE out (""27"F") + FI; + IF bit (master select bits,4) + THEN out (""27"G") + ELSE out (""27"H") + FI; + IF bit (master select bits,5) + THEN out (""27"W"1"") + ELSE out (""27"W"0"") + FI; + IF bit (master select bits,6) + THEN + ELSE + FI; + IF bit (master select bits,7) + THEN out (""27"-"1"") + ELSE out (""27"-"0"") + FI; + out (font text); + + +. switch to nlq : + out (""27"I"2""); + +. switch to draft : + out (""27"I"1""); + +END PROC execute; + +$typeokiibm$ + type : + font nr := param1 ; + buffer := font string (font nr); + vertical factor := code (buffer SUB 1); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is courier + THEN switch to courier + ELSE switch to kassette + FI ; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + switch to font; + +. switch to font : + INT VAR master select bits := font bits OR modification bits ; + IF bit (master select bits,0) + THEN out (""27":") + ELSE out (""18"") + FI; + IF bit (master select bits,1) + THEN out (""27"I"2""27"P"1"") + ELSE out (""27"P"0"") + FI; + IF bit (master select bits,2) + THEN out (""27""15"") + FI; + IF bit (master select bits,3) + THEN out (""27"E") + ELSE out (""27"F") + FI; + IF bit (master select bits,4) + THEN out (""27"G") + ELSE out (""27"H") + FI; + IF bit (master select bits,5) + THEN out (""27"W"1"") + ELSE out (""27"W"0"") + FI; + IF bit (master select bits,6) + THEN out(""27"%G") + ELSE out(""27"%H") + FI; + IF bit (master select bits,7) + THEN out (""27"-"1"") + ELSE out (""27"-"0"") + FI; + IF vertical factor = 2 + THEN out (""27""91""64""4""0""0""0""2""0"") + ELSE out (""27""91""64""4""0""0""0""1""0"") + FI; + out (font text); + + +. switch to nlq : + out (""27"I"2""); + +. switch to draft : + out (""27"I"0""); + +. switch to courier : + out (""27"k"0"") ; + +. switch to kassette : + out (""27"k"127"") ; +END PROC execute; + +$typebrother$ + type : + font nr := param1 ; + buffer := font string (font nr); + vertical factor := code (buffer SUB 1); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + switch to font; + +. switch to font : + INT VAR master select bits := font bits OR modification bits ; + IF bit (master select bits,0) + THEN out (""27":") + ELSE out (""18"") + FI; + IF bit (master select bits,1) + THEN out (""27"I"2""27"P"1"") + ELSE out (""27"P"0"") + FI; + IF bit (master select bits,2) + THEN out (""27""15"") + FI; + IF bit (master select bits,3) + THEN out (""27"E") + ELSE out (""27"F") + FI; + IF bit (master select bits,4) + THEN out (""27"G") + ELSE out (""27"H") + FI; + IF bit (master select bits,5) + THEN out (""27"W"1"") + ELSE out (""27"W"0"") + FI; + IF bit (master select bits,6) + THEN + ELSE + FI; + IF bit (master select bits,7) + THEN out (""27"-"1"") + ELSE out (""27"-"0"") + FI; + IF vertical factor = 2 + THEN out (""27""91""64""4""0""0""0""2""0"") + ELSE out (""27""91""64""4""0""0""0""1""0"") + FI; + out (font text); + +. switch to nlq : + out (""27"I"2""); + +. switch to draft : + out (""27"I"0""); + +END PROC execute; + +$typestar$ + type : + font nr := param1 ; + buffer := font string (font nr); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is roman + THEN switch to roman + ELSE switch to font1 + FI ; + switch to font; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + +. switch to font : + out (""27"!"); + out (code (font bits OR modification bits)); + out (font text); + +. switch to nlq : + out (""27"x"1""); + +. switch to draft : + out (""27"x"0""); + +. switch to roman : + out (""27"k"0"") ; + +. switch to font1 : + out (""27"k"1"") ; +END PROC execute; + + + +$printerlq1500$ +PACKET printer driver + +(**************************************************************************) +(* Stand : 29.07.86 *) +(* EPSON LQ-1500 Version : 4 *) +(* Autor : Rudolf Ruland *) +(* geändert am 15.12.88 hjh *) +(**************************************************************************) + + DEFINES printer, + open, + close, + execute, + + paper size, + std quality: + +LET +(* underline = 1, + bold = 2, + italics = 4, + reverse = 8, *) + + underline linetype = 1, + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8; + +INT VAR rest, high, low, factor; +BOOL VAR is nlq, factor was 6, condensed; +REAL VAR x size, y size; +TEXT VAR std quality name, buffer; + +(*********************************************************************) + +paper size (13.6 * 2.54, 12.0 * 2.54); +std quality ("draft"); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + + +PROC std quality (TEXT CONST quality) : + + IF quality = "nlq" OR quality = "draft" + THEN std quality name := quality; + ELSE errorstop ("unzulaessige Betriebsart") + FI; + +END PROC std quality; + +TEXT PROC std quality : std quality name END PROC std quality; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + factor := 0; + factor was 6 := FALSE; + condensed := FALSE; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 30) * 30; + out (""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + + +. x start : param1 +. y start : param2 +. + open page : + x start := 0; + y start := 0; + rest := 0; + out (""13""); + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page +END SELECT; + +. + close document : + + +. remaining y steps : param1 +. + close page : + IF remaining y steps > 0 THEN out (""12"") FI + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out subtext (string, from, to) + +. + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN is nlq := TRUE; + near letter quality; + ELIF buffer = "draft" + THEN is nlq := FALSE; + draft quality; + ELSE out (buffer); + FI; + + . near letter quality : + IF factor = 6 + THEN factor was 6 := TRUE; + factor := 4; + ELSE factor was 6 := FALSE; + FI; + IF condensed + THEN out (""27"x"0"") + ELSE out (""27"x"1"") + FI; + + . draft quality : + IF factor was 6 + THEN factor was 6 := FALSE; + factor := 6; + FI; + out (""27"x"0""); + + +(*. x steps to left margin : param1*) +. + carriage return : + rest := 0; + out (""13""); + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps < 0 OR y steps < 0 + THEN stop + ELIF x steps > 0 + THEN x move + ELIF y steps > 0 + THEN y move + FI; + + . x move : + high := (x steps + rest) DIV factor; + rest := (x steps + rest) MOD factor; + out (""27"\"); + out (code (high MOD 256)); + out (code (high DIV 256)); + + . y move : + high := y steps DIV 255; + low := y steps MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; + +. + draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype + THEN stop + ELIF x steps > 0 + THEN x draw + FI; + + . x draw : + high := (x steps + rest) DIV 6; + rest := (x steps + rest) MOD 6; + IF high > 0 + THEN low := high MOD 255; + high := high DIV 255; + out (""27"V"); + out (code (low)); + out (""27"*"1""1""0""1""27"V"0""); + FOR low FROM 1 UPTO high + REP out (""27"V"255""27"*"1""1""0""1""27"V"0"") PER; + FI; + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)) + ELSE stop + FI + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)) + ELSE stop + FI + + +. font nr : param1 +. + type : + buffer := font string (font nr); + out (buffer); + factor := pitch factor; + IF is nlq THEN near letter quality FI; + + . pitch factor : (* Mikroschritt *) + INT CONST font bits := code (buffer SUB 3); + IF bit (font bits, 1) + THEN condensed := FALSE; 2 (* proportional 1/360 Inch *) + ELIF pos (buffer, ""27"x"1"") <> 0 + THEN condensed := FALSE; 4 (* near letter 1/180 Inch *) + ELIF bit (font bits, 2) + THEN condensed := TRUE; 3 (* condensed 1/240 Inch *) + ELIF bit (font bits, 0) + THEN condensed := FALSE; 4 (* elite 1/180 Inch *) + ELSE condensed := FALSE; 6 (* pica 1/120 Inch *) + FI + +END PROC execute; + + +$end$ +INT VAR reply; DATASPACE VAR ds; FILE VAR file; + +PROC printer: + + disable stop; + continue (server channel); + check error (error message); + ds := nilspace; + REP forget (ds); + execute print; + IF is error AND online THEN put error; clear error; FI; + PER; +END PROC printer; + +PROC execute print: + + LET ack = 0, fetch code = 11, file type = 1003; + enable stop; + ds := nilspace; + call (father, fetch code, ds, reply); + IF reply = ack CAND type (ds) = file type + THEN file := sequential file (input, ds); + print (file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; +END PROC execute print; + +PROC check error(TEXT CONST message): + + IF is error + THEN clear error; rename myself (message); + IF is error THEN end(myself) FI; + pause (9000); end(myself); + FI; +END PROC check error; + +END PACKET printerdriver + + diff --git a/system/printer-24nadel/0.9/src/printer.24.nadel b/system/printer-24nadel/0.9/src/printer.24.nadel new file mode 100644 index 0000000..579f67f --- /dev/null +++ b/system/printer-24nadel/0.9/src/printer.24.nadel @@ -0,0 +1,776 @@ + +(*************************************************************************) +(* Installationsprogramm für Stand : 3. 1.89 *) +(* 24-Nadel Drucker Version : 0.9 *) +(* Autor : hjh *) +(*************************************************************************) + +PACKET driver inst 24 + + + DEFINES treiber einrichten: + + +LET up = ""3""13""5"", + + generator name = "printer.24.nadel", + + description file name = "beschreibungen24", + module file name = "module24"; + + +INT VAR pr channel, + quality, + paper format number, + service option; +TEXT VAR fonttab name :: "", + driver name :: ""; +TEXT VAR inp; +BOOL VAR was esc; + +treiber einrichten + +PROC treiber einrichten: + + treiber einrichten (0) +END PROC treiber einrichten; + +PROC treiber einrichten (INT CONST service opt): + + ask for print channel; + main menu; + IF installed + THEN generate printer spool + ELSE inform about restart + FI. + + ask for printchannel: + inits; + page; + headline ("Druckerkanal - Einstellung"); + cursor (1, 15); + putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); + putline (" 'serverchannel (Kanalnummer)' in der Task """ + + name (myself) + """"); + putline (" verändert werden."); + REP + cursor (1, 10); + put (""5"EUMEL-Kanalnummer des Druckerkanals:"); + get (pr channel); + disable stop; + serverchannel (pr channel); + BOOL VAR no error :: NOT is error; + IF is error + THEN cursor (1, 7); + put error; + putline ("Eingabe korrigiert wiederholen!") + FI; + clear error; + enable stop + UNTIL no error PER. + + inits: + line; + IF single task + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") + FI; + command dialogue (TRUE); + IF name (myself) <> "PRINTER" + THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + + name (myself) + """ !"); + IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") + THEN rename myself ("PRINTER") + FI + FI; + INT VAR choice; + service option := service opt. + + single task: (pcb (9) AND 255) = 1. + + main menu: + BOOL VAR installed :: FALSE; + REP + show main menu; + get choice; + treat choice + UNTIL was esc OR installed PER. + + show main menu: + page; + headline("Hauptmenü 24-Nadel-Drucker"); + putline (" 1. Brother"); + putline (" 2. Epson"); + putline (" 3. NEC"); + putline (" 4. OKI"); + putline (" 5. Toshiba"). + + get choice: + cursor (1,24); + put ("CR: Eingabe ESC: Installation abbrechen"); + ask user (5). + + treat choice: + SELECT int (inp) OF + CASE 1: brother menu + CASE 2: epson menu + CASE 3: nec menu + CASE 4: oki menu + CASE 5: toshiba menu + END SELECT. + + + brother menu: + page; + headline ("brother - Menü"); + putline (" 1. M-1724 L"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (1); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + brother m1724l inst + FI. + + brother m1724l inst: + putline ("brother M-1724 L"); + line; + putline ("Wählen Sie folgende DIP-Schalter Optionen:"); + putline ("Emulationsmodus IBM Proprinter XL "); + putline ("Automatischer Zeilenvorschub Nein "); + show control options ("paperfeed, std speed, top margin"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.brother"); + generate ("brotherm1724l"); + adjust papersize; + adjust quality; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + + toshiba menu: + page; + headline ("TOSHIBA - Menü"); + putline (" 1. P 321"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (1); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + toshiba p321 inst + FI. + + toshiba p321 inst: + putline ("TOSHIBA P 321"); + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("S3-8 S3-7 S3-5 übrige Schalter"); + putline ("OFF OFF *) egal "); + putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); + show control options ("std speed, paper feed"); + show material options("slow, fast"); + show command options ("nlq, draft"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.toshiba.p321"); + generate ("toshp321"); + adjust papersize; + adjust quality; + do ("papersize(21.0,30.48)"); + installed := TRUE; + FI. + + + epson menu: + page; + headline ("Epson - Menü"); + putline (" 1. LQ 850"); + putline (" 2. LQ 1050"); + putline (" 3. LQ 1500"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (3); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : lq850 inst + CASE 2 : lq850 inst + CASE 3 : lq1500 inst + END SELECT + FI. + + lq850 inst: + IF choice = 1 + THEN putline ("Epson LQ 850") + ELSE putline ("Epson LQ 1050") + FI; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8"); + putline ("egal egal egal egal egal egal *1) OFF "); + putline ("*1) ON: Einzelblatteinzug, OFF: kein Einzug"); line; + putline ("SW2-1 SW2-2 SW2-3 SW2-4 SW2-5 SW2-6 SW2-7 SW2-8"); + putline ("egal egal *2) OFF OFF"); + putline ("*2) SW2-2 bis SW2-6 müssen je nach Art der Schnittstelle "); + putline (" gesetzt werden (Druckerhandbuch)"); + show control options ("std speed, top margin, std typeface, paperfeed"); + show material options ("slow, fast, draft, nlq, roman, sansserif"); + show command options ("draft, nlq, roman, sansserif"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.epson.lq850"); + generate ("epsonlq850"); + adjust quality; + adjust papersize; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + lq1500 inst: + putline ("EPSON LQ-1500"); + show control options (""); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + IF all right + THEN get fonttable ("fonttab.epson.lq1500"); + generate ("epsonlq1500"); + adjust quality; + installed := TRUE + FI. + + nec menu: + page; + headline ("NEC - Menü"); + putline (" 1. PINWRITER P5 "); + putline (" 2. PINWRITER P6 "); + putline (" 3. PINWRITER P7 "); + putline (" 4. PINWRITER P6 PLUS"); + putline (" 5. PINWRITER P7 PLUS"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (5); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : necp5p7 inst + CASE 2 : necp6 inst + CASE 3 : necp5p7 inst + CASE 4 : necp6plus inst + CASE 5 : necp6plus inst + END SELECT + FI. + + necp5p7 inst: + IF choice = 1 + THEN putline ("NEC PINWRITER P5") + ELSE putline ("NEC PINWRITER P7") + FI; + show control options ("paper feed"); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.nec.p5.new"); + generate ("necp5p7"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + necp6 inst: + putline ("NEC PINWRITER P6 "); + show control options ("paper feed"); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.nec.p5.new"); + generate ("necp6"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + necp6plus inst: + IF choice = 4 + THEN putline ("NEC PINWRITER P6 PLUS") + ELSE putline ("NEC PINWRITER P7 PLUS") + FI; + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("CR FUNCTION CR ONLY "); + show control options ("std speed, top margin, std typeface, paperfeed"); + show material options ("slow, fast, draft, nlq, courier, souvenir"); + show command options ("draft, nlq, courier, souvenir"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.nec.p6+"); + generate ("necp6+"); + adjust papersize; + adjust quality; + installed := TRUE; + IF choice = 5 THEN do ("papersize (34.544, 30.48)") FI; + FI. + + oki menu: + page; + headline ("OKI - Menü"); + putline (" 1. MICROLINE 390 IBM-/EPSON-kompatibel"); + putline (" 2. MICROLINE 391 IBM-/EPSON-kompatibel"); + putline (" 3. MICROLINE 393/393C EPSON-kompatibel"); + putline (" 4. MICROLINE 393/393C IBM-kompatibel"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (4); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : oki ml390 inst + CASE 2 : oki ml390 inst + CASE 3 : oki ml393eps inst + CASE 4 : oki ml393ibm inst + END SELECT + FI. + + oki ml390 inst: + IF choice = 1 + THEN putline ("OKI Microline 390") ; + ELSE putline ("OKI Microline 391") ; + FI; + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("EMULATION MODE EPSON LQ "); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki390/391"); + adjust papersize; + adjust quality; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + + oki ml393eps inst: + putline ("OKI Microline 393 EPSON-kompatibel"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin, std typeface"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki393/393Ceps"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + oki ml393ibm inst: + putline ("OKI Microline 393 IBM-kompatibel"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("EMULATION MODE ASCII "); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin, std typeface"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki393/393Cibm"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + + +generate printer spool: + IF service opt = 0 + THEN forget (generator name, quiet); + forget (driver name, quiet) + FI; + eumel must advertise; + cursor (1, 10); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (2); + putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); + putline (" mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); + putline (" Drucker eingesetzt werden soll."); + line (2); + put ("Generierung beendet, weiter mit 'SV'"); + break (quiet); + do ("spool manager (PROC printer)"). + + inform about restart: + page; + putline ("Es ist kein Druckertreiber installiert worden!"); + line; + putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); + putline ("mit 'treiber einrichten' erneut aufgerufen werden."); + line. + +END PROC treiber einrichten; + +PROC headline (TEXT CONST header): + + cursor (13,1); + putline ("E U M E L - Druckertreiber - Installations - Programm"); + cursor (40 - LENGTH header DIV 2, 2); + put (header); + line (2) +END PROC headline; + +PROC ask user (INT CONST max choice): + + TEXT VAR exit; + inp := ""; + REP + cursor (1,23); + IF inp = "" + THEN put ("Ihre Wahl (Nummer eingeben):") + ELSE put ("FEHLER! Eingabe korrigieren:") + FI; + editget (inp, ""27"", "", exit); + was esc := exit = ""27""; + UNTIL was esc OR ok PER. + + ok: + int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. +END PROC ask user; + +PROC show control options (TEXT CONST options): + + line; + putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); + write ("papersize, std quality"); + IF options <> "" + THEN put (","); + putline (options) + FI +END PROC show control options; + +PROC show material options (TEXT CONST options): + + line; + putline ("Mögliche Materialwerte (#material(""..."")#):"); + putline (options) +END PROC show material options; + +PROC show command options (TEXT CONST options): + + line; + putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); + putline (options) +END PROC show command options; + +PROC ask for quality: + + line (1); + putline ("Standard - Druckqualität:"); + line; + REP out (up); + IF yes ("Draft Quality (schneller, aber nicht so schön)") + THEN quality := 1; LEAVE ask for quality + FI; + out (up); + IF yes ("Near Letter Quality (schöner, aber langsamer)") + THEN quality := 2; LEAVE ask for quality + FI; + PER +END PROC ask for quality; + +PROC adjust quality: + + IF quality = 1 + THEN do ("std quality (""draft"")") + ELSE do ("std quality (""nlq"")") + FI +END PROC adjust quality; + +PROC ask for papersize : +LET up = ""3""13""5""; + + paper format number := paper format ; + + . paper format : + line (1); + putline ("Papierformat:"); + line; + REP out (up); + IF yes ("Endlospapier, 8 Zoll breit") + THEN LEAVE paper format WITH 1 FI; + out (up); + IF yes ("Endlospapier, 13.2 Zoll breit") + THEN LEAVE paper format WITH 2 FI; + out (up); + IF yes ("Einzelblatteinzug, DINA 4") + THEN LEAVE paper format WITH 3 FI; + PER; + 0 +END PROC ask for papersize; + + +PROC adjust papersize: + + SELECT paper format number OF + CASE 1 : do("papersize ( 8.0 * 2.54, 12.0 * 2.54)"); + do ("paper feed (""tractor"")") + CASE 2 : do("papersize (13.2 * 2.54, 12.0 * 2.54)"); + do ("paper feed (""tractor"")") + CASE 3 : do("papersize (21.0, 29.7)"); + do ("paper feed (""sheet"")") + END SELECT + +END PROC adjust papersize; + +BOOL PROC all right: + + line (3); + cursor (1,23); + yes ("Soll der ausgewählte Druckertreiber installiert werden") +END PROC all right; + +PROC get fonttable (TEXT CONST name): + + fonttab name := name; + from archive ((description file name & module file name & fonttab name) + - all); + fonttable (fonttab name); + command dialogue (FALSE); + save (fonttab name, /"configurator"); + IF service option = 0 + THEN forget (fonttab name) + FI; + command dialogue (TRUE); +END PROC get fonttable; + +PROC from archive (THESAURUS CONST files): + + IF highest entry (files) > 0 + THEN fetch from archive; + release (archive); + putline ("Archiv abgemeldet !") + FI. + + fetch from archive: + THESAURUS VAR thes :: files; + REP + ask for archive; + reserve archive; + fetch (thes / ALL archive, archive); + thes := thes - all + UNTIL highest entry (thes) = 0 PER. + +ask for archive: + line; + putline ("Bitte Archiv mit den Dateien"); + TEXT VAR buffer; + INT VAR index :: 0; + REP + get (thes, buffer, index); + putline (" " + buffer) + UNTIL index = 0 PER; + putline ("einlegen !"); + line; + putline ("Wenn eingelegt: Taste drücken !"); + inchar (buffer). + +reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop. + +END PROC from archive; + +THESAURUS OP & (TEXT CONST left, right): + THESAURUS VAR result := empty thesaurus; + insert (result, left); + insert (result, right); + result +END OP &; + +THESAURUS OP & (THESAURUS CONST left, TEXT CONST right): + THESAURUS VAR result := left; + insert (result, right); + result +END OP &; + +PROC generate (TEXT CONST name): + + open files; + read description; + build programme; + insert programme; + forget files. + + open files: + line (5); + cursor (1, 20); + putline (""4"Bitte warten !"); + putline (" - Der Treiber wird generiert."); + driver name := "printer." + name + "(generiert)"; + IF exists (driver name) + THEN forget (driver name, quiet) + FI; + FILE VAR des file :: sequential file (modify, description file name), + mod file :: sequential file (modify, module file name), + driver file :: sequential file (output, driver name). + + read description: + to line (des file, 1); + col (des file, 1); + downety (des file, "$" + name + "$"); + IF eof (des file) + THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + + "Descriptions-File enthalten") + FI; + TEXT VAR description :: "", + record; + BOOL VAR done :: FALSE; + read record (des file, record); + record := subtext (record, col (des file) + LENGTH name + 2); + WHILE NOT eof (des file) AND NOT done REP + treat record + PER. + + treat record: + INT VAR dollar pos :: pos (record, "$"); + IF dollar pos = 0 + THEN description CAT compress (record); + down (des file); + read record (des file, record) + ELSE description CAT compress (subtext (record, 1, dollar pos - 1)); + col (des file, dollar pos); + done := TRUE; + FI. + + build programme: + get module name; + WHILE still modules REP + find module; + transfer module; + get module name + PER. + + get module name: + INT VAR semicol pos :: pos (description, ";"); + TEXT VAR module name; + IF semicol pos > 0 + THEN module name := subtext (description, 1, semicol pos - 1); + description := subtext (description, semicol pos + 1) + ELSE module name := description; + description := "" + FI. + + still modules: + module name <> "" OR description <> "". + + find module: + to line (mod file, 1); + col (mod file, 1); + downety (mod file, "$" + module name + "$"); + IF eof (mod file) + THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + + "Modul-File enthalten") + FI. + + transfer module: + done := FALSE; + read record (mod file, record); + record := subtext (record, col (mod file) + LENGTH module name + 2); + WHILE NOT eof (mod file) AND NOT done REP + transfer record + PER. + + transfer record: + dollar pos := pos (record, "$"); + IF dollar pos = 0 + THEN write (driver file, compress (record)); + line (driver file); + down (mod file); + read record (mod file, record) + ELSE write (driver file, compress (subtext (record, 1, + dollar pos - 1))); + col (mod file, dollar pos); + done := TRUE; + cout (line no (mod file)) + FI. + + insert programme: + IF online + THEN putline (" - Der Treiber wird insertiert.") + FI; + check off; + insert (driver name). + + forget files: + IF service option = 0 + THEN forget (description file name, quiet); + forget (module file name, quiet) + FI . +END PROC generate; + +END PACKET driver inst 24 + diff --git a/system/printer-24nadel/schulis-mathe-1.0/doc/readme b/system/printer-24nadel/schulis-mathe-1.0/doc/readme new file mode 100644 index 0000000..d526aa3 --- /dev/null +++ b/system/printer-24nadel/schulis-mathe-1.0/doc/readme @@ -0,0 +1,320 @@ +#type("nlq10")##limit(18.0)##start(1.5,1.0)# +#head# +Treiber-Installations-Programm #right#Seite % +für 24-Nadel-Matrixdrucker #right#23.12.1988 + + +#end# +#on("u")#Dokumentation zum Treiber-Installations-Programm für 24-Nadel- +Matrixdrucker#off("u")# + +#on("u")#Inhalt:#off("u")# + +1. Installations- und Gebrauchsanleitung +2. Druckertreiber-Auswahl +3. Steuerungsmöglichkeiten und Spezialfeatures +4. Weitere Hinweise + + +#on("b")#1. Installations- und Gebrauchsanleitung#off("b")# + +#on("u")#Einrichten#off("u")# +So wird das Treiber-Installationsprogramm eingerichtet: + + SV drücken + + nach 'gib supervisor kommando:' + + begin("PRINTER","SYSUR") + + in der Task "PRINTER" (nach 'gib kommando'): + + archive ("std.printer") + fetch ("printer.24.nadel",archive) + check off + insert ("printer.24.nadel") + +Das Programm wird dann insertiert. + +#on("u")#Druckerkanal#off("u")# +Hiernach wird die Kanalnummer des Druckers erfragt. Wenn der Drucker +über Parallelschnittstelle betrieben wird, ist die Kanalnummer +meistens 15. + +#on("u")#Menüsystem#off("u")# +Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern. +Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste +der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier +den passenden Typ aus! +Das Installationsprogramm zeigt nun einige Informationen zu dem ange­ +wählten Drucker. Besonders zu beachten sind hierbei #on("u")#Angaben zur Konfi­ +guration des Druckers#off("u")# (z.B. DIP-Schalter). Der Drucker muß unbedingt +wie angegeben konfiguriert werden, wenn er mit dem ausgewählten Trei­ +ber betrieben werden soll. + +Hinweise zu Konfigurationsangaben: +1. Die Angabe 'egal' bedeutet, daß die Einstellung für die Funktion + des Treibers keine Bedeutung hat. Dennoch solte der Anwender darauf + achten, welche Funktion die Schalter haben (Druckerhandbuch!). So + ist es zum Beispiel immer empfehlenswert, den Papierende-Sensor zu + aktivieren, damit der Drucker nach Papierende nicht auf der Walze + weiterdruckt. +2. Die Konfigurationsangaben beziehen sich immer auf genau den ausge­ + wählten Druckertyp. Wenn Sie den Treiber mit einem anderen Drucker + als den ausgewählten verwenden, dann beachten Sie folgende Regeln + für die Konfiguration: + - Der Drucker muß auf eine passende Emulation konfiguriert werden. + - Der Drucker darf bei einem Carriage Return (Code 13) keinen Zei­ + lenvorschub durchführen. + - Der Drucker darf die Perforation #on("u")#nicht#off("u")# automatisch überspringen. + + - Auf Seitenlängen und internationale Zeichensätze müssen Sie nicht + achten. + +(Hinweise zur Auswahl des richtigen Treibers gibt Abschnitt 2) + +Nach den Konfigurationsangaben werden Steuerungsmöglichkeiten des +ausgewählten Treibers angezeigt. (Siehe hierzu Abschnitt 3) + +Falls der Treiber bestimmte grundsätzliche Betriebsmöglichkeiten er­ +laubt (z.B. DRAFT/NLQ, Einzelblatteinzug), werden Sie danach gefragt, +welche Möglichkeit standardmäßig gewählt werden soll. diese Vorein­ +stellungen können nachträglich in der Task "PRINTER" mit den entspre­ +chenden Steuerprozeduren neu gesetzt werden. Außerdem können bestimmte +Einstellungen noch für jedes einzelne Dokument (d.h. für jede Druck­ +datei) gewählt ('material'-Anweisung) oder sogar innerhalb eines Doku­ +ments verändert werden (direkte Druckeranweisung \#"..."\#). +Über die Steuerungsmöglichkeiten informiert Abschnitt 3 ausführlicher. + + +#on("b")#2. Druckertreiber-Auswahl#off("b")# + +#on("u")#Verwendung nicht im Menü enthaltener Drucker#off("u")# +Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden, soll­ +ten Sie zunächst versuchen, ob ein Treiber für einen anderen Drucker +des gleichen Herstellers mit Ihrem Drucker korrekt arbeitet. +Falls dies nicht funktioniert oder der Hersteller überhaupt nicht im +Menü erscheint, müssen Sie herausfinden (Druckerhandbuch, -händler!), +welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist. +(Viele Drucker verfügen über EPSON LQ-1000 oder IBM Grafikdrucker bzw. +Proprinter-Eumulationen.) +Eine der beiden Anpassungen 'EPSON LQ-1050' oder 'OKI ML-393 +IBM-kompatibel' müßte immer einen (Minimal-) Betrieb ermöglichen (wobei die +Verwendung der Proportionalschrift bzw. der doppelt hohen Schriften u. U. +nicht funktioniert). + + +#on("b")#3. Steuerungsmöglichkeiten und Spezialfeatures#off("b")# + +Einige Treiber bieten bestimmte Einstellungsmöglichkeiten (z.B. +DRAFT/NLQ) und/oder Spezialfeatures (z.B. Farbdruck). +Die Einstellungen können über +- Steuerprozeduren +- Materialanweisungen bzw. +- direkte Druckeranweisungen +vorgenommen werden. + +#on("u")#Steuerprozeduren#off("u")# +setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten +sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER") +aufgerufen werden. #on("b")#Gültig werden die Änderungen erst, wenn danach in +der Druckspooltask das Kommando 'start' gegeben wird!#off("b")# + +PROC papersize (REAL CONST breite, länge) + Dient zur Einstellung der Größe der physikalisch beschreibbaren + Fläche. + Beispiel: papersize (20.32, 30.48) + (Standardeinstellung für Endlospapier 8 Zoll breit und + 12 Zoll lang) + +PROC papersize + Informationsprozedur + +PROC top margin (REAL CONST margin) + Falls der Drucker es nicht erlaubt, direkt am Blattanfang zu druk­ + ken (zum Beispiel wegen eines Einzelblatteinzugs), muß mit dieser + Prozedur die Länge des oberen Randes, den der Drucker nicht be­ + drucken kann, in cm angegeben werden. + Beispiel: top margin (2.0) + (Teilt dem Druckertreiber mit, daß die ersten 2 cm + nicht bedruckbar sind.) + +REAL PROC top margin + Informationsprozedur + +PROC std speed (TEXT CONST speed) + Parameter: slow, fast + Wahl zwischen Positionierung in Mikroschritten (slow) oder in + Blanks (fast). + Beispiel: std speed ("slow") + +TEXR PROC std speed + Informationsprozedur + +PROC std quality (TEXT CONST quality) + übliche Parameter: draft, nlq + Wahl zwischen Datenverarbeitungs-Qualität und Schönschrift- + Qualität + Beispiel: std quality ("draft") + +TEXT PROC std quality + Informationsprozedur + +PROC std typeface (TEXT CONST typeface) + übliche Parameter: roman, sansserif, courier + Wahl zwischen verschiedenen NLQ-Schriftarten (nur sichtbar im + NLQ-Modus, das heißt 'std typeface' schaltet nicht auf NLQ). + Beispiel: std typeface ("roman") + +TEXT PROC std typeface + Informationsprozedur + +PROC paper feed (TEXT CONST name) + übliche Parameter: tractor, sheet, schacht1, schacht2 + Wählt Endlospapier oder Einzelblatteinzug und ggf. Schachtnummer. + Beispiel: paper feed ("sheet") + +TEXT PROC paper feed + Informationsprozedur + + +#on("u")#Materialanweisungen \#material("...")\##off("u")# +müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und +setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben +für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge­ +stellten Standardwerten. Diese werden durch die Materialanweisung aber +nicht geändert.) + +Beispiel: \#material("nlq")\# + sorgt bei entsprechendem Treiber dafür, daß das gesamte + Dokument in Schönschrift-Qualität ausgedruckt wird, egal + wie 'std quality' eingestellt ist. + +#on("b")#Es darf in einer Datei nur eine Materialanweisung stehen!#off("b")# Sollen meh­ +rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung +erscheinen. Beispiel: \#material("sheet;draft")\# + + +#on("u")#direkte Druckeranweisungen \#"..."\##off("u")# +gelten ab der Position, an der sie in der Datei auftreten. Sie haben +(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und +Materialeinstellungen. + +Beispiel: \#"draft"\# + schaltet (bei entsprechendem Treiber) auf Datenverar­ + beitungs-Qualität, egal welche Standardeinstellung vorliegt + und welche Materialanweisung gegeben wurde. + +#on("b")#In einer Druckeranweisung darf nur eine Einstellung vorgenommen +werden.#off("b")# Also: \#"nlq"\#\#"sansserif"\# + + +#on("u")#Wichtig#off("u")# +- Achten Sie bei Materialanweisungen und direkten Druckeranweisungen + besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben + berücksichtigt! Also: \#"nlq"\# und keinesfalls \#"NLQ"\#!!! +- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und + nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann + daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse + erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen + Reihenfolge an den Drucker sendet, als er in der Datei steht, die + mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B. + für beide Spalten) unerwünscht erhalten bleibt. + + +#on("u")#Tabelle#off("u")# +Die Tabelle soll einen Anhaltspunkt dafür geben, wie welche Einstel­ +lungen erfolgen können. + +#type("17")# + Steuerprozeduren Materialanweisungen direkte Druckeranweisungen + +#on("u")#                                                                                          #off("u")# + +Positionierung std speed slow, fast ------ + slow, fast + +Qualität std quality z.B. draft, nlq z.B. draft, nlq + z.B. draft, nlq + +Schriftart std typeface z.B. roman, z.B. roman, +(nur bei NLQ) z.B. roman, sansserif, courier sansserif, courier + sansserif, courier + +Einzelblatt- paper feed z.B. schacht1, z.B. schacht1, +einzug z.B. tractor, schacht2 schacht2 + sheet, + schacht1, schacht2 + +Farbdruck ------ ------ z.B. schwarz, + rot, blau, + violett, gelb + orange, grün + + + +#type("nlq10")##on("b")#4. Weitere Hinweise#off("b")# + +#on("u")#Zeichensatzänderungen gegenüber früheren Versionen#off("u")# +In den Fonttabellen früherer Druckertreiber-Versionen wurden oberhalb +des Codes 127 einige internationale Zeichen zur Verfügung gestellt +(und zwar in Anlehnung an den Agfa-Laserdrucker-Zeichensatz). +Bei den Treibern der vorliegenden Version gilt folgendes: +- Wie bisher wird der volle im Benutzerhandbuch festgelegte EUMEL- + Zeichensatz (sofern möglich) unterstützt. +- Der Code 252 liefert das Paragraphzeichen. +- Alle übrigen (vom EUMEL-Zeichensatz nicht definierten) Zeichencodes + oberhalb 127 liefern, sofern möglich, die entsprechenden Zeichen des + IBM-Grafikzeichensatzes. + + +#on("u")#Hinweis zu Proportionalschriften#off("u")# +Bei Proportionalschriften kann die Modifikation \#on("i")\# zu Problemen +führen (z.B. beim Blocksatz), wenn die kursiven Zeichen andere +Proportionalbreiten haben. + +#on("u")#Hinweis zur Modifikation on/off("b") bzw. on/off("r")#off("u")# +Die meisten 24-Nadel Drucker verfügen sowohl über einen horizontalen als +auch über einen vertikalen Schattendruck. Diese beiden Druckarten können +mit der Modifikation on("b") (bold) bzw. on("r") (eigentlich für reverse +gedacht) eingeschaltet werden. + +#on("u")#Hinweis zur Benutzung von Einzelblatteinzügen#off("u")# +Bei der Benutzung von Einzelblatteinzügen müssen folgende Einstel­ +lungen vorgenommen werden (vgl. auch Abschnitt 3!): + + Am Drucker: +1. Sie müssen Ihren Drucker auf die Option Einzelblatteinzug + schalten (siehe Druckerhandbuch!). + + In der Druckspooltask (meist 'PRINTER'): +2. Falls der Druckertreiber die Steuerprozedur 'paper feed' zur Verfü­ + gung stellt, müssen Sie mit 'paperfeed ("sheet")' oder (für + 2-Schacht-Einzüge) mit 'paperfeed ("schacht1")' bzw. 'paperfeed + ("schacht2")' den Druckertreiber auf Einzelblatteinzug umschalten. +3. Falls Sie eine andere Papierlänge als 12 Zoll (=30.48 cm) verwen­ + den, müssen Sie die neuen Papiermaße mit 'papersize' in cm einstel­ + len. + Beispiel: papersize (21.0, 29.7) + (für DIN A4-Blätter) +4. Falls der Drucker mit dem Einzelblatteinzug nicht direkt am Blatt­ + anfang drucken kann, sondern ein gewisser oberer Rand bleibt, muß + mit 'top margin' die Länge des nicht bedruckbaren Randes in cm dem + Druckertreiber mitgeteilt werden. + Beispiel: top margin (1.5) + (Wie groß der obere Rand ist, kann festgestellt werden, indem eine + Datei mit \#start(0.0,0.0)\# ausgedruckt wird.) + + Wurde mit 'top margin' dem Treiber die Größe der nicht bedruckbaren + Fläche mitgeteilt, so ist darauf zu achten, daß in den Druckdateien + ein genügend großer y-Wert für die Startposition eingestellt wird + ('start'-Anweisung). Andernfalls kommt es bei der Ausgabe in der + ersten Zeile zu Überschreibungen. + + +#on("b")#5. Die Änderungen, die Sie in der Druckspooltask vorgenommen haben + werden erst wirksam, wenn das Spool-Kommando 'start' gegeben wird.#off("b")# + + + + diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/beschreibungen24 b/system/printer-24nadel/schulis-mathe-1.0/src/beschreibungen24 new file mode 100644 index 0000000..e3d2fa9 --- /dev/null +++ b/system/printer-24nadel/schulis-mathe-1.0/src/beschreibungen24 @@ -0,0 +1,62 @@ + +(*************************************************************************) +(* Stand : 3. 1.89 *) +(* Beschreibungen-Datei für 24-Nadel-Drucker Version : 0.9 *) +(* Autor : hjh *) +(*************************************************************************) + +$necp5p7$ +begin;headnecp5p7;declarations;feed; +open;opendoch;opendocp5p7;openpagep5-7;close;closepage; +execute;cmdp5-7;crs;move;movep5-7;onoff;typep5-7;end + +$necp6$ +begin;headnecp6;declarations;feed; +open;opendoch;opendocp6;openpagep5-7;close;closepage; +execute;cmdp5-7;crs;move;movep5-7;onoff;typep5-7;end + +$necp6+$ +begin;headnecp6+;declarations;speed;topmargin;typefacep6+;feed; +open;opendoch;initspeed;opendocp6+;openpage;close;closepage; +execute;cmdp6+;crs;move;stdmove;onoff;typep6+;end + +$epsonlq850$ +begin;headlq850;declarations;speed;topmargin;typefacelq850;feed; +open;opendoch;initspeed;opendoclq850;openpage;close;closepage; +execute;cmdlq850;crs;move;stdmove;onoff;typeplq850;end + +$epsonlq1500$ +printerlq1500;end + +$oki390/391$ +begin;headoki390/391;declarations;speed;topmargin;typefaceoki;feedschacht; +open;opendoch;initspeed;opendocokieps;openpage;close;closepage; +execute;cmdoki;crs;move;stdmove;onoff;typeokieps;end + +$oki393/393Ceps$ +begin;headoki393/393Ceps;declarations;speed;topmargin;typefaceoki;feedschacht; +open;opendoch;initspeed;opendocokieps;openpage;close;closepage; +execute;cmdoki;crs;move;stdmove;onoff;typeokieps;end + +$oki393/393Cibm$ +begin;headoki393/393Cibm;declarations;speed;topmargin;typefaceoki;feedschacht; +open;opendoch;initspeed;opendocokiibm;openpage;close;closepage; +execute;cmdoki;crs;move;stdmove;onoff;typeokiibm;end + +$toshp321$ +begin;headtoshp321;declarations;speed;feed; +open;opendochtosh;initspeed;opendoctosh;openpagetosh;close;closepagetosh; +execute;cmdtosh;crs;move;stdmove;onoff;typetosh;end + +$starnb24$ +begin;headstarnb24;declarations;speed;topmargin;typefacestar;feedschacht; +open;opendoch;initspeed;opendocstar;openpage;close;closepage; +execute;cmdstar;crs;move;stdmove;onoff;typestar;end + +$brotherm1724l$ +begin;headbrotherm1724l;declarations;speed;topmargin;feed; +open;opendoch;initspeed;opendocbrother;openpage;close;closepage; +execute;cmdtosh;crs;move;stdmove;onoff;typebrother;end + + + diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.brother b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.brother new file mode 100644 index 0000000..2251e18 Binary files /dev/null and b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.brother differ diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq1500 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq1500 new file mode 100644 index 0000000..1b4c6a6 Binary files /dev/null and b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq1500 differ diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq850 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq850 new file mode 100644 index 0000000..7a6d2f0 Binary files /dev/null and b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq850 differ diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5 new file mode 100644 index 0000000..9910da6 Binary files /dev/null and b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5 differ diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5.new b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5.new new file mode 100644 index 0000000..9804bd5 Binary files /dev/null and b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5.new differ diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p6+ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p6+ new file mode 100644 index 0000000..b209e81 Binary files /dev/null and b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p6+ differ diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.oki b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.oki new file mode 100644 index 0000000..2251e18 Binary files /dev/null and b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.oki differ diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.toshiba.p321 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.toshiba.p321 new file mode 100644 index 0000000..452afca Binary files /dev/null and b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.toshiba.p321 differ diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/inserter b/system/printer-24nadel/schulis-mathe-1.0/src/inserter new file mode 100644 index 0000000..1a165e0 --- /dev/null +++ b/system/printer-24nadel/schulis-mathe-1.0/src/inserter @@ -0,0 +1,793 @@ + +(*************************************************************************) +(* Installationsprogramm für Stand : 3. 1.89 *) +(* 24-Nadel Drucker Version : 0.9 *) +(* Autor : hjh *) +(*************************************************************************) + +PACKET driver inst 24 + + + DEFINES treiber einrichten: + + +LET up = ""3""13""5"", + + generator name = "printer.24.nadel", + + description file name = "beschreibungen24", + module file name = "module24"; + + +INT VAR pr channel, + quality, + paper format number, + service option; +TEXT VAR fonttab name :: "", + driver name :: ""; +TEXT VAR inp; +BOOL VAR was esc; + +treiber einrichten + +PROC treiber einrichten: + + treiber einrichten (0) +END PROC treiber einrichten; + +PROC treiber einrichten (INT CONST service opt): + + ask for print channel; + main menu; + IF installed + THEN generate printer spool + ELSE inform about restart + FI. + + ask for printchannel: + inits; + page; + headline ("Druckerkanal - Einstellung"); + cursor (1, 15); + putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); + putline (" 'serverchannel (Kanalnummer)' in der Task """ + + name (myself) + """"); + putline (" verändert werden."); + REP + cursor (1, 10); + put (""5"EUMEL-Kanalnummer des Druckerkanals:"); + get (pr channel); + disable stop; + serverchannel (pr channel); + BOOL VAR no error :: NOT is error; + clear error; + no error := no error CAND + (pr channel <> channel (myself)) CAND + (pr channel > 1) CAND + (pr channel < 17); + + IF NOT no error + THEN cursor (1, 7); + put error; + putline ("Eingabe korrigiert wiederholen!") + FI; + enable stop + UNTIL no error PER; + IF exists task ("canal " + text (pr channel)) + THEN end (/ ("canal " + text (pr channel))); + FI; + +. inits: + line; + IF single task + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") + FI; + command dialogue (TRUE); + IF name (myself) <> "PRINTER" + THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + + name (myself) + """ !"); + IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") + THEN rename myself ("PRINTER") + FI + FI; + INT VAR choice; + service option := service opt. + + single task: (pcb (9) AND 255) = 1. + + main menu: + BOOL VAR installed :: FALSE; + REP + show main menu; + get choice; + treat choice + UNTIL was esc OR installed PER. + + show main menu: + page; + headline("Hauptmenü 24-Nadel-Drucker"); + putline (" 1. Brother"); + putline (" 2. Epson"); + putline (" 3. NEC"); + putline (" 4. OKI"); + putline (" 5. Toshiba"). + + get choice: + cursor (1,24); + put ("CR: Eingabe ESC: Installation abbrechen"); + ask user (5). + + treat choice: + SELECT int (inp) OF + CASE 1: brother menu + CASE 2: epson menu + CASE 3: nec menu + CASE 4: oki menu + CASE 5: toshiba menu + END SELECT. + + + brother menu: + page; + headline ("brother - Menü"); + putline (" 1. M-1724 L"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (1); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + brother m1724l inst + FI. + + brother m1724l inst: + putline ("brother M-1724 L"); + line; + putline ("Wählen Sie folgende DIP-Schalter Optionen:"); + putline ("Emulationsmodus IBM Proprinter XL "); + putline ("Automatischer Zeilenvorschub Nein "); + show control options ("paperfeed, std speed, top margin"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.brother"); + generate ("brotherm1724l"); + adjust papersize; + adjust quality; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + + toshiba menu: + page; + headline ("TOSHIBA - Menü"); + putline (" 1. P 321"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (1); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + toshiba p321 inst + FI. + + toshiba p321 inst: + putline ("TOSHIBA P 321"); + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("S3-8 S3-7 S3-5 übrige Schalter"); + putline ("OFF OFF *) egal "); + putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); + show control options ("std speed, paper feed"); + show material options("slow, fast"); + show command options ("nlq, draft"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.toshiba.p321"); + generate ("toshp321"); + adjust papersize; + adjust quality; + do ("papersize(21.0,30.48)"); + installed := TRUE; + FI. + + + epson menu: + page; + headline ("Epson - Menü"); + putline (" 1. LQ 850"); + putline (" 2. LQ 1050"); + putline (" 3. LQ 1500"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (3); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : lq850 inst + CASE 2 : lq850 inst + CASE 3 : lq1500 inst + END SELECT + FI. + + lq850 inst: + IF choice = 1 + THEN putline ("Epson LQ 850") + ELSE putline ("Epson LQ 1050") + FI; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8"); + putline ("egal egal egal egal egal egal *1) OFF "); + putline ("*1) ON: Einzelblatteinzug, OFF: kein Einzug"); line; + putline ("SW2-1 SW2-2 SW2-3 SW2-4 SW2-5 SW2-6 SW2-7 SW2-8"); + putline ("egal egal *2) OFF OFF"); + putline ("*2) SW2-2 bis SW2-6 müssen je nach Art der Schnittstelle "); + putline (" gesetzt werden (Druckerhandbuch)"); + show control options ("std speed, top margin, std typeface, paperfeed"); + show material options ("slow, fast, draft, nlq, roman, sansserif"); + show command options ("draft, nlq, roman, sansserif"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.epson.lq850"); + generate ("epsonlq850"); + adjust quality; + adjust papersize; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + lq1500 inst: + putline ("EPSON LQ-1500"); + show control options (""); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + IF all right + THEN get fonttable ("fonttab.epson.lq1500"); + generate ("epsonlq1500"); + adjust quality; + installed := TRUE + FI. + + nec menu: + page; + headline ("NEC - Menü"); + putline (" 1. PINWRITER P5 "); + putline (" 2. PINWRITER P6 "); + putline (" 3. PINWRITER P7 "); + putline (" 4. PINWRITER P6 PLUS"); + putline (" 5. PINWRITER P7 PLUS"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (5); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : necp5p7 inst + CASE 2 : necp6 inst + CASE 3 : necp5p7 inst + CASE 4 : necp6plus inst + CASE 5 : necp6plus inst + END SELECT + FI. + + necp5p7 inst: + IF choice = 1 + THEN putline ("NEC PINWRITER P5") + ELSE putline ("NEC PINWRITER P7") + FI; + show control options ("paper feed"); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.nec.p5.new"); + generate ("necp5p7"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + necp6 inst: + putline ("NEC PINWRITER P6 "); + show control options ("paper feed"); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.nec.p5.new"); + generate ("necp6"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + necp6plus inst: + IF choice = 4 + THEN putline ("NEC PINWRITER P6 PLUS") + ELSE putline ("NEC PINWRITER P7 PLUS") + FI; + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("CR FUNCTION CR ONLY "); + show control options ("std speed, top margin, std typeface, paperfeed"); + show material options ("slow, fast, draft, nlq, courier, souvenir"); + show command options ("draft, nlq, courier, souvenir"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.nec.p6+"); + generate ("necp6+"); + adjust papersize; + adjust quality; + installed := TRUE; + IF choice = 5 THEN do ("papersize (34.544, 30.48)") FI; + FI. + + oki menu: + page; + headline ("OKI - Menü"); + putline (" 1. MICROLINE 390 IBM-/EPSON-kompatibel"); + putline (" 2. MICROLINE 391 IBM-/EPSON-kompatibel"); + putline (" 3. MICROLINE 393/393C EPSON-kompatibel"); + putline (" 4. MICROLINE 393/393C IBM-kompatibel"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (4); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : oki ml390 inst + CASE 2 : oki ml390 inst + CASE 3 : oki ml393eps inst + CASE 4 : oki ml393ibm inst + END SELECT + FI. + + oki ml390 inst: + IF choice = 1 + THEN putline ("OKI Microline 390") ; + ELSE putline ("OKI Microline 391") ; + FI; + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("EMULATION MODE EPSON LQ "); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki390/391"); + adjust papersize; + adjust quality; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + + oki ml393eps inst: + putline ("OKI Microline 393 EPSON-kompatibel"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin, std typeface"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki393/393Ceps"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + oki ml393ibm inst: + putline ("OKI Microline 393 IBM-kompatibel"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("EMULATION MODE ASCII "); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin, std typeface"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki393/393Cibm"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + + +generate printer spool: + IF service opt = 0 + THEN forget (generator name, quiet); + forget (driver name, quiet) + FI; + eumel must advertise; + cursor (1, 10); +(* putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (2); + putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); + putline (" mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); + putline (" Drucker eingesetzt werden soll."); + line (2); +*) +(* put ("Generierung beendet, weiter mit 'SV'"); + break (quiet); +*) + putline (" Generierung beendet."); + putline (" Weiter: Bitte Taste drücken"); + WHILE incharety <> "" REP ENDREP; + REP UNTIL incharety <> "" ENDREP; + unlink; + do ("spool manager (PROC printer)"). + + inform about restart: + page; + putline ("Es ist kein Druckertreiber installiert worden!"); + line; + putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); + putline ("mit 'treiber einrichten' erneut aufgerufen werden."); + line; + pause(50); + unlink. + +END PROC treiber einrichten; + +PROC headline (TEXT CONST header): + + cursor (13,1); + putline ("E U M E L - Druckertreiber - Installations - Programm"); + cursor (40 - LENGTH header DIV 2, 2); + put (header); + line (2) +END PROC headline; + +PROC ask user (INT CONST max choice): + + TEXT VAR exit; + inp := ""; + REP + cursor (1,23); + IF inp = "" + THEN put ("Ihre Wahl (Nummer eingeben):") + ELSE put ("FEHLER! Eingabe korrigieren:") + FI; + editget (inp, ""27"", "", exit); + was esc := exit = ""27""; + UNTIL was esc OR ok PER. + + ok: + int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. +END PROC ask user; + +PROC show control options (TEXT CONST options): + + line; + putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); + write ("papersize, std quality"); + IF options <> "" + THEN put (","); + putline (options) + FI +END PROC show control options; + +PROC show material options (TEXT CONST options): + + line; + putline ("Mögliche Materialwerte (#material(""..."")#):"); + putline (options) +END PROC show material options; + +PROC show command options (TEXT CONST options): + + line; + putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); + putline (options) +END PROC show command options; + +PROC ask for quality: + + line (1); + putline ("Standard - Druckqualität:"); + line; + REP out (up); + IF yes ("Draft Quality (schneller, aber nicht so schön)") + THEN quality := 1; LEAVE ask for quality + FI; + out (up); + IF yes ("Near Letter Quality (schöner, aber langsamer)") + THEN quality := 2; LEAVE ask for quality + FI; + PER +END PROC ask for quality; + +PROC adjust quality: + + IF quality = 1 + THEN do ("std quality (""draft"")") + ELSE do ("std quality (""nlq"")") + FI +END PROC adjust quality; + +PROC ask for papersize : +LET up = ""3""13""5""; + + paper format number := paper format ; + + . paper format : + line (1); + putline ("Papierformat:"); + line; + REP out (up); + IF yes ("Endlospapier, 8 Zoll breit") + THEN LEAVE paper format WITH 1 FI; + out (up); + IF yes ("Endlospapier, 13.2 Zoll breit") + THEN LEAVE paper format WITH 2 FI; + out (up); + IF yes ("Einzelblatteinzug, DINA 4") + THEN LEAVE paper format WITH 3 FI; + PER; + 0 +END PROC ask for papersize; + + +PROC adjust papersize: + + SELECT paper format number OF + CASE 1 : do("papersize ( 8.0 * 2.54, 12.0 * 2.54)"); + do ("paper feed (""tractor"")") + CASE 2 : do("papersize (13.2 * 2.54, 12.0 * 2.54)"); + do ("paper feed (""tractor"")") + CASE 3 : do("papersize (21.0, 29.7)"); + do ("paper feed (""sheet"")") + END SELECT + +END PROC adjust papersize; + +BOOL PROC all right: + + line (3); + cursor (1,23); + yes ("Soll der ausgewählte Druckertreiber installiert werden") +END PROC all right; + +PROC get fonttable (TEXT CONST name): + + fonttab name := name; + from archive ((description file name & module file name & fonttab name) + - all); + fonttable (fonttab name); + command dialogue (FALSE); + save (fonttab name, /"configurator"); + IF service option = 0 + THEN forget (fonttab name) + FI; + command dialogue (TRUE); +END PROC get fonttable; + +PROC from archive (THESAURUS CONST files): + + IF highest entry (files) > 0 + THEN fetch from archive; + release (archive); + putline ("Archiv abgemeldet !") + FI. + + fetch from archive: + THESAURUS VAR thes :: files; + REP + ask for archive; + reserve archive; + fetch (thes / ALL archive, archive); + thes := thes - all + UNTIL highest entry (thes) = 0 PER. + +ask for archive: + TEXT VAR buffer; +(*line; + putline ("Bitte Archiv mit den Dateien"); + INT VAR index :: 0; + REP + get (thes, buffer, index); + putline (" " + buffer) + UNTIL index = 0 PER; + putline ("einlegen !"); + line; + putline ("Wenn eingelegt: Taste drücken !"); + inchar (buffer)*). + +reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop. + +END PROC from archive; + +THESAURUS OP & (TEXT CONST left, right): + THESAURUS VAR result := empty thesaurus; + insert (result, left); + insert (result, right); + result +END OP &; + +THESAURUS OP & (THESAURUS CONST left, TEXT CONST right): + THESAURUS VAR result := left; + insert (result, right); + result +END OP &; + +PROC generate (TEXT CONST name): + + open files; + read description; + build programme; + insert programme; + forget files. + + open files: + line (5); + cursor (1, 20); + putline (""4"Bitte warten !"); + putline (" - Der Treiber wird generiert."); + driver name := "printer." + name + "(generiert)"; + IF exists (driver name) + THEN forget (driver name, quiet) + FI; + FILE VAR des file :: sequential file (modify, description file name), + mod file :: sequential file (modify, module file name), + driver file :: sequential file (output, driver name). + + read description: + to line (des file, 1); + col (des file, 1); + downety (des file, "$" + name + "$"); + IF eof (des file) + THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + + "Descriptions-File enthalten") + FI; + TEXT VAR description :: "", + record; + BOOL VAR done :: FALSE; + read record (des file, record); + record := subtext (record, col (des file) + LENGTH name + 2); + WHILE NOT eof (des file) AND NOT done REP + treat record + PER. + + treat record: + INT VAR dollar pos :: pos (record, "$"); + IF dollar pos = 0 + THEN description CAT compress (record); + down (des file); + read record (des file, record) + ELSE description CAT compress (subtext (record, 1, dollar pos - 1)); + col (des file, dollar pos); + done := TRUE; + FI. + + build programme: + get module name; + WHILE still modules REP + find module; + transfer module; + get module name + PER. + + get module name: + INT VAR semicol pos :: pos (description, ";"); + TEXT VAR module name; + IF semicol pos > 0 + THEN module name := subtext (description, 1, semicol pos - 1); + description := subtext (description, semicol pos + 1) + ELSE module name := description; + description := "" + FI. + + still modules: + module name <> "" OR description <> "". + + find module: + to line (mod file, 1); + col (mod file, 1); + downety (mod file, "$" + module name + "$"); + IF eof (mod file) + THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + + "Modul-File enthalten") + FI. + + transfer module: + done := FALSE; + read record (mod file, record); + record := subtext (record, col (mod file) + LENGTH module name + 2); + WHILE NOT eof (mod file) AND NOT done REP + transfer record + PER. + + transfer record: + dollar pos := pos (record, "$"); + IF dollar pos = 0 + THEN write (driver file, compress (record)); + line (driver file); + down (mod file); + read record (mod file, record) + ELSE write (driver file, compress (subtext (record, 1, + dollar pos - 1))); + col (mod file, dollar pos); + done := TRUE; + cout (line no (mod file)) + FI. + + insert programme: + IF online + THEN putline (" - Der Treiber wird insertiert.") + FI; + check off; + insert (driver name). + + forget files: + IF service option = 0 + THEN forget (description file name, quiet); + forget (module file name, quiet) + FI . +END PROC generate; + +END PACKET driver inst 24 + diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/module24 b/system/printer-24nadel/schulis-mathe-1.0/src/module24 new file mode 100644 index 0000000..a4957c2 --- /dev/null +++ b/system/printer-24nadel/schulis-mathe-1.0/src/module24 @@ -0,0 +1,1554 @@ + +(*************************************************************************) +(* Stand : 03. 1.89 *) +(* Module-Datei für 24-Nadel-Drucker Version : 0.9 *) +(* Autor : hjh *) +(*************************************************************************) + +$begin$ +PACKET printer driver + + DEFINES printer, + open, + close, + execute, + paper size, + std quality, + +$headnecp6$ paper feed: +(* Treiber fuer NEC P6, automatisch generiert *) +LET underline linetype = 1; +INT VAR factor 1, factor 2, draft factor 1, draft factor 2; + +$headnecp5p7$ paper feed: +(* Treiber fuer NEC P5, P7 , automatisch generiert *) +LET underline linetype = 1; +INT VAR factor 1, factor 2, draft factor 1, draft factor 2; + +$headnecp6+$ std speed, + top margin, + paper feed, + std typeface: +(* Treiber für NEC P6 plus/P7 plus ,automatisch generiert *) + + +$headlq850$ std speed, + top margin, + paper feed, + std typeface: +(* Treiber für EPSON LQ-850/1050 ,automatisch generiert *) + +$headbrotherm1724l$ + std speed, + top margin, + paper feed: +INT VAR vertical factor := 1; +(* Treiber für BROTHER M-1724L in IBM-Emulation, automatisch generiert *) + +$headoki390/391$ + std speed, + top margin, + paper feed, + std typeface: +INT VAR vertical factor := 1; +(* Treiber für OKI MIKROLINE 390/391 ,automatisch generiert *) + +$headoki393/393Ceps$ + std speed, + top margin, + paper feed, + std typeface: +INT VAR vertical factor := 1; +(* Treiber für OKI MIKROLINE 393/393C EPSON-kompatibel, automatisch generiert *) + +$headoki393/393Cibm$ + std speed, + top margin, + paper feed, + std typeface: +INT VAR vertical factor := 1; +(* Treiber für OKI MIKROLINE 393/393C IBM-kompatibel, automatisch generiert *) + +$headtoshp321$ std speed, + paper feed: +(* Treiber für TOSHIBA P321, automatisch generiert *) + +$headstarnb24$ + std speed, + top margin, + paper feed, + std typeface: +(* Treiber für STAR NB 24-10/15 in Standard Betriebsart automatisch generiert *) + +$declarations$ +INT VAR font nr, font bits, modification bits, + blankbreite, x rest, high, low, steps; +REAL VAR x size, y size; +TEXT VAR buffer :: ""; +BOOL VAR is nlq ; +TEXT VAR font text :: ""; +TEXT VAR std quality name :: "draft"; + +. is pica : font bits = 0 +. is elite : font bits = 1 +.; + + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; +END PROC paper size; + +papersize (20.32, 30.48); + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); +END PROC paper size; + + + +PROC std quality (TEXT CONST quality) : + + IF quality = "nlq" OR quality = "draft" + THEN std quality name := quality + ELSE errorstop ("unzulässige Qualitätsbezeichnung") + FI +END PROC std quality; + +TEXT PROC std quality : + + std quality name +END PROC std quality; + + +$topmargin$ +REAL VAR y margin := 0.0 ; + +PROC top margin (REAL CONST margin): + + y margin := margin +END PROC top margin; + +REAL PROC top margin: + + y margin +END PROC top margin; + + +$speed$ +BOOL VAR is slow :: TRUE; +TEXT VAR std speed name :: "slow"; + +PROC std speed (TEXT CONST speed) : + + IF speed = "fast" OR speed = "slow" + THEN std speed name := speed + ELSE errorstop ("unzulässige Geschwindigkeit") + FI +END PROC std speed; + +TEXT PROC std speed : + +std speed name +END PROC std speed; + + +$typefacelq850$ +TEXT VAR act typeface name :: ""; +TEXT VAR std typeface name :: ""; + +. is roman: + act typeface name = "roman". +. is sansserif: + act typeface name = "sansserif" +.; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "roman" OR typeface = "sansserif" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : + + std typeface name +END PROC std typeface; + + + +$typefacep6+$ +BOOL VAR is courier :: TRUE; +TEXT VAR std typeface name :: "courier"; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "courier" OR typeface = "souvenir" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : + + std typeface name +END PROC std typeface; + +$typefaceoki$ +BOOL VAR is courier ; +TEXT VAR std typeface name :: ""; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "courier" OR typeface = "kassette" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : + + std typeface name +END PROC std typeface; + +$typefacestar$ +BOOL VAR is roman ; +TEXT VAR std typeface name :: ""; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "roman" OR typeface = "font1" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : + + std typeface name +END PROC std typeface; + +$feed$ +BOOL VAR is sheet feed :: FALSE; + +PROC paper feed (TEXT CONST feeder) : + + IF feeder = "sheet" + THEN is sheet feed := TRUE + ELIF feeder = "tractor" + THEN is sheet feed := FALSE + ELSE errorstop ("unzulässige Einzugsart") + FI +END PROC paper feed; + +TEXT PROC paper feed: + IF is sheet feed + THEN "sheet" + ELSE "tractor" + FI +END PROC paper feed; + +$feedschacht$ +BOOL VAR is sheet feed :: FALSE; +TEXT VAR feeder name :: "tractor"; + +PROC paper feed (TEXT CONST feeder) : + + IF feeder = "tractor" + THEN feeder name := "tractor"; + is sheet feed := FALSE + ELIF feeder = "sheet" OR feeder = "schacht1" + THEN feeder name := "schacht1" ; + is sheet feed := TRUE + ELIF feeder = "schacht2" + THEN feeder name := "schacht2" ; + is sheet feed := TRUE + ELSE errorstop ("unzulässige Einzugsart") + FI +END PROC paper feed; + +TEXT PROC paper feed: feeder name END PROC paper feed; + +$open$ +PROC open (INT CONST op code, INT VAR param1, param2): + + SELECT op code OF + CASE 1: open document(param1,param2) + CASE 2: open page (param1,param2) + END SELECT. +END PROC open ; + + +$opendoch$ +PROC open document (INT VAR x steps,y steps): + modification bits := 0; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 30) * 30; + +$opendochtosh$ +PROC open document (INT VAR x steps,y steps): + modification bits := 0; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 36) * 36; + +$initspeed$ + IF pos (material, "slow") <> 0 + THEN is slow := TRUE; + ELIF pos (material, "fast") <> 0 + THEN is slow := FALSE; + ELSE is slow := std speed name = "slow" + FI; + +$opendocp6+$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"27"R"0""); (* Zeichentabelle 4 (Grafik) *) + out (""27"O"); + out (""27"2" + ""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF is sheet feed + THEN out (""27""25"4"); (* Sheetmode ein *) + FI; + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF pos (material, "courier") <> 0 + THEN is courier := TRUE ; + ELIF pos (material, "souvenir") <> 0 + THEN is courier := FALSE ; + ELSE is courier := std typeface name = "courier" + FI; +END PROC open document ; + +$opendocp5p7$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF is sheet feed + THEN out (""27""25"4"); (* Sheetmode ein *) + center paper ; + FI; + + . center paper : + INT CONST x steps in chars := x steps DIV x step conversion (2.54 / 10.0), + left margin := (136 - x steps in chars) DIV 2; + out (""27"P"); + out (""27"l"); out (code (left margin + 1)); +END PROC open document ; + +$opendocp6$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF is sheet feed + THEN out (""27""25"4"); (* Sheetmode ein *) + FI; +END PROC open document ; + +$opendoclq850$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"27"R"0""); (* Zeichentabelle 4 (Grafik) *) + out (""27"O"); + out (""27"2" + ""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF is sheet feed + THEN out (""27""25"4"); (* Sheetmode ein *) + FI; + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF pos (material, "roman") <> 0 + THEN act typeface name := "roman" + ELIF pos (material, "sansserif") <> 0 + THEN act typeface name := "sansserif" + ELSE act typeface name := std typeface name + FI; +END PROC open document ; + +$opendocokieps$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"27"R"0""); (* Zeichentabelle 4 (Grafik) *) + out (""27"O"); + out (""27"2" + ""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF is sheet feed + THEN IF feeder name = "schacht2" + THEN out (""27""25"2") + ELSE out (""27""25"1") + FI + FI; (* Sheetmode ein *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF pos (material, "courier") <> 0 + THEN is courier := TRUE ; + ELIF pos (material, "kassette") <> 0 + THEN is courier := FALSE ; + ELSE is courier := std typeface name = "courier" + FI; +END PROC open document ; + +$opendoctosh$ + out (""24""27"5"0""27"4"27"O"); (* Reset des Druckers *) + out (""27"6"); (* Zeichensatz *) + out (""27"A"12""27"2") ; + out (""27"C" + code (y steps DIV 36)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; +END PROC open document ; + +$opendocbrother$ + out (""24""27"5"0""27"4"27"O"); (* Reset des Druckers *) + out (""27"6" + ""27"R"0""); (* Zeichensatz II ascii *) + out (""27"A"10""27"2") ; (* Zeilenabstand *) + out (""27"C" + code (y steps DIV 36)); (* Formularlaenge *) + IF is sheet feed + THEN out (""27""25"4") + FI; (* Sheetmode ein *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; +END PROC open document ; + +$opendocokiibm$ + out (""24""27"5"0""27"4"27"O"); (* Reset des Druckers *) + out (""27"6" + ""27"!"64""); (* Zeichensatz II ascii *) + out (""27""91""92""4""0""0""0""180""); (* 1/180 *) + out (""27"A"12""27"2") ; (* Zeilenabstand *) + out (""27"C" + code (y steps DIV 36)); (* Formularlaenge *) + IF is sheet feed + THEN IF feeder name = "schacht2" + THEN out (""27""25"2") + ELSE out (""27""25"1") + FI + FI; (* Sheetmode ein *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF pos (material, "courier") <> 0 + THEN is courier := TRUE ; + ELIF pos (material, "kassette") <> 0 + THEN is courier := FALSE ; + ELSE is courier := std typeface name = "courier" + FI; +END PROC open document ; + +$opendocstar$ + out (""24""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* amerikanischer Zeichensatz *) + out (""27"O"); + out (""27"2" + ""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + IF is sheet feed + THEN IF feeder name = "schacht2" + THEN out (""27""25"2") + ELSE out (""27""25"1") + FI + FI; (* Sheetmode ein *) + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + IF pos (material, "roman") <> 0 + THEN is roman := TRUE ; + ELIF pos (material, "font1") <> 0 + THEN is roman := FALSE ; + ELSE is roman := std typeface name = "roman" + FI; +END PROC open document ; + +$openpagetosh$ +PROC open page (INT VAR x start , y start): + + x start := 0; + IF is sheet feed + THEN y start := y step conversion (2.54) (* 1 Inch *) + ELSE y start := 0; + FI; + x rest := 0; + out (""13""); +END PROC open page; + +$openpage$ +PROC open page (INT VAR x start , y start): + + x start := 0 ; + y start := y step conversion (y margin) ; + x rest := 0; + out (""13""). +END PROC open page; + +$openpagep5-7$ +PROC open page (INT VAR x start , y start): + + x start := 0; + IF is sheet feed + THEN y start := y step conversion (8.466667e-1) (* 2/6 Inch *) + ELSE y start := 0; + FI; + x rest := 0; + out (""13""); +END PROC open page; + +$close$ + +PROC close (INT CONST op code, INT CONST param1) : + + SELECT op code OF + CASE 1: close document + CASE 2: close page (param1) + END SELECT. + +close document : +. +END PROC close ; + +$closepage$ +PROC close page (INT CONST remaining y steps) : + IF remaining y steps > 0 + THEN out (""12"") + ELIF is sheet feed + THEN out (""27""25"R") + FI; +END PROC close page; + +$closepagetosh$ +PROC close page (INT CONST remaining y steps) : + IF is sheet feed + THEN out (""12"") + ELIF remaining y steps > 0 + THEN out (""12"") + FI; +END PROC close page; + +$execute$ +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE 1: write text + CASE 2: write cmd + CASE 3: carriage return + CASE 4: move + CASE 5: draw + CASE 6: on + CASE 7: off + CASE 8: type +END SELECT. + +from : param1. +to : param2. + + write text : + out subtext (string, from, to). + +$cmdp6+$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI; + ELIF buffer = "draft" + THEN IF is nlq THEN is nlq := FALSE; switch to draft FI; + ELIF buffer = "courier" + THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI; + ELIF buffer = "souvenir" + THEN IF is courier THEN is courier := FALSE; switch to souvenir FI; + ELIF buffer = "schwarz" + THEN out (""27"r0") + ELIF buffer = "rot" + THEN out (""27"r1") + ELIF buffer = "blau" + THEN out (""27"r2") + ELIF buffer = "violett" + THEN out (""27"r3") + ELIF buffer = "gelb" + THEN out (""27"r4") + ELIF buffer = "orange" + THEN out (""27"r5") + ELIF buffer = "grün" + THEN out (""27"r6") + ELSE out (buffer) + FI. + +$cmdp5-7$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN switch to nlq FI; + is nlq := TRUE; + ELIF buffer = "draft" + THEN IF is nlq THEN switch to draft FI; + is nlq := FALSE; + ELSE out (buffer); + FI;. + +$cmdlq850$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI; + ELIF buffer = "draft" + THEN IF is nlq THEN is nlq := FALSE; switch to draft FI; + ELIF buffer = "roman" + THEN IF NOT is roman THEN act typeface name := "roman" ; + switch to roman FI; + ELIF buffer = "sansserif" + THEN IF NOT is sansserif THEN act typeface name := "sansserif"; + switch to sansserif FI; + ELSE out (buffer) + FI. + +$cmdoki$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI; + ELIF buffer = "draft" + THEN IF is nlq THEN is nlq := FALSE; switch to draft FI; + ELIF buffer = "courier" + THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI; + ELIF buffer = "kassette" + THEN IF is courier THEN is courier := FALSE; switch to kassette FI; + ELIF buffer = "schwarz" + THEN out (""27"r0") + ELIF buffer = "rot" + THEN out (""27"r1") + ELIF buffer = "blau" + THEN out (""27"r2") + ELIF buffer = "violett" + THEN out (""27"r3") + ELIF buffer = "gelb" + THEN out (""27"r4") + ELIF buffer = "orange" + THEN out (""27"r5") + ELIF buffer = "grün" + THEN out (""27"r6") + ELSE out (buffer) + FI. + +$cmdtosh$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI; + ELIF buffer = "draft" + THEN IF is nlq THEN is nlq := FALSE; switch to draft FI; + ELSE out (buffer); + FI;. + +$cmdstar$ + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI; + ELIF buffer = "draft" + THEN IF is nlq THEN is nlq := FALSE; switch to draft FI; + ELIF buffer = "roman" + THEN IF NOT is roman THEN is roman := TRUE; switch to roman FI; + ELIF buffer = "font1" + THEN IF is roman THEN is roman := FALSE; switch to font1 FI; + FI. + +$crs$ + carriage return : + x rest := 0; + out (""13""). + +$move$ +x steps : param1. +y steps : param2. + +move : + IF x steps < 0 OR y steps < 0 THEN stop FI; + IF x steps > 0 THEN x move FI; + IF y steps > 0 THEN y move FI. + +$stdmove$ +x move : + x rest INCR x steps; + high := (x rest) DIV blankbreite; + x rest := (x rest) MOD blankbreite; + steps := x rest DIV 3; + IF high > 0 THEN high TIMESOUT " " FI; + IF steps > 0 AND is slow + THEN IF is underline THEN out (" "8"") FI; + out (""27"Y" + code (steps) + ""0""); (* 1/360 *) + steps TIMESOUT ""0""; + x rest := x rest MOD 3 + FI. + +is underline: + bit (modification bits,7). + +y move : + IF y steps > 0 + THEN high := y steps DIV 255; + low := y steps MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; (* 1/180 *) + IF low > 0 THEN out (""27"J" + code (low)) FI; + FI. + +draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> 1 + THEN stop + ELIF x steps > 0 + THEN x draw + FI. + +x draw : + x rest INCR x steps ; + steps := x steps DIV 3 ; + IF steps > 0 THEN + x rest := x steps MOD 3 ; + out (""27"Y"); + out (code (steps MOD 256)); + out (code (steps DIV 256)); + steps TIMESOUT ""1""; + FI. + +$movep5-7$ + x move : + x rest INCR x steps; + IF not is underline + THEN simple x move + ELSE underline x move + FI; + + . not is underline : + NOT bit (modification bits, 7) + + . simple x move : + high := x rest DIV factor 1; + x rest := x rest MOD factor 1; + out (""27"\"); + out (code (high MOD 256)); + out (code (high DIV 256)); + + . underline x move : + high := x rest DIV factor 2; + x rest := x rest MOD factor 2; + IF high < blankbreite + THEN stop + ELSE low := high MOD 127; + high := high DIV 127; + IF low >= blankbreite + THEN low DECR blankbreite; + ELSE high DECR 1; + low DECR (blankbreite - 127); + FI; + IF high > 0 + THEN out (""27" "); + out (code (127 - blankbreite)); + high TIMESOUT " "; + FI; + out (""27" "); + out (code (low)); + out (" "27" "0""); + FI; +. y move: + + low := y steps MOD 255; + high := y steps DIV 255; + IF high > 0 THEN high TIMESOUT (""27"J"255"") FI; + IF low > 0 THEN out (""27"J" + code (low)) FI; + +. draw : + IF x steps < 0 OR y steps <> 0 + THEN stop + ELIF x steps > 0 + THEN x draw + FI; + + . x draw : + x rest INCR x steps; + steps := x rest DIV 4; + x rest := x rest MOD 4; + IF steps > 0 + THEN low := steps MOD 256; + high := steps DIV 256; + out (""27"*"39""); + out (code (low)); + out (code (high)); + steps TIMESOUT dot; + FI; + + . dot : + IF linetype = underline linetype + THEN ""000""000""001"" + ELSE ""000""000""048"" + FI. + + +$onoff$ + modification : param1 +. + on : + buffer := on string (modification); + IF buffer <> "" + THEN modification bits := modification bits OR code (buffer); + switch to font; + ELSE stop + FI + +. + off : + buffer := off string (modification); + IF buffer <> "" + THEN modification bits := modification bits XOR code (buffer); + switch to font; + ELSE stop + FI. + +$typep6+$ + type : + font nr := param1 ; + buffer := font string (font nr); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is courier + THEN switch to courier + ELSE switch to souvenir + FI ; + switch to font; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + +. switch to font : + out (""27"!"); + out (code (font bits OR modification bits)); + out (font text); + +. switch to nlq : + out (""27"x"1""); + +. switch to draft : + out (""27"x"0""); + +. switch to courier : + out (""27"k"0"") ; + +. switch to souvenir : + out (""27"k"15"") ; +END PROC execute; + +$typeplq850$ + type : + font nr := param1 ; + buffer := font string (font nr); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is roman + THEN switch to roman + ELSE switch to sansserif + FI ; + switch to font; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + +. switch to font : + out (""27"!"); + out (code (font bits OR modification bits)); + out (font text); + +. switch to nlq : + out (""27"x"1""); + +. switch to draft : + out (""27"x"0""); + +. switch to roman : + out (""27"k"0"") ; + +. switch to sansserif : + out (""27"k"1"") ; +END PROC execute; + +$typeokieps$ + type : + font nr := param1 ; + buffer := font string (font nr); + font bits := code (buffer SUB 3); + vertical factor := code (buffer SUB 1); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is courier + THEN switch to courier + ELSE switch to kassette + FI ; + switch to font; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + +. switch to font : + out (""27"!"); + out (code (font bits OR modification bits)); + IF vertical factor = 2 + THEN out (""27"w"1"") + ELSE out (""27"w"0"") + FI; + out (font text); + +. switch to nlq : + out (""27"x"1""); + +. switch to draft : + out (""27"x"0""); + +. switch to courier : + out (""27"k"0"") ; + +. switch to kassette : + out (""27"k"127"") ; +END PROC execute; + +$typep5-7$ + type : + font nr := param1; + buffer := font string (font nr); + factor 1 := code (buffer SUB 1); (* 720 / Mikroschritte pro Inch mit ESC \ *) + factor 2 := code (buffer SUB 2); (* 720 / Mikroschritte pro Inch mit ESC Blank *) + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") DIV factor 2; + switch to font; + IF is nlq THEN switch to nlq FI; + +END PROC execute; + + +PROC switch to font : + + out (""27"!"); + out (code (font bits OR modification bits)); + out (font text); + +END PROC switch to font; + + +PROC switch to nlq : + + IF is pica OR is elite + THEN draft factor 1 := factor 1; + factor 1 := 4; + draft factor 2 := factor 2; + IF is pica + THEN factor 2 := 4 * factor 2 DIV 6; + blankbreite := char pitch (font nr, " ") DIV factor 2; + FI; + out (""27"x"1""); + ELSE out (""27"x"0""); + FI; + +END PROC switch to nlq; + + +PROC switch to draft : + + IF is pica OR is elite + THEN factor 1 := draft factor 1; + factor 2 := draft factor 2; + out (""27"x"0""); + FI; + +END PROC switch to draft; + +$typetosh$ + type : + font nr := param1 ; + buffer := font string (font nr); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + switch to font; + +. switch to font : + INT VAR master select bits := font bits OR modification bits ; + IF bit (master select bits,0) + THEN out (""27":") + ELSE out (""18"") + FI; + IF bit (master select bits,1) + THEN out (""27"I"2""27"P"1"") + ELSE out (""27"P"0"") + FI; + IF bit (master select bits,2) + THEN out (""27""15"") + FI; + IF bit (master select bits,3) + THEN out (""27"E") + ELSE out (""27"F") + FI; + IF bit (master select bits,4) + THEN out (""27"G") + ELSE out (""27"H") + FI; + IF bit (master select bits,5) + THEN out (""27"W"1"") + ELSE out (""27"W"0"") + FI; + IF bit (master select bits,6) + THEN + ELSE + FI; + IF bit (master select bits,7) + THEN out (""27"-"1"") + ELSE out (""27"-"0"") + FI; + out (font text); + + +. switch to nlq : + out (""27"I"2""); + +. switch to draft : + out (""27"I"1""); + +END PROC execute; + +$typeokiibm$ + type : + font nr := param1 ; + buffer := font string (font nr); + vertical factor := code (buffer SUB 1); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is courier + THEN switch to courier + ELSE switch to kassette + FI ; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + switch to font; + +. switch to font : + INT VAR master select bits := font bits OR modification bits ; + IF bit (master select bits,0) + THEN out (""27":") + ELSE out (""18"") + FI; + IF bit (master select bits,1) + THEN out (""27"I"2""27"P"1"") + ELSE out (""27"P"0"") + FI; + IF bit (master select bits,2) + THEN out (""27""15"") + FI; + IF bit (master select bits,3) + THEN out (""27"E") + ELSE out (""27"F") + FI; + IF bit (master select bits,4) + THEN out (""27"G") + ELSE out (""27"H") + FI; + IF bit (master select bits,5) + THEN out (""27"W"1"") + ELSE out (""27"W"0"") + FI; + IF bit (master select bits,6) + THEN out(""27"%G") + ELSE out(""27"%H") + FI; + IF bit (master select bits,7) + THEN out (""27"-"1"") + ELSE out (""27"-"0"") + FI; + IF vertical factor = 2 + THEN out (""27""91""64""4""0""0""0""2""0"") + ELSE out (""27""91""64""4""0""0""0""1""0"") + FI; + out (font text); + + +. switch to nlq : + out (""27"I"2""); + +. switch to draft : + out (""27"I"0""); + +. switch to courier : + out (""27"k"0"") ; + +. switch to kassette : + out (""27"k"127"") ; +END PROC execute; + +$typebrother$ + type : + font nr := param1 ; + buffer := font string (font nr); + vertical factor := code (buffer SUB 1); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + switch to font; + +. switch to font : + INT VAR master select bits := font bits OR modification bits ; + IF bit (master select bits,0) + THEN out (""27":") + ELSE out (""18"") + FI; + IF bit (master select bits,1) + THEN out (""27"I"2""27"P"1"") + ELSE out (""27"P"0"") + FI; + IF bit (master select bits,2) + THEN out (""27""15"") + FI; + IF bit (master select bits,3) + THEN out (""27"E") + ELSE out (""27"F") + FI; + IF bit (master select bits,4) + THEN out (""27"G") + ELSE out (""27"H") + FI; + IF bit (master select bits,5) + THEN out (""27"W"1"") + ELSE out (""27"W"0"") + FI; + IF bit (master select bits,6) + THEN + ELSE + FI; + IF bit (master select bits,7) + THEN out (""27"-"1"") + ELSE out (""27"-"0"") + FI; + IF vertical factor = 2 + THEN out (""27""91""64""4""0""0""0""2""0"") + ELSE out (""27""91""64""4""0""0""0""1""0"") + FI; + out (font text); + +. switch to nlq : + out (""27"I"2""); + +. switch to draft : + out (""27"I"0""); + +END PROC execute; + +$typestar$ + type : + font nr := param1 ; + buffer := font string (font nr); + font bits := code (buffer SUB 3); + font text := subtext (buffer, 4); + blankbreite := char pitch (font nr, " ") ; + IF is roman + THEN switch to roman + ELSE switch to font1 + FI ; + switch to font; + IF is nlq + THEN switch to nlq + ELSE switch to draft + FI; + +. switch to font : + out (""27"!"); + out (code (font bits OR modification bits)); + out (font text); + +. switch to nlq : + out (""27"x"1""); + +. switch to draft : + out (""27"x"0""); + +. switch to roman : + out (""27"k"0"") ; + +. switch to font1 : + out (""27"k"1"") ; +END PROC execute; + + + +$printerlq1500$ +PACKET printer driver + +(**************************************************************************) +(* Stand : 29.07.86 *) +(* EPSON LQ-1500 Version : 4 *) +(* Autor : Rudolf Ruland *) +(* geändert am 15.12.88 hjh *) +(**************************************************************************) + + DEFINES printer, + open, + close, + execute, + + paper size, + std quality: + +LET +(* underline = 1, + bold = 2, + italics = 4, + reverse = 8, *) + + underline linetype = 1, + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8; + +INT VAR rest, high, low, factor; +BOOL VAR is nlq, factor was 6, condensed; +REAL VAR x size, y size; +TEXT VAR std quality name, buffer; + +(*********************************************************************) + +paper size (13.6 * 2.54, 12.0 * 2.54); +std quality ("draft"); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + + +PROC std quality (TEXT CONST quality) : + + IF quality = "nlq" OR quality = "draft" + THEN std quality name := quality; + ELSE errorstop ("unzulaessige Betriebsart") + FI; + +END PROC std quality; + +TEXT PROC std quality : std quality name END PROC std quality; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + factor := 0; + factor was 6 := FALSE; + condensed := FALSE; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 30) * 30; + out (""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + + +. x start : param1 +. y start : param2 +. + open page : + x start := 0; + y start := 0; + rest := 0; + out (""13""); + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page +END SELECT; + +. + close document : + + +. remaining y steps : param1 +. + close page : + IF remaining y steps > 0 THEN out (""12"") FI + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out subtext (string, from, to) + +. + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN is nlq := TRUE; + near letter quality; + ELIF buffer = "draft" + THEN is nlq := FALSE; + draft quality; + ELSE out (buffer); + FI; + + . near letter quality : + IF factor = 6 + THEN factor was 6 := TRUE; + factor := 4; + ELSE factor was 6 := FALSE; + FI; + IF condensed + THEN out (""27"x"0"") + ELSE out (""27"x"1"") + FI; + + . draft quality : + IF factor was 6 + THEN factor was 6 := FALSE; + factor := 6; + FI; + out (""27"x"0""); + + +(*. x steps to left margin : param1*) +. + carriage return : + rest := 0; + out (""13""); + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps < 0 OR y steps < 0 + THEN stop + ELIF x steps > 0 + THEN x move + ELIF y steps > 0 + THEN y move + FI; + + . x move : + high := (x steps + rest) DIV factor; + rest := (x steps + rest) MOD factor; + out (""27"\"); + out (code (high MOD 256)); + out (code (high DIV 256)); + + . y move : + high := y steps DIV 255; + low := y steps MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; + +. + draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype + THEN stop + ELIF x steps > 0 + THEN x draw + FI; + + . x draw : + high := (x steps + rest) DIV 6; + rest := (x steps + rest) MOD 6; + IF high > 0 + THEN low := high MOD 255; + high := high DIV 255; + out (""27"V"); + out (code (low)); + out (""27"*"1""1""0""1""27"V"0""); + FOR low FROM 1 UPTO high + REP out (""27"V"255""27"*"1""1""0""1""27"V"0"") PER; + FI; + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)) + ELSE stop + FI + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)) + ELSE stop + FI + + +. font nr : param1 +. + type : + buffer := font string (font nr); + out (buffer); + factor := pitch factor; + IF is nlq THEN near letter quality FI; + + . pitch factor : (* Mikroschritt *) + INT CONST font bits := code (buffer SUB 3); + IF bit (font bits, 1) + THEN condensed := FALSE; 2 (* proportional 1/360 Inch *) + ELIF pos (buffer, ""27"x"1"") <> 0 + THEN condensed := FALSE; 4 (* near letter 1/180 Inch *) + ELIF bit (font bits, 2) + THEN condensed := TRUE; 3 (* condensed 1/240 Inch *) + ELIF bit (font bits, 0) + THEN condensed := FALSE; 4 (* elite 1/180 Inch *) + ELSE condensed := FALSE; 6 (* pica 1/120 Inch *) + FI + +END PROC execute; + + +$end$ +INT VAR reply; DATASPACE VAR ds; FILE VAR file; + +PROC printer: + + disable stop; + continue (server channel); + check error (error message); + ds := nilspace; + REP forget (ds); + execute print; + IF is error AND online THEN put error; clear error; FI; + PER; +END PROC printer; + +PROC execute print: + + LET ack = 0, fetch code = 11, file type = 1003; + enable stop; + ds := nilspace; + call (father, fetch code, ds, reply); + IF reply = ack CAND type (ds) = file type + THEN file := sequential file (input, ds); + print (file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; +END PROC execute print; + +PROC check error(TEXT CONST message): + + IF is error + THEN clear error; rename myself (message); + IF is error THEN end(myself) FI; + pause (9000); end(myself); + FI; +END PROC check error; + +END PACKET printerdriver + + diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/printer.24.nadel b/system/printer-24nadel/schulis-mathe-1.0/src/printer.24.nadel new file mode 100644 index 0000000..579f67f --- /dev/null +++ b/system/printer-24nadel/schulis-mathe-1.0/src/printer.24.nadel @@ -0,0 +1,776 @@ + +(*************************************************************************) +(* Installationsprogramm für Stand : 3. 1.89 *) +(* 24-Nadel Drucker Version : 0.9 *) +(* Autor : hjh *) +(*************************************************************************) + +PACKET driver inst 24 + + + DEFINES treiber einrichten: + + +LET up = ""3""13""5"", + + generator name = "printer.24.nadel", + + description file name = "beschreibungen24", + module file name = "module24"; + + +INT VAR pr channel, + quality, + paper format number, + service option; +TEXT VAR fonttab name :: "", + driver name :: ""; +TEXT VAR inp; +BOOL VAR was esc; + +treiber einrichten + +PROC treiber einrichten: + + treiber einrichten (0) +END PROC treiber einrichten; + +PROC treiber einrichten (INT CONST service opt): + + ask for print channel; + main menu; + IF installed + THEN generate printer spool + ELSE inform about restart + FI. + + ask for printchannel: + inits; + page; + headline ("Druckerkanal - Einstellung"); + cursor (1, 15); + putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); + putline (" 'serverchannel (Kanalnummer)' in der Task """ + + name (myself) + """"); + putline (" verändert werden."); + REP + cursor (1, 10); + put (""5"EUMEL-Kanalnummer des Druckerkanals:"); + get (pr channel); + disable stop; + serverchannel (pr channel); + BOOL VAR no error :: NOT is error; + IF is error + THEN cursor (1, 7); + put error; + putline ("Eingabe korrigiert wiederholen!") + FI; + clear error; + enable stop + UNTIL no error PER. + + inits: + line; + IF single task + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") + FI; + command dialogue (TRUE); + IF name (myself) <> "PRINTER" + THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + + name (myself) + """ !"); + IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") + THEN rename myself ("PRINTER") + FI + FI; + INT VAR choice; + service option := service opt. + + single task: (pcb (9) AND 255) = 1. + + main menu: + BOOL VAR installed :: FALSE; + REP + show main menu; + get choice; + treat choice + UNTIL was esc OR installed PER. + + show main menu: + page; + headline("Hauptmenü 24-Nadel-Drucker"); + putline (" 1. Brother"); + putline (" 2. Epson"); + putline (" 3. NEC"); + putline (" 4. OKI"); + putline (" 5. Toshiba"). + + get choice: + cursor (1,24); + put ("CR: Eingabe ESC: Installation abbrechen"); + ask user (5). + + treat choice: + SELECT int (inp) OF + CASE 1: brother menu + CASE 2: epson menu + CASE 3: nec menu + CASE 4: oki menu + CASE 5: toshiba menu + END SELECT. + + + brother menu: + page; + headline ("brother - Menü"); + putline (" 1. M-1724 L"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (1); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + brother m1724l inst + FI. + + brother m1724l inst: + putline ("brother M-1724 L"); + line; + putline ("Wählen Sie folgende DIP-Schalter Optionen:"); + putline ("Emulationsmodus IBM Proprinter XL "); + putline ("Automatischer Zeilenvorschub Nein "); + show control options ("paperfeed, std speed, top margin"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.brother"); + generate ("brotherm1724l"); + adjust papersize; + adjust quality; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + + toshiba menu: + page; + headline ("TOSHIBA - Menü"); + putline (" 1. P 321"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (1); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + toshiba p321 inst + FI. + + toshiba p321 inst: + putline ("TOSHIBA P 321"); + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("S3-8 S3-7 S3-5 übrige Schalter"); + putline ("OFF OFF *) egal "); + putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); + show control options ("std speed, paper feed"); + show material options("slow, fast"); + show command options ("nlq, draft"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.toshiba.p321"); + generate ("toshp321"); + adjust papersize; + adjust quality; + do ("papersize(21.0,30.48)"); + installed := TRUE; + FI. + + + epson menu: + page; + headline ("Epson - Menü"); + putline (" 1. LQ 850"); + putline (" 2. LQ 1050"); + putline (" 3. LQ 1500"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (3); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : lq850 inst + CASE 2 : lq850 inst + CASE 3 : lq1500 inst + END SELECT + FI. + + lq850 inst: + IF choice = 1 + THEN putline ("Epson LQ 850") + ELSE putline ("Epson LQ 1050") + FI; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8"); + putline ("egal egal egal egal egal egal *1) OFF "); + putline ("*1) ON: Einzelblatteinzug, OFF: kein Einzug"); line; + putline ("SW2-1 SW2-2 SW2-3 SW2-4 SW2-5 SW2-6 SW2-7 SW2-8"); + putline ("egal egal *2) OFF OFF"); + putline ("*2) SW2-2 bis SW2-6 müssen je nach Art der Schnittstelle "); + putline (" gesetzt werden (Druckerhandbuch)"); + show control options ("std speed, top margin, std typeface, paperfeed"); + show material options ("slow, fast, draft, nlq, roman, sansserif"); + show command options ("draft, nlq, roman, sansserif"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.epson.lq850"); + generate ("epsonlq850"); + adjust quality; + adjust papersize; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + lq1500 inst: + putline ("EPSON LQ-1500"); + show control options (""); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + IF all right + THEN get fonttable ("fonttab.epson.lq1500"); + generate ("epsonlq1500"); + adjust quality; + installed := TRUE + FI. + + nec menu: + page; + headline ("NEC - Menü"); + putline (" 1. PINWRITER P5 "); + putline (" 2. PINWRITER P6 "); + putline (" 3. PINWRITER P7 "); + putline (" 4. PINWRITER P6 PLUS"); + putline (" 5. PINWRITER P7 PLUS"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (5); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : necp5p7 inst + CASE 2 : necp6 inst + CASE 3 : necp5p7 inst + CASE 4 : necp6plus inst + CASE 5 : necp6plus inst + END SELECT + FI. + + necp5p7 inst: + IF choice = 1 + THEN putline ("NEC PINWRITER P5") + ELSE putline ("NEC PINWRITER P7") + FI; + show control options ("paper feed"); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.nec.p5.new"); + generate ("necp5p7"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + necp6 inst: + putline ("NEC PINWRITER P6 "); + show control options ("paper feed"); + show material options ("draft, nlq"); + show command options ("draft, nlq"); + ask for quality; + ask for papersize; + IF all right + THEN get fonttable ("fonttab.nec.p5.new"); + generate ("necp6"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + necp6plus inst: + IF choice = 4 + THEN putline ("NEC PINWRITER P6 PLUS") + ELSE putline ("NEC PINWRITER P7 PLUS") + FI; + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("CR FUNCTION CR ONLY "); + show control options ("std speed, top margin, std typeface, paperfeed"); + show material options ("slow, fast, draft, nlq, courier, souvenir"); + show command options ("draft, nlq, courier, souvenir"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.nec.p6+"); + generate ("necp6+"); + adjust papersize; + adjust quality; + installed := TRUE; + IF choice = 5 THEN do ("papersize (34.544, 30.48)") FI; + FI. + + oki menu: + page; + headline ("OKI - Menü"); + putline (" 1. MICROLINE 390 IBM-/EPSON-kompatibel"); + putline (" 2. MICROLINE 391 IBM-/EPSON-kompatibel"); + putline (" 3. MICROLINE 393/393C EPSON-kompatibel"); + putline (" 4. MICROLINE 393/393C IBM-kompatibel"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (4); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1 : oki ml390 inst + CASE 2 : oki ml390 inst + CASE 3 : oki ml393eps inst + CASE 4 : oki ml393ibm inst + END SELECT + FI. + + oki ml390 inst: + IF choice = 1 + THEN putline ("OKI Microline 390") ; + ELSE putline ("OKI Microline 391") ; + FI; + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("EMULATION MODE EPSON LQ "); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki390/391"); + adjust papersize; + adjust quality; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + + oki ml393eps inst: + putline ("OKI Microline 393 EPSON-kompatibel"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin, std typeface"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki393/393Ceps"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + oki ml393ibm inst: + putline ("OKI Microline 393 IBM-kompatibel"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); + putline ("EMULATION MODE ASCII "); + putline ("AUTO LF NO "); + show control options ("paperfeed, std speed, top margin, std typeface"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); + ask for papersize; + ask for quality; + IF all right + THEN get fonttable ("fonttab.oki"); + generate ("oki393/393Cibm"); + adjust papersize; + adjust quality; + installed := TRUE + FI. + + + +generate printer spool: + IF service opt = 0 + THEN forget (generator name, quiet); + forget (driver name, quiet) + FI; + eumel must advertise; + cursor (1, 10); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (2); + putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); + putline (" mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); + putline (" Drucker eingesetzt werden soll."); + line (2); + put ("Generierung beendet, weiter mit 'SV'"); + break (quiet); + do ("spool manager (PROC printer)"). + + inform about restart: + page; + putline ("Es ist kein Druckertreiber installiert worden!"); + line; + putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); + putline ("mit 'treiber einrichten' erneut aufgerufen werden."); + line. + +END PROC treiber einrichten; + +PROC headline (TEXT CONST header): + + cursor (13,1); + putline ("E U M E L - Druckertreiber - Installations - Programm"); + cursor (40 - LENGTH header DIV 2, 2); + put (header); + line (2) +END PROC headline; + +PROC ask user (INT CONST max choice): + + TEXT VAR exit; + inp := ""; + REP + cursor (1,23); + IF inp = "" + THEN put ("Ihre Wahl (Nummer eingeben):") + ELSE put ("FEHLER! Eingabe korrigieren:") + FI; + editget (inp, ""27"", "", exit); + was esc := exit = ""27""; + UNTIL was esc OR ok PER. + + ok: + int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. +END PROC ask user; + +PROC show control options (TEXT CONST options): + + line; + putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); + write ("papersize, std quality"); + IF options <> "" + THEN put (","); + putline (options) + FI +END PROC show control options; + +PROC show material options (TEXT CONST options): + + line; + putline ("Mögliche Materialwerte (#material(""..."")#):"); + putline (options) +END PROC show material options; + +PROC show command options (TEXT CONST options): + + line; + putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); + putline (options) +END PROC show command options; + +PROC ask for quality: + + line (1); + putline ("Standard - Druckqualität:"); + line; + REP out (up); + IF yes ("Draft Quality (schneller, aber nicht so schön)") + THEN quality := 1; LEAVE ask for quality + FI; + out (up); + IF yes ("Near Letter Quality (schöner, aber langsamer)") + THEN quality := 2; LEAVE ask for quality + FI; + PER +END PROC ask for quality; + +PROC adjust quality: + + IF quality = 1 + THEN do ("std quality (""draft"")") + ELSE do ("std quality (""nlq"")") + FI +END PROC adjust quality; + +PROC ask for papersize : +LET up = ""3""13""5""; + + paper format number := paper format ; + + . paper format : + line (1); + putline ("Papierformat:"); + line; + REP out (up); + IF yes ("Endlospapier, 8 Zoll breit") + THEN LEAVE paper format WITH 1 FI; + out (up); + IF yes ("Endlospapier, 13.2 Zoll breit") + THEN LEAVE paper format WITH 2 FI; + out (up); + IF yes ("Einzelblatteinzug, DINA 4") + THEN LEAVE paper format WITH 3 FI; + PER; + 0 +END PROC ask for papersize; + + +PROC adjust papersize: + + SELECT paper format number OF + CASE 1 : do("papersize ( 8.0 * 2.54, 12.0 * 2.54)"); + do ("paper feed (""tractor"")") + CASE 2 : do("papersize (13.2 * 2.54, 12.0 * 2.54)"); + do ("paper feed (""tractor"")") + CASE 3 : do("papersize (21.0, 29.7)"); + do ("paper feed (""sheet"")") + END SELECT + +END PROC adjust papersize; + +BOOL PROC all right: + + line (3); + cursor (1,23); + yes ("Soll der ausgewählte Druckertreiber installiert werden") +END PROC all right; + +PROC get fonttable (TEXT CONST name): + + fonttab name := name; + from archive ((description file name & module file name & fonttab name) + - all); + fonttable (fonttab name); + command dialogue (FALSE); + save (fonttab name, /"configurator"); + IF service option = 0 + THEN forget (fonttab name) + FI; + command dialogue (TRUE); +END PROC get fonttable; + +PROC from archive (THESAURUS CONST files): + + IF highest entry (files) > 0 + THEN fetch from archive; + release (archive); + putline ("Archiv abgemeldet !") + FI. + + fetch from archive: + THESAURUS VAR thes :: files; + REP + ask for archive; + reserve archive; + fetch (thes / ALL archive, archive); + thes := thes - all + UNTIL highest entry (thes) = 0 PER. + +ask for archive: + line; + putline ("Bitte Archiv mit den Dateien"); + TEXT VAR buffer; + INT VAR index :: 0; + REP + get (thes, buffer, index); + putline (" " + buffer) + UNTIL index = 0 PER; + putline ("einlegen !"); + line; + putline ("Wenn eingelegt: Taste drücken !"); + inchar (buffer). + +reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop. + +END PROC from archive; + +THESAURUS OP & (TEXT CONST left, right): + THESAURUS VAR result := empty thesaurus; + insert (result, left); + insert (result, right); + result +END OP &; + +THESAURUS OP & (THESAURUS CONST left, TEXT CONST right): + THESAURUS VAR result := left; + insert (result, right); + result +END OP &; + +PROC generate (TEXT CONST name): + + open files; + read description; + build programme; + insert programme; + forget files. + + open files: + line (5); + cursor (1, 20); + putline (""4"Bitte warten !"); + putline (" - Der Treiber wird generiert."); + driver name := "printer." + name + "(generiert)"; + IF exists (driver name) + THEN forget (driver name, quiet) + FI; + FILE VAR des file :: sequential file (modify, description file name), + mod file :: sequential file (modify, module file name), + driver file :: sequential file (output, driver name). + + read description: + to line (des file, 1); + col (des file, 1); + downety (des file, "$" + name + "$"); + IF eof (des file) + THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + + "Descriptions-File enthalten") + FI; + TEXT VAR description :: "", + record; + BOOL VAR done :: FALSE; + read record (des file, record); + record := subtext (record, col (des file) + LENGTH name + 2); + WHILE NOT eof (des file) AND NOT done REP + treat record + PER. + + treat record: + INT VAR dollar pos :: pos (record, "$"); + IF dollar pos = 0 + THEN description CAT compress (record); + down (des file); + read record (des file, record) + ELSE description CAT compress (subtext (record, 1, dollar pos - 1)); + col (des file, dollar pos); + done := TRUE; + FI. + + build programme: + get module name; + WHILE still modules REP + find module; + transfer module; + get module name + PER. + + get module name: + INT VAR semicol pos :: pos (description, ";"); + TEXT VAR module name; + IF semicol pos > 0 + THEN module name := subtext (description, 1, semicol pos - 1); + description := subtext (description, semicol pos + 1) + ELSE module name := description; + description := "" + FI. + + still modules: + module name <> "" OR description <> "". + + find module: + to line (mod file, 1); + col (mod file, 1); + downety (mod file, "$" + module name + "$"); + IF eof (mod file) + THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + + "Modul-File enthalten") + FI. + + transfer module: + done := FALSE; + read record (mod file, record); + record := subtext (record, col (mod file) + LENGTH module name + 2); + WHILE NOT eof (mod file) AND NOT done REP + transfer record + PER. + + transfer record: + dollar pos := pos (record, "$"); + IF dollar pos = 0 + THEN write (driver file, compress (record)); + line (driver file); + down (mod file); + read record (mod file, record) + ELSE write (driver file, compress (subtext (record, 1, + dollar pos - 1))); + col (mod file, dollar pos); + done := TRUE; + cout (line no (mod file)) + FI. + + insert programme: + IF online + THEN putline (" - Der Treiber wird insertiert.") + FI; + check off; + insert (driver name). + + forget files: + IF service option = 0 + THEN forget (description file name, quiet); + forget (module file name, quiet) + FI . +END PROC generate; + +END PACKET driver inst 24 + diff --git a/system/printer-24nadel/schulis-sim-3.0 b/system/printer-24nadel/schulis-sim-3.0 new file mode 120000 index 0000000..5ca05f9 --- /dev/null +++ b/system/printer-24nadel/schulis-sim-3.0 @@ -0,0 +1 @@ +schulis-mathe-1.0/ \ No newline at end of file diff --git a/system/printer-9nadel/0.9/doc/readme b/system/printer-9nadel/0.9/doc/readme new file mode 100644 index 0000000..2047abe --- /dev/null +++ b/system/printer-9nadel/0.9/doc/readme @@ -0,0 +1,324 @@ +#type("nlq10")##limit(18.0)##start(1.5,1.0)# +#head# +Treiber-Installations-Programm #right#Seite % +für 9-Nadel-Matrixdrucker #right#23.06.1988 + + +#end# +#on("u")#Dokumentation zum Treiber-Installations-Programm für 9-Nadel- +Matrixdrucker#off("u")# + +#on("u")#Inhalt:#off("u")# + +1. Installations- und Gebrauchsanleitung +2. Druckertreiber-Auswahl +3. Steuerungsmöglichkeiten und Spezialfeatures +4. Weitere Hinweise + + +#on("b")#1. Installations- und Gebrauchsanleitung#off("b")# + +#on("u")#Einrichten#off("u")# +So wird das Treiber-Installationsprogramm eingerichtet: + + SV drücken + + nach 'gib supervisor kommando:' + + begin("PRINTER","SYSUR") + + in der Task "PRINTER" (nach 'gib kommando'): + + archive ("std.printer") + fetch ("printer.neun.nadel",archive) + check off + insert ("printer.neun.nadel") + +Das Programm wird dann insertiert. + +#on("u")#Druckerkanal#off("u")# +Hiernach wird die Kanalnummer des Druckers erfragt. Wenn der Drucker +über Parallelschnittstelle betrieben wird, ist die Kanalnummer +meistens 15. + +#on("u")#Menüsystem#off("u")# +Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern. +Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste +der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier +den passenden Typ aus! +Das Installationsprogramm zeigt nun einige Informationen zu dem ange­ +wählten Drucker. Besonders zu beachten sind hierbei #on("u")#Angaben zur Konfi­ +guration des Druckers#off("u")# (z.B. DIP-Schalter). Der Drucker muß unbedingt +wie angegeben konfiguriert werden, wenn er mit dem ausgewählten Trei­ +ber betrieben werden soll. + +Hinweise zu Konfigurationsangaben: +1. Die Angabe 'egal' bedeutet, daß die Einstellung für die Funktion + des Treibers keine Bedeutung hat. Dennoch solte der Anwender darauf + achten, welche Funktion die Schalter haben (Druckerhandbuch!). So + ist es zum Beispiel immer empfehlenswert, den Papierende-Sensor zu + aktivieren, damit der Drucker nach Papierende nicht auf der Walze + weiterdruckt. +2. Die Konfigurationsangaben beziehen sich immer auf genau den ausge­ + wählten Druckertyp. Wenn Sie den Treiber mit einem anderen Drucker + als den ausgewählten verwenden, dann beachten Sie folgende Regeln + für die Konfiguration: + - Der Drucker muß auf eine passende Emulation konfiguriert werden. + - Der Drucker darf bei einem Carriage Return (Code 13) keinen Zei­ + lenvorschub durchführen. + - Der Drucker darf die Perforation #on("u")#nicht#off("u")# automatisch überspringen. + + - Auf Seitenlängen und internationale Zeichensätze müssen Sie nicht + achten. + +(Hinweise zur Auswahl des richtigen Treibers gibt Abschnitt 2) + +Nach den Konfigurationsangaben werden Steuerungsmöglichkeiten des +ausgewählten Treibers angezeigt. (Siehe hierzu Abschnitt 3) + +Falls der Treiber bestimmte grundsätzliche Betriebsmöglichkeiten er­ +laubt (z.B. DRAFT/NLQ, Einzelblatteinzug), werden Sie danach gefragt, +welche Möglichkeit standardmäßig gewählt werden soll. diese Vorein­ +stellungen können nachträglich in der Task "PRINTER" mit den entspre­ +chenden Steuerprozeduren neu gesetzt werden. Außerdem können bestimmte +Einstellungen noch für jedes einzelne Dokument (d.h. für jede Druck­ +datei) gewählt ('material'-Anweisung) oder sogar innerhalb eines Doku­ +ments verändert werden (direkte Druckeranweisung \#"..."\#). +Über die Steuerungsmöglichkeiten informiert Abschnitt 3 ausführlicher. + + +#on("b")#2. Druckertreiber-Auswahl#off("b")# + +#on("u")#Verwendung nicht im Menü enthaltener Drucker#off("u")# +Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden, soll­ +ten Sie zunächst versuchen, ob ein Treiber für einen anderen Drucker +des gleichen Herstellers mit Ihrem Drucker korrekt arbeitet. +Falls dies nicht funktioniert oder der Hersteller überhaupt nicht im +Menü erscheint, müssen Sie herausfinden (Druckerhandbuch, -händler!), +welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist. +(Viele Drucker verfügen über EPSON FX-85 bzw. FX-800-Emulationen oder +IBM Grafikdrucker bzw. Proprinter-Eumulationen.) +Eine der beiden Anpassungen 'EPSON MX' oder 'IBM-Grafikdrucker' müßte +immer einen (Minimal-) Betrieb ermöglichen. + +#on("u")#Hinweise zu den Treibern für FX-80/85-kompatilble Drucker#off("u")# +Die Treiber für FX-80-bzw. FX-85-kompatible Geräte, die oft auch IBM- +kompatibel sind, basieren üblicherweise auf den Treibern für EPSON- +Drucker, weil so einige Schrifttypen (z.B. Proportionalschrift) und +Modifikationen leichter ausgenutzt werden können. Ein Nachteil liegt +aber darin, daß beim FX-80 und FX-85 noch die alten EPSON-Zeichensätze +benutzt werden, die nicht die IBM-üblichen Grafik- und Sonderzeichen +enthalten. +Falls für Sie die Benutzung dieser Zeichen vordringlich ist, sollten +Sie Ihren Drucker (nachdem er auf IBM-Emulation konfiguriert wurde) +zusammen mit dem Treiber für IBM-Grafikdrucker bzw. -Proprinter ver­ +wenden. + + +#on("b")#3. Steuerungsmöglichkeiten und Spezialfeatures#off("b")# + +Einige Treiber bieten bestimmte Einstellungsmöglichkeiten (z.B. +DRAFT/NLQ) und/oder Spezialfeatures (z.B. Farbdruck). +Die Einstellungen können über +- Steuerprozeduren +- Materialanweisungen bzw. +- direkte Druckeranweisungen +vorgenommen werden. + +#on("u")#Steuerprozeduren#off("u")# +setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten +sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER") +aufgerufen werden. #on("b")#Gültig werden die Änderungen erst, wenn danach in +der Druckspooltask das Kommando 'start' gegeben wird!#off("b")# + +PROC papersize (REAL CONST breite, länge) + Dient zur Einstellung der Größe der physikalisch beschreibbaren + Fläche. + Beispiel: papersize (20.32, 30.48) + (Standardeinstellung für Endlospapier 8 Zoll breit und + 12 Zoll lang) + +PROC papersize + Informationsprozedur + +PROC top margin (REAL CONST margin) + Falls der Drucker es nicht erlaubt, direkt am Blattanfang zu druk­ + ken (zum Beispiel wegen eines Einzelblatteinzugs), muß mit dieser + Prozedur die Länge des oberen Randes, den der Drucker nicht be­ + drucken kann, in cm angegeben werden. + Beispiel: top margin (2.0) + (Teilt dem Druckertreiber mit, daß die ersten 2 cm + nicht bedruckbar sind.) + +REAL PROC top margin + Informationsprozedur + +PROC std speed (TEXT CONST speed) + Parameter: slow, fast + Wahl zwischen Positionierung in Mikroschritten (slow) oder in + Blanks (fast). + Beispiel: std speed ("slow") + +TEXR PROC std speed + Informationsprozedur + +PROC std quality (TEXT CONST quality) + übliche Parameter: draft, nlq + Wahl zwischen Datenverarbeitungs-Qualität und Schönschrift- + Qualität + Beispiel: std quality ("draft") + +TEXT PROC std quality + Informationsprozedur + +PROC std typeface (TEXT CONST typeface) + übliche Parameter: roman, sansserif, courier + Wahl zwischen verschiedenen NLQ-Schriftarten (nur sichtbar im + NLQ-Modus, das heißt 'std typeface' schaltet nicht auf NLQ). + Beispiel: std typeface ("roman") + +TEXT PROC std typeface + Informationsprozedur + +PROC paper feed (TEXT CONST name) + übliche Parameter: tractor, sheet, schacht1, schacht2 + Wählt Endlospapier oder Einzelblatteinzug und ggf. Schachtnummer. + Beispiel: paper feed ("sheet") + +TEXT PROC paper feed + Informationsprozedur + + +#on("u")#Materialanweisungen \#material("...")\##off("u")# +müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und +setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben +für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge­ +stellten Standardwerten. Diese werden durch die Materialanweisung aber +nicht geändert.) + +Beispiel: \#material("nlq")\# + sorgt bei entsprechendem Treiber dafür, daß das gesamte + Dokument in Schönschrift-Qualität ausgedruckt wird, egal + wie 'std quality' eingestellt ist. + +#on("b")#Es darf in einer Datei nur eine Materialanweisung stehen!#off("b")# Sollen meh­ +rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung +erscheinen. Beispiel: \#material("sheet;draft")\# + + +#on("u")#direkte Druckeranweisungen \#"..."\##off("u")# +gelten ab der Position, an der sie in der Datei auftreten. Sie haben +(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und +Materialeinstellungen. + +Beispiel: \#"draft"\# + schaltet (bei entsprechendem Treiber) auf Datenverar­ + beitungs-Qualität, egal welche Standardeinstellung vorliegt + und welche Materialanweisung gegeben wurde. + +#on("b")#In einer Druckeranweisung darf nur eine Einstellung vorgenommen +werden.#off("b")# Also: \#"nlq"\#\#"sansserif"\# + + +#on("u")#Wichtig#off("u")# +- Achten Sie bei Materialanweisungen und direkten Druckeranweisungen + besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben + berücksichtigt! Also: \#"nlq"\# und keinesfalls \#"NLQ"\#!!! +- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und + nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann + daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse + erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen + Reihenfolge an den Drucker sendet, als er in der Datei steht, die + mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B. + für beide Spalten) unerwünscht erhalten bleibt. + + +#on("u")#Tabelle#off("u")# +Die Tabelle soll einen Anhaltspunkt dafür geben, wie welche Einstel­ +lungen erfolgen können. + +#type("17")# + Steuerprozeduren Materialanweisungen direkte Druckeranweisungen + +#on("u")#                                                                                          #off("u")# + +Positionierung std speed slow, fast ------ + slow, fast + +Qualität std quality z.B. draft, nlq z.B. draft, nlq + z.B. draft, nlq + +Schriftart std typeface z.B. roman, z.B. roman, +(nur bei NLQ) z.B. roman, sansserif, courier sansserif, courier + sansserif, courier + +Einzelblatt- paper feed z.B. schacht1, z.B. schacht1, +einzug z.B. tractor, schacht2 schacht2 + sheet, + schacht1, schacht2 + +Farbdruck ------ ------ z.B. schwarz, + rot, blau, + violett, gelb + orange, grün + + + +#type("nlq10")##on("b")#4. Weitere Hinweise#off("b")# + +#on("u")#Zeichensatzänderungen gegenüber früheren Versionen#off("u")# +In den Fonttabellen früherer Druckertreiber-Versionen wurden oberhalb +des Codes 127 einige internationale Zeichen zur Verfügung gestellt +(und zwar in Anlehnung an den Agfa-Laserdrucker-Zeichensatz). +Bei den Treibern der vorliegenden Version gilt folgendes: +- Wie bisher wird der volle im Benutzerhandbuch festgelegte EUMEL- + Zeichensatz (sofern möglich) unterstützt. +- Der Code 252 liefert das Paragraphzeichen. +- Alle übrigen (vom EUMEL-Zeichensatz nicht definierten) Zeichencodes + oberhalb 127 liefern, sofern möglich, die entsprechenden Zeichen des + IBM-Grafikzeichensatzes. + + +#on("u")#Hinweis zu Proportionalschriften#off("u")# +Bei Proportionalschriften sollte die Modifikation \#on("i")\# nicht +benutzt werden, da die kursiven Zeichen andere Proportionalbreiten +haben. Stattdessen sollte auf den schrägen Typ umgeschaltet werden +(z.B. von "prop10" auf "prop10i"). + + +#on("u")#Hinweis zur Benutzung von Einzelblatteinzügen#off("u")# +Bei der Benutzung von Einzelblatteinzügen müssen folgende Einstel­ +lungen vorgenommen werden (vgl. auch Abschnitt 3!): + + Am Drucker: +1. Sie müssen Ihren Drucker auf die Option Einzelblatteinzug konfigu­ + rieren (siehe Druckerhandbuch!). + + In der Druckspooltask (meist 'PRINTER'): +2. Falls der Druckertreiber die Steuerprozedur 'paper feed' zur Verfü­ + gung stellt, müssen Sie mit 'paperfeed ("sheet")' oder (für + 2-Schacht-Einzüge) mit 'paperfeed ("schacht1")' bzw. 'paperfeed + ("schacht2")' den Druckertreiber auf Einzelblatteinzug umschalten. +3. Falls Sie eine andere Papierlänge als 12 Zoll (=30.48 cm) verwen­ + den, müssen Sie die neuen Papiermaße mit 'papersize' in cm einstel­ + len. + Beispiel: papersize (21.0, 29.7) + (für DIN A4-Blätter) +4. Falls der Drucker mit dem Einzelblatteinzug nicht direkt am Blatt­ + anfang drucken kann, sondern ein gewisser oberer Rand bleibt, muß + mit 'top margin' die Länge des nicht bedruckbaren Randes in cm dem + Druckertreiber mitgeteilt werden. + Beispiel: top margin (1.5) + (Wie groß der obere Rand ist, kann festgestellt werden, indem eine + Datei mit \#start(0.0,0.0)\# ausgedruckt wird.) + + Wurde mit 'top margin' dem Treiber die Größe der nicht bedruckbaren + Fläche mitgeteilt, so ist darauf zu achten, daß in den Druckdateien + ein genügend großer y-Wert für die Startposition eingestellt wird + ('start'-Anweisung). Andernfalls kommt es bei der Ausgabe in der + ersten Zeile zu Überschreibungen. + + +#on("b")#5. Die Änderungen, die Sie in der Druckspooltask vorgenommen haben + werden erst wirksam, wenn das Spool-Kommando 'start' gegeben wird.#off("b")# + diff --git a/system/printer-9nadel/0.9/source-disk b/system/printer-9nadel/0.9/source-disk new file mode 100644 index 0000000..ddcd852 --- /dev/null +++ b/system/printer-9nadel/0.9/source-disk @@ -0,0 +1 @@ +grundpaket/06_std.printer_9_nadel.img diff --git a/system/printer-9nadel/0.9/src/beschreibungen9 b/system/printer-9nadel/0.9/src/beschreibungen9 new file mode 100644 index 0000000..6a74b88 --- /dev/null +++ b/system/printer-9nadel/0.9/src/beschreibungen9 @@ -0,0 +1,97 @@ + +(*************************************************************************) +(* Stand : 01.10.88 *) +(* Beschreibungen-Datei für 9-Nadel-Drucker Version : 0.9 *) +(* Autoren : mov/hjh *) +(*************************************************************************) + +$fx85$ +head;hfx85;decl;speed;openh;opendoch;initspeed;opendocfx85;openpge;betwoc; +clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end + +$fx800$ +head;hfx800;decl;quality;typeface;openh;opendoch;opendocfx800;openpge;betwoc; +clpge;betwce;cmdfx800;crs;moh;mofx800;ymodr;onoff;tyfx800;end + +$mx$ +head;hmx;decl;speed;openh;opendoch;initspeed;opendocmx;openpge;betwoc;clpge; +betwce;cmd;crs;moh;modrmx;onoff;tymx;end + +$lx800$ +head;hlx800;decl;speed;quality;typeface;openh;opendoch;initspeed; +opendocfx800;openpge;betwoc;clpge;betwce;cmdfx800;crs;moh;mofx85;ymodr;onoff; +tyfx800;end + +$ibmgp$ +head;hgp;decl;speed;openh;opendoch;initspeed;opendocgp;openpge;betwoc; +clpge;betwce;cmd;crs;moh;mogp;ymodr;onoff;tyfx85;end + +$ibmpp$ +head;hpp;decl;speed;quality;openh;opendoch;initspeed;opendocpp;openpge; +betwoc;clpge;betwce;cmdpp;crs;moh;mofx85;ymodr;onoffpp;tyfx85;end + +$okiml182i$ +head;hml182i;decl;speed;quality;openh;opendoch;initspeed;opendocml182i; +opendocgp;openpge;betwoc;clpge;betwce;cmdml182i;crs;moh;mogp;ymodr;onoff; +tyohnesmall;end + +$okiml192el$ +head;hml192el;decl;speed;feed;openh;opendoch;initspeed;opendocml192el; +openpgemlsf;betwoc;clmlsf;betwce;cmd;crs;moh;moml192el;ymodr;onoff;tyml192el; +end + +$okiml292el$ +head;hml292el;decl;quality;typeface292;feed;openh;opendoch;opendocml292el; +openpgemlsf;betwoc;clmlsf;betwce;cmdml292el;crs;moh;mofx800;ymodr;onoff; +tyml292el;end + +$okiml294i$ +head;hml294i;decl;speed;quality;feed;openh;opendoch;initspeed;opendocml294i; +openpgemlsf;betwoc;clmlsf;betwce;cmdml294i;crs;moh;mofx85;ymodr;ontyml294i;end + +$okiml320$ +head;hml320;decl;speed;openh;opendoch;initspeed;opendocml320; +openpge;betwoc;clpge;betwce;cmd;crs;moh;moml192el;ymodr;onoff;tyml192el; +end + +$starlc10$ +head;hlc10;decl;quality;typefacelc10;openh;opendoch;opendoclc10;openpge; +betwoc;clpge;betwce;cmdlc10;crs;moh;mofx800;ymodr;onoff;tyfx800;end + +$dmp4000$ +head;hdmp4000;decl;speed;openh;opendoch;initspeed;opendocdmp4000;openpge; +betwoc;clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end + +$starnx15$ +head;hnx15;decl;speed;openh;opendoch;initspeed;opendocnx15;openpge;betwoc; +clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end + +$mt230$ +head;hmt230;decl;speed;feedschacht;openh;opendoch;initspeed;opendocmt; +openpgemtsf;betwoc;clmtsf;betwce;cmdmt230;crs;moh;mofx85;ymodr;onoff; +tyfx85;end + +$mt340$ +head;hmt340;decl;speed;feedschacht;openh;opendoch;initspeed;opendocmt; +openpgemtsf;betwoc;clmtsf;betwce;cmdmt230;crs;moh;moml192el;ymodr;onoff; +tyml192el;end + +$citi120d$ +head;h120d;decl;openh;opendoch;opendoc120d;openpge;betwoc; +clpge;betwce;cmd;crs;moh;mofx800;ymodr;onoff;tyfx85;end + +$citohc310cxp$ +head;hc310;decl;speed;feedschacht;openh;opendoch;initspeed;opendocc310; +openpgec310sf;betwoc;clc310sf;betwce;cmdc310;crs;moh;mofx85;ymodr;onoff; +tyfx85;end + +$citohci3500$ +head;hci3500;decl;speed;openh;opendoch;initspeed;opendocgp;openpge;betwoc; +clpge;betwce;cmd;crs;moh;mogp;ymodr;onoff;tyfx85;end + +$fujdx2100$ +head;hdx2100;decl;speed;feed;openh;opendoch;initspeed;opendocdx2100; +openpge;betwoc;clpge;betwce;cmddx2100;crs;moh;moml192el;ymodr;onoff;tyml192el; +end + + diff --git a/system/printer-9nadel/0.9/src/fonttab.1 b/system/printer-9nadel/0.9/src/fonttab.1 new file mode 100644 index 0000000..b5d17e6 Binary files /dev/null and b/system/printer-9nadel/0.9/src/fonttab.1 differ diff --git a/system/printer-9nadel/0.9/src/fonttab.10 b/system/printer-9nadel/0.9/src/fonttab.10 new file mode 100644 index 0000000..6a13c49 Binary files /dev/null and b/system/printer-9nadel/0.9/src/fonttab.10 differ diff --git a/system/printer-9nadel/0.9/src/fonttab.20 b/system/printer-9nadel/0.9/src/fonttab.20 new file mode 100644 index 0000000..7cf0aaf Binary files /dev/null and b/system/printer-9nadel/0.9/src/fonttab.20 differ diff --git a/system/printer-9nadel/0.9/src/fonttab.20.lc b/system/printer-9nadel/0.9/src/fonttab.20.lc new file mode 100644 index 0000000..ddf4535 Binary files /dev/null and b/system/printer-9nadel/0.9/src/fonttab.20.lc differ diff --git a/system/printer-9nadel/0.9/src/fonttab.20.lx b/system/printer-9nadel/0.9/src/fonttab.20.lx new file mode 100644 index 0000000..1ce0940 Binary files /dev/null and b/system/printer-9nadel/0.9/src/fonttab.20.lx differ diff --git a/system/printer-9nadel/0.9/src/fonttab.7 b/system/printer-9nadel/0.9/src/fonttab.7 new file mode 100644 index 0000000..676b9a0 Binary files /dev/null and b/system/printer-9nadel/0.9/src/fonttab.7 differ diff --git a/system/printer-9nadel/0.9/src/fonttab.7.cxp b/system/printer-9nadel/0.9/src/fonttab.7.cxp new file mode 100644 index 0000000..0a996f3 Binary files /dev/null and b/system/printer-9nadel/0.9/src/fonttab.7.cxp differ diff --git a/system/printer-9nadel/0.9/src/fonttab.7.fuj b/system/printer-9nadel/0.9/src/fonttab.7.fuj new file mode 100644 index 0000000..1ed83be Binary files /dev/null and b/system/printer-9nadel/0.9/src/fonttab.7.fuj differ diff --git a/system/printer-9nadel/0.9/src/fonttab.7.mt b/system/printer-9nadel/0.9/src/fonttab.7.mt new file mode 100644 index 0000000..c816646 Binary files /dev/null and b/system/printer-9nadel/0.9/src/fonttab.7.mt differ diff --git a/system/printer-9nadel/0.9/src/module9 b/system/printer-9nadel/0.9/src/module9 new file mode 100644 index 0000000..65de1ee --- /dev/null +++ b/system/printer-9nadel/0.9/src/module9 @@ -0,0 +1,1099 @@ + +(*************************************************************************) +(* Stand : 01.10.88 *) +(* Module-Datei für 9-Nadel-Drucker Version : 0.9 *) +(* Autoren : mov/hjh *) +(*************************************************************************) + +$head$ +PACKET printer driver + + DEFINES printer, + open, + close, + execute, + paper size, + top margin, + +$hfx85$ std speed: +(* Treiber für EPSON FX85/105, automatisch generiert *) + +$hfx800$ std quality, + std typeface: +(* Treiber für EPSON FX800/1000, automatisch generiert *) +BOOL VAR was tall font; + +$hmx$ std speed: +(* Treiber für EPSON MX80/100, Typ III *) +(* Treiber automatisch generiert *) +BOOL VAR is condensed, is small; + +$hlx800$ std speed, + std quality, + std typeface: +(* Treiber für EPSON LX800/1000, automatisch generiert *) +BOOL VAR was tall font; + +$hgp$ std speed: +(* Treiber für IBM-Grafikdrucker *) +(* Treiber automatisch generiert *) + +$hpp$ std speed, + std quality: +(* Treiber für IBM-Proprinter *) +(* Treiber automatisch generiert *) + +$hml182i$ std speed, + std quality: +(* Treiber für OKI ML182/183 IBM-kompatibel *) +(* Treiber automatisch generiert *) + +$hml192el$ paper feed, + std speed: +(* Treiber für OKI ML192/193 Elite *) +(* Treiber automatisch generiert *) +BOOL VAR prop font; + +$hml292el$ std quality, + std typeface, + paper feed: +(* Treiber für OKI ML292/293 Elite *) +(* Treiber automatisch generiert *) +BOOL VAR was tall font; + +$hml294i$ std speed, + paper feed, + std quality: +(* Treiber für OKI ML294 IBM-kompatibel *) +(* Treiber automatisch generiert *) + +$hml320$ std speed: +(* Treiber für OKI ML320 IBM/EPSON-kompatibel *) +(* Treiber automatisch generiert *) +BOOL VAR prop font; + +$hlc10$ std quality, + std typeface: +(* Treiber für Star LC-10 oder LC-10 Colour *) +(* Treiber automatisch generiert *) +BOOL VAR was tall font; + +$hdmp4000$ std speed: +(* Treiber für Schneider DMP4000, automatisch generiert *) + +$hnx15$ std speed: +(* Treiber für Star NX-15, ND-10, ND-15, NR-10 und NR-15 *) +(* Treiber automatisch generiert *) + +$hmt230$ paper feed, + std speed: +(* Treiber für Mannesmann-Tally MT 230 *) +(* Treiber automatisch generiert *) + +$hmt340$ paper feed, + std speed: +(* Treiber für Mannesmann-Tally MT 340 *) +(* Treiber automatisch generiert *) +BOOL VAR prop font := FALSE; + +$h120d$ : +(* Treiber für Citizen 120-D *) +(* Treiber automatisch generiert *) + +$hc310$ paper feed, + std speed: +(* Treiber für C. Itoh C 310/315 CXP *) +(* Treiber automatisch generiert *) + +$hci3500$ std speed: +(* Treiber für C. Itoh CI-3500 *) +(* Treiber automatisch generiert *) + +$hdx2100$ paper feed, + std speed: +(* Treiber für Fujitsu DX 2100 *) +(* Treiber automatisch generiert *) +BOOL VAR prop font := FALSE ; + +$decl$ +INT VAR blankbreite, x rest, y rest, high, low, small, modifikations; +REAL VAR x size, y size, y margin; +TEXT VAR buffer :: ""; + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); +END PROC paper size; + +papersize (20.32, 30.48); + +PROC top margin (REAL CONST margin): + + y margin := margin +END PROC top margin; + +REAL PROC top margin: y margin END PROC top margin; + +top margin (0.0); + +$speed$ +BOOL VAR is slow; +TEXT VAR std speed name :: "slow"; + +PROC std speed (TEXT CONST speed) : + + IF speed = "fast" OR speed = "slow" + THEN std speed name := speed + ELSE errorstop ("unzulässige Geschwindigkeit") + FI +END PROC std speed; + +TEXT PROC std speed : std speed name END PROC std speed; + +$quality$ +TEXT VAR std quality name :: "draft"; + +PROC std quality (TEXT CONST quality) : + + IF quality = "nlq" OR quality = "draft" + THEN std quality name := quality + ELSE errorstop ("unzulässige Qualitätsbezeichnung") + FI +END PROC std quality; + +TEXT PROC std quality : std quality name END PROC std quality; + +$typeface$ +TEXT VAR std typeface name :: ""; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "roman" OR typeface = "sansserif" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : std typeface name END PROC std typeface; + +$typeface292$ +TEXT VAR std typeface name :: ""; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "courier" OR typeface = "sansserif" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : std typeface name END PROC std typeface; + +$typefacelc10$ +TEXT VAR std typeface name :: ""; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "courier" OR typeface = "sansserif" + OR typeface = "orator1" OR typeface = "orator2" + THEN std typeface name := typeface + ELSE errorstop ("unzulässige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : std typeface name END PROC std typeface; + +$feed$ +TEXT VAR feeder name :: "tractor"; + +PROC paper feed (TEXT CONST feeder) : + + IF feeder = "sheet" OR feeder = "tractor" + THEN feeder name := feeder + ELSE errorstop ("unzulässige Einzugsart") + FI +END PROC paper feed; + +TEXT PROC paper feed: feeder name END PROC paper feed; + +$feedschacht$ +TEXT VAR act feeder :: "", + feeder name :: "tractor"; + +PROC paper feed (TEXT CONST feeder) : + + IF feeder = "tractor" OR feeder = "schacht1" OR feeder = "schacht2" + THEN feeder name := feeder + ELIF feeder = "sheet" + THEN feeder name := "schacht1" + ELSE errorstop ("unzulässige Einzugsart") + FI +END PROC paper feed; + +TEXT PROC paper feed: feeder name END PROC paper feed; + +$openh$ +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE 1: open document + CASE 2: open page +END SELECT. + +$opendoch$ + open document : + modifikations := 0; + param 1 := x step conversion ( x size ); + param 2 := y step conversion ( y size ); +$initspeed$ + IF pos (material, "slow") <> 0 + THEN is slow := TRUE; + ELIF pos (material, "fast") <> 0 + THEN is slow := FALSE; + ELSE is slow := std speed name = "slow" + FI; +$opendocfx85$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"27"6"); + out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *) + +$opendocfx800$ + param 2 := (param 2 DIV 36) * 36; + was tall font := TRUE; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"); (* Zeichentabelle 4 (Grafik) *) + out (""27"R"0""27"9"27"O"27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + IF pos (material, "nlq") <> 0 + THEN out (""27"x"1"") + ELIF pos (material, "draft") <> 0 + THEN out (""27"x"0"") + ELIF std quality name = "nlq" + THEN out (""27"x"1"") + ELSE out (""27"x"0"") + FI; + IF pos (material, "roman") <> 0 + THEN out (""27"k"0"") + ELIF pos (material, "sansserif") <> 0 + THEN out (""27"k"1"") + ELIF std typeface name = "roman" + THEN out (""27"k"0"") + ELIF std typeface name = "sansserif" + THEN out (""27"k"1"") + FI. + +$opendocmx$ + param 2 := (param 2 DIV 36) * 36; + out (""27"R"0""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"9"27"O"). + +$opendocgp$ + param 2 := (param 2 DIV 36) * 36; + out (""27"6"); (* Zeichensatz 2 *) + out (""18""27"F"27"H"27"W"0""27"T"27"-"0""); (* Modifikationen rücksetzen *) + out (""27"9"27"O"27"A"12""27"2"); + out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *) + +$opendocpp$ + param 2 := (param 2 DIV 36) * 36; + out (""27"6"); (* Zeichensatz 2 *) + out (""18""27"F"27"W"0""27"T"27"-"0""); (* Modifikationen rücksetzen *) + out (""27"9"27"O"27"A"12""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + IF pos (material, "nlq") <> 0 + THEN out (""27"G") + ELIF pos (material, "draft") <> 0 + THEN out (""27"H") + ELIF std quality name = "nlq" + THEN out (""27"G") + ELSE out (""27"H") + FI. + +$opendocml182i$ + IF pos (material, "nlq") <> 0 + THEN out (""27"I3") + ELIF pos (material, "draft") <> 0 + THEN out (""27"I1") + ELIF std quality name = "nlq" + THEN out (""27"I3") + ELSE out (""27"I1") + FI; + out (""27"N"0""); (* Kein Sprung über Perf. *) + +$opendocml192el$ + param 2 := (param 2 DIV 36) * 36; + prop font := FALSE; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"6"); (* Erweiterung des Zeichensatzes *) + out (""27"9"27"O"27"x"0""). + +$opendocml292el$ + param 2 := (param 2 DIV 36) * 36; + was tall font := TRUE; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"); (* Zeichentabelle 4 (Grafik) *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"9"27"O"27"r0"); + IF pos (material, "nlq") <> 0 + THEN out (""27"x"1"") + ELIF pos (material, "draft") <> 0 + THEN out (""27"x"0"") + ELIF std quality name = "nlq" + THEN out (""27"x"1"") + ELSE out (""27"x"0"") + FI; + IF pos (material, "courier") <> 0 + THEN out (""27"k"0"") + ELIF pos (material, "sansserif") <> 0 + THEN out (""27"k"1"") + ELIF std typeface name = "courier" + THEN out (""27"k"0"") + ELIF std typeface name = "sansserif" + THEN out (""27"k"1"") + FI. + +$opendocml294i$ + param 2 := (param 2 DIV 36) * 36; + out (""27"6"); (* Zeichensatz 2 *) + out (""18""27"F"27"W0"27"T"27"-0"27"%H"); (* Modifikationen rücksetzen *) + out (""27"9"27"O"27"A"12""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + IF pos (material, "nlq") <> 0 + THEN out (""27"G") + ELIF pos (material, "draft") <> 0 + THEN out (""27"H") + ELIF std quality name = "nlq" + THEN out (""27"G") + ELSE out (""27"H") + FI. + +$opendocml320$ + param 2 := (param 2 DIV 36) * 36; + prop font := FALSE; + out (""27"{"99""27"{"40""); (* Umschaltung auf EPSON-Emulation *) + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"6"); (* Erweiterung des Zeichensatzes *) + out (""27"9"27"O"27"x"0""). + +$opendoclc10$ + param 2 := (param 2 DIV 36) * 36; + was tall font := TRUE; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"); (* Zeichentabelle 4 (Grafik) *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"9"27"r"0""); + IF pos (material, "nlq") <> 0 + THEN out (""27"x"1"") + ELIF pos (material, "draft") <> 0 + THEN out (""27"x"0"") + ELIF std quality name = "nlq" + THEN out (""27"x"1"") + ELSE out (""27"x"0"") + FI; + IF pos (material, "courier") <> 0 + THEN out (""27"k"0"") + ELIF pos (material, "sansserif") <> 0 + THEN out (""27"k"1"") + ELIF pos (material, "orator1") <> 0 + THEN out (""27"k"2"") + ELIF pos (material, "orator2") <> 0 + THEN out (""27"k"3"") + ELIF std typeface name = "courier" + THEN out (""27"k"0"") + ELIF std typeface name = "sansserif" + THEN out (""27"k"1"") + ELIF std typeface name = "orator1" + THEN out (""27"k"2"") + ELIF std typeface name = "orator2" + THEN out (""27"k"3"") + FI. + +$opendocnx15$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"6"); (* Erweiterung des Zeichensatzes *) + out (""27"9"27"x"0""). + +$opendocdmp4000$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"m"0""27"R"0""27"9"27"O"27"2"27"6"); + out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *) + +$opendocmt$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"O"27"x"0""27"r"0""27"6"); + IF feeder name = "tractor" + THEN act feeder := feeder name; + out (""27"[5{") + ELSE out (""27"[0{"); + IF pos (material, "schacht1") <> 0 + THEN act feeder := "schacht1" + ELIF pos (material, "schacht2") <> 0 + THEN act feeder := "schacht2" + ELSE act feeder := feeder name + FI + FI. + +$opendocdx2100$ +param 2 := (param 2 DIV 36) * 36; +out (""24""27""64""); (* Reset des Druckers *) +out (""27"R"0""); (* US-Zeichensatz *) +out (""27"2" + ""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) +out (""27"N"0""); (* skip perforation *) +out (""27"x"0"" + ""27"r"0""). (* draft und black *) + + +$opendoc120d$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"9"27"O"27"x0"27"2"); + out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *) + +$opendocc310$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"O"27"x"0""27"r"0""27"6"); + IF feeder name = "tractor" + THEN act feeder := feeder name; + ELSE IF pos (material, "schacht1") <> 0 + THEN act feeder := "schacht1" + ELIF pos (material, "schacht2") <> 0 + THEN act feeder := "schacht2" + ELSE act feeder := feeder name + FI + FI. + +$openpge$ + open page : + param 1 := 0; + param 2 := y step conversion (y margin); + x rest := 0; + y rest := 0; + small := 0; + out (""13""). +$openpgemlsf$ + open page : + param 1 := 0; + param 2 := 0; + x rest := 0; + y rest := 0; + small := 0; + IF feeder name = "sheet" THEN out (""12"") FI; + out (""13""). +$openpgemtsf$ + open page : + param 1 := 0; + param 2 := 0; + x rest := 0; + y rest := 0; + small := 0; + IF feeder name = "schacht1" + THEN out (""27"[21{"12"") + ELIF feeder name = "schacht2" + THEN out (""27"[22{"12"") + FI; + out (""13""). + +$openpgec310sf$ + open page : + param 1 := 0; + param 2 := 0; + x rest := 0; + y rest := 0; + small := 0; + IF feeder name = "schacht1" + THEN out (""27""25"1"12"") + ELIF feeder name = "schacht2" + THEN out (""27""25"2"12"") + FI; + out (""13""). + +$betwoc$ +END PROC open; + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE 1: close document + CASE 2: close page +END SELECT. +close document : +$clpge$ +. close page : + IF param 1 > 0 THEN out (""12"") FI. +$clmlsf$ +.close page : + IF feeder name = "sheet" + THEN out (""27""25""3"") + ELIF param 1 > 0 + THEN out (""12"") + FI. +$clmtsf$ +.close page : + IF feeder name <> "tractor" + THEN out (""27"[2J") + ELIF param 1 > 0 + THEN out (""12"") + FI. +$clc310sf$ +.close page : + IF feeder name = "sheet" + THEN out (""27""25"R") + ELIF param 1 > 0 + THEN out (""12"") + FI. + +$betwce$ +END PROC close; + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE 1: write text + CASE 2: write cmd + CASE 3: carriage return + CASE 4: move + CASE 5: draw + CASE 6: on + CASE 7: off + CASE 8: type +END SELECT. + +is underline: bit (modifikations, 0). +is bold : bit (modifikations, 1). +is italics : bit (modifikations, 2). + + write text : + out subtext (string, param 1, param 2). +$cmd$ + write cmd : + out subtext (string, param 1, param 2). +$cmdfx800$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"x"0"") + ELIF buffer = "nlq" + THEN out (""27"x"1"") + ELIF buffer = "roman" + THEN out (""27"k"0"") + ELIF buffer = "sansserif" + THEN out (""27"k"1"") + ELSE out (buffer) + FI. +$cmdpp$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"H") + ELIF buffer = "nlq" + THEN out (""27"G") + ELSE out (buffer) + FI. +$cmdml182i$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"I1") + ELIF buffer = "nlq" + THEN out (""27"I3") + ELSE out (buffer) + FI. +$cmdml292el$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"x"0"") + ELIF buffer = "nlq" + THEN out (""27"x"1"") + ELIF buffer = "courier" + THEN out (""27"k"0"") + ELIF buffer = "sansserif" + THEN out (""27"k"1"") + ELIF buffer = "schwarz" + THEN out (""27"r0") + ELIF buffer = "rot" + THEN out (""27"r1") + ELIF buffer = "blau" + THEN out (""27"r2") + ELIF buffer = "violett" + THEN out (""27"r3") + ELIF buffer = "gelb" + THEN out (""27"r4") + ELIF buffer = "orange" + THEN out (""27"r5") + ELIF buffer = "grün" + THEN out (""27"r6") + ELSE out (buffer) + FI. +$cmdml294i$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"H") + ELIF buffer = "nlq" + THEN out (""27"G") + ELIF buffer = "schwarz" + THEN out (""27"r0") + ELIF buffer = "rot" + THEN out (""27"r1") + ELIF buffer = "blau" + THEN out (""27"r2") + ELIF buffer = "violett" + THEN out (""27"r3") + ELIF buffer = "gelb" + THEN out (""27"r4") + ELIF buffer = "orange" + THEN out (""27"r5") + ELIF buffer = "grün" + THEN out (""27"r6") + ELSE out (buffer) + FI. +$cmdlc10$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"x"0"") + ELIF buffer = "nlq" + THEN out (""27"x"1"") + ELIF buffer = "courier" + THEN out (""27"k"0"") + ELIF buffer = "sansserif" + THEN out (""27"k"1"") + ELIF buffer = "orator1" + THEN out (""27"k"2"") + ELIF buffer = "orator2" + THEN out (""27"k"3"") + ELIF buffer = "schwarz" + THEN out (""27"r"0"") + ELIF buffer = "rot" + THEN out (""27"r"1"") + ELIF buffer = "blau" + THEN out (""27"r"2"") + ELIF buffer = "violett" + THEN out (""27"r"3"") + ELIF buffer = "gelb" + THEN out (""27"r"4"") + ELIF buffer = "orange" + THEN out (""27"r"5"") + ELIF buffer = "grün" + THEN out (""27"r"6"") + ELSE out (buffer) + FI. +$cmdmt230$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF feeder name <> "tractor" + THEN IF buffer = "schacht1" OR buffer = "schacht2" + THEN act feeder := buffer + FI + ELIF buffer = "schwarz" + THEN out (""27"r"0"") + ELIF buffer = "magenta" + THEN out (""27"r"1"") + ELIF buffer = "cyan" + THEN out (""27"r"2"") + ELIF buffer = "blau" + THEN out (""27"r"3"") + ELIF buffer = "gelb" + THEN out (""27"r"4"") + ELIF buffer = "rot" + THEN out (""27"r"5"") + ELIF buffer = "grün" + THEN out (""27"r"6"") + ELSE out (buffer) + FI. + +$cmdc310$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF feeder name <> "tractor" + THEN IF buffer = "schacht1" OR buffer = "schacht2" + THEN act feeder := buffer + FI + ELIF buffer = "schwarz" + THEN out (""27"r"0"") + ELIF buffer = "rot" + THEN out (""27"r"1"") + ELIF buffer = "blau" + THEN out (""27"r"2"") + ELIF buffer = "violett" + THEN out (""27"r"3"") + ELIF buffer = "gelb" + THEN out (""27"r"4"") + ELIF buffer = "orange" + THEN out (""27"r"5"") + ELIF buffer = "grün" + THEN out (""27"r"6"") + ELSE out (buffer) + FI. + +$cmddx2100$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "schwarz" + THEN out (""27"r"0"") + ELIF buffer = "rot" + THEN out (""27"r"1"") + ELIF buffer = "blau" + THEN out (""27"r"2"") + ELIF buffer = "violett" + THEN out (""27"r"3"") + ELIF buffer = "gelb" + THEN out (""27"r"4"") + ELIF buffer = "orange" + THEN out (""27"r"5"") + ELIF buffer = "grün" + THEN out (""27"r"6"") + ELSE out (buffer) + FI. + +$crs$ + carriage return : + y rest INCR small; + x rest := 0; + small := 0; + out (""13""). +$moh$ +x steps : param1. +y steps : param2. + +move : + IF x steps < 0 OR y steps < 0 THEN stop FI; + IF x steps > 0 THEN x move FI; + IF y steps > 0 THEN y move FI. + +$mofx85$ +x move : + high := (x steps + x rest) DIV blankbreite; + x rest := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF x rest > 0 AND is slow + THEN IF is underline THEN out (" "8"") FI; + out (""27"Y"+ code (x rest) + ""0""); + x rest TIMESOUT ""0""; + x rest := 0 + FI. + + +$mofx800$ +x move : + IF is underline + THEN underline x move + ELSE simple x move + FI. + +underline x move: + high := (x steps + x rest) DIV blankbreite; + low := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF low > 0 + THEN out (" "8""27"\"+ code (low) + ""0"") + FI. + +simple x move: + out (""27"\"); + out (code (x steps MOD 256)); + out (code (x steps DIV 256)). + +$modrmx$ +x move : + high := (x steps + x rest) DIV blankbreite; + low := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF low > 0 AND is slow + THEN IF is underline THEN out ("_"8"") FI; + IF is condensed + THEN high := low; + low := 0; + out (""27"L"+ code (high) + ""0""); + ELSE high := low DIV 2; + low := low MOD 2; + out (""27"K"+ code (high) + ""0""); + FI; + high TIMESOUT ""0""; + IF is small + THEN out (""27"S"1""); + small DECR 1; + FI; + FI; + x rest := low. + +y move : + y rest INCR y steps; + IF y rest > 0 + THEN high := y rest DIV 255; + low := y rest MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; + y rest := 0 + FI. + +draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> 1 + THEN stop + ELIF x steps > 0 + THEN x draw + FI. + +x draw : + out (""27"L"); + out (code (x steps MOD 256)); + out (code (x steps DIV 256)); + x steps TIMESOUT ""1""; + IF is small THEN out (""27"S"1"") FI. + +$mogp$ +x move : + high := (x steps + x rest) DIV blankbreite; + x rest := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF x rest > 0 AND is slow + THEN IF is underline + THEN out (" "13""27"Y"); + out (code (x pos MOD 256)); + out (code (x pos DIV 256)); + x pos TIMESOUT ""0"" + ELSE out (""27"Y"+ code (x rest) + ""0""); + x rest TIMESOUT ""0"" + FI; + x rest := 0 + FI. + +$moml192el$ +x move : + high := (x steps + x rest) DIV blankbreite; + x rest := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF x rest > 0 AND is slow + THEN IF is underline THEN + IF prop font THEN + out (""27"p"0"" + " "8"" + ""27"p"1"") + ELSE + out (" "8"") + FI; + FI; + out (""27"Y"+ code (x rest) + ""0""); + x rest TIMESOUT ""0""; + x rest := 0 + FI. + +$ymodr$ +y move : + y rest INCR y steps; + IF y rest > 0 + THEN high := y rest DIV 255; + low := y rest MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; + y rest := 0 + FI. + +draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> 1 + THEN stop + ELIF x steps > 0 + THEN x draw + FI. + +x draw : + out (""27"Y"); + out (code (x steps MOD 256)); + out (code (x steps DIV 256)); + x steps TIMESOUT ""1"". + +$onoff$ + on : + IF on string (param 1) <> "" + THEN out (on string (param 1)); + modifikations := modifikations OR param 1 + ELSE stop + FI. + + off : + IF off string (param 1) <> "" + THEN out (off string (param 1)); + modifikations := modifikations AND (param 1 XOR -1) + ELSE stop + FI. + +$onoffpp$ + on : + IF on string (param 1) <> "" AND param 1 <> 2 + THEN out (on string (param 1)); + modifikations := modifikations OR param 1 + ELSE stop + FI. + + off : + IF off string (param 1) <> "" AND param 1 <> 2 + THEN out (off string (param 1)); + modifikations := modifikations AND (param 1 XOR -1) + ELSE stop + FI. + +$tyfx85$ + type : + buffer := font string (param 1); + out (buffer); + restore modifikations; + blankbreite := char pitch (param 1, " "); + IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI. + +$tyfx800$ + type : + buffer := font string (param 1); + IF was tall font + THEN out (""27"w"0"") + FI; + out (buffer); + restore modifikations; + blankbreite := char pitch (param 1, " "); + was tall font := pos (buffer, ""27"w"1"") <> 0. + +$tymx$ + type : + buffer := font string (param 1); + blankbreite := char pitch (param 1, " "); + is condensed := pos (buffer, ""15"") <> 0; + IF pos (buffer, ""27"S") <> 0 + THEN small DECR 1; + is small := TRUE; + ELSE is small := FALSE; + FI; + out (buffer); + restore modifikations. + +$tyohnesmall$ + type : + buffer := font string (param 1); + out (buffer); + restore modifikations; + blankbreite := char pitch (param 1, " "). + +$tyml192el$ + type : + buffer := font string (param 1); + out (buffer); + restore modifikations; + blankbreite := char pitch (param 1, " "); + prop font := pos (buffer, ""27"p"1"") <> 0; + IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI. + +$tyml292el$ + type : + buffer := font string (param 1); + IF was tall font + THEN out (""27""31"0"27"U0") + FI; + was tall font := pos (buffer, ""27"w"1"") <> 0; + change all (buffer, ""27"w"0"", ""27""31"0"27"U0"); + change all (buffer, ""27"w"1"", ""27""31"1"27"U1"); + out (buffer); + restore modifikations; + blankbreite := char pitch (param 1, " "). + +$ontyml294i$ + on : + IF on string (param 1) <> "" AND param 1 <> 2 + THEN out (on string (param 1)); + modifikations := modifikations OR param 1 + ELIF param 1 = 4 + THEN out (""27"%G"); + modifikations := modifikations OR param 1 + ELSE stop + FI. + + off : + IF off string (param 1) <> "" AND param 1 <> 2 + THEN out (off string (param 1)); + modifikations := modifikations AND (param 1 XOR -1) + ELIF param 1 = 4 + THEN out (""27"%H"); + modifikations := modifikations AND (param 1 XOR -1) + ELSE stop + FI. + + type : + buffer := font string (param 1); + out (buffer); + IF is underline THEN out (on string (1)) FI; + IF is bold THEN out (on string (2)) FI; + IF is italics THEN out (""27"%G") FI; + blankbreite := char pitch (param 1, " "); + IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI. + +$end$ + restore modifikations: + IF is underline THEN out (on string (1)) FI; + IF is bold THEN out (on string (2)) FI; + IF is italics THEN out (on string (4)) FI. + +END PROC execute; + +INT VAR reply; DATASPACE VAR ds; FILE VAR file; + +PROC printer: + + disable stop; + continue (server channel); + check error (error message); + ds := nilspace; + REP forget (ds); + execute print; + IF is error AND online THEN put error; clear error; FI; + PER; +END PROC printer; + +PROC execute print: + + LET ack = 0, fetch code = 11, file type = 1003; + enable stop; + ds := nilspace; + call (father, fetch code, ds, reply); + IF reply = ack CAND type (ds) = file type + THEN file := sequential file (input, ds); + print (file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; +END PROC execute print; + +PROC check error(TEXT CONST message): + + IF is error + THEN clear error; rename myself (message); + IF is error THEN end(myself) FI; + pause (9000); end(myself); + FI; +END PROC check error; + +END PACKET printerdriver + + diff --git a/system/printer-9nadel/0.9/src/printer.neun.nadel b/system/printer-9nadel/0.9/src/printer.neun.nadel new file mode 100644 index 0000000..00f698b --- /dev/null +++ b/system/printer-9nadel/0.9/src/printer.neun.nadel @@ -0,0 +1,1129 @@ +PACKET driver inst 9 (* Autoren : mov/hjh *) + (* Stand : 01.10.88 *) + + DEFINES druckerkanal, + treiber einrichten: + + +LET up = ""3""13""5"", + + generator name = "printer.neun.nadel", + + description file name = "beschreibungen9", + module file name = "module9"; + + +INT VAR pr channel, + positioning, + quality, + sheet feeder, + service option; +TEXT VAR fonttab name :: "", + driver name :: ""; +TEXT VAR inp; +BOOL VAR was esc; + + +PROC druckerkanal (INT CONST channel) : + + serverchannel (channel) + +END PROC druckerkanal; + +INT PROC druckerkanal : pr channel END PROC druckerkanal; + + +PROC treiber einrichten: + + treiber einrichten (0) +END PROC treiber einrichten; + +PROC treiber einrichten (INT CONST service opt): + + ask for print channel; + main menu; + IF installed + THEN generate printer spool + ELSE inform about restart + FI. + + ask for printchannel: + inits; + page; + headline ("Druckerkanal - Einstellung"); + cursor (1, 15); + putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); + putline (" 'druckerkanal (Kanalnummer)' in der Task """ + + name (myself) + """"); + putline (" verändert werden."); + REP + cursor (1, 10); + put (""5"EUMEL-Kanalnummer des Druckerkanals:"); + get (pr channel); + disable stop; + druckerkanal (pr channel); + BOOL VAR no error :: NOT is error; + IF is error + THEN cursor (1, 7); + put error; + putline ("Eingabe korrigiert wiederholen!") + FI; + clear error; + enable stop + UNTIL no error PER. + + inits: + line; + IF single task + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") + FI; + command dialogue (TRUE); + IF name (myself) <> "PRINTER" + THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + + name (myself) + """ !"); + IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") + THEN rename myself ("PRINTER") + FI + FI; + INT VAR choice; + service option := service opt. + + single task: (pcb (9) AND 255) = 1. + + main menu: + BOOL VAR installed :: FALSE; + REP + show main menu; + get choice; + treat choice + UNTIL was esc OR installed PER. + + show main menu: + page; + headline ("Hauptmenü 9-Nadel-Drucker"); + putline (" 1. Brother"); + putline (" 2. Citizen"); + putline (" 3. C. Itoh"); + putline (" 4. Epson"); + putline (" 5. Fujitsu"); + putline (" 6. IBM"); + putline (" 7. Mannesmann - Tally"); + putline (" 8. OKI"); + putline (" 9. Schneider"); + putline ("10. Star"). + + get choice: + cursor (1,24); + put ("CR: Eingabe ESC: Installation abbrechen"); + ask user (10). + + treat choice: + SELECT int (inp) OF + CASE 1: brother menu + CASE 2: citizen menu + CASE 3: c itoh menu + CASE 4: epson menu + CASE 5: fujitsu menu + CASE 6: ibm menu + CASE 7: mannesmann menu + CASE 8: oki menu + CASE 9: schneider menu + CASE 10: star menu + END SELECT. + + + brother menu:. + + citizen menu: + page; + headline ("Citizen - Menü"); + putline (" 1. 120-D"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (1); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + citi120d inst + FI. + + citi120d inst: + putline ("Citizen 120-D"); + line; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("S1 S2 S3 S4 S5 S6 S7 S8"); + putline ("egal OFF OFF egal egal egal egal egal"); + show control options (""); + IF all right + THEN get fonttable ("fonttab.7"); + generate ("citi120d"); + installed := TRUE + FI. + + c itoh menu: + page; + headline ("C. Itoh - Menü"); + putline (" 1. C 310 CXP"); + putline (" 2. C 315 CXP"); + putline (" 3. CI-3500"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (3); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + IF choice = 3 + THEN ci3500 inst + ELSE c310 inst + FI + FI. + + c310 inst: + IF choice = 1 + THEN putline ("C. Itoh C 310 CXP") + ELSE putline ("C. Itoh C 315 CXP") + FI; + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); + putline ("- 00: Epson-Modus (02)"); + putline ("- 22: nur Wagenrücklauf (01)"); + show control options ("std speed, paperfeed"); + show material options ("slow, fast, schacht1, schacht2"); + show command options ("schacht1, schacht2, schwarz, rot, blau, violett, gelb, orange, grün"); + ask for positioning; + ask for paper feed; + IF all right + THEN get fonttable ("fonttab.7.cxp"); + generate ("citohc310cxp"); + adjust positioning; + adjust paper feed; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + ci3500 inst: + putline ("C. Itoh CI-3500"); + line; + putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); + putline ("- 26: nur Wagenrücklauf (1)"); + putline ("- 49: 17,1 Zeichen pro Zoll (17)"); + show control options ("std speed"); + show material options ("slow, fast"); + ask for positioning; + IF all right + THEN get fonttable ("fonttab.10"); + generate ("citohci3500"); + adjust positioning; + installed := TRUE + FI. + + epson menu: + page; + headline ("Epson - Menü"); + putline (" 1. MX 80 Typ III"); + putline (" 2. MX 100 Typ III"); + putline (" 3. LX 800"); + putline (" 4. LX 1000"); + putline (" 5. FX 85"); + putline (" 6. FX 105"); + putline (" 7. FX 800 oder FX 850"); + putline (" 8. FX 1000 oder FX 1050"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (8); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1, 2: mx80 inst + CASE 3, 4: lx800 inst + CASE 5, 6: fx85 inst + CASE 7, 8: fx800 inst + END SELECT + FI. + + mx80 inst: + IF choice = 1 + THEN putline ("Epson MX 80 Typ III") + ELSE putline ("Epson MX 100 Typ III") + FI; + show control options ("std speed"); + show material options ("slow, fast"); + ask for positioning; + IF all right + THEN get fonttable ("fonttab.1"); + generate ("mx"); + adjust positioning; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + lx800 inst: + IF choice = 3 + THEN putline ("Epson LX 800") + ELSE putline ("Epson LX 1000") + FI; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8 SW2-1 SW2-2 SW2-3 SW2-4"); + putline ("egal egal egal egal egal egal egal egal egal *) OFF OFF"); + putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); + show control options ("std speed, std quality, std typeface"); + show material options ("slow, fast, draft, nlq, roman, sansserif"); + show command options ("draft, nlq, roman, sansserif"); + ask for positioning; + ask for quality; + IF all right + THEN get fonttable ("fonttab.20.lx"); + generate ("lx800"); + adjust positioning; + adjust quality; + IF choice = 4 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + fx85 inst: + IF choice = 5 + THEN putline ("Epson FX 85") + ELSE putline ("Epson FX 105") + FI; + line; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8 SW2-1 SW2-2 SW2-3 SW2-4"); + putline ("egal egal egal ON egal egal egal egal egal egal OFF OFF"); + show control options ("std speed"); + show material options ("slow, fast"); + ask for positioning; + IF all right + THEN get fonttable ("fonttab.7"); + generate ("fx85"); + adjust positioning; + IF choice = 6 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + fx800 inst: + IF choice = 7 + THEN putline ("Epson FX 800 oder FX 850") + ELSE putline ("Epson FX 1000 oder FX 1050") + FI; + line; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8 SW2-1 SW2-2 SW2-3 SW2-4"); + putline ("egal egal egal ON egal egal egal egal egal *) OFF OFF"); + putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); + show control options ("std quality, std typeface"); + show material options ("draft, nlq, roman, sansserif"); + show command options ("draft, nlq, roman, sansserif"); + ask for quality; + IF all right + THEN get fonttable ("fonttab.20"); + generate ("fx800"); + adjust quality; + IF choice = 8 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + fujitsu menu: + page; + headline ("Fujitsu - Menü"); + putline (" 1. DX 2100"); + putline (" 2. DX 2200"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (2); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1,2 : dx2100 inst + END SELECT + FI. + + dx2100 inst: + IF choice = 1 + THEN putline ("Fujitsu DX 2100") + ELSE putline ("Fujitsu DX 2200") + FI; + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8 SW2-1 SW2-2 SW2-3 SW2-4"); + putline ("egal egal egal egal egal egal egal egal egal *) OFF OFF"); + putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); + show control options ("std speed, paper feed"); + show material options ("slow, fast"); + show command options ("schwarz, rot, blau, violett, gelb, rot, grün"); + ask for positioning; + ask for paper feed; + IF all right + THEN get fonttable ("fonttab.7.fuj"); + generate ("fujdx2100"); + adjust positioning; + adjust paper feed; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + + + ibm menu: + page; + headline ("IBM - Menü"); + putline (" 1. Grafikdrucker (""80 Zeichen breit"")"); + putline (" 2. Grafikdrucker (""136 Zeichen breit"")"); + putline (" 3. Proprinter/Grafikdrucker II (""80 Zeichen breit"")"); + putline (" 4. Proprinter/Grafikdrucker II (""136 Zeichen breit"")"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (4); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + IF choice = 1 OR choice = 2 + THEN ibmgp inst + ELSE ibmpp inst + FI + FI. + + ibmgp inst: + IF choice = 1 + THEN putline ("IBM Grafikdrucker (""80 Zeichen breit"")") + ELSE putline ("IBM Grafikdrucker (""136 Zeichen breit"")") + FI; + show control options ("std speed"); + show material options ("slow, fast"); + ask for positioning; + IF all right + THEN get fonttable ("fonttab.10"); + generate ("ibmgp"); + adjust positioning; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + ibmpp inst: + IF choice = 3 + THEN putline ("IBM Proprinter/Grafikdrucker II (""80 Zeichen breit"")") + ELSE putline ("IBM Proprinter/Grafikdrucker II (""136 Zeichen breit"")") + FI; + show control options ("std speed, std quality"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq"); + ask for positioning; + ask for quality; + IF all right + THEN get fonttable ("fonttab.10"); + generate ("ibmpp"); + adjust positioning; + adjust quality; + IF choice = 4 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + mannesmann menu: + page; + headline ("Mannesmann - Tally - Menü"); + putline (" 1. MT 230"); + putline (" 2. MT 340"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (2); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + IF choice = 1 + THEN mt230 inst + ELSE mt340 inst + FI + FI. + + mt230 inst: + putline ("Mannesmann-Tally MT 230"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Der Drucker muß auf den ANSI+EPSON - Modus eingestellt werden."); + putline ("(Siehe: MT 230 Anwenderhandbuch, S. 4-145)"); + show control options ("std speed, paperfeed"); + show material options ("slow, fast, schacht1, schacht2"); + show command options ("schacht1, schacht2, schwarz, magenta, cyan, blau, gelb, rot, grün"); + ask for positioning; + ask for paper feed; + IF all right + THEN get fonttable ("fonttab.7"); + generate ("mt230"); + adjust positioning; + adjust paper feed; + do ("papersize (39.37, 30.48)"); + installed := TRUE + FI. + + mt340 inst: + putline ("Mannesmann-Tally MT 340"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Der Drucker muß auf den ANSI+EPSON - Modus eingestellt werden."); + putline ("(Siehe: MT 340 Anwenderhandbuch, S. 4-104)"); + show control options ("std speed, paperfeed"); + show material options ("slow, fast, schacht1, schacht2"); + show command options ("schacht1, schacht2, schwarz, magenta, cyan, blau, gelb, rot, grün"); + ask for positioning; + ask for paper feed; + IF all right + THEN get fonttable ("fonttab.7.mt"); + generate ("mt340"); + adjust positioning; + adjust paper feed; + do ("papersize (39.37, 30.48)"); + installed := TRUE + FI. + + oki menu: + page; + headline ("OKI - Menü"); + putline (" 1. MICROLINE 182 IBM-kompatibel"); + putline (" 2. MICROLINE 183 IBM-kompatibel"); + putline (" 3. MICROLINE 192 ELITE"); + putline (" 4. MICROLINE 193 ELITE"); + putline (" 5. MICROLINE 292 ELITE"); + putline (" 6. MICROLINE 293 ELITE"); + putline (" 7. MICROLINE 294 IBM-kompatibel"); + putline (" 8. MICROLINE 320"); + putline (" 9. MICROLINE 321"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (9); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + SELECT choice OF + CASE 1, 2: ml182i inst + CASE 3, 4: ml192el inst + CASE 5, 6: ml292el inst + CASE 7 : ml294i inst + CASE 8, 9: ml320 inst + END SELECT + FI. + + ml182i inst: + IF choice = 1 + THEN putline ("OKI Microline 182 IBM-kompatibel") + ELSE putline ("OKI Microline 183 IBM-kompatibel") + FI; + line; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("S-1 S-2 S-3 S-4 S-5 S-6 S-7 S-8"); + putline ("egal egal OFF egal egal OFF egal OFF"); + show control options ("std speed, std quality"); + show material options ("slow, fast, draft, nlq"); + show command options ("draft, nlq"); + ask for positioning; + ask for quality; + IF all right + THEN get fonttable ("fonttab.10"); + generate ("okiml182i"); + adjust positioning; + adjust quality; + IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + ml192el inst: + IF choice = 3 + THEN putline ("OKI Microline 192 ELITE (IBM/EPSON-kompatibel)") + ELSE putline ("OKI Microline 193 ELITE (IBM/EPSON-kompatibel)") + FI; + line; + putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); + putline ("- 13: Automatic Line Feed: Nein"); + putline ("- 18: Compatibility: EPSON FX"); + putline ("(Außerdem: Jumper SP5 in Position 'B')"); + show control options ("std speed, paperfeed"); + show material options ("slow, fast"); + ask for positioning; + ask for paper feed; + IF all right + THEN get fonttable ("fonttab.7"); + generate ("okiml192el"); + adjust positioning; + adjust paper feed; + IF choice = 4 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + ml292el inst: + IF choice = 5 + THEN putline ("OKI Microline 292 ELITE (IBM/EPSON-kompatibel)") + ELSE putline ("OKI Microline 293 ELITE (IBM/EPSON-kompatibel)") + FI; + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); + putline ("- Automatic Line Feed: NO"); + putline ("- Compatibility: EPSON EX"); + putline ("(Außerdem: Jumper SP5 in Position 'B')"); + show control options ("paperfeed, std quality, std typeface"); + show material options ("draft, nlq, courier, sansserif"); + show command options ("draft, nlq, courier, sansserif"); + putline ("schwarz, rot, blau, violett, gelb, orange, grün"); + ask for paper feed; + ask for quality; + IF all right + THEN get fonttable ("fonttab.20"); + generate ("okiml292el"); + adjust paper feed; + adjust quality; + IF choice = 6 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + ml294i inst: + putline ("OKI Microline 294 IBM-kompatibel"); + putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); + putline ("Farbband."); + line; + putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); + putline ("- Proportional Spacing: NO"); + putline ("- Automatic Line Feed: NO"); + putline ("- Compatibility: PROPRINTER XL"); + show control options ("paperfeed, std quality"); + show material options ("draft, nlq"); + show command options ("draft, nlq, schwarz, rot, blau, violett, gelb, orange, grün"); + ask for paper feed; + ask for quality; + IF all right + THEN get fonttable ("fonttab.10"); + generate ("okiml294i"); + adjust paper feed; + adjust quality; + do ("papersize (34.544, 30.48)"); + installed := TRUE + FI. + + ml320 inst: + IF choice = 8 + THEN putline ("OKI Microline 320 IBM/EPSON-kompatibel") + ELSE putline ("OKI Microline 321 IBM/EPSON-kompatibel") + FI; + line; + putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); + putline ("- Automatic Line Feed: Nein"); + show control options ("std speed"); + show material options ("slow, fast"); + ask for positioning; + IF all right + THEN get fonttable ("fonttab.7"); + generate ("okiml320"); + adjust positioning; + IF choice = 9 THEN do ("papersize (34.544, 30.48)") FI; + installed := TRUE + FI. + + schneider menu: + page; + headline ("Schneider - Menü"); + putline (" 1. DMP 4000"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (1); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + dmp4000 inst + FI. + + dmp4000 inst: + putline ("Schneider DMP 4000"); + line; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("DS1-4 übrige Schalter"); + putline (" OFF egal"); + show control options ("std speed"); + show material options ("slow, fast"); + ask for positioning; + IF all right + THEN get fonttable ("fonttab.7"); + generate ("dmp4000"); + adjust positioning; + do ("papersize (39.37, 30.48)"); + installed := TRUE + FI. + + star menu: + page; + headline ("Star - Menü"); + putline (" 1. LC-10 (auch LC-10 Colour)"); + putline (" 2. NX-15"); + putline (" 3. ND-10"); + putline (" 4. ND-15"); + putline (" 5. NR-10"); + putline (" 6. NR-15"); + cursor (1,24); + put ("CR: Eingabe ESC: Zurück zum Hauptmenü"); + ask user (6); + page; + choice := int (inp); + IF was esc + THEN was esc := FALSE + ELSE headline (""); + putline ("Druckertyp:"); + IF choice = 1 + THEN lc10 inst + ELIF choice = 2 + THEN nx15 inst + ELSE nd10 inst + FI + FI. + + lc10 inst: + putline ("Star LC-10 oder LC-10 Colour"); + line; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("S1-1 S1-2 S1-3 S1-4 S1-5 S1-6 S1-7 S1-8 S2-1 S2-2 S2-3 S2-4"); + putline ("egal egal egal *) egal EIN egal EIN egal egal egal egal"); + putline ("*) AUS: Einzelblatteinzug, EIN: kein Einzug"); + show control options ("std quality, std typeface"); + show material options ("draft, nlq, courier, sansserif, orator1, orator2"); + show command options ("draft, nlq, courier, sansserif, orator1, orator2"); + putline ("schwarz, rot, blau, violett, gelb, orange, grün"); + ask for quality; + IF all right + THEN get fonttable ("fonttab.20.lc"); + generate ("starlc10"); + adjust quality; + do ("papersize (21.0, 30.48)"); + installed := TRUE + FI. + + nx15 inst: + putline ("Star NX-15"); + line; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("S1-4 S1-8 S2-5 übrige Schalter"); + putline ("EIN EIN EIN egal"); + show control options ("std speed"); + show material options ("slow, fast"); + ask for positioning; + IF all right + THEN get fonttable ("fonttab.7"); + generate ("starnx15"); + adjust positioning; + do ("papersize (36.0, 30.48)"); + installed := TRUE + FI. + + nd10 inst: + IF choice = 3 + THEN putline ("Star ND-10"); + ELIF choice = 4 + THEN putline ("Star ND-15"); + ELIF choice = 5 + THEN putline ("Star NR-10"); + ELSE putline ("Star NR-15"); + FI; + line; + putline ("Die DIP-Schalter müssen so eingestellt sein:"); + putline ("S1-5 S1-6 S2-2 übrige Schalter"); + putline ("EIN EIN EIN egal"); + show control options ("std speed"); + show material options ("slow, fast"); + ask for positioning; + IF all right + THEN get fonttable ("fonttab.7"); + generate ("starnx15"); + adjust positioning; + IF choice = 3 OR choice = 5 + THEN do ("papersize (21.0, 30.48)") + ELSE do ("papersize (36.0, 30.48)") + FI; + installed := TRUE + FI. + +generate printer spool: + IF service opt = 0 + THEN forget (generator name, quiet); + forget (driver name, quiet) + FI; + eumel must advertise; + cursor (1, 10); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (2); + putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); + putline (" mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); + putline (" Drucker eingesetzt werden soll."); + line (2); + put ("Generierung beendet, weiter mit 'SV'"); + break (quiet); + do ("spool manager (PROC printer)"). + + inform about restart: + page; + putline ("Es ist kein Druckertreiber installiert worden!"); + line; + putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); + putline ("mit 'treiber einrichten' erneut aufgerufen werden."); + line. + +END PROC treiber einrichten; + +PROC headline (TEXT CONST header): + + cursor (13,1); + putline ("E U M E L - Druckertreiber - Installations - Programm"); + cursor (40 - LENGTH header DIV 2, 2); + put (header); + line (2) +END PROC headline; + +PROC ask user (INT CONST max choice): + + TEXT VAR exit; + inp := ""; + REP + cursor (1,23); + IF inp = "" + THEN put ("Ihre Wahl (Nummer eingeben):") + ELSE put ("FEHLER! Eingabe korrigieren:") + FI; + editget (inp, ""27"", "", exit); + was esc := exit = ""27""; + UNTIL was esc OR ok PER. + + ok: + int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. +END PROC ask user; + +PROC show control options (TEXT CONST options): + + line; + putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); + write ("papersize, top margin"); + IF options <> "" + THEN put (","); + putline (options) + FI +END PROC show control options; + +PROC show material options (TEXT CONST options): + + line; + putline ("Mögliche Materialwerte (#material(""..."")#):"); + putline (options) +END PROC show material options; + +PROC show command options (TEXT CONST options): + + line; + putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); + putline (options) +END PROC show command options; + +PROC ask for positioning: + + line (2); + putline ("Positionierung in x-Richtung:"); + line; + REP out (up); + IF yes ("in Mikroschritten (genauer, aber langsamer)") + THEN positioning := 1; LEAVE ask for positioning + FI; + out (up); + IF yes ("in Blanks (schneller, aber ungenauer)") + THEN positioning := 2; LEAVE ask for positioning + FI; + PER +END PROC ask for positioning; + +PROC ask for quality: + + line (2); + putline ("Standard - Druckqualität:"); + line; + REP out (up); + IF yes ("Draft Quality (schneller, aber nicht so schön)") + THEN quality := 1; LEAVE ask for quality + FI; + out (up); + IF yes ("Near Letter Quality (schöner, aber langsamer)") + THEN quality := 2; LEAVE ask for quality + FI; + PER +END PROC ask for quality; + +PROC ask for paper feed: + + line (2); + putline ("Einzelblatteinzug:"); + line; + REP out (up); + IF yes ("kein Einzelblatteinzug vorhanden") + THEN sheet feeder := 0; LEAVE ask for paper feed + FI; + out (up); + IF yes ("Einzelblatteinzug vorhanden") + THEN sheet feeder := 1; LEAVE ask for paper feed + FI; + PER +END PROC ask for paper feed; + +BOOL PROC all right: + + line (3); + cursor (1,23); + yes ("Soll der ausgewählte Druckertreiber installiert werden") +END PROC all right; + +PROC get fonttable (TEXT CONST name): + + fonttab name := name; + from archive ((description file name & module file name & fonttab name) + - all); + fonttable (fonttab name); + command dialogue (FALSE); + save (fonttab name, /"configurator"); + IF service option = 0 + THEN forget (fonttab name) + FI; + command dialogue (TRUE); +END PROC get fonttable; + +PROC from archive (THESAURUS CONST files): + + IF highest entry (files) > 0 + THEN fetch from archive; + release (archive); + putline ("Archiv abgemeldet !") + FI. + + fetch from archive: + THESAURUS VAR thes :: files; + REP + ask for archive; + reserve archive; + fetch (thes / ALL archive, archive); + thes := thes - all + UNTIL highest entry (thes) = 0 PER. + +ask for archive: + line; + putline ("Bitte Archiv mit den Dateien"); + TEXT VAR buffer; + INT VAR index :: 0; + REP + get (thes, buffer, index); + putline (" " + buffer) + UNTIL index = 0 PER; + putline ("einlegen !"); + line; + putline ("Wenn eingelegt: Taste drücken !"); + inchar (buffer). + +reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop. + +END PROC from archive; + +THESAURUS OP & (TEXT CONST left, right): + THESAURUS VAR result := empty thesaurus; + insert (result, left); + insert (result, right); + result +END OP &; + +THESAURUS OP & (THESAURUS CONST left, TEXT CONST right): + THESAURUS VAR result := left; + insert (result, right); + result +END OP &; + +PROC generate (TEXT CONST name): + + open files; + read description; + build programme; + insert programme; + forget files. + + open files: + line (5); + cursor (1, 20); + putline (""4"Bitte warten !"); + putline (" - Der Treiber wird generiert."); + driver name := "printer." + name + "(generiert)"; + IF exists (driver name) + THEN forget (driver name, quiet) + FI; + FILE VAR des file :: sequential file (modify, description file name), + mod file :: sequential file (modify, module file name), + driver file :: sequential file (output, driver name). + + read description: + to line (des file, 1); + col (des file, 1); + downety (des file, "$" + name + "$"); + IF eof (des file) + THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + + "Descriptions-File enthalten") + FI; + TEXT VAR description :: "", + record; + BOOL VAR done :: FALSE; + read record (des file, record); + record := subtext (record, col (des file) + LENGTH name + 2); + WHILE NOT eof (des file) AND NOT done REP + treat record + PER. + + treat record: + INT VAR dollar pos :: pos (record, "$"); + IF dollar pos = 0 + THEN description CAT compress (record); + down (des file); + read record (des file, record) + ELSE description CAT compress (subtext (record, 1, dollar pos - 1)); + col (des file, dollar pos); + done := TRUE; + FI. + + build programme: + get module name; + WHILE still modules REP + find module; + transfer module; + get module name + PER. + + get module name: + INT VAR semicol pos :: pos (description, ";"); + TEXT VAR module name; + IF semicol pos > 0 + THEN module name := subtext (description, 1, semicol pos - 1); + description := subtext (description, semicol pos + 1) + ELSE module name := description; + description := "" + FI. + + still modules: + module name <> "" OR description <> "". + + find module: + to line (mod file, 1); + col (mod file, 1); + downety (mod file, "$" + module name + "$"); + IF eof (mod file) + THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + + "Modul-File enthalten") + FI. + + transfer module: + done := FALSE; + read record (mod file, record); + record := subtext (record, col (mod file) + LENGTH module name + 2); + WHILE NOT eof (mod file) AND NOT done REP + transfer record + PER. + + transfer record: + dollar pos := pos (record, "$"); + IF dollar pos = 0 + THEN write (driver file, compress (record)); + line (driver file); + down (mod file); + read record (mod file, record) + ELSE write (driver file, compress (subtext (record, 1, + dollar pos - 1))); + col (mod file, dollar pos); + done := TRUE; + cout (line no (mod file)) + FI. + + insert programme: + IF online + THEN putline (" - Der Treiber wird insertiert.") + FI; + check off; + insert (driver name). + + forget files: + IF service option = 0 + THEN forget (description file name, quiet); + forget (module file name, quiet) + FI. +END PROC generate; + +PROC adjust positioning: + + IF positioning = 1 + THEN do ("std speed (""slow"")") + ELSE do ("std speed (""fast"")") + FI +END PROC adjust positioning; + +PROC adjust quality: + + IF quality = 1 + THEN do ("std quality (""draft"")") + ELSE do ("std quality (""nlq"")") + FI +END PROC adjust quality; + +PROC adjust paper feed: + + IF sheet feeder = 1 + THEN do ("paper feed (""sheet"")") + ELSE do ("paper feed (""tractor"")") + FI +END PROC adjust paperfeed; + +treiber einrichten + +END PACKET driver inst 9 + diff --git a/system/printer-laser/4/doc/readme b/system/printer-laser/4/doc/readme new file mode 100644 index 0000000..019d75c --- /dev/null +++ b/system/printer-laser/4/doc/readme @@ -0,0 +1,155 @@ +Treiber-Installations-Programm für Laserdrucker 21. 2.1989 + + +1. Installations- und Gebrauchsanleitung + +Einrichten +So wird das Treiber-Installationsprogramm eingerichtet: + + Richten Sie die Task PRINTER als Sohn von SYSUR ein : + + begin ("PRINTER", "SYSUR") + + Geben Sie in der Task PRINTER nacheinander folgende Kommandos + ein, die Sie jeweils mit der ENTER-Taste bestätigen: + + archive ("std.printer") + fetch("laser.inserter",archive) + insert ("laser.inserter") + +Das Programm wird dann insertiert. + + +Menüsystem +Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern. +Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste +der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier +den passenden Typ aus! +Das Installationsprogramm fragt nun nach der Art der Druckerschnittstelle. +Die Druckerhardware muß wie hier angegeben konfiguriert sein, wenn sie +mit dem ausgewählten Treiber betrieben werden soll. + +Das Installationsprogramm kann mit 'treiber einrichten' erneut aufgerufen +werden. Die Druckerschnittstelle kann mit 'printer setup' nachträglich +umkonfiguriert werden. + +2. Druckertreiber-Auswahl + +Verwendung nicht im Menü enthaltener Drucker +Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden, +müssen Sie herausfinden (Druckerhandbuch, -händler!), +welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist. +(Die meisten Laserdrucker verfügen über eine HP-Laserjet Emulation). + + +3. Steuerungsmöglichkeiten und Spezialfeatures + +Einige Treiber bieten bestimmte Einstellungsmöglichkeiten. +Die Einstellungen können über +- Steuerprozeduren +- Materialanweisungen bzw. +- direkte Druckeranweisungen +vorgenommen werden. + +Steuerprozeduren +setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten +sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER") +aufgerufen werden. Vor Aufruf der Prozeduren muß das Spoolkommando +'stop spool' gegeben werden! + + + +PROC papersize (REAL CONST breite, länge) + Dient zur Einstellung der Größe der physikalisch beschreibbaren + Fläche. + Beispiel: papersize (21.0, 29.7) + (Standardeinstellung für DIN A4 Format) + +PROC papersize + Informationsprozedur + +Die Änderungen, die Sie in der Druckspooltask vorgenommen haben +werden erst wirksam, nachdem das Spool-Kommando 'start spool' ge­ +geben und die Druckspooltask verlassen wurde. + + + +Materialanweisungen \#material("...")\# +müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und +setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben +für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge­ +stellten Standardwerten. Diese werden durch die Materialanweisung aber +nicht geändert.) + +Beispiel: \#material("landscape")\# oder \#material("quer")\# + Der Druckertreiber stellt sich auf Querdruck ein. Für das + Papierformat werden die + durch papersize eingestellten Werte vertauscht angenommen. + Es sollten nur Schrifttypen verwendet werden, die auch im + Landscape-Modus vorhanden sind. + + +- Es darf in einer Datei nur eine Materialanweisung stehen! Sollen meh­ + rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung + erscheinen. Beispiel: \#material("quer;2")\# + +- Achten Sie bei Materialanweisungen + besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben + berücksichtigt! Also: \#"quer"\# und keinesfalls \#"QUER"\#!!! + +- Bei Laserdruckern gebräuchliche Materialanweisungen sind: + - landscape (quer) + - manual + - tray + +direkte Druckeranweisungen \#"..."\# +gelten ab der Position, an der sie in der Datei auftreten. Sie haben +(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und +Materialeinstellungen. + + +- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und + nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann + daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse + erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen + Reihenfolge an den Drucker sendet, als er in der Datei steht, die + mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B. + für beide Spalten) unerwünscht erhalten bleibt. Direkte + Druckeranweisungen, die das Schriftformat verändern, + sollten grundsätzlich nicht gegeben werden. + + +4. Spezialfeatures: + +Die Druckertreiber für die Drucker APPLE-Laserwriter und NEC LC-08 +verfügen über Anweisungen zum Zeichnen einer Linie, Box oder eines Kuchen- +stücks, die als direkte Druckeranweisungen in ELAN-Syntax gegeben werden +müssen. +Folgende Anweisungen stehen zur Verfügung: + +PROC line (REAL CONST x offset, y offset, width, height, line width) : + +PROC x line (REAL CONST x offset, y offset, width, line width) : + +PROC y line (REAL CONST x offset, y offset, height, line width) : + +PROC box (REAL CONST x offset, y offset, width, height, line width, pattern): + +PROC box shade (REAL CONST x offset, y offset, width, height, pattern) : + +PROC box frame (REAL CONST x offset, y offset, width, height, line width) : + +PROC cake (REAL CONST x offset, y offset, radius, start angle, sweep angle, + line width, pattern) : + +PROC cake shade (REAL CONST x offset, y offset, radius, start angle, + sweep angle, pattern) : + +PROC cake frame (REAL CONST x offset, y offset, radius, start angle, + sweep angle, line width) : + + + + + + diff --git a/system/printer-laser/4/source-disk b/system/printer-laser/4/source-disk new file mode 100644 index 0000000..d21e78b --- /dev/null +++ b/system/printer-laser/4/source-disk @@ -0,0 +1 @@ +grundpaket/08_std.printer_laser.img diff --git a/system/printer-laser/4/src/fonttab.apple.laserwriter b/system/printer-laser/4/src/fonttab.apple.laserwriter new file mode 100644 index 0000000..bee2d6a Binary files /dev/null and b/system/printer-laser/4/src/fonttab.apple.laserwriter differ diff --git a/system/printer-laser/4/src/fonttab.canon.lbp-8 b/system/printer-laser/4/src/fonttab.canon.lbp-8 new file mode 100644 index 0000000..45314ac Binary files /dev/null and b/system/printer-laser/4/src/fonttab.canon.lbp-8 differ diff --git a/system/printer-laser/4/src/fonttab.epson.sq b/system/printer-laser/4/src/fonttab.epson.sq new file mode 100644 index 0000000..a3f7af3 Binary files /dev/null and b/system/printer-laser/4/src/fonttab.epson.sq differ diff --git a/system/printer-laser/4/src/fonttab.hp.laserjet b/system/printer-laser/4/src/fonttab.hp.laserjet new file mode 100644 index 0000000..4082e46 Binary files /dev/null and b/system/printer-laser/4/src/fonttab.hp.laserjet differ diff --git a/system/printer-laser/4/src/fonttab.kyocera.f-1010 b/system/printer-laser/4/src/fonttab.kyocera.f-1010 new file mode 100644 index 0000000..9c3fbda Binary files /dev/null and b/system/printer-laser/4/src/fonttab.kyocera.f-1010 differ diff --git a/system/printer-laser/4/src/fonttab.nec.lc-08 b/system/printer-laser/4/src/fonttab.nec.lc-08 new file mode 100644 index 0000000..f032953 Binary files /dev/null and b/system/printer-laser/4/src/fonttab.nec.lc-08 differ diff --git a/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1 b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1 new file mode 100644 index 0000000..fae8c09 --- /dev/null +++ b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1 @@ -0,0 +1,30 @@ +#"!"82"! "# +#"CMNT 'dyn1.6 '; GENF 10220, 'DYNAMIC1', 22, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "# +#"CMNT 'dyn1.6.i '; GENF 10224, 'DYNAMIC1', 22, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "# +#"CMNT 'dyn1.8 '; GENF 10280, 'DYNAMIC1', 28, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "# +#"CMNT 'dyn1.8.i '; GENF 10284, 'DYNAMIC1', 28, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "# +#"CMNT 'dyn1.10 '; GENF 10340, 'DYNAMIC1', 34, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "# +#"CMNT 'dyn1.10.i'; GENF 10344, 'DYNAMIC1', 34, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "# +#"CMNT 'dyn1.12 '; GENF 10420, 'DYNAMIC1', 42, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "# +#"CMNT 'dyn1.12.i'; GENF 10424, 'DYNAMIC1', 42, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "# +#"CMNT 'dyn1.14 '; GENF 10500, 'DYNAMIC1', 50, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "# +#"CMNT 'dyn1.14.b'; GENF 10502, 'DYNAMIC1', 50, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "# +#"CMNT 'dyn1.18.b'; GENF 10682, 'DYNAMIC1', 68, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "# +#"CMNT 'dyn1.24.b'; GENF 10922, 'DYNAMIC1', 92, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "# +#"CMNT 'dyn1.36.b'; GENF 11322, 'DYNAMIC1', 132, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "# +#"MAP 0, 0; EXIT;"# + +#type ("dyn1.6") #\#type("dyn1.6")\# +#type ("dyn1.6.i") #\#type("dyn1.6.i")\# +#type ("dyn1.8") #\#type("dyn1.8")\# +#type ("dyn1.8.i") #\#type("dyn1.8.i")\# +#type ("dyn1.10") #\#type("dyn1.10")\# +#type ("dyn1.10.i")#\#type("dyn1.10.i")\# +#type ("dyn1.12") #\#type("dyn1.12")\# +#type ("dyn1.12.i")#\#type("dyn1.12.i")\# +#type ("dyn1.14") #\#type("dyn1.14")\# +#type ("dyn1.14.b")#\#type("dyn1.14.b")\# +#type ("dyn1.18.b")#\#type("dyn1.18.b")\# +#type ("dyn1.24.b")#\#type("dyn1.24.b")\# +#type ("dyn1.36.b")#\#type("dyn1.36.b")\# + diff --git a/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2 b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2 new file mode 100644 index 0000000..f425a7f --- /dev/null +++ b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2 @@ -0,0 +1,30 @@ +#"!"82"! "# +#"CMNT 'dyn2.6 '; GENF 20200, 'DYNAMIC2', 20, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "# +#"CMNT 'dyn2.6.i '; GENF 20204, 'DYNAMIC2', 20, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "# +#"CMNT 'dyn2.8 '; GENF 20260, 'DYNAMIC2', 26, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "# +#"CMNT 'dyn2.8.i '; GENF 20264, 'DYNAMIC2', 26, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "# +#"CMNT 'dyn2.10 '; GENF 20320, 'DYNAMIC2', 32, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "# +#"CMNT 'dyn2.10.i'; GENF 20324, 'DYNAMIC2', 32, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "# +#"CMNT 'dyn2.12 '; GENF 20400, 'DYNAMIC2', 40, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "# +#"CMNT 'dyn2.12.i'; GENF 20404, 'DYNAMIC2', 40, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "# +#"CMNT 'dyn2.14 '; GENF 20480, 'DYNAMIC2', 48, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "# +#"CMNT 'dyn2.14.b'; GENF 20482, 'DYNAMIC2', 48, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "# +#"CMNT 'dyn2.18.b'; GENF 20662, 'DYNAMIC2', 66, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "# +#"CMNT 'dyn2.24.b'; GENF 20902, 'DYNAMIC2', 90, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "# +#"CMNT 'dyn2.36.b'; GENF 21302, 'DYNAMIC2', 130, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "# +#"MAP 0, 0; EXIT;"# + +#type ("dyn2.6") #\#type("dyn2.6")\# +#type ("dyn2.6.i") #\#type("dyn2.6.i")\# +#type ("dyn2.8") #\#type("dyn2.8")\# +#type ("dyn2.8.i") #\#type("dyn2.8.i")\# +#type ("dyn2.10") #\#type("dyn2.10")\# +#type ("dyn2.10.i")#\#type("dyn2.10.i")\# +#type ("dyn2.12") #\#type("dyn2.12")\# +#type ("dyn2.12.i")#\#type("dyn2.12.i")\# +#type ("dyn2.14") #\#type("dyn2.14")\# +#type ("dyn2.14.b")#\#type("dyn2.14.b")\# +#type ("dyn2.18.b")#\#type("dyn2.18.b")\# +#type ("dyn2.24.b")#\#type("dyn2.24.b")\# +#type ("dyn2.36.b")#\#type("dyn2.36.b")\# + diff --git a/system/printer-laser/4/src/laser.inserter b/system/printer-laser/4/src/laser.inserter new file mode 100644 index 0000000..c28766f --- /dev/null +++ b/system/printer-laser/4/src/laser.inserter @@ -0,0 +1,275 @@ +PACKET laserdrucker inserter DEFINES treiber einrichten : + +(**************************************************************************) +(* Installationsprogramm Stand : 12.12.88 *) +(* für Tintenstrahl- Version : 0.9 *) +(* und Laserdrucker Autor : hjh *) +(**************************************************************************) + +LET anzahl firmen = 6 ; +LET apple = "APPLE" , + canon = "CANON" , + epson = "EPSON" , + hp = "HEWLETT PACKARD" , + kyo = "KYOCERA" , + nec = "NEC" ; + +THESAURUS VAR firmen := empty thesaurus ; + +INT VAR i ; +ROW anzahl firmen THESAURUS VAR drucker ; +FOR i FROM 1 UPTO anzahl firmen REP + drucker (i) := empty thesaurus +PER ; +ROW anzahl firmen THESAURUS VAR printer ; +FOR i FROM 1 UPTO anzahl firmen REP + printer (i) := empty thesaurus +PER ; +ROW anzahl firmen THESAURUS VAR fonttables ; +FOR i FROM 1 UPTO anzahl firmen REP + fonttables (i) := empty thesaurus +PER ; + +liste (apple,"LASERWRITER","printer.apple.laserwriter","fonttab.apple.laserwriter"); +liste (canon , "LBP-8" ,"printer.canon.lbp-8" ,"fonttab.canon.lbp-8"); +liste (epson , "SQ 2500" ,"printer.epson.sq" ,"fonttab.epson.sq"); +liste (hp , "HP LASERJET" ,"printer.hp.laserjet" ,"fonttab.hp.laserjet"); +liste (hp , "HP LASERJET+" ,"printer.hp.laserjet" ,"fonttab.hp.laserjet"); +liste (kyo , "F-1010" ,"printer.kyocera.f-1010" ,"fonttab.kyocera.f-1010"); +liste (kyo , "F-2200" ,"printer.kyocera.f-1010" ,"fonttab.kyocera.f-1010"); +liste (nec , "SILENTWRITER LC-08" ,"printer.nec.lc-08" +,"fonttab.nec.lc-08"); + +treiber einrichten; + +PROC liste (TEXT CONST firmenname, druckername , + printername, fonttabname ) : + INT VAR firmnum ; + IF firmen CONTAINS firmenname + THEN firmnum := link (firmen,firmenname) + ELSE insert (firmen,firmenname,firmnum) + FI; + insert (drucker(firmnum), druckername) ; + insert (printer(firmnum), printername) ; + insert (fonttables(firmnum), fonttabname) ; +END PROC liste ; + +PROC treiber einrichten : + INT VAR menu phase := 1 ; + BOOL VAR installed := FALSE ; + BOOL VAR was esc ; + INT VAR firmnum, druckernum ; + TEXT VAR firmenname, druckername, printername, fonttabname ; + + pre menu ; + REP + SELECT menu phase OF + CASE 1 : menu ("Hauptmenü Tintenstrahl und Laserdrucker", firmen, + "CR: Eingabe ESC : Installation abrechen", + firmnum, was esc ) ; + IF was esc + THEN menu phase := 0 + ELSE menu phase := 2 ; + firmenname := name (firmen,firmnum) ; + FI ; + + CASE 2 : menu (firmenname + " - Menü", drucker(firmnum), + "CR: Eingabe ESC : Zurück zum Hauptmenü", + druckernum, was esc) ; + IF was esc + THEN menu phase := 1 + ELSE menu phase := 3 ; + druckername := name (drucker(firmnum),druckernum); + printername := name (printer(firmnum),druckernum); + fonttabname := name (fonttables(firmnum),druckernum); + FI; + + CASE 3 : inst (druckername, printername, fonttabname, installed) ; + IF NOT installed THEN menu phase := 1 FI; + END SELECT + UNTIL installed OR abbruch PER ; + post menu. + + abbruch: + menu phase < 1 . + + pre menu: + line; + IF is single task system + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") + FI; + IF NOT is system task (myself) + THEN errorstop ("Die Druckertask muß im Systemzweig angelegt werden") + FI; + command dialogue (TRUE); + IF name (myself) <> "PRINTER" + THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + + name (myself) + """ !"); + IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") + THEN rename myself ("PRINTER") + FI + FI. + + is single task system: (pcb (9) AND 255) = 1. + + post menu: + IF NOT installed + THEN page; + putline ("Es ist kein Druckertreiber installiert worden!"); + line; + putline ("Wenn dieses Installationsprogramm insertiert wurde,"); + putline ("kann es in der Task """ + name (myself) + """ "); + putline ("mit 'treiber einrichten' erneut aufgerufen werden."); + line; + FI. + +END PROC treiber einrichten ; + +PROCEDURE menu (TEXT CONST header, THESAURUS CONST items, TEXT CONST bottom, + INT VAR choice, BOOL VAR was esc) : + INT VAR anzahl ; + page; + headline (header) ; + show list (items,anzahl) ; + bottomline (bottom) ; + ask user (anzahl,choice,was esc); +END PROC menu ; + +PROC headline (TEXT CONST header): + cursor (13,1); + putline ("E U M E L - Druckertreiber - Installations - Programm"); + cursor (40 - LENGTH header DIV 2, 2); + IF header <> "" THEN put (header) FI ; + line (2) +END PROC headline; + +PROC bottomline (TEXT CONST bottom): + cursor (1,24); + IF bottom <> "" THEN put (""5"" + bottom) FI ; +END PROC bottomline; + +PROC show list (THESAURUS CONST items , INT VAR anzahl ) : + INT VAR i ; + anzahl := highest entry (items); + FOR i FROM 1 UPTO anzahl REP + putline ( text(i) + ". " + name (items,i) ) ; + PER; +END PROC show list ; + +PROC ask user (INT CONST max choice, INT VAR choice, BOOL VAR was esc): + TEXT VAR exit; + TEXT VAR inp := ""; + REP + cursor (1,23); + IF inp = "" + THEN put ("Ihre Wahl (Nummer eingeben):") + ELSE put ("FEHLER! Eingabe korrigieren:") + FI; + editget (inp, ""27"", "", exit); + was esc := exit = ""27""; + UNTIL was esc OR ok PER. + + ok: + choice := int (inp) ; + last conversion ok CAND ( choice > 0 AND choice <= max choice) . +END PROC ask user; + +BOOL PROC is system task (TASK CONST task): + TASK VAR tsk := task ; + WHILE NOT (tsk = supervisor OR tsk = niltask) REP + tsk := father (tsk) ; + PER; + tsk = supervisor +END PROC is system task ; + +PROC inst (TEXT CONST druckername, printername, fonttabname, + BOOL VAR success) : + page ; + headline (druckername) ; + fetch from archive if necessary ((empty thesaurus + + printer name + fonttab name) - all ,success); + IF success AND ok + THEN page ; + putline ("Der Drucker wird insertiert"); + insert (printer name) ; + ELSE success := FALSE ; + FI. + +ok: + bottomline (" "); + yes ("Soll der ausgewählte Drucker insertiert werden"). + +END PROC inst ; + +PROC fetch from archive if necessary (THESAURUS CONST files, + BOOL VAR success ): + BOOL VAR was esc ; + THESAURUS VAR thes :: files; + + WHILE highest entry (thes) > 0 REP + ask for archive; + IF NOT was esc + THEN disable stop ; + bottomline ("Bitte warten ! "); + reserve archive; + IF NOT is error + THEN IF highest entry (thes / ALL archive) > 0 + THEN fetch (thes / ALL archive, archive); + ELSE fehler ("Dateien nicht gefunden") + FI; + thes := thes - all; + FI; + IF is error + THEN fehler (errormessage); + clear error + FI; + command dialogue (FALSE); + release (archive); + command dialogue (TRUE); + enable stop ; + FI; + UNTIL was esc PER; + success := highest entry (thes) = 0. + +ask for archive: + headline ("") ; + putline ("Bitte Archiv mit den Dateien"); + TEXT VAR buffer; + INT VAR index :: 0; + REP + get (thes, buffer, index); + putline (" " + buffer) + UNTIL index = 0 PER; + putline ("einlegen !"); + bottomline ("CR: Wenn Archiv eingelegt ESC : Zurück zum Hauptmenü"); + cursor (1,24); + REP + inchar (buffer) ; + UNTIL buffer = ""13"" OR buffer = ""27"" PER ; + was esc := buffer = ""27"". + +reserve archive : + INT VAR p1, p2; + archive (" "31" "); + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI. + +END PROC fetch from archive if necessary ; + +PROC fehler (TEXT CONST fehlermeldung): + bottomline (""7"" + fehlermeldung + " Bitte eine Taste drücken") ; + pause ; + bottomline (" ") ; +END PROC fehler; + +END PACKET laserdrucker inserter; + diff --git a/system/printer-laser/4/src/printer.apple.laserwriter b/system/printer-laser/4/src/printer.apple.laserwriter new file mode 100644 index 0000000..d4c6adf --- /dev/null +++ b/system/printer-laser/4/src/printer.apple.laserwriter @@ -0,0 +1,770 @@ +PACKET apple laser writer printer + +(**************************************************************************) +(* Stand : 24.02.88 *) +(* APPLE LaswerWriter (PostScript) Verison : 4 *) +(* Autor : Rudolf Ruland *) +(**************************************************************************) + + DEFINES open, + close, + execute, + + paper size, + paper x size, + paper y size, + + load positioning procs, + load underline procs, + load italics procs, + load encoding, + + read ps input, + + box commands, + insert box command, + delete box command, + + print error, + : + +LET +(* underline = 1, + bold = 2, + italics = 4, + reverse = 8, +*) + underline linetype = 1, + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8, + + ps input name = "PostScript.input", + ps error = 999, + + tag type = 1; + +INT VAR paper length, font no, underline no, symbol type; +REAL VAR x size, y size; +BOOL VAR is landscape; +TEXT VAR record, char, command, symbol; +FILE VAR ps input; +THESAURUS VAR box cmds := empty thesaurus; + +(*********************************************************************) + +paper size (21.0, 29.7); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + +REAL PROC paper x size : x size END PROC paper x size; + +REAL PROC paper y size : y size END PROC paper y size; + + +THESAURUS PROC box commands : box cmds END PROC box commands; + +PROC insert box command (TEXT CONST new command) : + + command := new command; + change all (command, " ", ""); + insert (box cmds, command) + +END PROC insert box command; + +PROC delete box command (TEXT CONST old command) : + + INT VAR dummy; + command := old command; + change all (command, " ", ""); + delete (box cmds, command, dummy) + +END PROC delete box command; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + IF pos (material, "landscape") > 0 OR pos (material, "quer") > 0 + THEN is landscape := TRUE; + x steps := x step conversion ( y size ); + y steps := y step conversion ( x size ); + ELSE is landscape := FALSE; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + FI; + forget (ps input name, quiet); + ps input := sequential file (output, ps input name); + paper length := y steps; + font no := 0; + underline no := 0; + disable stop; + out (""4""); + read ps input (ps input, 18000, ""4""); + clear error; + enable stop; + out ("initgraphics erasepage statusdict /waittimeout 3000 put "); + load positioning procs; + load underline procs; + load italics procs; + load encoding; + read ps input (ps input, 0, ""); + +. x start : param1 +. y start : param2 +. + open page : + x start := 0; + y start := 0; + IF pos (material, "tray") > 0 + THEN out ("statusdict /manualfeed false put "); + ELIF pos (material, "manual") > 0 + THEN out ("statusdict /manualfeed true put statusdict /manualfeedtimeout 3600 put "); + FI; + IF material contains a number + THEN out ("/#copies "); out (number); out ("def "); + FI; + IF is landscape + THEN out (paper length); + out ("ys 0 translate 90 rotate "); + FI; + read ps input (ps input, 0, ""); + + . material contains a number : + INT VAR number := pos (material, "0", "9", 1); + IF number = 0 + THEN FALSE + ELSE number := max (1, int (subtext (material, number, number + 1))); + TRUE + FI + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page + OTHERWISE : put (param1) +END SELECT; + +. + close document : + disable stop; + out (""4""); + read ps input (ps input, 18000, ""4""); + + +(*. remaining y steps : param1*) +. + close page : + outline ("showpage"); + read ps input (ps input, 0, ""); + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out ("("); + out subtext (string, from, to); + out (") show "); +. + write cmd : + command := subtext (string, from, to); + IF is box cmd + THEN disable stop; + do (command); + clear error; + ELSE out (command); + out (" "); + FI; + + . is box cmd : + scan (command); + next symbol (symbol, symbol type); + (symbol type = tag type) CAND (box cmds CONTAINS symbol) + + +(*. x steps to left margin : param1*) +. + carriage return : + move to (0, y pos); + line; + read ps input (ps input, 0, ""); + + +. x steps : param1 +. y steps : param2 + +. + move : + move to (x pos, y pos); + +. + draw : + IF y steps <> 0 COR x steps < 0 COR linetype <> underline linetype + THEN stop + ELSE IF underline no <> font no THEN out ("lu ") FI; + out (x steps); + out ("ul "); + FI; + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)); + out (" "); + ELSE stop + FI + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)); + out (" "); + ELSE stop + FI + + +. font nr : param1 +. + type : + font no := font nr; + out (fontstring (font nr)); + out (" /af exch def af setfont "); + +END PROC execute; + + +PROC move to (INT CONST x, y) : + + out (x); out ("xs "); + out (paper length - y); out ("ys moveto "); + +END PROC move to; + + +PROC line : out (""13""10"") END PROC line; + +PROC outline (TEXT CONST string) : out (string); out (""13""10"") END PROC outline; + +PROC out (INT CONST value) : out (text (value)); out (" ") END PROC out; + +PROC out (REAL CONST value) : out (text (value)); out (" ") END PROC out; + + +PROC load positioning procs : + + out ("/xs {"); out (72.0 / 2.54 * x step conversion (1)); out ("mul} def "); + out ("/ys {"); out (72.0 / 2.54 * y step conversion (1)); out ("mul} def "); + +END PROC load positioning procs; + + +PROC load underline procs : + + out ("/ul {xs ut setlinewidth 0 up rmoveto dup gsave 0 rlineto stroke grestore up neg rmoveto} def "); + out ("/lu {af /FontMatrix get 3 get af /FontInfo get 2 copy /up 3 1 roll /UnderlinePosition get mul 3 mul def /ut 3 1 roll /UnderlineThickness get mul def} def "); + +END PROC load underline procs; + + +PROC load italics procs : + + out ("/iton {/m matrix def m 2 12 sin 12 cos div put af m makefont setfont} def "); + out ("/itoff {af setfont} def "); + +END PROC load italics procs; + + +PROC load encoding : + + out ("/reencsmalldict 12 dict def "); + out ("/ReEncodeSmall {reencsmalldict begin "); + out ("/newcodesandnames exch def /newfontname exch def /basefontname exch def "); + out ("/basefontdict basefontname findfont def /newfont basefontdict maxlength dict def "); + out ("basefontdict {exch dup /FID ne {dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch newfont 3 1 roll put} ifelse} {pop pop} ifelse} forall "); + out ("newfont /FontName newfontname put newcodesandnames aload pop newcodesandnames length 2 idiv {newfont /Encoding get 3 1 roll put} repeat "); + out ("newfontname newfont definefont pop "); + out ("end} def "); + out ("/eumelencoding[10#128 /Ccedilla 10#129 /udieresis 10#128 /Ccedilla 10#129 /udieresis "); + out ("10#130 /eacute 10#131 /acircumflex 10#132 /adieresis 10#133 /agrave 10#134 /aring 10#135 /ccedilla 10#136 /ecircumflex 10#137 /edieresis 10#138 /egrave 10#139 /idieresis "); + out ("10#140 /icircumflex 10#141 /igrave 10#142 /Adieresis 10#143 /Aring 10#144 /Eacute 10#145 /ae 10#146 /AE 10#147 /ocircumflex 10#148 /odieresis 10#149 /ograve "); + out ("10#150 /ucircumflex 10#151 /ugrave 10#152 /ydieresis 10#153 /Odieresis 10#154 /Udieresis 10#155 /cent 10#156 /sterling 10#157 /yen 10#158 /currency 10#159 /florin "); + out ("10#160 /aacute 10#161 /iacute 10#162 /oacute 10#163 /uacute 10#164 /ntilde 10#165 /Ntilde 10#166 /ordfeminine 10#167 /ordmasculine 10#168 /questiondown 10#169 /quotedblleft "); + out ("10#170 /quotedblright 10#171 /guilsinglleft 10#172 /guilsinglright 10#173 /exclamdown 10#174 /guillemotleft 10#175 /guillemotright 10#176 /atilde 10#177 /otilde 10#178 /Oslash 10#179 /oslash "); + out ("10#180 /oe 10#181 /OE 10#182 /Agrave 10#183 /Atilde 10#184 /Otilde 10#185 /section 10#186 /daggerdbl 10#187 /dagger 10#188 /paragraph 10#189 /space "); + out ("10#190 /space 10#191 /space 10#192 /quotedblbase 10#193 /ellipsis 10#194 /perthousand 10#195 /bullet 10#196 /endash 10#197 /emdash 10#198 /space 10#199 /Aacute "); + out ("10#200 /Acircumflex 10#201 /Egrave 10#202 /Ecircumflex 10#203 /Edieresis 10#204 /Igrave 10#205 /Iacute 10#206 /Icircumflex 10#207 /Idieresis 10#208 /Ograve 10#209 /Oacute "); + out ("10#210 /Ocircumflex 10#211 /Scaron 10#212 /scaron 10#213 /Ugrave 10#214 /Adieresis 10#215 /Odieresis 10#216 /Udieresis 10#217 /adieresis 10#218 /odieresis 10#219 /udieresis "); + out ("10#220 /k 10#221 /hyphen 10#222 /numbersign 10#223 /space 10#224 /grave 10#225 /acute 10#226 /circumflex 10#227 /tilde 10#228 /dieresis 10#229 /ring "); + out ("10#230 /cedilla 10#231 /caron 10#232 /Lslash 10#233 /Oslash 10#234 /OE 10#235 /ordmasculine 10#236 /Uacute 10#237 /Ucircumflex 10#238 /Ydieresis 10#239 /germandbls "); + out ("10#240 /Zcaron 10#241 /zcaron 10#242 /fraction 10#243 /ae "); + out ("10#251 /germandbls 10#252 /section] def "); + out ("/Helvetica /EHelvetica eumelencoding ReEncodeSmall "); + out ("/Helvetica-Bold /EHelvetica-Bold eumelencoding ReEncodeSmall "); + out ("/Helvetica-Oblique /EHelvetica-Oblique eumelencoding ReEncodeSmall "); + out ("/Helvetica-BoldOblique /EHelvetica-BoldOblique eumelencoding ReEncodeSmall "); + out ("/Times-Roman /ETimes-Roman eumelencoding ReEncodeSmall "); + out ("/Times-Bold /ETimes-Bold eumelencoding ReEncodeSmall "); + out ("/Times-Italic /ETimes-Italic eumelencoding ReEncodeSmall "); + out ("/Times-BoldItalic /ETimes-BoldItalic eumelencoding ReEncodeSmall "); + out ("/Courier /ECourier eumelencoding ReEncodeSmall "); + out ("/Courier-Oblique /ECourier-Oblique eumelencoding ReEncodeSmall "); + out ("/Courier-BoldOblique /ECourier-BoldOblique eumelencoding ReEncodeSmall "); + out ("/Courier-Bold /ECourier-Bold eumelencoding ReEncodeSmall "); + line; + +END PROC load encoding; + + +PROC read ps input (FILE VAR input file, INT CONST timeout, TEXT CONST ok) : + + BOOL VAR was cr; + record := ""; + was cr := FALSE; + char := incharety (timeout); + REP IF char = ""10"" CAND was cr + THEN put record; + was cr := FALSE; + ELIF char = ""13"" CAND NOT was cr + THEN was cr := TRUE; + ELSE IF was cr + THEN record CAT """13"""; + was cr := FALSE; + FI; + IF char = ""4"" + THEN IF record <> "" THEN put record FI; + putline (input file, "-- EOF --"); + line (input file); + ELIF char >= " " + THEN record CAT char + ELIF char >= ""0"" + THEN record CAT """"; + record CAT text (code (char)); + record CAT """"; + ELSE IF record <> "" THEN put record FI; + LEAVE read ps input; + FI; + FI; + IF pos (ok, char) > 0 + THEN IF record <> "" THEN put record FI; + LEAVE read ps input; + FI; + cat input (record, char); + IF char = "" THEN char := incharety (min (5, time out)) FI; + PER; + + . put record : + putline (input file, record); + IF NOT is error CAND pos (record, "%%[ Error:") > 0 + THEN errorstop (ps error, record) FI; + record := ""; + +END PROC read ps input; + + +PROC print error (TEXT CONST error message, INT CONST error line) : + + REAL CONST pl := y size * 72.0 / 2.54, + ys := 56.69291, + xs := 51.02362, + h := 12.0; + REAL VAR x := xs, y := ys + h; + outline ("/Courier findfont 10 scalefont setfont"); + move to x and y; + out ("(FEHLER : "); + out (error message); + IF error line > 0 + THEN out (" in Zeile "); + out (error line); + FI; + outline (") show"); + IF exists (ps input name) + THEN ps input := sequential file (input, ps input name); + y INCR 3.0 * h; + move to x and y; + outline ("(PostScript - Input :) show"); + y INCR h; + WHILE NOT eof (ps input) + REP getline (ps input, record); + y INCR h; + move to x and y; + out ("("); + out (record); + outline (") show"); + PER; + output (ps input); + FI; + outline ("showpage"); + out (""4""); + read ps input (ps input, 18000, ""4""); + + . move to x and y : + out (x); out (pl - y); out ("moveto "); + +END PROC print error; + + +END PACKET apple laser writer printer; + + +PACKET apple laserwriter box commands + +(**************************************************************************) +(* *) +(* Kommandos zum Zeichen von Boxen, Linien und Schraffuren *) +(* für den Apple LaserWriter *) +(* *) +(* Autor : Rudolf Ruland *) +(* Stand : 24.02.88 *) +(**************************************************************************) + + DEFINES line, + x line, + y line, + + box, + box frame, + box shade, + + cake, + cake frame, + cake shade, + : + +INT VAR x, y, h, w; + +WHILE highest entry (box commands) > 0 + REP delete box command (name (box commands, highest entry (box commands))) PER; +insert box command ("line"); +insert box command ("xline"); +insert box command ("yline"); +insert box command ("box"); +insert box command ("boxshade"); +insert box command ("boxframe"); +insert box command ("cake"); +insert box command ("cakeshade"); +insert box command ("cakeframe"); + + +PROC line (REAL CONST x offset, y offset, width, height, line width) : + + IF line width > 0.0 + THEN graph on (x offset, y offset, width, height); + out (text (line width / 300.0 * 72.0)); + out (" setlinewidth "); + out (text (w)); + out (" xs "); + out (text (-h)); + out (" ys rlineto stroke "); + graph off; + FI; + +END PROC line; + +PROC x line (REAL CONST x offset, y offset, width, line width) : + + line (x offset, y offset, width, 0.0, line width); + +END PROC x line; + +PROC y line (REAL CONST x offset, y offset, height, line width) : + + line (x offset, y offset, 0.0, height, line width); + +END PROC y line; + + +PROC box (REAL CONST x offset, y offset, width, height, line width, pattern): + + box shade (x offset, y offset, width, height, pattern); + box frame (x offset, y offset, width, height, line width); + +END PROC box; + + +PROC box shade (REAL CONST x offset, y offset, width, height, pattern) : + + graph on (x offset, y offset, width, height); + box path; + out (text (pattern)); + out (" setgray fill "); + graph off; + +END PROC box shade; + + +PROC box frame (REAL CONST x offset, y offset, width, height, line width) : + + IF line width <> 0.0 + THEN graph on (x offset, y offset, width, height); + box path; + out (text (line width / 300.0 * 72.0)); + out (" setlinewidth stroke "); + graph off; + FI; + +END PROC box frame; + + +PROC box path : + + out (text (w)); + out (" xs 0 rlineto 0 "); + out (text (-h)); + out (" ys rlineto "); + out (text (-w)); + out (" xs 0 rlineto closepath "); + +END PROC box path; + + + +PROC cake (REAL CONST x offset, y offset, radius, start angle, sweep angle, line width, pattern) : + + cake shade (x offset, y offset, radius, start angle, sweep angle, pattern); + cake frame (x offset, y offset, radius, start angle, sweep angle, line width); + +END PROC cake; + + +PROC cake shade (REAL CONST x offset, y offset, radius, start angle, sweep angle, pattern) : + + graph on (x offset, y offset, radius, 0.0); + cake path (start angle, sweep angle); + out (text (pattern)); + out (" setgray fill "); + graph off; + +END PROC cake shade; + + +PROC cake frame (REAL CONST x offset, y offset, radius, start angle, sweep angle, line width) : + + + IF line width <> 0.0 + THEN graph on (x offset, y offset, radius, 0.0); + cake path (start angle, sweep angle); + out (text (line width / 300.0 * 72.0)); + out (" setlinewidth stroke "); + graph off; + FI; + +END PROC cake frame; + + +PROC cake path (REAL CONST start angle, sweep angle) : + + out (text (start angle)); + out (" rotate "); + out ("currentpoint "); + out (text (w)); + out (" xs 0 "); + out (text (sweep angle)); + out (" "); + IF sweep angle < 360.0 + THEN out ("2 setlinejoin arc closepath "); + ELSE out (text (w)); + out (" xs 0 rmoveto arc "); + FI; + +END PROC cake path; + + +PROC graph on (REAL CONST x offset, y offset, width, height) : + + x := x step conversion (x offset); + y := y step conversion (y offset); + w := x step conversion (width); + h := y step conversion (height); + out ("gsave "); + out (text (x)); + out (" xs "); + out (text (-y)); + out (" ys rmoveto "); + +END PROC graph on; + +PROC graph off : + + out ("grestore "); + +END PROC graph off; + + +END PACKET apple laserwriter box commands; + + + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) +(* +LET up = ""3""13""5""; +*) +LET printer name = "printer.apple.laserwriter"; +TEXT VAR fonttab name := "fonttab.apple.laserwriter"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +IF NOT multi user + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") +FI; +ask for print channel; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +command dialogue (TRUE); +check on; +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + do ("serverchannel(" + text (pr channel) + ")" ) ; + line; +. + load font table : + IF NOT exists (fonttab name) + THEN REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online THEN clear error; print error (error message, 0); clear error FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; + diff --git a/system/printer-laser/4/src/printer.canon.lbp-8 b/system/printer-laser/4/src/printer.canon.lbp-8 new file mode 100644 index 0000000..4dfe9f8 --- /dev/null +++ b/system/printer-laser/4/src/printer.canon.lbp-8 @@ -0,0 +1,327 @@ +PACKET canon lbp 8 printer + +(*************************************************************************) +(* Stand : 29.07.86 *) +(* CANON LBP-8 A1/A2 Version : 4 *) +(* Autor : Rudolf Ruland *) +(*************************************************************************) + + + DEFINES open, + close, + execute, + + paper size : + +LET underline = 1, +(* bold = 2, + italics = 4, + reverse = 8, + + underline linetype = 1, *) + + csi = ""155"", + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8; + +REAL VAR x size, y size; +BOOL VAR is underline; + +(*********************************************************************) + +paper size (21.0, 29.7); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + is underline := FALSE; + x steps := x step conversion ( x size - 0.8043333 ); + y steps := y step conversion ( y size - 0.508); + out (""27":"27"P"13""); (* Enable - Prop.Type *) + out (""27";"27"<"155"11h"); (* Reset des Druckers *) + out (""27"(B"); (* ACSII-Zeichensatz *) + out (""155"1;4 D"); (* Char.Satz 1 = PICA *) + +. x start : param1 +. y start : param2 +. + open page : + x start := x step conversion (0.4064 ); + y start := y step conversion (0.508 + 0.6345); + out (""13""); + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page + OTHERWISE : put (param1) +END SELECT; + +. + close document : + (* out(""155"0q") von Standard-Cassette Papier holen *) + +(*. remaining y steps : param1*) +. + close page : + out (""13""12""); + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + INT VAR new from, new to; + IF is underline + THEN IF pos (string, " ", from, from) <> 0 + THEN out ("_"); + new from := from + 1; + ELSE new from := from; + FI; + IF from < to AND pos (string, " ", to, to) <> 0 + THEN new to := to - 1; + ELSE new to := to; + FI; + out subtext (string, new from, new to); + IF to <> new to THEN out ("_") FI; + ELSE out subtext (string, from, to) + FI; + +. + write cmd : + out subtext (string, from, to) + + +(*. x steps to left margin : param1*) +. + carriage return : + out (""13"") + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps > 0 + THEN out (csi); out (text ( x steps)); out ("a") + ELIF x steps < 0 + THEN out (csi); out (text (- x steps)); out ("j") + FI; + IF y steps > 0 + THEN out (csi); out (text ( y steps)); out ("e") + ELIF y steps < 0 + THEN out (csi); out (text (- y steps)); out ("k") + FI; + +. + draw : + stop + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)); + IF modification = underline THEN is underline := TRUE FI; + ELSE stop + FI + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)); + IF modification = underline THEN is underline := FALSE FI; + ELSE stop + FI + + +. font nr : param1 +. + type : + out (font string (font nr)); + +END PROC execute; + + +END PACKET canon lbp 8 printer; + + + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) + +LET printer name = "printer.canon.lbp-8"; + +TEXT VAR fonttab name := "fonttab.canon.lbp-8"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +IF NOT multi user + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") +FI; +ask for print channel; +ask for font cartridge; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +check on; +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + do ("serverchannel(" + text (pr channel) + ")" ) ; + line; +. + ask for font cartridge : +. + load font table : + IF NOT exists (fonttab name) + THEN command dialogue (TRUE); + REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online THEN put error; clear error; FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; + diff --git a/system/printer-laser/4/src/printer.epson.sq b/system/printer-laser/4/src/printer.epson.sq new file mode 100644 index 0000000..63e474f --- /dev/null +++ b/system/printer-laser/4/src/printer.epson.sq @@ -0,0 +1,585 @@ +PACKET epson sq printer + +(**************************************************************************) +(* Stand : 03.12.86 *) +(* EPSON SQ-2500 Version : 4 *) +(* Autor : Rudolf Ruland *) +(**************************************************************************) + + DEFINES open, + close, + execute, + + paper size, + (* paper feed, *) (* <-- nicht getestet *) + std typeface, + std quality: + +LET +(* underline = 1, + bold = 2, + italics = 4, + reverse = 8, *) + + underline linetype = 1, + + c document = 1, + c page = 2, + + c write text = 1, cmd draft = 1, + c write cmd = 2, cmd nlq = 2, + c carriage return = 3, cmd roman = 3, + c move = 4, cmd sansserif = 4, + c draw = 5, cmd courier = 5, + c on = 6, cmd prestige = 6, + c off = 7, cmd script = 7, + c type = 8; + +INT VAR font nr, x rest, high, low, font bits, modification bits, blank pitch, + factor 1, factor 2, steps; +BOOL VAR is nlq, sheet feed; +REAL VAR x size, y size; +TEXT VAR std quality name, std typeface name, buffer, symbol, font text; +THESAURUS VAR commands := empty thesaurus; + +insert (commands, "draft"); +insert (commands, "nlq"); +insert (commands, "roman"); +insert (commands, "sansserif"); +insert (commands, "courier"); +insert (commands, "prestige"); +insert (commands, "script"); + +. is prop : bit (font bits, 1) +. is double : bit (font bits, 5) +.; + +(*********************************************************************) + +paper size (13.6 * 2.54, 12.0 * 2.54); +paper size ( 8.0 * 2.54, 12.0 * 2.54); +paper feed ("tractor"); +std typeface ("roman"); +std quality ("draft"); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + + +PROC paper feed (TEXT CONST paper) : + + IF pos (paper, "sheet") <> 0 + THEN sheet feed := TRUE; + ELIF pos (paper, "tractor") <> 0 + THEN sheet feed := FALSE; + ELSE errorstop ("unzulaessige Papiereinfuehrung") + FI; + +END PROC paper feed; + +TEXT PROC paper feed : + + IF sheet feed + THEN "sheet" + ELSE "tractor" + FI + +END PROC paper feed; + + +PROC std typeface (TEXT CONST typeface) : + + buffer := typeface; + changeall (buffer, " ", ""); + IF link (commands, buffer) >= cmd roman + THEN std typeface name := buffer + ELSE errorstop ("unzulaessige Schriftart") + FI; + +END PROC std typeface; + +TEXT PROC std typeface : std typeface name END PROC std typeface; + + +PROC std quality (TEXT CONST quality) : + + IF quality = "nlq" OR quality = "draft" + THEN std quality name := quality; + ELSE errorstop ("unzulaessige Betriebsart") + FI; + +END PROC std quality; + +TEXT PROC std quality : std quality name END PROC std quality; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 30) * 30; + modification bits := 0; + out (""24""27""64""); (* Reset des Druckers *) + out (""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualität *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"t"1""27"6"); (* Erweiterung des Zeichensatzes *) + IF sheet feed THEN out (""27""25"4") FI; (* Sheetmode ein *) + IF pos (material, "roman") <> 0 + THEN out (""27"k"0"") + ELIF pos (material, "sansserif") <> 0 + THEN out (""27"k"1"") + ELIF pos (material, "courier") <> 0 + THEN out (""27"k"2"") + ELIF pos (material, "prestige") <> 0 + THEN out (""27"k"3"") + ELIF pos (material, "script") <> 0 + THEN out (""27"k"4"") + ELSE out (""27"k" + code (link (commands, std typeface) - cmd roman)); + FI; + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + + +. x start : param1 +. y start : param2 +. + open page : + x start := 0; + IF sheet feed + THEN y start := y step conversion (8.466667e-1) (* 2/6 Inch *) + ELSE y start := 0; + FI; + x rest := 0; + out (""13""); + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page +END SELECT; + +. + close document : + + +. remaining y steps : param1 +. + close page : + IF sheet feed + THEN out (""27""25"R") + ELIF remaining y steps > 0 + THEN out (""12"") + FI; + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out subtext (string, from, to) + +. + write cmd : + buffer := subtext (string, from, to); + scan (buffer); + next symbol (symbol); + SELECT link (commands, symbol) OF + CASE cmd draft : IF is nlq THEN switch to draft FI; is nlq := FALSE; + CASE cmd nlq : IF NOT is nlq THEN switch to nlq FI; is nlq := TRUE; + CASE cmd roman : out (""27"k"0"") + CASE cmd sansserif : out (""27"k"1"") + CASE cmd courier : out (""27"k"2"") + CASE cmd prestige : out (""27"k"3"") + CASE cmd script : out (""27"k"4"") + OTHERWISE : out (buffer); + END SELECT; + + +(*. x steps to left margin : param1*) +. + carriage return : + x rest := 0; + out (""13""); + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps < 0 OR y steps < 0 + THEN stop + ELSE IF x steps > 0 THEN x move FI; + IF y steps > 0 THEN y move FI; + FI; + + . x move : + x rest INCR x steps; + IF not is underline + THEN simple x move + ELSE underline x move + FI; + + . not is underline : + NOT bit (modification bits, 7) + + . simple x move : + high := x rest DIV factor 1; + x rest := x rest MOD factor 1; + out (""27"\"); + out (code (high MOD 256)); + out (code (high DIV 256)); + + . underline x move : + high := x rest DIV factor 2; + x rest := x rest MOD factor 2; + IF high < blank pitch + THEN stop + ELSE low := high MOD 127; + high := high DIV 127; + IF low >= blank pitch + THEN low DECR blankpitch; + ELSE high DECR 1; + low DECR (blankpitch - 127); + FI; + IF high > 0 + THEN out (""27" "); + out (code (127 - blankpitch)); + high TIMESOUT " "; + FI; + out (""27" "); + out (code (low)); + out (" "27" "0""); + FI; + + . y move : + low := y steps MOD 255; + high := y steps DIV 255; + IF high > 0 THEN high TIMESOUT (""27"J"255"") FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; +. + draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype + THEN stop + ELIF x steps > 0 + THEN x draw + FI; + + . x draw : + x rest INCR x steps; + steps := x rest DIV 6; + x rest := x rest MOD 6; + IF steps > 0 + THEN low := steps MOD 256; + high := steps DIV 256; + out (""27"L"); + out (code (low)); + out (code (high)); + steps TIMESOUT ""1""; + FI; + + +. modification : param1 +. + on : + buffer := on string (modification); + IF buffer <> "" + THEN modification bits := modification bits OR code (buffer); + switch to font; + ELSE stop + FI + +. + off : + buffer := off string (modification); + IF buffer <> "" + THEN modification bits := modification bits XOR code (buffer); + switch to font; + ELSE stop + FI + +. + type : + font nr := param1; + buffer := font string (font nr); + font bits := code (buffer SUB 1); + font text := subtext (buffer, 2); + IF is prop + THEN factor 1 := 4; + factor 2 := 4; + ELSE factor 1 := 6; + factor 2 := 6; + FI; + IF is double THEN factor 2 INCR factor 2 FI; + blank pitch := char pitch (font nr, " ") DIV factor 2; + switch to font; + IF is nlq THEN switch to nlq FI; + +END PROC execute; + + +PROC switch to font : + + out (""27"!"); + out (code (font bits OR modification bits)); + out (font text); + +END PROC switch to font; + + +PROC switch to nlq : + + IF NOT is prop + THEN factor 1 := 4; + factor 2 := (4 * factor 2) DIV 6; + blankpitch := (6 * blankpitch) DIV 4; + out (""27"x"1""); + ELSE out (""27"x"0""); + FI; + +END PROC switch to nlq; + + +PROC switch to draft : + + IF NOT is prop + THEN factor 1 := 6; + factor 2 := (6 * factor 2) DIV 4; + blankpitch := (4 * blankpitch) DIV 6; + out (""27"x"0""); + FI; + +END PROC switch to draft; + + +END PACKET epson sq printer; + + + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) + +LET printer name = "printer.epson.sq", + up = ""3""13""5""; + +TEXT VAR fonttab name := "fonttab.epson.sq"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +IF NOT multi user + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") +FI; +ask for print channel; +ask for paper format; +ask for typeface; +ask for print quality; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +check on; +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + do ("serverchannel(" + text (pr channel) + ")" ) ; + line; +. + ask for paper format : + SELECT paper format OF + CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54) + CASE 2 : papersize (13.6 * 2.54, 12.0 * 2.54) + CASE 3 : papersize (21.0, 29.7) + END SELECT + + . paper format : + line; + REP out (up); + IF yes ("Papierformat : endlos, 8 Zoll breit") + THEN LEAVE paper format WITH 1 FI; + out (up); + IF yes ("Papierformat : endlos, 13.6 Zoll breit") + THEN LEAVE paper format WITH 2 FI; + out (up); + IF yes ("Papierformat : DINA 4") + THEN LEAVE paper format WITH 3 FI; + PER; + 0 +. + ask for typeface : + line; + std typeface (typeface) + + . typeface : + REP out (up); + IF yes ("standardmäßige Schriftart : roman") + THEN LEAVE typeface WITH "roman" FI; + out (up); + IF yes ("standardmäßige Schriftart : sansserif") + THEN LEAVE typeface WITH "sansserif" FI; + out (up); + IF yes ("standardmäßige Schriftart : courier") + THEN LEAVE typeface WITH "courier" FI; + out (up); + IF yes ("standardmäßige Schriftart : prestige") + THEN LEAVE typeface WITH "prestige" FI; + out (up); + IF yes ("standardmäßige Schriftart : script") + THEN LEAVE typeface WITH "script" FI; + PER; + "" +. + ask for print quality : + line; + std quality (quality); + + . quality : + REP out (up); + IF yes ("standardmäßige Druckqualität : draft quality") + THEN LEAVE quality WITH "draft" FI; + out (up); + IF yes ("standardmäßige Druckqualität : near letter quality") + THEN LEAVE quality WITH "nlq" FI; + PER; + "" +. + load font table : + IF NOT exists (fonttab name) + THEN command dialogue (TRUE); + REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online THEN put error; clear error; FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; + diff --git a/system/printer-laser/4/src/printer.hp.laserjet b/system/printer-laser/4/src/printer.hp.laserjet new file mode 100644 index 0000000..152ee8e --- /dev/null +++ b/system/printer-laser/4/src/printer.hp.laserjet @@ -0,0 +1,417 @@ +PACKET hp laserjet printer + +(**************************************************************************) +(* Stand : 03.02.88 *) +(* HP 2686A LaserJet / LaserJet+ Verison : 4 *) +(* Autor : Rudolf Ruland *) +(**************************************************************************) + + DEFINES open, + close, + execute, + + paper size, + printer type : + +LET +(* underline = 1, + bold = 2, + italics = 4, + reverse = 8, + + underline linetype = 1, *) + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8; + +INT VAR abs x pos +REAL VAR x size, y size; +BOOL VAR is laser jet plus, is landscape; + +(*********************************************************************) + +paper size (21.0, 29.7); +printer type ("LaserJet"); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + +PROC printer type (TEXT CONST type) : + + is laser jet plus := pos (type, "+") <> 0 + +END PROC printer type; + +TEXT PROC printer type : + + IF is laser jet plus + THEN "LaserJet+" + ELSE "LaserJet" + FI + +END PROC printer type; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + out (""27"E"); (* Reset des Druckers *) + out (""27"&s1C"); (* 'end of line wrap' aus *) + out (""27"&l0L"); (* 'perforation skip' aus *) + out (""27"&l1X"); (* eine Kopie *) + out (""27"&l1H"); (* upper tray *) + IF pos (material, "landscape") > 0 OR pos (material, "quer") > 0 + THEN is landscape := TRUE; + x steps := x step conversion ( y size ); + y steps := y step conversion ( x size ); + out (""27"&l1O"); + ELSE is landscape := FALSE; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + FI; + +. x start : param1 +. y start : param2 +. + open page : + IF is landscape + THEN x start := x step conversion (0.508); (* 0.200*2.54 *) + y start := y step conversion (1.693333); (* 0.500*2.54 + 2.54/6.0 *) + ELSE x start := x step conversion (0.39878); (* 0.157*2.54 *) + y start := y step conversion (1.693333); (* 0.500*2.54 + 2.54/6.0 *) + FI; + IF pos (material, "lower tray") > 0 COR pos (material, "lowertray") > 0 + THEN out (""27"&l4H"); + ELIF pos (material, "tray") > 0 COR pos (material, "upper tray") > 0 COR pos (material, "uppertray") > 0 + THEN out (""27"&l1H"); + ELIF pos (material, "manual") > 0 + THEN out (""27"&l2H"); + ELIF pos (material, "envelope") > 0 + THEN out (""27"&l3H"); + FI; + IF material contains a number + THEN out (""27"&l" + text (number) + "X"); + FI; + out (""13""); + + . material contains a number : + INT VAR number := pos (material, "0", "9", 1); + IF number = 0 + THEN FALSE + ELSE number := max (1, int (subtext (material, number, number + 1))); + TRUE + FI + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page + OTHERWISE : put (param1) +END SELECT; + +. + close document : + + +(*. remaining y steps : param1*) +. + close page : + out (""12"") + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out subtext (string, from, to) + +. + write cmd : + out subtext (string, from, to) + + +(*. x steps to left margin : param1*) +. + carriage return : + out (""13"") + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps <> 0 + THEN x move + ELIF y steps > 0 + THEN out (""27"&a+" + text (y steps) + "V"); + ELIF y steps < 0 + THEN out (""27"&a" + text (y steps) + "V"); + FI; + + . x move : + IF is laser jet plus + THEN laser jet plus x move + ELSE laser jet x move + FI; + + . laser jet plus x move : + IF x steps >= 0 + THEN out (""27"*p+" + text (x steps) + "X"); + ELSE out (""27"*p" + text (x steps) + "X"); + FI; + + . laser jet x move : + abs x pos := x pos; + IF abs x pos >= 0 + THEN out (""27"&a"); + out (text ((abs x pos DIV 5) * 12 + ((abs x pos MOD 5) * 12 + 4) DIV 5)); + out ("H"); + ELSE stop + FI; + +. + draw : + stop + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)) + ELSE stop + FI + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)) + ELSE stop + FI + + +. font nr : param1 +. + type : + out (font string (font nr)); + +END PROC execute; + + +END PACKET hp laserjet printer; + + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) + +LET printer name = "printer.hp.laserjet", + up = ""3""13""5""; + +TEXT VAR fonttab name := "fonttab.hp.laserjet"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +IF NOT multi user + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") +FI; +ask for print channel; +ask for printer type; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +check on; +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + do ("serverchannel(" + text (pr channel) + ")" ) ; + line; +. + ask for printer type : + printer type (laser jet); + + . laser jet : + line; + REP out (up); + IF yes ("Druckertyp : HP LaserJet") + THEN LEAVE laser jet WITH "LaserJet" FI; + out (up); + IF yes ("Druckertyp : HP LaserJet+") + THEN LEAVE laser jet WITH "LaserJet+" FI; + PER; + "" +. + load font table : + line (2); + write (""13""4""); + putline ("Die Fonttabelle """ + fonttab name + + """ enthält die Schrifttypen der"); + putline ("Font Cartriges:"); + putline (" 92286A Courier 1"); + putline (" 92286C International 1"); + putline (" 92286D Prestige Elite"); + putline (" 92286E Letter Gothic"); + putline (" 92286F TMS Proportional 2"); + putline (" 92286L Courier P&L"); + putline (" 92286M Prestige Elite P&L"); + putline (" 92286N Letter Gothic P&L"); + putline (" 92286P TMS RMN P&L"); + putline (" 92286Q Memo 1"); + line; + putline ("Für ein korrektes Druckbild dürfen immer nur die Schrifttypen angesprochen"); + putline ("werden, deren Cartrige eingeschoben ist!"); + IF printer type = "LaserJet" + THEN line; + putline ("ELAN-Listings können nur gedruckt werden, wenn ein Cartrige mit dem"); + putline ("Schrifttyp 'LINE PRINTER' eingeschoben ist!"); + FI; + line (2); + putline ("Weiter nach Eingabe einer Taste"); + pause; + IF NOT exists (fonttab name) + THEN command dialogue (TRUE); + REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online"; + buffer CAT " THEN out (""""27""(8U""27""(s0p10h12v0s0b3T"");"; + buffer CAT " put error; clear error; out (""""12"""");"; + buffer CAT " FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; + diff --git a/system/printer-laser/4/src/printer.kyocera.f-1010 b/system/printer-laser/4/src/printer.kyocera.f-1010 new file mode 100644 index 0000000..a46f7b3 --- /dev/null +++ b/system/printer-laser/4/src/printer.kyocera.f-1010 @@ -0,0 +1,373 @@ +PACKET kyocera f 1010 printer + +(**************************************************************************) +(* Stand : 03.12.86 *) +(* KYOCERA F - 1010 Verison : 4 *) +(* Autor : Rudolf Ruland *) +(**************************************************************************) + +(**************************************************************************) +(* Hinweis : Die 'time-out' Zeit, nach der der Eingabepuffer ausgegeben *) +(* wird, wenn keine Eingabe mehr erfolgt, sollte moeglichst *) +(* gross gewaehlt werden, *) +(* z.B. mit FRPO H9, 60; wird sie auf 5 Min. gesetzt *) +(**************************************************************************) + + + DEFINES open, + close, + execute, + + paper size : + +LET underline = 1, +(* bold = 2, + italics = 4, + reverse = 8, + + underline linetype = 1, *) + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8; + +INT VAR blankpitch, high, low; +REAL VAR x size, y size; +BOOL VAR is landscape, is underline; + +(*********************************************************************) + +paper size (21.0, 29.7); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + out ("!"82"! RES; UNIT D; EXIT;"); (* Reset des Druckers *) + IF pos (material, "landscape") > 0 OR pos (material, "quer") > 0 + THEN is landscape := TRUE; + x steps := x step conversion ( y size ); + y steps := y step conversion ( x size ); + out (""27"&l1O"); + ELSE is landscape := FALSE; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + FI; + is underline := FALSE; + IF y size < 29.7 OR x size < 21.0 + THEN out ("!"82"! SLM "); + IF is landscape + THEN out (text (x step conversion (29.7 - y size))); + out ("; STM "); + out (text (y step conversion ((21.0 - x size) * 0.5))); + ELSE out (text (x step conversion ((21.0 - x size) * 0.5))); + FI; + out ("; EXIT;"); + FI; + +. x start : param1 +. y start : param2 +. + open page : + out ("!"82"! MZP 0, 0; EXIT;"); (* Positionierung zum Nullpunkt *) + IF is landscape + THEN x start := x step conversion (0.19); + y start := y step conversion (0.70); + ELSE x start := x step conversion (0.56); + y start := y step conversion (0.60); + FI; + IF pos (material, "tray") > 0 + THEN out (""27"&l1H"); + ELIF pos (material, "manual") > 0 + THEN out (""27"&l2H"); + FI; + out (""13""); + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page + OTHERWISE : put (param1) +END SELECT; + +. + close document : + + +(*. remaining y steps : param1*) +. + close page : + out (""12""); + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out subtext (string, from, to) + +. + write cmd : + out subtext (string, from, to) + + +(*. x steps to left margin : param1*) +. + carriage return : + out (""13"") + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps > 0 + THEN IF is underline + THEN underline x move + ELSE out (""27"*p+" + text (x steps) + "X"); + FI; + ELIF x steps < 0 + THEN out (""27"*p" + text (x steps) + "X"); + ELIF y steps > 0 + THEN out (""27"*p+" + text (y steps) + "Y"); + ELIF y steps < 0 + THEN out (""27"*p" + text (y steps) + "Y"); + FI; + + . underline x move : + high := x steps DIV blankpitch; + low := x steps MOD blankpitch; + IF high > 0 THEN high TIMESOUT " " FI; + IF low > 0 THEN out (" "27"*p" + text (low - blank pitch) + "X") FI; + +. + draw : + stop + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)); + IF modification = underline THEN is underline := TRUE FI; + ELSE stop + FI + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)); + IF modification = underline THEN is underline := FALSE FI; + ELSE stop + FI + + +. font nr : param1 +. + type : + out (font string (font nr)); + blankpitch := char pitch (font nr, " "); + +END PROC execute; + + +END PACKET kyocera f 1010 printer; + + + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) + +LET printer name = "printer.kyocera.f-1010"; + +TEXT VAR fonttab name := "fonttab.kyocera.f-1010"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +IF NOT multi user + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") +FI; +ask for print channel; +dynamic font hint; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +check on; +command dialogue (TRUE); +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + do ("serverchannel(" + text (pr channel) + ")" ) ; + line; +. + dynamic font hint : + line (3); + putline (""4"Hinweis zur Benutzung der dynamischen Schrifttypen:"); + line; + putline (" In der Fonttabelle """ + fonttab name + """ sind einige dynamische"); + putline (" Schrifttypen angepaßt. Diese müssen nach jedem Einschalten des"); + putline (" Druckers neu generiert werden."); + putline (" Zur Generierung dieser Schrifttypen befinden sich auf dem Standard-"); + putline (" archive die folgenden Dateien:"); + line; + putline (" ""genfont.kyocera.f-1010.dynamic1"""); + putline (" ""genfont.kyocera.f-1010.dynamic2"""); + line; + putline (" Nach Einschalten des Druckers müssen diese Dateien zuerst ausgedruckt"); + putline (" werden."); + putline (" Die Generierung benötigt pro Schriftart etwa 15 Minuten."); + line (2); + putline ("Weiter nach Eingabe einer Taste"); + pause; +. + load font table : + IF NOT exists (fonttab name) + THEN REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online"; + buffer CAT " THEN out (""""27""(8U""27""(s0p10h12v0s0b3T"");"; + buffer CAT " put error; clear error; out (""""12"""");"; + buffer CAT " FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; + diff --git a/system/printer-laser/4/src/printer.nec.lc-08 b/system/printer-laser/4/src/printer.nec.lc-08 new file mode 100644 index 0000000..9ee2837 --- /dev/null +++ b/system/printer-laser/4/src/printer.nec.lc-08 @@ -0,0 +1,626 @@ +PACKET nec lc 08 printer + +(**************************************************************************) +(* Stand : 29.01.88 *) +(* NEC Silentwriter LC-08 Verison : 4 *) +(* Autor : Rudolf Ruland *) +(**************************************************************************) + + DEFINES open, + close, + execute, + + box commands, + insert box command, + delete box command, + + paper size, + paper x size, + paper y size: + +LET +(* underline = 1, + bold = 2, + italics = 4, + reverse = 8, + + underline linetype = 1, *) + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8, + + tag type = 1; + +INT VAR symbol type; +REAL VAR x size, y size; +BOOL VAR is landscape, was cr; +TEXT VAR bold buffer, mod string, command, symbol; +THESAURUS VAR box cmds := empty thesaurus; + +(*********************************************************************) + +paper size (21.0, 29.7); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + +REAL PROC paper x size : x size END PROC paper x size; +REAL PROC paper y size : y size END PROC paper y size; + + +THESAURUS PROC box commands : box cmds END PROC box commands; + +PROC insert box command (TEXT CONST new command) : + + command := new command; + change all (command, " ", ""); + insert (box cmds, command) + +END PROC insert box command; + +PROC delete box command (TEXT CONST old command) : + + INT VAR dummy; + command := old command; + change all (command, " ", ""); + delete (box cmds, command, dummy) + +END PROC delete box command; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + out (""28"Cz"); (* Diablo 630 Emulation *) + out (""27""13"P"); (* Reset *) + out (""28"$"); (* Formatlaenge loeschen *) + out (""28"Ca"27"6"28"Cz"); (* Zeichensatz 2 *) + out (""28"Ra"); (* USA-Zeichensatz *) + out (""27""25"1"); (* Sheet 1 *) + is landscape := pos (material, "landscape") > 0; + IF is landscape + THEN x steps := x step conversion ( y size ); + y steps := y step conversion ( x size ); + out (""28")"128""0""); (* Landscape-Mode *) + ELSE x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + out (""28")"001""0""); (* Portait -Mode *) + FI; + was cr := FALSE; + bold buffer := ""; + +. x start : param1 +. y start : param2 +. + open page : + IF is landscape + THEN x start := x step conversion (0.45); + y start := y step conversion (0.9); + ELSE x start := x step conversion (0.7); + y start := y step conversion (0.9); + FI; + IF pos (material, "sheet1") > 0 + THEN out (""27""25"1") + ELIF pos (material, "sheet2") > 0 + THEN out (""27""25"2") + ELIF pos (material, "manual") > 0 + THEN out (""27""25"E") + FI; + out (""28"'a"0""0""28"&a"0""0""); (* Positionierung auf den Nullpunkt *) + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page + OTHERWISE : put (param1) +END SELECT; + +. + close document : + + +(*. remaining y steps : param1*) +. + close page : + out (""12"") + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + IF was cr + THEN was cr := FALSE; + out (bold buffer); + FI; + out subtext (string, from, to) + +. + write cmd : + IF was cr + THEN was cr := FALSE; + out (bold buffer); + FI; + command := subtext (string, from, to); + IF is box cmd + THEN disable stop; + do (command); + clear error; + ELSE out (command); + FI; + + . is box cmd : + scan (command); + next symbol (symbol, symbol type); + (symbol type = tag type) CAND (box cmds CONTAINS symbol) + + +(*. x steps to left margin : param1*) +. + carriage return : + out (""13""); + was cr := TRUE; + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps <> 0 THEN x move FI; + IF y steps <> 0 THEN y move FI; + + . x move : + IF x steps > 0 THEN out (""28"&c") ELSE out (""28"&d") FI; + out (x steps low); + out (x steps high); + + . x steps low : code (abs (x steps) MOD 256) + . x steps high : code (abs (x steps) DIV 256) + + . y move : + IF y steps > 0 THEN out (""28"'c") ELSE out (""28"'d") FI; + out (y steps low); + out (y steps high); + + . y steps low : code (abs (y steps) MOD 256) + . y steps high : code (abs (y steps) DIV 256) +. + draw : + stop + + +. modification : param1 +. + on : + mod string := on string (modification); + IF mod string <> "" + THEN out (mod string); + IF pos (""27"W"27"O", mod string) > 0 + THEN bold buffer CAT mod string; + FI; + ELSE stop + FI + +. + off : + mod string := off string (modification); + IF mod string <> "" + THEN out (mod string); + IF pos (""27"&", mod string) > 0 + THEN bold buffer := subtext (bold buffer, 1, LENGTH bold buffer - 2); + out (bold buffer); + FI; + ELSE stop + FI + + +. font nr : param1 +. + type : + out (""28")"); (* Font Identifikation *) + command := font string (font nr); + IF is landscape + THEN out subtext (command, 3, 4); + ELSE out subtext (command, 1, 2); + FI; + out (""28"E"); (* Zeilenvorschub (VMI) *) + out (code (font height (font nr) + font depth (font nr) + font lead (font nr))); + out (""28"F"); (* Zeichenabstand (HMI) *) + out (code (char pitch (font nr, " "))); + out (""27"P"); (* proportional ein *) + out subtext (command, 5); + +END PROC execute; + +END PACKET nec lc 08 printer; + + +PACKET nec lc 08 box commands + +(**************************************************************************) +(* *) +(* Kommandos zum Zeichen von Boxen, Linien und Schraffuren *) +(* für den NEC Laserdrucker LC-08 *) +(* *) +(* Autor : Rudolf Ruland *) +(* Stand : 29.01.88 *) +(**************************************************************************) + + DEFINES line, + x line, + y line, + + box, + box frame, + box shade, + + cake, + cake frame, + cake shade, + : + +INT VAR x, y, h, w; + +WHILE highest entry (box commands) > 0 + REP delete box command (name (box commands, highest entry (box commands))) PER; +insert box command ("line"); +insert box command ("xline"); +insert box command ("yline"); +insert box command ("box"); +insert box command ("boxshade"); +insert box command ("boxframe"); +insert box command ("cake"); +insert box command ("cakeshade"); +insert box command ("cakeframe"); + + +PROC line (REAL CONST x offset, y offset, width, height, INT CONST line width) : + + IF line width > 0 + THEN graph on (x offset, y offset, width, height); + out ("LW" + text (line width) + ";"); + out ("PR;"); + out ("PD" + text (+w) + "," + text (-h) + ";"); + graph off; + FI; + +END PROC line; + +PROC x line (REAL CONST x offset, y offset, width, INT CONST line width) : + + IF line width > 0 + THEN graph on (x offset, y offset, width, 0.0); + out ("LW" + text (line width) + ";"); + out ("PR;"); + out ("PD" + text (+w) + "," + "0;"); + graph off; + FI; + +END PROC x line; + +PROC y line (REAL CONST x offset, y offset, height, INT CONST line width) : + + IF line width > 0 + THEN graph on (x offset, y offset, 0.0, height); + out ("LW" + text (line width) + ";"); + out ("PR;"); + out ("PD0," + text (-h) + ";"); + graph off; + FI; + +END PROC y line; + + +PROC box (REAL CONST x offset, y offset, width, height, + INT CONST pattern type, line width) : + + IF pattern type = 0 + THEN box frame (x offset, y offset, width, height, line width) + ELIF line width = 0 + THEN box shade (x offset, y offset, width, height, pattern type) + ELSE graph on (x offset, y offset, width, height); + out ("LW" + text (line width) + ";"); + set pattern (pattern type); + out ("ER" + text (+w) + "," + text (-h) + ";"); + graph off; + FI; + +END PROC box; + + +PROC box shade (REAL CONST x offset, y offset, width, height, + INT CONST pattern type) : + + IF pattern type <> 0 + THEN graph on (x offset, y offset, width, height); + set pattern (pattern type); + out ("RR" + text (+w) + "," + text (-h) + ";"); + graph off; + FI; + +END PROC box shade; + + +PROC box frame (REAL CONST x offset, y offset, width, height, + INT CONST line width) : + + IF line width <> 0 + THEN graph on (x offset, y offset, width, height); + out ("LW" + text (line width) + ";"); + out ("PR;"); + out ("PD"); + out (text (+w) + "," + "0,"); + out ( "0," + text (-h) + ","); + out (text (-w) + "," + "0,"); + out ( "0," + text (+h) + ";"); + graph off; + FI; + +END PROC box frame; + + +PROC cake (REAL CONST x offset, y offset, radius, start angle, sweep angle, + INT CONST pattern type, line width) : + + IF pattern type = 0 + THEN cake frame (x offset, y offset, radius, start angle, sweep angle, line width) + ELIF line width = 0 + THEN cake shade (x offset, y offset, radius, start angle, sweep angle, pattern type) + ELSE graph on (x offset, y offset, radius, 0.0); + out ("LW" + text (line width) + ";"); + set pattern (pattern type); + out ("EW" + text (+w) + "," + text (start angle) + "," + text (sweep angle) + ";"); + graph off; + FI; + +END PROC cake; + + +PROC cake shade (REAL CONST x offset, y offset, radius, start angle, sweep angle, + INT CONST pattern type) : + + IF pattern type > 0 CAND w > 0 + THEN graph on (x offset, y offset, radius, 0.0); + set pattern (pattern type); + out ("WG" + text (+w) + "," + text (start angle) + "," + text (sweep angle) + ";"); + graph off; + FI; + +END PROC cake shade; + + +PROC cake frame (REAL CONST x offset, y offset, radius, start angle, sweep angle, + INT CONST line width) : + + + IF line width <> 0 + THEN REAL CONST xs := real (x) + cos (start angle*pi/180.0) * real (w), + ys := real (y) + sin (start angle*pi/180.0) * real (w); + graph on (x offset, y offset, radius, 0.0); + out ("LW" + text (line width) + ";"); + out ("MA"+ text (xs) + "," + text (ys) + ";"); + out ("FA"+ text ( x) + "," + text ( y) + "," + text (sweep angle) + ";"); + out ("MA"+ text ( x) + "," + text ( y) + ";"); + graph off; + FI; + +END PROC cake frame; + + +PROC graph on (REAL CONST x offset, y offset, width, height) : + + x := x pos + x step conversion (x offset); + y := plot y size - (y pos + y step conversion (y offset)); + w := x step conversion (width); + h := y step conversion (height); + out (""28"Aa"); + out ("DF;"); + out ("MA"+ text (x) + "," + text (y) + ";"); + + . plot y size : 3389 - y step conversion (1.0) + +END PROC graph on; + +PROC graph off : + + out (""28"Az"); + +END PROC graph off; + + +PROC set pattern (INT CONST pattern type) : + + out ("XX1;"); + out (pattern); + + . pattern : + SELECT pattern type OF + CASE 1 : "FT2,1,0;" + CASE 2 : "FT2,1,90;" + CASE 3 : "FT2,1,45;" + CASE 4 : "FT3,1,0;" + CASE 5 : "FT3,1,45;" + CASE 6 : "FT2,100,0;" + CASE 7 : "FT2,100,90;" + CASE 8 : "FT2,100,45;" + CASE 9 : "FT3,100,0;" + CASE 10 : "FT3,100,45;" + OTHERWISE : "FT1;" + END SELECT + +END PROC set pattern; + + +END PACKET nec lc 08 box commands; + + + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) + +LET printer name = "printer.nec.lc-08"; + +TEXT VAR fonttab name := "fonttab.nec.lc-08"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +IF NOT multi user + THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") +FI; +ask for print channel; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +command dialogue (TRUE); +check on; +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + do ("serverchannel(" + text (pr channel) + ")" ) ; + line; +. + load font table : + IF NOT exists (fonttab name) + THEN REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online THEN put error; clear error; FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; + diff --git a/system/setup/3.1/source-disk b/system/setup/3.1/source-disk new file mode 100644 index 0000000..1421205 --- /dev/null +++ b/system/setup/3.1/source-disk @@ -0,0 +1 @@ +setup/setup-src-3.1_shard-4.9_1989-04-18.img diff --git a/system/setup/3.1/src/AT-4.x b/system/setup/3.1/src/AT-4.x new file mode 100644 index 0000000..86962e3 Binary files /dev/null and b/system/setup/3.1/src/AT-4.x differ diff --git a/system/setup/3.1/src/SHARD b/system/setup/3.1/src/SHARD new file mode 100644 index 0000000..c1619b3 Binary files /dev/null and b/system/setup/3.1/src/SHARD differ diff --git a/system/setup/3.1/src/SHard Basis b/system/setup/3.1/src/SHard Basis new file mode 100644 index 0000000..60800a1 Binary files /dev/null and b/system/setup/3.1/src/SHard Basis differ diff --git a/system/setup/3.1/src/bootblock b/system/setup/3.1/src/bootblock new file mode 100644 index 0000000..00b56a2 Binary files /dev/null and b/system/setup/3.1/src/bootblock differ diff --git a/system/setup/3.1/src/configuration b/system/setup/3.1/src/configuration new file mode 100644 index 0000000..139597f --- /dev/null +++ b/system/setup/3.1/src/configuration @@ -0,0 +1,2 @@ + + diff --git a/system/setup/3.1/src/neu b/system/setup/3.1/src/neu new file mode 100644 index 0000000..a89779c --- /dev/null +++ b/system/setup/3.1/src/neu @@ -0,0 +1,34 @@ +TEXT VAR t1 :: "SHardmodul Floppy", t2 :: "FLOPPY.EXE"; +reserve ("ds", /"DOS"); +IF yes("init",FALSE) + THEN init modules list; +FI; +THESAURUS VAR th1 :: all modules, th2 :: empty thesaurus; +WHILE yes ("noch Module holen", TRUE) REP +t2 := ONE /"DOS"; +t1 := ONE (th1); +editget (t1); line; +forget (t1); +fetch (t2, /"DOS"); +copy (t2, t1); last param (t1); +th2 := th2 + t1 +PER; +WHILE yes ("jetzt noch andere holen", FALSE) REP + t2 := ONE /"DOS"; + t1 := ONE all; +editget (t1); line; +forget (t1); +fetch (t2, /"DOS"); +copy (t2, t1); last param (t1); +PER; +release (/"DOS"); + +linkshard module (th2); + + + + + + + + diff --git a/system/setup/3.1/src/setup eumel -1: mini eumel dummies b/system/setup/3.1/src/setup eumel -1: mini eumel dummies new file mode 100644 index 0000000..a1fa2b5 --- /dev/null +++ b/system/setup/3.1/src/setup eumel -1: mini eumel dummies @@ -0,0 +1,28 @@ + +PACKET setup eumel mini eumel dummies (* Stand : 08.04.88 *) +DEFINES FILE, + sequentialfile, + output, + putline, + :=, + run : + +TYPE FILE = INT; + +INT CONST output :: 0; + +OP := (FILE VAR a, FILE CONST b): + +END OP :=; +FILE PROC sequentialfile (INT CONST a, TEXT CONST b) : + FILE : (0). +END PROC sequentialfile; + +PROC putline (FILE CONST a, TEXT CONST b): +END PROC putline; + +PROC run (TEXT CONST a): +END PROC run; + +END PACKET setup eumel mini eumel dummies; + diff --git a/system/setup/3.1/src/setup eumel 0: -M b/system/setup/3.1/src/setup eumel 0: -M new file mode 100644 index 0000000..bad5028 --- /dev/null +++ b/system/setup/3.1/src/setup eumel 0: -M @@ -0,0 +1,32 @@ +PACKET setup eumel multiuserspecials (* Copyright (C) 1985, 1988 *) +DEFINES terminal setup, (* Martin Schönbeck, Spenge *) + indirect list, (* Lutz Prechelt, Karlsruhe *) + setup testing : (* Stand: 07.05.88 2.1 *) + +LET sysout file = "sysout"; + +BOOL VAR setup test version :: FALSE; + +PROC terminal setup: + (* It took about 2 manmonths to debug this procedure ! *) +END PROC terminal setup; + +PROC indirect list (BOOL CONST make indirection) : + IF make indirection + THEN sysout (sysout file); + ELSE sysout (""); + print (sysout file); + forget (sysout file, quiet) + FI. +END PROC indirect list; + +PROC setup testing (BOOL CONST new ): + setup test version := new; +END PROC setup testing; + +BOOL PROC setup testing : + setup test version. +END PROC setup testing; + +END PACKET setup eumel multiuserspecials; + diff --git a/system/setup/3.1/src/setup eumel 0: -S b/system/setup/3.1/src/setup eumel 0: -S new file mode 100644 index 0000000..50a8330 --- /dev/null +++ b/system/setup/3.1/src/setup eumel 0: -S @@ -0,0 +1,35 @@ +PACKET setup eumel singleuserspecials (* Copyright (C) 1985, 1988 *) +DEFINES terminal setup, (* Martin Schönbeck, Spenge *) + break, (* Lutz Prechelt, Karlsruhe *) + indirect list, (* Stand: 07.05.88 2.1 *) + setup testing : + +LET printer channel = 15, + screen channel = 1; + + +PROC break (QUIET CONST quiet): +END PROC break; + +PROC terminal setup: + setup +END PROC terminal setup; + +PROC indirect list (BOOL CONST make indirection) : + (* Man beachte, daß es nicht besonders sinnvoll ist, auf einem Drucker + cout zu machen... + *) + IF make indirection + THEN continue (printer channel) + ELSE continue (screen channel) FI. +END PROC indirect list; + +PROC setup testing (BOOL CONST new): +END PROC setup testing; + +BOOL PROC setup testing : + FALSE. +END PROC setup testing; + +END PACKET setup eumel singleuserspecials; + diff --git a/system/setup/3.1/src/setup eumel 1: basisoperationen b/system/setup/3.1/src/setup eumel 1: basisoperationen new file mode 100644 index 0000000..a705ff4 --- /dev/null +++ b/system/setup/3.1/src/setup eumel 1: basisoperationen @@ -0,0 +1,1071 @@ + +(**************************************************************************) +(***** Grundoperationen für den Setup-Eumel (Modul-SHard) *****************) +(***** Copyright (c) 1985 - 1988 by *****************) +(***** Martin Schönbeck, Spenge / Lutz Prechelt, Karlsruhe ****************) +(**************************************************************************) + +(* Fünf Pakete : + 1. setup eumel basisoperationen + Handhabung von 16-Bit unsigned Werten in INTs und Editierfunktionen + 2. splitting + Worttrennung von REALs und Bytetrennung von INTs + 3. basic block io + blockin und blockout auf Datenräume mit retrys und Fehlermeldungen + 4. write file + Direktes Schreiben/Lesen eines Datenraums in/aus eine(r) Partition + 5. thesaurus utilities + ONE,CERTAIN,certain zum Aussuchen aus Thesauri ohne Editor +*) + + +PACKET setup eumel basisoperationen (* (C) 1987 Lutz Prechelt, Karlsruhe *) +DEFINES editget, editgetchar, (* Stand: 08.04.88 Version 1.1 *) + yes, no, (* Eumel 1.8.0 *) + direction, reset direction, + data error, write head, + LIST, list, CAT, emptylist, + (*UNSIGNED,*) unsigned, int, text, + RANGE, range, everywhere, + ANDXOR, andxor, + dec, hex, bin, + IN, + := , + put : + +(* Dieses Paket stellt die Basisfunktionen für den Elanteil des Setup-SHard + zur Verfügung. + Es ist dies im Wesentlichen die Handhabung von INT-Werten auch in Binär- + und Hexdarstellung, sowie die Plausibilitätsprüfung mit Fehleranzeigen. +*) + +TYPE LIST = TEXT, (* TEXT aus mehreren UNSIGNEDen (replace/ISUB) *) + RANGE = STRUCT (UNSIGNED low, high), + ANDXOR = STRUCT (UNSIGNED and mask, xor mask); + +LET UNSIGNED = INT; (* 16 bit *) + +TYPE REPRESENTATION = INT; + +REPRESENTATION CONST dec :: REPRESENTATION : (10), + hex :: REPRESENTATION : (16), + bin :: REPRESENTATION : (2); + +(* Diese Typen dienen zur Wertprüfung bei der Eingabe. *) + +LET up = ""3"", + down = ""10"", + right = ""2"", + error = ""0""; (* fuer current direction *) + +TEXT VAR current direction :: ""; (* enthaelt up oder down oder "" *) +BOOL VAR direction valid :: FALSE; + +TEXT CONST hex digits :: "0123456789abcdef"; + +(********************* Zuweisungen *************************************) + +OP := (LIST VAR a, LIST CONST b) : + CONCR (a) := CONCR (b) +END OP := ; + +OP := (RANGE VAR a, RANGE CONST b) : + a.low := b.low; + a.high := b.high +END OP := ; + +OP := (ANDXOR VAR a, ANDXOR CONST b) : + a.and mask := b.and mask; + a.xor mask := b.xor mask +END OP := ; + +OP := (REPRESENTATION VAR a, REPRESENTATION CONST b) : + CONCR (a) := CONCR (b) +END OP := ; + +(************************** IN ******************************************) + +BOOL OP IN (UNSIGNED CONST a, LIST CONST l) : + INT CONST p :: pos (CONCR (l), textform (a)); + p > 0 AND p MOD 2 = 1 (* enthalten und word-aligned *) +END OP IN; + +BOOL OP IN (UNSIGNED CONST a, RANGE CONST b) : + (* RANGES sind inklusiv ihrer Grenzen *) + reverse (textform (a)) <= reverse (textform (b.high)) AND + reverse (textform (a)) >= reverse (textform (b.low)) +END OP IN; + +BOOL OP IN (UNSIGNED CONST a, ANDXOR CONST mask) : + (* Es muss (Bitweise) (a AND andmask) XOR xormask = 0 sein *) + ((a AND mask.and mask) XOR mask.xor mask) = 0 +END OP IN; + +(************************* Konstruktoren ********************************) + +LIST CONST emptylist :: LIST : (""); + +LIST PROC list (TEXT CONST list text) : + (* Konstruiert aus einer in Textform gegebenen Liste von Unsigneds eine + LIST. Die einzelnen Werte sind durch Komma getrennt und dürfen in + dezimaler, sedezimaler oder binärer Darstellung notiert sein. + *) + TEXT VAR t :: compress (list text); + IF t = "" THEN emptylist + ELSE TEXT VAR result :: ""; + REPEAT + INT VAR first comma pos :: pos (t, ","); + IF first comma pos = 0 THEN first comma pos := LENGTH t + 1 FI; + result CAT textform (unsigned (subtext (t, 1, first comma pos - 1))); + t := subtext (t, first comma pos + 1) + UNTIL t = "" PER; + LIST : (result) + FI +END PROC list; + +(*UNSIGNED PROC unsigned (INT CONST sixteen bits) : + sixteen bits +END PROC unsigned;*) + +UNSIGNED PROC unsigned (TEXT CONST number) : + INT VAR result :: 0, i; + TEXT VAR t :: compress (to lower (number)), type :: t SUB LENGTH t; + IF pos ("hb" + hex digits, type) = 0 + THEN set conversion (FALSE); + LEAVE unsigned WITH 0 + FI; + IF type = "h" + THEN convert hex + ELIF type = "b" + THEN convert binary + ELSE convert decimal FI; + result. + +convert hex : + FOR i FROM 1 UPTO LENGTH t - 1 REP + TEXT CONST c :: t SUB i; + IF pos (hex digits, c) = 0 + THEN set conversion (FALSE); + LEAVE unsigned WITH 0 + FI; + rotate (result, 4); + result INCR pos (hex digits, c) - 1 + PER. + +convert binary : + FOR i FROM 1 UPTO LENGTH t - 1 REP + TEXT CONST bit :: t SUB i; + IF bit <> "0" AND bit <> "1" + THEN set conversion (FALSE); + LEAVE unsigned WITH 0 + FI; + rotate (result, 1); + result INCR int (bit) + PER. + +convert decimal : + REAL VAR x :: real (t); + IF NOT last conversion ok THEN LEAVE unsigned WITH 0 FI; + IF x < 32768.0 + THEN result := int (x) + ELSE result := int (x - 65536.0) FI. +END PROC unsigned; + +RANGE CONST everywhere :: RANGE : (0, -1); + +RANGE PROC range (UNSIGNED CONST low, high) : + RANGE : (low, high) +END PROC range; + +ANDXOR PROC andxor (UNSIGNED CONST and mask, xor mask) : + ANDXOR : (and mask, xor mask) +ENDPROC andxor; + + +(******* weitere Operationen für UNSIGNED, LIST, RANGE, ANDXOR **************) + +INT PROC int (UNSIGNED CONST a) : + (* falls jemand noch exotische Dinge damit tun will *) + a +END PROC int; + +OP CAT (LIST VAR l, UNSIGNED CONST a) : + (* Liste nachtraeglich erweitern *) + CONCR (l) CAT textform (a) +END OP CAT; + +(********************* editget(char), yes, no *****************************) + +PROC editget (INT CONST spalte, zeile, TEXT CONST prompt, INT VAR i) : + cursor (spalte, zeile); + editget (prompt, i) +END PROC editget; + +PROC editget (INT CONST spalte, zeile, TEXT CONST prompt, UNSIGNED VAR a, + REPRESENTATION CONST r) : + cursor (spalte, zeile); + editget (prompt, a, r) +END PROC editget; + +PROC editget (TEXT CONST prompt, INT VAR i) : + TEXT VAR t :: text (i); + test up or down (prompt, t); + IF current direction <> "" THEN LEAVE editget FI; + editget (t,7,7); + i := int (t); + IF NOT last conversion ok + THEN data error ("Eingabe unerlaubt als Zahl") FI +END PROC editget; + +PROC editget (TEXT CONST prompt, UNSIGNED VAR a, REPRESENTATION CONST r) : + TEXT VAR t :: text (a, r); + test up or down (prompt, t); + IF current direction <> "" THEN LEAVE editget FI; + editget (t,18,18); + a := unsigned (t); + IF NOT last conversion ok + THEN data error ("Eingabe unerlaubt") FI +END PROC editget; + +BOOL PROC yes (TEXT CONST frage, BOOL CONST std antwort) : + (* Achtung: hierdrin kann nicht die alte "yes" Prozedur benutzt werden, da + diese kein getchar benutzt. + Die alten yes/no werden unten durch Resultatlose ueberdeckt. + *) + LET allowed = "NnJj"; + INT VAR x,y; get cursor (x,y); + IF NOT command dialogue THEN LEAVE yes WITH std antwort FI; + REP UNTIL getcharety = "" PER; + REP + cursor (x,y); + test up or down (frage + " ? (j/n)", standard antwort text); + IF current direction <> "" THEN LEAVE yes WITH std antwort FI; + TEXT VAR t; + getchar (t); + IF t = ""13"" + THEN t := standard antwort text FI; + IF pos (allowed, t) = 0 + THEN out (""7"") ELSE out (t); out (""13""10"") FI + UNTIL pos (allowed, t) <> 0 PER; + t = "j" OR t = "J". + +standard antwort text: + IF std antwort + THEN "j" + ELSE "n" + FI. +END PROC yes; + +BOOL PROC yes (INT CONST spalte, zeile, TEXT CONST frage, + BOOL CONST std antwort) : + cursor (spalte, zeile); + yes (frage, std antwort). +END PROC yes; + +PROC yes (TEXT CONST dummy): END PROC yes; + +PROC no (TEXT CONST dummy): END PROC no; + +PROC editgetchar (INT CONST spalte, zeile, TEXT CONST prompt, allowed, + UNSIGNED VAR a) : + cursor (spalte, zeile); + editgetchar (prompt, allowed, a) +END PROC editgetchar; + +PROC editgetchar (TEXT CONST prompt, allowed, UNSIGNED VAR a) : + (* Bietet Zeichen an (nehmen mit RETURN), nimmt nur die in allowed. + obere 8 Bit der Vorbesetzung werden abgeschnitten. + *) + TEXT VAR t; + test up or down (prompt, perhaps a); + a := a MOD 256; + IF current direction <> "" THEN LEAVE editgetchar FI; + getchar (t); + IF t = ""13"" + THEN (* Vorbesetzung behalten *) + out (right) + ELIF pos (allowed, t) <> 0 + THEN a := code (t); + out (t) + ELSE out (t); + data error ("unzulässiges Zeichen") + FI. + +perhaps a: + IF a > 31 THEN code (a) ELSE "" FI. +END PROC editgetchar; + +(********* data error, write head, (reset) direction *********************) + +PROC data error (TEXT CONST fehlermeldung) : + cursor (1, 24); + out (""7"Fehler : " + fehlermeldung + " (Bitte Taste) "); + REP UNTIL incharety (2) = "" PER; pause; + cursor (1, 24); out (""4""); + current direction := error +END PROC data error; + +PROC write head (TEXT CONST headtext) : + TEXT CONST text :: subtext (headtext, 1, 77); + INT CONST luecke :: (79 - LENGTH text) DIV 2 - 1; + out (""1""4""15""); + luecke TIMESOUT " "; + out (text); + luecke TIMESOUT " "; + out (""14""13""10""10""). +END PROC write head; + +TEXT PROC direction : + current direction +END PROC direction; + +PROC reset direction (BOOL CONST manouvres possible) : + (* Hiermit kann die letzte Manövrierbewegung nach der Auswertung gelöscht + werden. Mit NOT manouvres possible wird der ganze Manövriermechanismus + außer Betrieb gesetzt. + *) + direction valid := manouvres possible; + current direction := "" +END PROC reset direction; + +(*********************** put *******************************************) + +PROC put (INT CONST spalte, zeile, UNSIGNED CONST a, REPRESENTATION CONST r): + cursor (spalte, zeile); + put (a, r) +END PROC put; + +PROC put (INT CONST spalte, zeile, LIST CONST l, REPRESENTATION CONST r): + cursor (spalte, zeile); + put (l, r) +END PROC put; + +PROC put (INT CONST spalte, zeile, RANGE CONST a, REPRESENTATION CONST r): + cursor (spalte, zeile); + put (a, r) +END PROC put; + +PROC put (UNSIGNED CONST a, REPRESENTATION CONST r) : + put (text (a, r)) +END PROC put; + +PROC put (LIST CONST a, REPRESENTATION CONST r) : + INT VAR i, l :: LENGTH CONCR (a) DIV 2; + write ("("); + FOR i FROM 1 UPTO l REP + put (text (CONCR (a) ISUB i, r)); + IF i < l THEN put (",") FI + PER; + IF l > 0 THEN out (""8"") FI; + put (")") +END PROC put; + +PROC put (RANGE CONST a, REPRESENTATION CONST r) : + write (text (a.low, r)); + write ("..."); + write (text (a.high, r)) +END PROC put; +(*** ist put auf RANGE in dieser Weise sinnvoll ? + vielleicht lieber die Maske bitweise mit x, 1, 0 darstellen ? +***) + +PROC put (BOOL CONST b): + IF b + THEN put ("Ja "); + ELSE put ("Nein"); + FI +END PROC put; + + +(********************* interne Hilfsprozeduren ****************************) + +TEXT PROC text (UNSIGNED CONST a, REPRESENTATION CONST r) : + TEXT VAR result :: ""; + INT VAR i; + set conversion (TRUE); + IF CONCR (r) = 10 THEN decimal form + ELIF CONCR (r) = 2 THEN binary form + ELSE hex form FI. + +decimal form : + IF bit (a, 15) (* dann kriegt man im Eumel negatives Vorzeichen *) + THEN result := text (real (text (a)) + 65536.0); (* Der Umweg ueber + Text ist noetig, wegen (1.8.0) real (-32767-1) --> stack overflow *) + subtext (result, 1, pos (result, ".") - 1) (* Dezimalpunkt weghauen *) + ELSE text (a) FI. + +binary form : + FOR i FROM 15 DOWNTO 0 REP + IF bit (a, i) THEN result CAT "1" ELSE result CAT "0" FI + PER; + result + "b". + +hex form : + INT VAR help :: a; + FOR i FROM 1 UPTO 4 REP + rotate (help, 4); (* oberste 4 bit zu untersten 4 machen *) + result CAT (hex digits SUB nibble + 1); (* oberste 4 bit darstellen *) + PER; + result + "h". + +nibble : + help MOD 16. (* unterste 4 bit *) +END PROC text; + +TEXT PROC textform (UNSIGNED CONST a) : + (* speichert das INT in einen TEXT (mit ISUB lesbar) *) + TEXT VAR ta :: " "; + replace (ta, 1, a); + ta +END PROC textform; + +TEXT PROC reverse (TEXT CONST a) : + (* Text umdrehen. Das braucht man, um die ISUBS direkt vergleichen zu + koennen. + *) + IF LENGTH a <= 1 THEN a + ELSE reverse (subtext (a, 2)) + (a SUB 1) FI +END PROC reverse; + +PROC test up or down (TEXT CONST prompt, data) : + IF current direction <> "" AND NOT direction valid + THEN current direction := ""; + LEAVE test up or down + FI; + out (prompt); + out (" "8""8""8""8""8""8""); (* nächste 6 Zeichen Löschen *) + out (data); LENGTH data TIMESOUT ""8""; + IF NOT direction valid THEN LEAVE test up or down FI; + getchar (current direction); + IF current direction = up OR current direction = down + THEN (* verschlucken, spaeter auswerten *) + ELSE push (current direction); + current direction := "" + FI +END PROC test up or down; + +TEXT PROC to lower (TEXT CONST text) : + TEXT VAR t :: text; + INT VAR i; + FOR i FROM 1 UPTO LENGTH t REP + IF (t SUB i) >= ""65"" AND (t SUB i) <= ""90"" + THEN replace (t, i, code (code (t SUB i) + 32)) FI + PER; + t +END PROC to lower; + +END PACKET setup eumel basisoperationen; + + + +PACKET splitting DEFINES low byte, (* Copyright (C) 1985 *) + high byte, (* Martin Schönbeck, Spenge *) + low word, (* Stand: 13.09.85 *) + high word: + +INT PROC high byte (INT CONST value): + + TEXT VAR x := " "; + replace (x, 1, value); + code (x SUB 2) + +END PROC high byte; + +INT PROC low byte (INT CONST value): + + TEXT VAR x := " "; + replace (x, 1, value); + code (x SUB 1) + +END PROC low byte; + +INT PROC high word (REAL CONST double precission int): + + int (double precission int / 65536.0) + +END PROC high word; + +INT PROC low word (REAL CONST double precission int): + + string of low bytes ISUB 1. + +string of low bytes: + code (int (double precission int MOD 256.0)) + + code (int ((double precission int MOD 65536.0) / 256.0)). + +END PROC low word; + +END PACKET splitting; + + + +PACKET basic block io DEFINES + verify track, + read block, + write block: + + +PROC read block (DATASPACE VAR ds, + INT CONST ds page no, + INT CONST block no, + INT VAR return code): + read block; + retry if read error. + +read block: + block in (ds, ds page no, 0, block no, return code). + +retry if read error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + read block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN block in (ds, ds page no, 0, 0, return code) + FI. + +END PROC read block; + +PROC write block (DATASPACE CONST ds, + INT CONST ds page no, + INT CONST block no, + INT VAR return code): + write block; + retry if write error. + +write block: + block out (ds, ds page no, 0, block no, return code). + +retry if write error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + write block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN disable stop; + DATASPACE VAR dummy ds := nilspace; + block in (dummy ds, 2, 0, 0, return code); + forget (dummy ds); + enable stop + FI. + +END PROC write block; + +PROC read block (DATASPACE VAR ds, INT CONST ds page, + REAL CONST archive block): + + enable stop; + read block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht gelesen werden"); + CASE 2: error stop ("Lesefehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + +END PROC read block; + +PROC write block (DATASPACE CONST ds, INT CONST ds page, + REAL CONST archive block): + + enable stop; + write block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht geschrieben werden"); + CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + +END PROC write block; + +PROC read block (DATASPACE VAR ds, + INT CONST ds page no, + REAL CONST block no, + INT VAR return code): + read block; + retry if read error. + +read block: + block in (ds, ds page no, high word (block no) OR -512, + low word (block no), return code). + +retry if read error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + read block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN block in (ds, ds page no, 0, 0, return code) + FI. + +END PROC read block; + +PROC write block (DATASPACE CONST ds, + INT CONST ds page no, + REAL CONST block no, + INT VAR return code): + write block; + retry if write error. + +write block: + block out (ds, ds page no, high word (block no) OR -512, + low word (block no), return code). + +retry if write error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + write block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN disable stop; + DATASPACE VAR dummy ds := nilspace; + block in (dummy ds, 2, 0, 0, return code); + forget (dummy ds); + enable stop + FI. + +END PROC write block; + +PROC verify track (DATASPACE VAR ds, INT CONST ds page no, + REAL CONST startblock no, INT VAR return code): + block in (ds, ds page no, high word (startblock no) OR -256, + low word (startblock no), return code); +END PROC verify track; + +END PACKET basic block io; + + + +PACKET write file DEFINES write file, (* Copyright (C) 1985, 1987 *) + read file : (* Martin Schönbeck, Spenge *) + (* Lutz Prechelt, Karlsruhe *) + (* Stand: 07.06.87 *) + +PROC write file (TEXT CONST file name, REAL CONST start block, + INT CONST number of blocks): + + INT VAR count; + disable stop; + DATASPACE VAR ds := old (file name); + FOR count FROM 0 UPTO (number of blocks - 1) REP + write block (ds, count + 3, start block + real (count)) + UNTIL is error PER; + forget (ds). + +END PROC write file; + +PROC write file (TEXT CONST file name, REAL CONST start block, + INT CONST number of blocks, write channel): + + enable stop; + INT VAR old channel := channel; + IF old channel <> write channel THEN continue (write channel) FI; + disable stop; + write file (file name, start block, number of blocks); + IF old channel <> write channel + THEN break (quiet); + continue (old channel) + FI. +END PROC write file; + +PROC read file (DATASPACE VAR file, REAL CONST start block, + INT CONST number of blocks): + INT VAR count; + disable stop; + forget (file); file := nilspace; + FOR count FROM 0 UPTO (number of blocks - 1) REP + read block (file, count + 3, start block + real (count)) + UNTIL is error PER. +END PROC read file; + +PROC read file (DATASPACE VAR file, REAL CONST start block, + INT CONST number of blocks, read channel): + enable stop; + INT VAR old channel := channel; + IF old channel <> read channel THEN continue (read channel) FI; + disable stop; + read file (file, start block, number of blocks); + IF old channel <> channel + THEN break (quiet); + continue (old channel) + FI. +END PROC read file; + +END PACKET write file; + +PACKET thesaurus utilities +DEFINES ONE, certain : (* Stand: 21.03.88 *) + (* Korr : Lutz Prechelt *) +LET max entries = 200; + +LET oben unten rubout return = ""3""10""12""13""; + +INT VAR anzahl, + firstline, size, (* erste Bildschirmz./Anz. Zeilen für Vorgang *) + realc, virtc; (* akt. Zeile in Fenster/Eintragsnummer *) + +TEXT VAR string; + +THESAURUS PROC certain (THESAURUS CONST in, pre) : + einzelne (in, pre, TRUE). +END PROC certain; + +TEXT OP ONE (THESAURUS CONST t): + name (einzelne (t, empty thesaurus, FALSE),1) +END OP ONE; + +THESAURUS PROC einzelne (THESAURUS CONST thes, preselections, + BOOL CONST viele): + (* Benutzt nur den Rest des Bildschirms ab der aktuellen Zeile nach unten. + Die in preselections enthaltenen Namen aus t sind bereits zu Beginn + angekreuzt. + Ein Aufruf mit NOT viele und preselections/t <> empty thesaurus ist + nicht sinnvoll. + Die Cursorposition nach Verlassen ist wieder in der "aktuellen" Zeile + auf Position 1, so daß mit out (""4"") der Kram selektiv gelöscht + werden kann. + *) + ROW maxentries TEXT VAR eintrag; + THESAURUS VAR ausgabe :: empty thesaurus, + t :: empty thesaurus + thes; (* Leereinträge entfernen! *) + INT VAR i; + initialisiere ankreuzen; + IF anzahl = 0 THEN LEAVE einzelne WITH empty thesaurus FI; + bildschirm vorbereiten; + bild (1, eintrag); + virtc := 1; + realc := 1; + realcursor setzen; + kreuze an (viele, eintrag); + ausgabe erzeugen; + cursor (1, firstline - 2); out (""4""); + ausgabe. + +initialisiere ankreuzen: + anzahl := highest entry (t); + string := ""; + (* t enthält keine Leereinträge mehr ! *) + FOR i FROM 1 UPTO anzahl REP + eintrag [i] := name (t,i) + PER; + FOR i FROM 1 UPTO highest entry (preselections) REP + INT CONST preselection link :: link (t, name (preselections, i)); + IF preselection link > 0 + THEN string CAT textstr (preselection link) FI + PER. + +bildschirm vorbereiten: + get cursor (i, firstline); + out (""13""4""); (* Restbildschirm löschen *) + IF viele + THEN putline ("Wählen Löschen " + + "alle Löschen Beenden q") + ELSE putline ("Auswählen ") FI; + putline ("Marke bewegen "); + firstline INCR 2; + size := 24 - firstline + 1. + +ausgabe erzeugen: + WHILE string <> "" REP + insert (ausgabe, eintrag [string ISUB 1]); + string := subtext (string, 3); + PER +END PROC einzelne; + +PROC realcursor setzen: + TEXT CONST mark :: marke (virtc, TRUE); + cursor (1, firstline + realc - 1); + out (mark + LENGTH mark * ""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 " " + FI +END PROC marke; + +PROC bild (INT CONST anfang, ROW maxentries TEXT CONST eintrag): + cursor (1, firstline); + out (""4""3""); (* Restschirm löschen, 1 Zeile rauf *) + INT VAR i; + FOR i FROM anfang UPTO grenze REP + out (""13""10""); + out (marke (i, FALSE)); + out (eintrag [i]) + PER. + +grenze: + min (anzahl, anfang + size - 1) +END PROC bild; + +PROC kreuze an (BOOL CONST viele, ROW maxentries TEXT CONST eintrag) : + REP zeichen lesen; + zeichen interpretieren + PER. + +zeichen lesen: + TEXT VAR zeichen; + inchar (zeichen, ""1""27""3""10""13"1Xx+"11""12"Oo0-"). + +zeichen interpretieren: + SELECT code (zeichen) OF + CASE 1 (* hop *) : hoppen (eintrag) + CASE 27 (* ESC *) : IF incharety (600) = "q" THEN LEAVE kreuze an FI + CASE 3 (* rauf *) : nach oben (eintrag) + CASE 10 (* runter *) : nach unten (eintrag) + CASE 13 (* Return *) : ankreuzen (eintrag, TRUE); evtl aufhoeren + CASE 49,(* 1 *) + 88,(* X *) + 120,(* x *) + 43,(* + *) + 11 (* Rubin *) : ankreuzen (eintrag, FALSE); evtl aufhoeren + CASE 12,(* Rubout *) + 79,(* O *) + 111,(* o *) + 48,(* 0 *) + 45 (* - *) : auskreuzen (eintrag) + END SELECT. + +evtl aufhoeren: + IF NOT viele THEN LEAVE kreuze an FI. + +END PROC kreuze an; + +PROC hoppen (ROW maxentries TEXT CONST eintrag) : + zweites zeichen lesen; + zeichen interpretieren. + +zweites zeichen lesen: + TEXT VAR zz; + inchar (zz). + +zeichen interpretieren: + SELECT pos (oben unten rubout return, zz) OF + CASE 1 : hop nach oben + CASE 2 : hop nach unten + CASE 3 : alles loeschen + CASE 4 : rest ankreuzen + OTHERWISE out (""7"") + END SELECT. + +rest ankreuzen: + INT VAR i; + FOR i FROM 1 UPTO anzahl REP (* alles *) + IF nr (i) = 0 (* was noch nicht angekreuzt ist *) + THEN string CAT textstr (i) (* ankreuzen *) + FI + PER; + bild aktualisieren. + +alles loeschen: + string := ""; + bild aktualisieren. + +hop nach oben: + IF ganz oben + THEN out (""7"") + ELIF oben im fenster + THEN raufblaettern + ELSE top of page + FI. + +ganz oben: + virtc = 1. + +oben im fenster: + realc = 1. + +raufblaettern: + virtc DECR size; + virtc := max (virtc, 1); + bild (virtc, eintrag); + 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 im fenster + THEN runterblaettern + ELSE bottom of page + FI. + +ganz unten: + virtc = anzahl. + +unten im fenster: + firstline + realc > 24. + +runterblaettern: + INT VAR alter virtc :: virtc; + virtc INCR size; + virtc := min (virtc, anzahl); + realc := virtc - alter virtc; + bild (alter virtc + 1, eintrag); + realcursor setzen. + +bottom of page: + loesche marke; + alter virtc := virtc; + virtc INCR (size - realc); + virtc := min (anzahl, virtc); + realc INCR (virtc - alter virtc); + realcursor setzen +END PROC hoppen; + +PROC ankreuzen (ROW maxentries TEXT CONST eintrag, BOOL CONST ggf auskreuzen): + (* bei ggf auskreuzen wird der Eintrag, falls er schon angekreuzt ist, + ausgekreuzt, andernfalls normal angekreuzt. + *) + INT VAR pl :: nr (virtc); + IF pl <> 0 + THEN schon angekreuzt + FI; + string CAT textstr (virtc); + IF virtc < anzahl THEN nach unten (eintrag) ELSE realcursor setzen FI. + +schon angekreuzt : + IF ggf auskreuzen THEN auskreuzen (eintrag) ELSE out (""7"") FI; + LEAVE ankreuzen. +END PROC ankreuzen; + +PROC auskreuzen (ROW maxentries TEXT CONST eintrag) : + INT VAR posi :: nr (virtc); + IF posi = 0 + THEN out (""7""); LEAVE auskreuzen + FI; + rausschmeissen; + loesche marke; + bild aktualisieren; + IF virtc < anzahl THEN nach unten (eintrag) FI. + +rausschmeissen: + string := subtext (string,1, 2*posi-2) + subtext (string,2*posi+1) +END PROC auskreuzen; + +PROC bild aktualisieren: + INT VAR ob, un, i; + ob := virtc - realc + 1; + un := min (ob + size - 1, anzahl); + cursor (1, firstline - 1); + FOR i FROM ob UPTO un REP + out (""13""10""); out (marke (i, FALSE)) + PER; + realcursor setzen. +END PROC bild aktualisieren; + +PROC nach oben (ROW maxentries TEXT CONST eintrag) : + IF noch nicht oben (* virtuell *) + THEN gehe nach oben + ELSE out (""7"") + FI; + realcursor setzen. + +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, eintrag). + +cursor up: + loesche marke; + virtc DECR 1; + realc DECR 1. +END PROC nach oben; + +PROC nach unten (ROW maxentries TEXT CONST eintrag) : + IF noch nicht unten (* virtuell *) + THEN gehe nach unten + ELSE out (""7"") + FI. + +noch nicht unten: + virtc < anzahl. + +gehe nach unten: + IF realc > size - 1 + THEN scroll up + ELSE cursor down + FI. + +scroll up: + virtc INCR 1; + bild (virtc - size + 1, eintrag); + realcursor setzen. + +cursor down: + loesche marke; + virtc INCR 1; + realc INCR 1; + realcursor setzen +END PROC nach unten; + +PROC loesche marke: + out (marke (virtc, FALSE)) +END PROC loesche marke; + +TEXT PROC textstr (INT CONST nr): + TEXT VAR help :: " "; + replace (help, 1, nr); + help. +END PROC textstr; + +INT PROC nr (INT CONST zeiger): + IF pos (string, textstr (zeiger)) = 0 (* haut hin, da zeiger < 255 *) + THEN 0 + ELSE (pos (string,textstr (zeiger)) DIV 2) + 1 + FI +END PROC nr; + +PROC inchar (TEXT VAR t, TEXT CONST allowed) : + REP + getchar (t); + IF pos (allowed, t) = 0 THEN out (""7"") FI + UNTIL pos (allowed, t) > 0 PER. +END PROC inchar; + +END PACKET thesaurus utilities; + diff --git a/system/setup/3.1/src/setup eumel 2: modulzugriffe b/system/setup/3.1/src/setup eumel 2: modulzugriffe new file mode 100644 index 0000000..42163f4 --- /dev/null +++ b/system/setup/3.1/src/setup eumel 2: modulzugriffe @@ -0,0 +1,441 @@ + +(* Pakete: + 1. setup eumel modulzugriffe + Abstrakter Datentyp MODUL : Typ, Datenraumtyp, Zugriffsoperationen + 2. setup eumel modul und shard zugriffe + Zugriffe in Module und SHards (Datentyp MODUL) mit Strukturwissen +*) + +(**************************************************************************) +(***** Datentyp MODUL und Zugriffsoperationen dafür ****************) +(***** Copyright (c) 1987, 1988 by ****************) +(***** Lutz Prechelt, Karlsruhe ****************) +(**************************************************************************) + +PACKET setup eumel modulzugriffe (* Copyright (c) 1987 by *) +DEFINES int, byte, text, unsigned, (* Lutz Prechelt, Karlsruhe *) + dtcb abfragen, ccb abfragen, (* Stand : 12.03.88 1.1 *) + dtcb refinements, ccb refinements, (* Eumel 1.8.1 *) + info, + page, + copy, + datenraumtyp modul, + MODUL : + + +(* Dies Paket realisiert gezielte Zugriffe in einen Struct vom Typ MODUL. + Dies ist das Format eines SHard Moduls. Der Typ wird auch verwendet, um + das SHard-Hauptmodul oder einzelne ccbs zu handhaben! + Für die Adressierung der Bytes werden REAL-Werte verwendet, damit die + Größe nicht auf maxint beschränkt ist. Dies ist normalerweise sicher + (wegen der BCD-Arithmetik des Eumel), jedoch sind sinnlose nichtganzzahlige + Adressen dadurch möglich. Das wird aus Effizienzgründen nicht abgefangen, + die korrekte Benutzung liegt in der Verantwortung des Aufrufers. + Es sollen alle Zugriffe auf Module nur mit den Prozeduren dieses Pakets + abgewickelt werden. +*) + + +INT CONST high only ::-256, + low only :: 255; + +LET max page = 128; + +TYPE MODUL = STRUCT (ALIGN dummy, ROW 256 INT header, + ROW max page ROW 256 INT b, + INT dtcb abfragen, ccb abfragen, + TEXT dtcb ref, ccb ref, info); + +(* Der Typ kann wegen des ALIGN direkt auf einen Datenraum (für ein Modul) + gelegt werden. Der Teil b fasst 64kB Daten und kann direkt für blockout + verwendet werden. Die restlichen Teile sind nur für Module relevant. +*) + +INT CONST datenraumtyp modul :: 5687; (* Typ eines MODUL als Datenraum *) + +(*********************** INT ********************************************) + +INT PROC int (MODUL CONST m, REAL CONST byte nr) : + (* liefert das INT aus dem Modul m, das bei Byte "byte nr" beginnt *) + INT VAR page :: int (byte nr DIV 512.0) + 1, + nr :: int (byte nr MOD 512.0) DIV 2 + 1; + INT VAR whole int :: m.b[page][nr]; + IF byte nr MOD 2.0 <> 0.0 + THEN rotate (whole int, 8); (* high und low byte vertauschen *) + (whole int AND low only) + next byte in high + ELSE whole int FI. + +next byte in high : + IF nr = 256 THEN nr := 1; page INCR 1 ELSE nr INCR 1 FI; + INT VAR help :: m.b[page][nr] AND low only; + rotate (help, 8); + help. +END PROC int; + +INT PROC int (MODUL CONST m, INT CONST byte nr) : + int (m, real (byte nr)) +END PROC int; + +PROC int (MODUL VAR m, REAL CONST byte nr, INT CONST new) : + (* schreibt den neuen 16-Bit Wert new ab dem Byte "byte nr" in den Teil b + des Moduls m. Hier kommt es nicht sehr aufs Tempo an, deshalb benutzen + wir hier einfach "byte". + *) + INT VAR value :: new; + rotate (value, 8); (* high byte zu low byte machen *) + byte (m, byte nr, new AND low only); + byte (m, byte nr + 1.0, value AND low only); +END PROC int; + +PROC int (MODUL VAR m, INT CONST byte nr, INT CONST new) : + int (m, real (byte nr), new) +END PROC int; + +(************************** BYTE *******************************************) + +INT PROC byte (MODUL CONST m, REAL CONST byte nr) : + (* liefert das Byte mit der Nummer "byte nr" aus dem Teil b des Moduls m. + Das erste Byte hat die Nummer 0 + *) + INT CONST page :: int (byte nr DIV 512.0) + 1, + nr :: int (byte nr MOD 512.0) DIV 2 + 1; + INT VAR whole int :: m.b[page][nr]; + IF byte nr MOD 2.0 <> 0.0 + THEN rotate (whole int, 8); (* high und low byte vertauschen *) FI; + whole int AND low only. +END PROC byte; + +INT PROC byte (MODUL CONST m, INT CONST byte nr) : + byte (m, real (byte nr)) +END PROC byte; + +PROC byte (MODUL VAR m, REAL CONST byte nr, INT CONST new) : + (* Schreibt die unteren 8 bit von new an das Byte der Stelle byte nr im + Modul m + *) + INT CONST page :: int (byte nr DIV 512.0) + 1, + nr :: int (byte nr MOD 512.0) DIV 2 + 1; + INT VAR new byte :: new AND low only, + whole int :: m.b[page][nr]; + m.b[page][nr] := new int. + +new int : + IF byte nr MOD 2.0 = 0.0 (* low byte ändern ? *) + THEN (whole int AND high only) + new byte + ELSE rotate (new byte, 8); (* new nach high rotieren *) + new byte + (whole int AND low only) + FI. +END PROC byte; + +PROC byte (MODUL VAR m, INT CONST byte nr, INT CONST new) : + byte (m, real (byte nr), new) +END PROC byte; + +(*********************** TEXT ********************************************) + +TEXT PROC text (MODUL CONST m, REAL CONST first byte nr, INT CONST length) : + (* Extrahiert die naechsten length bytes aus m ab byte nr als TEXT *) + REAL VAR i :: first byte nr; + TEXT VAR result :: ""; + WHILE i < first byte nr + real (length) REP + result CAT code (byte (m, i)); + i INCR 1.0 + PER; + result. +END PROC text; + +TEXT PROC text (MODUL CONST m, INT CONST first byte nr, INT CONST length) : + text (m, real (first byte nr), length) +END PROC text; + +(* Ein schreibendes Analogon zu "text" gibt es nicht. *) + +(*********************** unsigned *****************************************) + +REAL PROC unsigned (INT CONST sixteen bits) : + (* hiermit kann man die Vorzeichenprobleme umschiffen, die der Eumel bei + INTs über maxint macht. + Liefert das INT als 16-Bit unsigned Wert interpretiert im REAL-Format. + *) + real (text (sixteen bits, dec)) +END PROC unsigned; + +INT PROC unsigned (REAL CONST sixteen bit value) : + (* Umkehrung des obigen : REAL 0..65536 rein, passenden 16 bit unsigned + Wert raus + *) + TEXT CONST t :: text (sixteen bit value); + int (unsigned (value text)). + +value text : + IF pos (t, ".") <> 0 + THEN subtext (t, 1, pos (t, ".") - 1) + ELSE t + FI. +END PROC unsigned; + +(******************** dtcb, ccb, info **************************************) + +INT PROC dtcb abfragen (MODUL CONST m) : + m.dtcb abfragen +END PROC dtcb abfragen; + +PROC dtcb abfragen (MODUL VAR m, INT CONST neu) : + m.dtcb abfragen := neu +END PROC dtcb abfragen; + +TEXT PROC dtcb refinements (MODUL CONST m) : + m.dtcb ref +END PROC dtcb refinements; + +PROC dtcb refinements (MODUL VAR m, TEXT CONST neu) : + m.dtcb ref := neu +END PROC dtcb refinements; + +INT PROC ccb abfragen (MODUL CONST m) : + m.ccb abfragen +END PROC ccb abfragen; + +PROC ccb abfragen (MODUL VAR m, INT CONST neu) : + m.ccb abfragen := neu +END PROC ccb abfragen; + +TEXT PROC ccb refinements (MODUL CONST m) : + m.ccb ref +END PROC ccb refinements; + +PROC ccb refinements (MODUL VAR m, TEXT CONST neu) : + m.ccb ref := neu +END PROC ccb refinements; + +TEXT PROC info (MODUL CONST m) : + m.info +END PROC info; + +PROC info (MODUL VAR m, TEXT CONST neu) : + m.info := neu +END PROC info; + +(********************* page **********************************************) + +(* Die Prozedur page dient dazu, aus dem Datenbereich b eines MODULs + einzelne Seiten (512 Byte Blöcke) in Form eines ROW 256 INT anzusprechen + um damit blockin/blockout zu machen. + Die Seitennummern gehen von 1 bis max page +*) + +ROW 256 INT PROC page (MODUL CONST m, INT CONST page nr) : + m.b[page nr] +END PROC page; + +PROC page (MODUL VAR m, INT CONST page nr, ROW 256 INT CONST new page) : + m.b[page nr] := new page +END PROC page; + +(*********************** copy ********************************************) + +PROC copy (MODUL CONST from, REAL CONST origin, + MODUL VAR to, REAL CONST destination, INT CONST length) : + (* Kopiert schnell eine Anzahl von Bytes aus einem Modul in ein anderes + die Optimierung klappt nur, wenn von einer geraden Adresse an eine + gerade Adresse kopiert wird oder von ungerade nach ungerade. + Macht cout. + *) + INT VAR i, interval :: cout interval; + REAL VAR offset :: 0.0; + IF length < 0 THEN errorstop ("copy : length = " + text (length)) FI; + IF origin MOD 2.0 <> destination MOD 2.0 + THEN copy slow + ELSE copy fast FI; + cout (length). + +cout interval : + IF length > 1024 THEN 32 + ELIF length > 64 THEN 8 + ELSE 1 FI. + +copy slow : + FOR i FROM 1 UPTO length REP + IF i MOD 2*interval = 0 THEN cout (i) FI; + byte (to, destination + offset, byte (from, origin + offset)); + offset INCR 1.0 + PER. + +copy fast : + IF origin MOD 2.0 <> 0.0 AND length > 0 + THEN byte (to, destination, byte (from, origin)); + offset := 1.0 + FI; + FOR i FROM 1 UPTO (length - int (origin MOD 2.0)) DIV 2 REP + INT CONST page1 :: int ((origin+offset) DIV 512.0) + 1, + nr1 :: int ((origin+offset) MOD 512.0) DIV 2 + 1, + page2 :: int ((destination+offset) DIV 512.0) + 1, + nr2 :: int ((destination+offset) MOD 512.0) DIV 2 + 1; + to.b[page2][nr2] := from.b[page1][nr1]; + IF i MOD interval = 0 THEN cout (2*i) FI; + offset INCR 2.0 + PER; + IF length - int (offset) = 1 + THEN byte (to, destination + offset, byte (from, origin + offset)) FI. +END PROC copy; + +(************************ Hilfsprozeduren ********************************) + +REAL OP DIV (REAL CONST a, b) : + floor (a/b) +END OP DIV; + +END PACKET setup eumel modulzugriffe; + + +(**************************************************************************) +(***** Zugriffe in Module mit Strukturwissen ****************) +(***** Copyright (c) 1988 by ****************) +(***** Lutz Prechelt, Karlsruhe ****************) +(**************************************************************************) + +PACKET setup eumel modul und shard zugriffe (* Copyright (c) 1988 by *) +DEFINES sh dtcb offset, (* Lutz Prechelt, Karlsruhe *) + sh ccb offset, (* Stand : 23.04.88 1.2 *) + get new channel table, (* Eumel 1.8.1 *) + init modules list, + all modules, + module type, + module name: + +(* Dieses Paket definiert Operationen zum Zugriff auf bestimmte Daten in + SHardmodulen und SHards. Es ist hierin Wissen über die Struktur dieser + Teile enthalten. + Beschreibung des SHardformats siehe setup eumel 4: modulkonfiguration +*) + +LET nr of channels total = 40, + offset channel table pointer = 10; + +THESAURUS VAR all the beautiful modules we know :: emptythesaurus; + +(******************* Kanaltabelle lesen/schreiben **************************) + +(* Hier geht schöne Struktur (und damit zugleich einfache Programmierung) + über gute Performance. (Wir lesen einiges mehrfach) +*) + +REAL PROC sh dtcb offset (MODUL CONST shard, INT CONST kanal) : + unsigned (int (shard, ct + 4 * kanal)). + +ct : + int (shard, offset channel table pointer). +END PROC sh dtcb offset; + +REAL PROC sh ccb offset (MODUL CONST shard, INT CONST kanal) : + unsigned (int (shard, ct + 4 * kanal + 2)). + +ct : + int (shard, offset channel table pointer). +END PROC sh ccb offset; + +PROC sh dtcb offset (MODUL VAR shard, INT CONST kanal, REAL CONST value) : + int (shard, ct + 4 * kanal, unsigned (value)). + +ct : + int (shard, offset channel table pointer). +END PROC sh dtcb offset; + +PROC sh ccb offset (MODUL VAR shard, INT CONST kanal, REAL CONST value) : + int (shard, ct + 4 * kanal + 2, unsigned (value)). + +ct : + int (shard, offset channel table pointer). +END PROC sh ccb offset; + +PROC get new channel table (MODUL CONST new shard, + ROW 256 INT VAR channel table of new shard) : + (* Kopiert die Kanaltabelle aus new shard nach + channel table of new shard + *) + INT VAR offset :: int (new shard, offset channel table pointer); + INT VAR i; + FOR i FROM 1 UPTO 2 * nr of channels total REP + channel table of new shard [i] := int (new shard, offset); + offset INCR 2 + PER. +END PROC get new channel table; + +(********************* modules list handling *****************************) + +TEXT VAR m list; + +PROC init modules list : + (* Baut in der Variablen m list einen "Assoziativspeicher" für + Modulnamen <--> Modultyp auf und erstellt eine Liste aller + Shardmoduldateinamen für "all modules" + Der Text m list enthält für jede Datei, die ein SHardmodul enthält, + einen Eintrag folgender Form : + ""0"", modultyp, ""0"", Dateiname, ""0"" + Dabei ist modultyp genau 4 Byte lang. + Diese Eintragsform ermöglicht ein (auf dem Eumel) sehr effizientes + Suchen, sowohl von Modultypen zu Modulnamen als auch umgekehrt. + Die Prozedur macht cout (dateinummer) + *) + INT VAR i; + TEXT VAR t; + m list := ""; all the beautiful modules we know := empty thesaurus; + FOR i FROM 1 UPTO highest entry (all) REP + cout (i); + t := name (all, i); + IF t <> "" CAND type (old (t)) = datenraumtyp modul + THEN add t FI + PER. + +add t : + insert (all the beautiful modules we know, t); + TEXT CONST typ :: read module type (t); + m list cat typmarker; + m list CAT t; + m list CAT ""0"". + +m list cat typmarker : + m list CAT ""0""; + m list CAT typ; + m list CAT ""0"". +END PROC init modules list; + +THESAURUS PROC all modules : + all the beautiful modules we know. +END PROC all modules; + +TEXT PROC read module type (TEXT CONST datei) : + (* Liefert den 4-Byte Modultyp des in der Datei datei enthaltenen + SHardmoduls, falls möglich, andernfalls "" + *) + IF NOT exists (datei) COR type (old (datei)) <> datenraumtyp modul + THEN "" + ELSE BOUND MODUL CONST m :: old (datei); + text (m, int (m, 8), 4) + FI. +END PROC read module type; + +TEXT PROC module type (TEXT CONST module name) : + (* Liefert den 4-Byte Modultyp zu module name aus m list, sofern vorhanden + andernfalls "" + *) + INT CONST p :: pos (m list, ""0"" + module name + ""0""); + IF p = 0 + THEN "" + ELSE subtext (m list, p - 4, p - 1) FI. +END PROC module type; + +TEXT PROC module name (TEXT CONST module type) : + (* Liefert den Moduldateinamen zum 4-Byte Modultyp module type, oder + "" falls kein solches Modul vorhanden. + *) + INT VAR p :: pos (m list, ""0"" + module type + ""0""); + IF p = 0 + THEN "" + ELSE p INCR 6; + subtext (m list, p, pos (m list, ""0"", p) - 1) + FI. +END PROC module name; + +END PACKET setup eumel modul und shard zugriffe; + diff --git a/system/setup/3.1/src/setup eumel 3: modulkonfiguration b/system/setup/3.1/src/setup eumel 3: modulkonfiguration new file mode 100644 index 0000000..529d0de --- /dev/null +++ b/system/setup/3.1/src/setup eumel 3: modulkonfiguration @@ -0,0 +1,854 @@ + +(**************************************************************************) +(***** Ergänzung des SHards um ein Modul (mit Dialog) *****************) +(***** Copyright (c) 1987, 1988 by *****************) +(***** Lutz Prechelt, Karlsruhe *****************) +(**************************************************************************) + +PACKET setup eumel modulkonfiguration (* Copyright (c) by *) +DEFINES configurate module, (* Lutz Prechelt, Karlsruhe *) + print configuration, (* Eumel 1.8.1 *) + give me, take you, (* Stand : 12.07.88 3.2 *) + new index, + perform dtcb dialogue, + perform ccb dialogue, + (* für Modulprogrammierer : *) + write info, + channel free, + reserve channel, + channels of this module, + buffer address : + +(* Dieses Modul führt den kompletten Dialog mit dem Benutzer durch, der + nötig ist, um alle Kanäle, die mit demselben Modul laufen sollen, zu + konfigurieren. + Verfahren : + im alten SHard den dtcb suchen + dtcb und Modul im neuen SHard eintragen + dtcb mit oder ohne Vorbild konfigurieren + alle ccbs zu dem Modul im alten SHard suchen und Kanalnummern merken + Auswahl einer Kanalmenge durch Benutzer mit alten als Vorschlag + ccbs in neuen SHard kopieren + ccbs mit oder ohne Vorbild konfigurieren + Kanaltabelle auf den neuen Stand bringen + neuen Shard und seine geänderte Länge zurückgeben + + Dabei kann der "Dialog" bei geeigneten Rahmenbedingungen durch bloßes + Übertragen der Werte aus einem Vorlage-SHard ersetzt werden, wenn der + Benutzer dies wünscht (want automatic mode). Dann geht alles von selbst. + (....kaufen Sie Setup-Eumel und es geht alles wie von selbst !) + +Format des SHard-Hauptmoduls : + 1. (Byte 0-2) jmp boot (3 Byte) + 2. (Byte 3) reserviert + 3. (Byte 4) SHard-Version + 4. (Byte 5) SHard-Release + 5. (Byte 6/7) SHardlänge (2 Byte) + 6. (Byte 8/9) Verweis auf Bad-Block Tabelle (2 Byte) + 7. (Byte 10/11) Verweis auf Kanaltabelle + 8. (Byte 16-175) Eumelleiste + 9. (Byte 176-299) SHardleiste + 10. (ab Byte 300) Shardhauptmodulroutinen und -daten + 11. (danach) Rumpf des Hauptmoduls mit Bad-Block-Tabelle, + Kanaltabelle, Routinen und Daten + 12. (danach) Folge der Module (bis Byte SHardlänge - 1) + +Kanaltabelle: + feste Länge 40 Einträge "nr of channels total" (Kanal 0 bis Kanal 39) + jeder Eintrag besteht aus : (alles 2 Byte) + offset dtcb, offset ccb + +Achtung : Dieses Programm schmiert bei SHards über 32767 Byte Länge + eventuell ab (es hat noch niemand probiert) ! + +Abkürzungen: cb steht für control block und meint entweder ccb oder dtcb + +Implementationsanmerkung : +Bei der Verwendung von THESAURUS wird von dem Wissen über die Art der +Implementation derselben Gebrauch gemacht, indem folgende Annahmen in den +Code eingehen: +1. Bei einem THESAURUS, in dem nicht gelöscht wurde, ist highest entry gleich + der Kardinalität +2. außerdem entspricht dann die Nummer (link) eines Eintrags seinem + Eintragszeitpunkt, d.h. der Position in der Eintragsfolge +3. + und - liefert THESAURi, in denen nicht gelöscht wurde und die Eintrags- + reihenfolge ist wie von den Parametern vorgegeben (bei + links zuerst) +4. certain und ONE liefern THESAURi, in denen nicht gelöscht wurde. +*) + +(************************* Daten ********************************) + +LET nr of channels total = 40, (* SHard Tabellenlänge *) + mdts = 40, (* max dialogtable size in INTs *) + mchm = 20, (* max channels for module *) + offset sh version = 4, + offset sh structureversion = 5, + offset shardlength = 6, + + do name = "PrOgRaM tO Do"; + +LET UNSIGNED = INT, + VARIABLES = ROW mdts ROW mchm INT; +TEXT CONST variables var xxv :: "ROW " + text (mdts) + " ROW "+ + text (mchm) + " INT VARxxv;"; + +VARIABLES VAR v; (* siehe give me / take you *) + +INT VAR max index; (* Information für new index *) + +INT VAR channels of module; (* Information für channels of this module *) + +TEXT VAR actual info; (* fuer write info *) + +ROW 256 INT VAR channel table of new shard; (* für channel free *) + +DATASPACE VAR dummy ds; (* für print configuration *) + +REAL VAR new shard length; + +(***************************************************************************) +(************* Hier geht's los...... ***************************************) +(***************************************************************************) + +(******************** configurate module **********************************) + +PROC configurate module (MODUL VAR new shard, MODUL CONST old shard, + BOOL CONST old shard valid, want automatic mode, + TEXT CONST modulname) : + do configurate module (new shard, old shard, old shard valid, + want automatic mode, modulname, FALSE) +END PROC configurate module; + +(********************** print configuration *******************************) + +PROC print configuration (MODUL CONST old shard, TEXT CONST modulname) : + (* Es ist hier schon sichergestellt, daß old shard valid ist und das Modul + auch im SHard enthalten + *) + forget (dummy ds); dummy ds := nilspace; + BOUND MODUL VAR dummy :: dummy ds; + do configurate module (dummy, old shard, TRUE, FALSE, modulname, TRUE); + forget (dummy ds). +END PROC print configuration; + + +(******************* do configurate module *********************************) + +PROC do configurate module (MODUL VAR new shard, MODUL CONST old shard, + BOOL CONST old shard valid, want automatic mode, + TEXT CONST modulname, + BOOL CONST print configuration only): + (* In dieser Prozedur ist die Beschränkung auf Module mit unter 32kB + Länge ausgenutzt. + Ist kein alter SHard vorhanden, so muss ein leerer SHard übergeben + werden (d.h. alle Einträge in der Kanaltabelle sind 0). + Ein alter SHard darf keinesfalls unterschiedliche releases desselben + Modultyps enthalten. + Resultierende SHardgesamtlängen von über 32k sind noch nicht getestet. + *) + BOUND MODUL VAR m; + INT VAR (***** Daten über das neue Modul *****) + sh version, sh structure version, release, + max ccb, nr of ccbs, + dtcb table entries, offset dtcb table, (* Variablentabellen *) + ccb table entries, offset ccb table, + muster ccb length, offset muster ccb, (* Muster-ccb im Modul *) + module body length, (* Länge des zu kopierenden Modulrumpfs *) + offset module body, offset dtcb; + TEXT VAR modultyp; (* 4 Byte *) + INT VAR (***** Daten über den alten SHard *****) + old release :: -2; (* garantiert inkompatibel *) + REAL VAR offset old dtcb :: 0.0; + ROW nr of channels total REAL VAR offset old ccb; + BOOL VAR old cbs valid :: FALSE; + THESAURUS VAR old channels :: empty thesaurus; + (***** Daten über den neuen SHard *****) + REAL VAR dtcb location; + ROW nr of channels total REAL VAR ccb location; + (***** Sonstige Daten *****) + INT VAR i, k, kanal, ccb count; + BOOL VAR automatic mode, configurate :: NOT print configuration only; + reset direction (FALSE); (* zur Sicherheit *) + IF configurate + THEN new shard length := unsigned (int (new shard, offset shard length)) FI; + connect module; + get module data; + test sh version compatibility; (* ggf. LEAVE *) + (* Bisher wurde nur gelesen, ab jetzt darf nicht mehr abgebrochen werden *) + search old shard for module and find all old ccbs; + test release compatibility; (* ggf. LEAVE *) + IF configurate + THEN write module with dtcb to shard; + perhaps set automatic mode; + FI; + configurate dtcb; + IF configurate + THEN kopf; + select channels; + write ccbs to shard; + ELSE nr of ccbs := highest entry (old channels) + FI; + configurate ccbs; + IF configurate + THEN make entries in channeltable of new shard; + int (new shard, offset shardlength, unsigned (new shard length)) + FI. + +connect module : + m := old (modulname); + actual info := info (m); + IF configurate + THEN kopf + ELSE put ("-----"); put (modulname); putline ("-----") + FI. + +get module data : + (* Format des Moduls in den ersten Bytes: + Byte Entry + 0/1 offset dtcb variablen tabelle + 2/3 offset ccb variablen tabelle + 4/5 offset muster-ccb + 6/7 offset modulrumpf + 8/9 offset dtcb + 10/11 max anzahl ccbs + die tabellen enthalten im ersten Wort die Anzahl ihrer Einträge + der modulrumpf und der ccb ihre Länge in Byte + die Länge der Tabellen ergibt sich aus den offset-Differenzen. + dtcb-Format : Modultyp (4 Byte) + SHardversion (1 Byte) + SHardstrukturversion (1 Byte) + Modulrelease (2 Byte) .... + *) + max ccb := int (m, 10); + offset dtcb table := int (m, 0); + dtcb table entries := int (m, offset dtcb table); + offset ccb table := int (m, 2); + ccb table entries := int (m, offset ccb table); + offset muster ccb := int (m, 4); + muster ccb length := int (m, offset muster ccb); + offset module body := int (m, 6); + module body length := int (m, offset module body); + offset dtcb := int (m, 8); +(***** +put (" offset dtcb table:"); put( offset dtcb table); line; +put (" dtcb table entrie:"); put( dtcb table entries); line; +put (" offset ccb table :"); put( offset ccb table); line; +put (" ccb table entrie:"); put( ccb table entries); line; +put (" offset muster ccb:"); put( offset muster ccb); line; +put (" muster ccb length:"); put( muster ccb length); line; +put (" offset module bod:"); put( offset module body); line; +put (" module body lengt:"); put( module body length); line; +put (" offset dtcb :"); put( offset dtcb); line;*****) + modultyp := text (m, offset dtcb, 4); + sh version := byte (m, offset dtcb + 4); + sh structureversion := byte (m, offset dtcb + 5); + release := int (m, offset dtcb + 6). + +test sh version compatibility : + IF configurate AND NOT version is compatible + THEN putline ("Das Modul ist mit dieser SHard-Version nicht mehr verträglich."); + putline (""10""10""15" Installation des Moduls wird abgebrochen. "14""7""13""10""); + go on; + LEAVE do configurate module + FI. + +version is compatible: + (* Kompatibel, wenn das Modul eine ältere oder gleiche sh version verlangt + und die gleiche sh structureversion + *) + sh version <= byte (new shard, offset sh version) CAND + sh structure version = byte (new shard, offset sh structureversion). + +search old shard for module and find all old ccbs : + (* Es werden alle Kanäle des alten SHard untersucht, ob der dortige Treiber + den gleichen Modultyp hat und in diesem Fall die Kanalnummer in + "old channels" gesammelt, sowie offset old ccb gemerkt, im Nichterfolgs- + falle wird offset old ccb auf diesem Kanal 0 gesetzt. + Es werden auch alle verketteten Treiber untersucht. + Auch old cbs valid und offset old dtcb werden ggf. gesetzt. + *) + IF NOT old shard valid + THEN LEAVE search old shard for module and find all old ccbs FI; + IF configurate THEN put ("Ich untersuche den alten SHard :") FI; + FOR kanal FROM 0 UPTO nr of channels total - 1 REP + IF configurate THEN cout (kanal) FI; + collect ccbs on this channel + PER; + IF configurate THEN put (""13""5"") FI. (* Zeile löschen *) + +collect ccbs on this channel : + REAL VAR p dtcb :: sh dtcb offset (old shard, kanal), + p ccb :: sh ccb offset (old shard, kanal); + WHILE p dtcb <> 0.0 AND p ccb <> 0.0 REP + BOOL CONST success :: text (old shard, p dtcb, 4) = modultyp; + IF success + THEN offset old dtcb := p dtcb; + old release := int (old shard, p dtcb + 6.0); + insert (old channels, text (kanal)); + offset old ccb [kanal+1] := p ccb + ELSE p dtcb := unsigned (int (old shard, p ccb + 2.0)); (* verkettet *) + p ccb := unsigned (int (old shard, p ccb + 4.0)) + FI + UNTIL success PER; + old cbs valid := old shard valid AND offset old dtcb <> 0.0 AND + (release = old release + 1 OR release = old release). + +test release compatibility: + IF print configuration only AND NOT old cbs valid + THEN putline ("Kein Zugriff auf die Konfigurationsdaten möglich"); + LEAVE do configurate module + FI. + +write module with dtcb to shard : + put ("Modul """ + modulname + """ wird in den SHard eingetragen :"); + IF int (new shard length MOD 2.0) <> offset module body MOD 2 + THEN new shard length INCR 1.0 FI; (* kopiert so schneller *) + dtcb location := new shard length + + real (offset dtcb - offset module body); + copy (m, real (offset module body), new shard, new shard length, + module body length); + new shard length INCR real (module body length). + +perhaps set automatic mode : + IF old cbs valid AND old release = release + THEN automatic mode := want automatic mode + ELSE automatic mode := FALSE FI. + +configurate dtcb : + IF configurate + THEN kopf; + putline ("Konfiguration des Treibers :"); + get new channel table (new shard, channel table of new shard); + FI; + perform dtcb dialogue (m, real (offset dtcb table+2), dtcb table entries, + new shard, dtcb location, + old shard, offset old dtcb, + old cbs valid, release = old release, + dtcb refinements (m), dtcb abfragen (m), + automatic mode, print configuration only). + +select channels : + ccb count := highest entry (old channels); + k := min (ccb count, max ccb); (* .... Mutter der Porzellankiste *) + nr of ccbs := max (k, 1); + IF automatic mode THEN LEAVE select channels FI; + IF max ccb > 1 + THEN REP + editget ("Wieviele Kanäle mit diesem Treiber (1 bis " + + text (max ccb) + ") : ", nr of ccbs); + out (""13"") + UNTIL nr of ccbs IN range (1, max ccb) PER; + out (""10""10"") + ELSE nr of ccbs := 1 FI; + IF nr of ccbs < ccb count (* weniger als früher *) + THEN put ("Wählen Sie mindestens"); putline (x kanäle aus deren); + putline ("Werte nicht als Vorbesetzung angeboten werden sollen"10""); + REP + THESAURUS CONST help :: certain (old channels, empty thesaurus); + IF NOT enough refused THEN out (""7"") FI + UNTIL enough refused PER; + old channels := old channels - help; + out (""3""3""3""4"") (* clear screen from incl. "Wählen..." on *) + FI. + +x kanäle aus deren : + IF ccb count - nr of ccbs > 1 + THEN text (ccb count - nr of ccbs) + " Kanäle aus, deren" + ELSE "einen Kanal aus, dessen" FI. + +enough refused : + highest entry (help) >= ccb count - nr of ccbs. + +write ccbs to shard : + (* Ausserdem wird hier ccb location vorbereitet *) + out ("Die Kanäle werden in den neuen SHard eingetragen : "); + FOR i FROM 1 UPTO nr of ccbs REP + ccb location [i] := new shard length; + copy (m, real (offset muster ccb + 2), new shard, new shard length, + muster ccb length); + new shard length INCR real (muster ccb length) + PER. + +configurate ccbs : + (*put (old shard valid); put ("Release:"); put (release); put (" old release:"); put (old release); + put (old cbs valid); pause;*) + IF configurate + THEN out (""13""10"Konfiguration der Kanäle:"13""10""); + get new channel table (new shard, channel table of new shard) + FI; + ccb count := 0; + FOR kanal FROM 0 UPTO nr of channels total REP + IF old channels CONTAINS text (kanal) + THEN ccb count INCR 1; + offset old ccb [ccb count] := offset old ccb [kanal+1] + FI + PER; + FOR i FROM ccb count + 1 UPTO nr of ccbs REP + offset old ccb [i] := 0.0 + PER; + perform ccb dialogue (m, real (offset ccb table+2), ccb table entries, + new shard, ccb location, + old shard, offset old ccb, + nr of ccbs, + offset old dtcb <> 0.0, release = old release, + ccb refinements (m), ccb abfragen (m), + automatic mode, print configuration only). + +make entries in channeltable of new shard : + kopf; + out ("Konfigurationsdaten werden in den neuen SHard eingetragen : "); + FOR i FROM 1 UPTO nr of ccbs REP + cout (i); + kanal := (*v[1][i]falsch???!!!*) byte (new shard, ccb location [i]); + make entry in channeltable of new shard + PER. + +make entry in channeltable of new shard : + IF NOT channel free (kanal) + THEN (* dtcb/ccb Adresse aus channel table nach neuem ccb umtragen. *) + int (new shard, ccb location [i] + 2.0, + unsigned (sh dtcb offset (new shard, kanal))); + int (new shard, ccb location [i] + 4.0, + unsigned (sh ccb offset (new shard, kanal))); + ELSE (* Folge-dtcb/ccb Adresse auf 0 setzen *) + int (new shard, ccb location [i] + 2.0, 0); + int (new shard, ccb location [i] + 4.0, 0); + FI; + (* Jetzt neue Adresse in channel table eintragen *) + sh dtcb offset (new shard, kanal, dtcb location); + sh ccb offset (new shard, kanal, ccb location [i]); + k := byte (new shard, ccb location [i] + 1.0); (* Zusatzkanalnummer *) + IF k <> 255 (* 255 = kein Zusatzkanal vorhanden *) + THEN (* IF NOT channel free (k) THEN alter eintrag futsch !!! *) + sh dtcb offset (new shard, k, dtcb location); + sh ccb offset (new shard, k, ccb location [i]) + FI. + +kopf : + write head ("""" + modulname + """ in den SHard aufnehmen"); + out (actual info); + out (""13""10""). +END PROC do configurate module; + + +(********************* perform dialogue ************************************) + +PROC perform dtcb dialogue + (MODUL VAR m, REAL CONST offset dialogue table, + INT CONST dialogue table entries, + MODUL VAR dtcb, REAL CONST offset dtcb, + MODUL CONST old dtcb, REAL CONST offset old dtcb, + BOOL CONST old dtcb valid, same release, + TEXT CONST refinements, INT CONST count, + BOOL CONST automatic mode, print configuration only): + ROW nr of channels total REAL VAR offset cb, offset old cb; + offset cb [1] := offset dtcb; + offset old cb [1] := offset old dtcb; + perform dialogue (TRUE, m, offset dialogue table, dialogue table entries, + dtcb, offset cb, old dtcb, offset old cb, 1, + old dtcb valid, same release, refinements, count, + automatic mode, print configuration only). +END PROC perform dtcb dialogue; + +PROC perform ccb dialogue + (MODUL VAR m, REAL CONST offset dialogue table, + INT CONST dialogue table entries, + MODUL VAR ccb, ROW nr of channels total REAL CONST offset ccb, + MODUL CONST old ccb, ROW nr of channels total REAL CONST offset old ccb, + INT CONST nr of ccbs, BOOL CONST old ccbs valid, same release, + TEXT CONST refinements, INT CONST count, + BOOL CONST automatic mode, print configuration only) : + perform dialogue (FALSE, m, offset dialogue table, dialogue table entries, + ccb, offset ccb, old ccb, offset old ccb, nr of ccbs, + old ccbs valid, same release, refinements, count, + automatic mode, print configuration only). +END PROC perform ccb dialogue; + + +PROC perform dialogue + (BOOL CONST is dtcb, + MODUL VAR m, REAL CONST offset dialogue table, + INT CONST dialogue table entries, + MODUL VAR cb, ROW nr of channels total REAL CONST offset cb, + MODUL CONST old cb, ROW nr of channels total REAL CONST offset old cb, + INT CONST nr of cbs, BOOL CONST old cb valid, same release, + TEXT CONST refinements, INT CONST refinement count, + BOOL CONST automatic mode, print configuration only) : + (* Konfigurationsdialog für einen (Satz von) Kontrollblock(s) oder bloßes + Anzeigen der Konfigurationsdaten derselben. + + 1. bei NOT print configuration only: + Führt den Dialog für eine Tabelle (also ccb oder dtcb Variablentabelle) + durch und bestückt den controlblock entsprechend. + Es wird gleich eine ganze Tabelle von controlblocks (max. mchm Stück) + abgearbeitet und zwar nr of cbs Stück; im Falle is dtcb wird natürlich + nur der Eintrag 1 der Tabellen benutzt (vom Aufrufer). + Das Eingabemodul ist m mit der zu bearbeitenden Tabelle an der Stelle + offset dialogue table. Die Tabelle enthält dialogue table entries + Einträge (max. mdts Stück !) + Die Ausgabe des Prozesses landet im Modul cb ab den Stellen offset cb. + cb ist dabei jeweils der neue SHard, damit man nicht das Modul ändert. + Die Vorlagen zum Abgucken liefert, falls old cb valid ist, das + Modul old cb (der alte SHard) ab offset old cb, dabei ist die Struktur + gleich der neuen, wenn same release gilt, andernfalls sind die + Vorversionsoffsets zu benutzen (Versionsnummer um genau 1 erhöht). + Bei automatic mode werden nur still diese Vorgabewerte übernommen. + Die Elan-Teile für den Dialog liefert schliesslich der Text refinements, + er enthält refinement count Abfragen der Namen r1, r2, ..... + Wenn refinent count = 0 ist, passiert hier eigentlich nichts, + deshalb sollte dann + für eine korrekte Initialisierung auch die Variablentabelle leer sein; + ist sie es allerdings doch nicht, werden hier noch die Standardwerte in + die ccbs eingetragen und nur der leere Dialog unterdrückt. + Vor Beginn/Nach Ende des gesamten Dialogs wird das refinement + dialoguestart/dialogueend aufgerufen; bei NOT is dtcb vor/nach dem Dialog + jedes Kanals auch noch channelstart/channelend. + + 2. bei print configuration only: + Die Daten zum new shard werden überhaupt nicht benutzt, von den + refinements wird nur für jeden Kanal einmal "print configuration" + aufgerufen. + *) + REAL VAR table byte :: offset dialogue table; + ROW mdts INT VAR offset, old offset, length; + INT VAR i, k; + BOOL VAR configurate :: NOT print configuration only; + TEXT VAR program, t; + IF print configuration only (* Hier wird evtl. schon verlassen *) + THEN startup for print + ELSE startup for dialogue FI; + IF refinement count > 0 THEN build program FI; + build data in v; + IF refinement count > 0 THEN do program FI; + IF configurate THEN put values in cb FI. + +startup for print : + IF refinement count = 0 OR dialogue table entries = 0 + THEN LEAVE perform dialogue FI. + +startup for dialogue: + IF refinement count = 0 + THEN putline ("Keine Konfiguration notwendig."); + IF dialogue table entries = 0 + THEN pause (20); LEAVE perform dialogue FI + ELSE putline ("Die Konfiguration wird vorbereitet.") FI. + +build program: + max index := refinement count; (* damit new index bescheid weiss *) + program := variables var xxv; + program cat main part; + perhaps program cat data refinements; + program CAT refinements. + +program cat main part : + program CAT "LET UNSIGNED=INT;giveme(xxv);INT VARxxi::1,actchannel;"; + IF print configuration only OR automatic mode + THEN program cat main part for print or automatic mode + ELSE program cat main part for dialogue FI. + +program cat main part for print or automatic mode: + (* Leider muss man, wenn man den Modulprogrammierer bei den .ccb und .dtcb + Teilen nicht zu stark reglementieren will, einiges mitübersetzen, was + dann gar nicht benutzt wird (z.B. alle Refinements). + Und der Gedanke macht ihn blaß, + wenn er fragt: was kostet das ? + Wilhelm Busch + *) + program CAT "FORactchannelFROM 1 UPTOchannelsofthismoduleREP"; + IF print configuration only + THEN program CAT "printconfigurationPER." + ELSE (* automatic mode: *) program CAT "automaticPER;takeyou(xxv)." + FI; + program CAT " xxa:actchannel. thischannel:"; + IF NOT is dtcb THEN program CAT "channelstart;" FI; + FOR i FROM 1 UPTO refinement count REP + program CAT "r"; (* Alle in this channel aufrufen, damit *) + program CAT text (i); (* "LEAVE this channel" kein Fehler ist. *) + program CAT ";" + PER; + IF NOT is dtcb + THEN program CAT "channelend" FI; + program CAT ". ". + +program cat main part for dialogue: + program CAT "dialoguestart;FORactchannelFROM 1 UPTOchannelsofthismoduleREP"; + program CAT "thischannelPER;dialogueend;takeyou(xxv). "; + program CAT "xxa:actchannel. thischannel:"; + IF NOT is dtcb THEN program CAT "channelstart;" FI; + program CAT "REP SELECTxxiOF "; + FOR i FROM 1 UPTO refinement count REP + program CAT "CASE "; + program CAT text (i); + program CAT ":r"; + program CAT text (i); + program CAT " " + PER; + program CAT "ENDSELECT UNTIL NOTnewindex(xxi)PER"; + IF NOT is dtcb + THEN program CAT ";channelend;reservechannel(xxv[1][xxa])" FI; + program CAT ". ". + +perhaps program cat data refinements : + FOR i FROM 1 UPTO dialogue table entries REP + IF configurate THEN cout (i) FI; + read start of next table entry; (* must be done in autom. mode, too, *) + t := next variable name; (* to get offset/oldoffset/length [i] *) + program CAT t; + program CAT ":xxv["; + program CAT text (i); + program CAT "][xxa]. "; (* Das war der normale Eintrag "varname" *) + program CAT t; (* Jetzt der für alle Kanäle "varname k" *) + program CAT "k:xxv["; + program CAT text (i); + program CAT "]. " + PER. + +read start of next table entry : + (* Format der Einträge in den Variablentabellen: + dw offset in cb + dw offset in old cb (oder ffffh falls neu) + db Typ (d.h. Länge und ist 1 oder 2) + db Namenslänge + db ...(Name)... + *) + INT CONST length of variable :: byte (m, table byte + 4.0), + length of name :: byte (m, table byte + 5.0); + old offset [i] := int (m, table byte + 2.0); (* Diese Sammlung *) + offset [i] := int (m, table byte); (* bereitet das Datenholen vor *) + length [i] := length of variable; + IF length of variable < 1 OR length of variable > 2 + THEN errorstop ("invalid variablelength : " + text (length of variable)) + FI; + table byte INCR 6.0. + +next variable name: + table byte INCR real (length of name); + text (m, table byte - real (length of name), length of name). + +build data in v : + FOR k FROM 1 UPTO nr of cbs REP (* Kanäle *) + IF configurate THEN cout (k) FI; + FOR i FROM 1 UPTO dialogue table entries REP (* Variablen *) + v[i][k] := next init value + PER + PER. + +next init value : + IF old cb valid CAND old cb present CAND value accessible + THEN value from old cb + ELSE value from new cb FI. + +old cb present : + offset old cb [k] > 0.0. + +value accessible : + same release OR + (* Ein release zuvor und Variable gibts schon: *) old offset [i] <> -1. + +value from old cb : + IF length [i] = 1 + THEN byte (old cb, offset old cb [k] + real (offset of old value)) + ELSE int (old cb, offset old cb [k] + real (offset of old value)) + FI. + +value from new cb : + IF length [i] = 1 + THEN byte (cb, offset cb [k] + real (offset [i])) + ELSE int (cb, offset cb [k] + real (offset [i])) FI. + +offset of old value : + IF same release + THEN offset [i] + ELSE old offset [i] FI. + +do program : + reset direction (TRUE); + channels of module := nr of cbs; + IF setup testing + THEN (* für diesen THEN-Teil beim abgespeckten Eumel + setup eummel mini eumel dummies insertieren *) + forget (do name, quiet); + FILE VAR f := sequentialfile (output, do name); + putline (f, program); + (*edit (do name);*) + run (do name); + forget(do name, quiet); + ELSE do (program); + FI; + program := ""; (* Platz sparen *) + reset direction (FALSE). + +put values in cb : + FOR k FROM 1 UPTO nr of cbs REP + cout (k); + FOR i FROM 1 UPTO dialogue table entries REP + IF length [i] = 1 THEN put byte ELSE put int FI + PER; + PER. + +put byte : + byte (cb, offset cb [k] + real (offset [i]), v[i][k]). + +put int : + int (cb, offset cb [k] + real (offset [i]), v[i][k]). +END PROC perform dialogue; + +(****************** give me, take you, new index ***************************) + +(* Diese Prozeduren werden aus dem do beim perform dialogue heraus aufgerufen + Sie dienen zur Kommunikation mit den Paketdaten dieses Pakets (give me, + take you) oder zur Verkleinerung des do-Programms (new index) +*) + +PROC give me (VARIABLES VAR variables) : + (* Der Sinn dieser Prozedur besteht in Folgendem : + bei perform dialogue wird in dem do, das die refinements des + SHard-Moduls ausführt, eine Datenstruktur vom Typ VARIABLES aufgebaut, + die alle in den Variablentabellen des Moduls aufgeführten Variablen + enthält und einzeln über passend benannte refinements zugänglich macht. + Diese Datenstruktur wird zuvor in diesem Paket hier initialisiert mit + Initwerten aus der Variablentabelle oder wenn möglich mit den + entsprechenden Werten aus dem alten SHard. Mit give me fordert das + do-Programm die initialisierte Datenstruktur aus diesem Paket hier an. + Im do wird am Schluss mit take you diese Datenstruktur an dieses Paket + (und damit an perform dialogue) zurückgegeben, damit die durch den + Dialog gesetzten Werte in den neuen SHard eingetragen werden können. + Eine alternative Methode, diese Kommunikation zu realisieren, wäre die + Benutzung von BOUND VARIABLES VARs mit demselben Datenraum. + *) + variables := v +END PROC give me; + +PROC take you (VARIABLES CONST variables) : + (* Gegenstück zu give me, siehe dort *) + v := variables +END PROC take you; + +BOOL PROC new index (INT VAR index) : + (* Verändert den Index je nach der direction und fragt bei down am Ende, + ob fertig. Liefert, ob es noch weitergehen soll (falls nein: index = 1) + *) + LET up = ""3"", + down = ""10"", + error = ""0""; + TEXT CONST old direction :: direction; + reset direction (TRUE); + IF old direction = error (* Bei Fehlern immer stehenbleiben *) + THEN TRUE + ELIF index = max index (* am Schluss aufhören oder nach 1 springen *) + THEN perhaps end + ELIF index = 1 AND old direction = up (* bei 1 und up an den Schluss *) + THEN index := max index; TRUE + ELSE normal new index (* sonst je nach direction up oder down *) + FI. + +perhaps end : (* index = max index *) + IF old direction = up AND max index > 1 (* hoch vom Ende *) + THEN index DECR 1; + TRUE + ELIF old direction = up + THEN TRUE + ELIF old direction = down (* runter am Ende *) + THEN index := 1; + TRUE + ELSE reset direction (FALSE); (* normal oder runter ans Ende *) + index := 1; + BOOL CONST ready :: yes (1, 23, "Fertig", FALSE); + reset direction (TRUE); + NOT ready + FI. + +normal new index : + IF old direction = up + THEN index DECR 1; TRUE + ELSE index INCR 1; TRUE FI. +END PROC new index; + +(******************** channel (table) handling *****************************) + +BOOL PROC channel free (INT CONST nr, + ROW 256 INT CONST channel table of shard) : + IF nr < 0 OR nr > nr of channels total + THEN FALSE + ELSE channel table of shard [index ccb offset] = 0 FI. + +index ccb offset : + 2 * nr + 1 + 1. +END PROC channel free; + +BOOL PROC channel free (INT CONST nr) : + channel free (nr, channel table of new shard). +END PROC channel free; + +PROC reserve channel (INT CONST nr, + ROW 256 INT VAR channel table of shard) : + IF nr >= 0 AND nr < nr of channels total + THEN channel table of shard [index ccb offset] := 1 (* nichtnull *) FI. + +index ccb offset : + 2 * nr + 1 + 1. (* Start nicht bei 0 und ccb hinter dtcb *) +END PROC reserve channel; + +PROC reserve channel (INT CONST nr) : + reserve channel (nr, channel table of new shard). +END PROC reserve channel; + +(*THESAURUS PROC free channels (ROW 256 INT VAR channel table of shard): + (* Liefert einen THESAURUS, der die Klartextform genau aller in + channel table of shard als frei angegebenen Kanäle enthält. + *) + INT VAR i; + THESAURUS VAR result :: empty thesaurus; + FOR i FROM 1 UPTO nr of channels total REP + IF channel free (i, channel table of shard) + THEN insert (result, text (i)) FI + PER; + result. +END PROC free channels;*) + +INT PROC channels of this module : + channels of module. +END PROC channels of this module; + +(********************* write info, buffer adress **************************) + +PROC write info : + putline (actual info) +END PROC write info; + +INT PROC buffer address (INT CONST buffer size): + IF new shard length MOD 2.0 <> 0.0 THEN new shard length INCR 1.0 FI; + INT CONST buf adr := unsigned (new shard length); + new shard length INCR real (buffer size); + IF new shard length >= 65536.0 OR buffer size > 1024 + THEN errorstop ("zu großer Puffer verlangt") + FI; + buf adr +END PROC buffer address; + +(************************* Hilfsprozeduren *******************************) + +PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, + INT VAR start module nr, BOOL CONST new init, ins, dump, lst, + sys, coder, rt check, sermon) : + EXTERNAL 256 +END PROC elan; + +PROC do (TEXT CONST long line) : + DATASPACE VAR ds; + INT VAR module nr :: 0; + elan (2, ds, long line, module nr, FALSE, FALSE, FALSE, FALSE, + FALSE, FALSE, FALSE, FALSE); + forget (ds); + no do again +END PROC do; + +PROC go on : + put (" >>>>> Taste drücken zum Weitermachen "); + REPEAT UNTIL incharety (2) = "" PER; + pause; + line. +END PROC go on; + +END PACKET setup eumel modulkonfiguration; + diff --git a/system/setup/3.1/src/setup eumel 4: dienstprogramme b/system/setup/3.1/src/setup eumel 4: dienstprogramme new file mode 100644 index 0000000..9ce9ca3 --- /dev/null +++ b/system/setup/3.1/src/setup eumel 4: dienstprogramme @@ -0,0 +1,218 @@ + +(**************************************************************************) +(***** Dienstprogramme für Modulprogrammierer *****************) +(***** Copyright (c) 1987, 1988 *****************) +(***** Lutz Prechelt, Karlsruhe *****************) +(**************************************************************************) + +PACKET setup eumel dienstprogramme (* Copyright (c) 1987 by *) +DEFINES (* Lutz Prechelt, Karlsruhe *) + file as one text, (* Stand : 07.05.88 1.4 *) + ich schreibe jetzt ein neues shard modul, (* Eumel 1.8.1 *) + link shard module, + all modules: + +(* Dies sind Dienstprogramme, die der Modul-Programmierer braucht *) + +(* Das Format der Refinementdateien für den dtcb- und ccb-Setupdialog ist wie + folgt: + 1. Zeile: INT-Denoter für die Anzahl von Abfragerefinements, die drin sind + Rest der Zeile muß leer sein. + Danach : lauter ELAN-Refinements mit den Namen r1, r2 usw. + evtl. weitere Refinements zur Hilfe mit beliebigen Namen (es + gibt ein paar Ausnahmen, über die man beim ersten Test dann aber + stolpert.) + In den Refinements dürfen Variablen vereinbart werden. Vor dem ersten + refinement der Datei darf KEIN Punkt sein (es ist sowieso schlechter + Stil, die Punkte nicht hinter die vorherige Zeile zu setzen, sondern + vor den refinementnamen.), hingegen MUSS nach dem letzten Refinement der + Datei ein Punkt stehen. + Wer das für nötig hält, kann auch Prozeduren definieren und verwenden, + was allerdings nicht geht, sind Pakete. + Wenn man mit Kommentaren und sonstigen Bytefressern sparsam + umgeht, läuft der Dialog beim Setup später etwas schneller an. +*) + +LET modul namentyp = "SHardmodul *"; + +DATASPACE VAR ds; + +(***************************************************************************) + +THESAURUS PROC all modules (THESAURUS CONST th): + (* Hier wird schlabberig nach Namen ausgewählt, während der Setup Eumel + im Betrieb die Datenraumtypen als Auswahlkriterium verwendet. + Die Schwierigkeiten, die bei Nichteinhalten der Namenskonventionen + entstehen, veranlassen hoffentlich jeden zur nötigen Disziplin... + *) + (th LIKE "SHardmodul *") - (th LIKE "SHardmodul *.ccb") + - (th LIKE "SHardmodul *.dtcb") - (th LIKE "SHardmodul *.info") +END PROC all modules; + +(*****THESAURUS PROC all modules: wird sauber in Teil 2 realisiert + all modules (all) +END PROC all modules; +*****) + +(********************* link shard module *********************************) + +PROC link shard module: + TEXT VAR module :: std; + REPEAT + page; + putline (" L I N K S H A R D - M O D U L E"); line (2); + put ("Modulname:"); editget (module); line (2); + link shard module (module); line; + UNTIL NOT yes ("noch ein Modul linken", FALSE) PER +END PROC link shard module; + +PROC link shard module (THESAURUS CONST th): + do (PROC (TEXT CONST) link shard module, th); +END PROC link shard module; + +PROC link shard module (TEXT CONST module): + (* Ruft link shard module (modul, dtcb, ccb, info) unter Anwendung von + Namenskonventionen (nämlich entsprechende Suffixe ".dtcb" etc.) auf. + *) + TEXT VAR dtcb, ccb, info; + BOOL VAR elan neu; + dtcb := module + ".dtcb"; + ccb := module + ".ccb"; + info := module + ".info"; + perhaps change filenames; + elan neu := yes (module + ": neue Elan Teile machen", FALSE); + IF elan neu THEN neue elan teile machen FI; + link shard module (module, dtcb, ccb, info); + IF elan neu THEN check syntax FI. + +neue elan teile machen: + edit (dtcb); line (2); + edit (ccb); line (2); + edit (info); page. + +perhaps change filenames: +(*put ("Datei mit dtcb-refinements :"); editget (dtcb); line; + put ("Datei mit ccb-refinements :"); editget (ccb); line; + put ("Datei mit Infotext :"); editget (info); line (2)*) . + +check syntax : + line (2); put (module); putline (": Syntax-Check"); + forget (ds); + ds := nilspace; + BOUND MODUL VAR m :: old (module), old shard :: ds, new shard :: ds; + INT VAR offset dtcb table :: int (m, 0), + dtcb table entries :: int (m, offset dtcb table), + offset ccb table :: int (m, 2), + ccb table entries :: int (m, offset ccb table); + (* Jetzt einen total verkrüppelten automatischen "perform dialogue" für + die Probeübersetzung der .dtcb und .ccb refinements aufrufen. + *) + perform dtcb dialogue (m, real (offset dtcb table+2), dtcb table entries, + new shard, 0.0, + old shard, 0.0, + FALSE, FALSE, + dtcb refinements (m), dtcb abfragen (m), + TRUE, FALSE); + putline ("dtcb refinements O.K."); + ROW 40 REAL VAR x :: ROW 40 REAL : (0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + 0.0, 0.0); + perform ccb dialogue (m, real (offset ccb table+2), ccb table entries, + new shard, x, + old shard, x, + 1, + FALSE, FALSE, + ccb refinements (m), ccb abfragen (m), + TRUE, FALSE); + putline ("ccb refinements O.K."); + forget (ds). +END PROC link shard module; + +PROC link shard module (TEXT CONST module, dtcb, ccb, infofile) : + IF type (old (module)) <> datenraumtyp modul CAND NOT typ aendern + THEN LEAVE link shard module + ELSE type (old (module), datenraumtyp modul) FI; + IF NOT (module LIKE modul namentyp) + THEN errorstop ("Module MÜSSEN Namen der Art """ + modul namentyp + + """ haben") + FI; + line; + BOUND MODUL VAR m :: old (module); + TEXT VAR dtcb ref :: file as one text (dtcb, FALSE), + ccb ref :: file as one text (ccb, FALSE), + info text:: file as one text (infofile, TRUE); + INT CONST pos dtcb :: pos (dtcb ref, " "), (* Ende der ersten Zeile, die *) + pos ccb :: pos (ccb ref, " "); (* die Abfragezahl enthält *) + INT VAR dtcb count, ccb count; + dtcb count := int (subtext (dtcb ref, 1, pos dtcb)); + IF NOT last conversion ok OR dtcb count < 0 OR dtcb count > 1000 + THEN errorstop ("keine vernünftige Zahl von dtcb Abfragen gefunden") FI; + ccb count := int (subtext (ccb ref, 1, pos ccb)); + IF NOT last conversion ok OR ccb count < 0 OR ccb count > 1000 + THEN errorstop ("keine vernünftige Zahl von ccb Abfragen gefunden") FI; + (* JETZT PASSIERTS : *) + dtcb abfragen (m, dtcb count); + dtcb refinements (m, subtext (dtcb ref, pos dtcb + 1)); + ccb abfragen (m, ccb count); + ccb refinements (m, subtext (ccb ref, pos ccb + 1)); + info (m, infotext); + line; + putline (""""+module+""" gelinkt. " + text (storage (old (module))) + + " K Datenraumgröße."). + +typ aendern : + IF type (old (module)) = 1003 (* file type *) + THEN putline ("(""" + module + """ hat den Typ FILE)") FI; + putline ("Achtung: """ + module + """ ist nicht vom Typ eines SHard-Moduls"); + yes ("Soll es dazu gemacht werden (Typ aufprägen)", FALSE). +END PROC link shard module; + +(******************** file as one text ************************************) + +TEXT PROC file as one text (TEXT CONST filename, BOOL CONST verbatim) : + FILE VAR f :: sequential file (input, filename); + TEXT VAR result :: "", t; + put ("Lese """ + filename + """ :"); + WHILE NOT eof (f) REP + cout (line no (f)); + getline (f, t); + work on t; + result CAT t + PER; + line; + result. + +work on t : + IF verbatim + THEN t CAT ""13""10"" + ELSE t := compress (t); t CAT " " FI. +END PROC file as one text; + +(****** ich schreibe jetzt ein neues shard modul ***************************) + +PROC ich schreibe jetzt ein neues shard modul : + line (2); + putline ("So so, Sie wollen also ein neues SHard-Modul schreiben."); line; + pause (20); + putline ("Mir kommt es so vor, als sei heute der " + date + + " und im Moment gerade " + time of day + " Uhr"); line; + IF NOT yes ("Stimmt das ungefähr (auf 5 Minuten kommt's nicht an)", TRUE) + THEN do ("set date"); line (2) FI; + putline ("Also gut. Schreiben Sie Ihr verdammtes Modul."); + putline ("Aber merken Sie sich die folgenden 4 Bytes als ihren Modultyp"); + put (""15" "); + REAL VAR x :: floor (clock (1) - date ("05.05.79") - time ("10:00:00")); + INT VAR i; + FOR i FROM 1 UPTO 4 REP + put (int (x MOD 256.0)); + x := floor (x / 256.0) + PER; + put (" "14""); line (2); + putline ("Also : die Dinger merken (schreiben Sie sie auf, sonst vergessen Sie"); + putline (" sie ja doch) und NICHT MEHR ÄNDERN !"); + line (3) +END PROC ich schreibe jetzt ein neues shard modul; + +END PACKET setup eumel dienstprogramme; + diff --git a/system/setup/3.1/src/setup eumel 5: partitionierung b/system/setup/3.1/src/setup eumel 5: partitionierung new file mode 100644 index 0000000..705f26d --- /dev/null +++ b/system/setup/3.1/src/setup eumel 5: partitionierung @@ -0,0 +1,435 @@ +PACKET setup eumel partitionierung (* Copyright (C) 1985 *) + (* Martin Schönbeck, Spenge *) +DEFINES tracks, (* Lutz Prechelt, Karlsruhe *) + sectors, (* Änderungen: Ley ms *) + heads, (* Stand: 07.04.89 *) + first track, + last track, + partition start, + partition type, + partition active, + partition size, + partition word 0, + + get boot block, + put boot block, + clear partition, + + (*get bad track table,*) + get bad sector table, + clear partition table, + setup channel, + start of partition: + + LET bst size = 1024; (* nr of bad sector table entrys *) + +ROW 256 INT VAR boot block; +INT VAR boot block session := session - 1; +INT VAR fd channel := 28; (* Festplatten-Setupkanal *) + +INT PROC setup channel: + fd channel +END PROC setup channel; + +PROC setup channel (INT CONST new channel): + enable stop; + teste kanal typ; + boot block session DECR 1; + wirf altes pac raus; + fd channel := new channel; + sorge dafuer dass kanal uptodate ist. + +teste kanal typ: + IF (get value (1, new channel) AND 12) <> 12 + THEN errorstop ("Hier gibt es leider keine Platte") + FI. + +wirf altes pac raus: + IF new channel <> fd channel + THEN INT VAR raus := get value (-13, fd channel); + FI. + +sorge dafuer dass kanal uptodate ist: + INT VAR old channel := channel; + ROW 256 INT VAR dummy; INT VAR i; + continue (new channel); + disable stop; + blockin (dummy, -1, -1, i); + break (quiet); + continue (old channel). + +END PROC setup channel; + +PROC get bad sector table (ROW bst size REAL VAR bb tab, + INT VAR bad sect, INT CONST eumel type): + initialisiere tabelle; + suche schlechte sectoren. + +initialisiere tabelle: + INT VAR i; + FOR i FROM 1 UPTO bst size REP + bb tab [i] := -1.0; + PER. + +suche schlechte sectoren: + INT VAR my channel := channel; + REAL VAR sector := start of partition (eumel type), + end := sector + partition size (partition number (eumel type)), + track mode restart :: 0.0; + INT VAR akt track := 0, + fehler code; + bad sect := 1; (* Eintragsnr. des NÄCHSTEN schlechten Sektors *) + continue (fd channel); + disable stop; + DATASPACE VAR ds := nilspace; + REAL CONST cylinder size :: real (sectors * heads), + track size :: real (sectors); + track mode restart := sector + track size - + (sector MOD track size); + (* wenn sector nicht erster der spur, dann die erste einzeln *) + WHILE sector < end REP + IF sector MOD cylinder size = 0.0 + THEN melde naechste spur FI; + IF sector >= track mode restart + THEN check track + ELSE check sector FI + UNTIL bad sect > bst size OR is error PER; + continue (my channel); + forget (ds); + enable stop; + IF bad sect > bst size + THEN errorstop ("Zu viele schlechte Sektoren"); + FI; + lass nicht zu dass ein ersatzsektor ein schlechter ist; + bad sect DECR 1. (* ANZAHL schlechter Sektoren *) + +melde naechste spur: + break (quiet); + continue (my channel); + akt track INCR 1; + cout (akt track); + continue (fd channel). + +check track : + verify track (ds, 2, sector, fehler code); + IF schlechten sektor gefunden + THEN track mode restart := sector + tracksize + ELSE sector INCR track size FI. + +check sector : + read block (ds, 2, sector, fehler code); + IF schlechten sektor gefunden + THEN eintragen FI; + sector INCR 1.0. + +schlechten sektor gefunden: + SELECT fehler code OF + CASE 0: FALSE + CASE 1: error stop ("Platte kann nicht gelesen werden"); FALSE + CASE 2: TRUE + CASE 3: error stop ("Versorgungsfehler beim Plattentest"); FALSE + OTHERWISE error stop ("unbekannter Fehler auf Platte"); FALSE + END SELECT. + +eintragen: + bb tab [bad sect] := sector; + bad sect INCR 1. + +lass nicht zu dass ein ersatzsektor ein schlechter ist: + REAL VAR aktueller ersatz := end - real (bad sect - 1); + INT VAR akt b sect; + FOR akt b sect FROM 1 UPTO bad sect - 1 REP + IF aktueller ersatz ist in tabelle + THEN vertausche aktuell zu ersetzenden mit ihm + FI; + PER. + +aktueller ersatz ist in tabelle: + INT VAR such index; + FOR such index FROM 1 UPTO bad sect REP + IF aktueller ersatz = bb tab (such index) + THEN LEAVE aktueller ersatz ist in tabelle WITH TRUE + FI; + PER; + FALSE. + +vertausche aktuell zu ersetzenden mit ihm: + bb tab ( such index ) := bb tab ( akt b sect ); + bb tab (akt b sect) := aktueller ersatz. +END PROC get bad sector table; + +INT PROC cyl and head (REAL CONST sector): + cylinder code (int (sector / real (sectors)) DIV heads) OR head. + +head : + (int (sector / real (sectors)) MOD heads). +END PROC cyl and head; + +PROC get boot block: + IF boot block session <> session + THEN hole aktuellen boot block + FI. + +hole aktuellen bootblock : + disable stop; + DATASPACE VAR dummy ds := nilspace; + BOUND STRUCT (ALIGN dummy, + ROW 256 INT block) VAR partition table := dummy ds; + get external block (dummy ds, 2, 0, fd channel); + IF NOT is error + THEN transfer data to boot block + FI; + forget (dummy ds). + +transfer data to boot block: + IF not valid boot block + THEN try to get valid boot block from file + FI; + boot block := partition table. block; + boot block session := session. + +not valid boot block: + partition table. block [256] <> boot indicator OR + it is an old boot block of eumel. + +boot indicator: -21931. + +it is an old boot block of eumel: + partition table. block [1] = 1514. + +try to get valid boot block from file: + forget (dummy ds); + partition table := old ("bootblock"); + IF is error THEN LEAVE transfer data to boot block FI. +END PROC get boot block; + +PROC clear partition table (INT CONST sicherung): + IF sicherung = -3475 + THEN neuen boot block; + put boot block + FI. + +neuen boot block: + enable stop; + BOUND STRUCT (ALIGN dummy, + ROW 256 INT block) VAR partition table; + partition table := old ("bootblock"); + boot block := partition table. block; + boot block session := session. +END PROC clear partition table; + +PROC put boot block: + IF boot block ist uptodate + THEN schreibe block auf platte + ELSE errorstop ("boot block nicht uptodate") + FI. + +boot block ist uptodate: + boot block session = session. + +schreibe block auf platte: + disable stop; + DATASPACE VAR dummy ds := nilspace; + BOUND STRUCT (ALIGN dummy, + ROW 256 INT block) VAR partition table := dummy ds; + transfer data to dataspace; + put external block (dummy ds, 2, 0, fd channel); + forget (dummy ds). + +transfer data to dataspace: + partition table. block := boot block. +END PROC put boot block; + +INT PROC partition number (INT CONST part type): + INT VAR partition; + FOR partition FROM 1 UPTO 4 REP + IF partition type (partition) = part type + THEN LEAVE partition number WITH partition + FI + PER; + errorstop ("Partitiontyp gibt es nicht"); + 7. +END PROC partition number; + +INT PROC partition word 0 (INT CONST partition): + boot block (entry (partition)) +END PROC partition word 0; + +PROC partition word 0 (INT CONST partition, word): + boot block (entry (partition)) := word +END PROC partition word 0; + +REAL PROC start of partition (INT CONST partition type): + partition start (partition number (partition type)) +END PROC start of partition; + + +INT PROC first track (INT CONST partition): + high byte (boot block [entry (partition) + 1]) + + 4 * (low byte (boot block [entry (partition) + 1]) AND (128 + 64)) +END PROC first track; + +INT PROC last track (INT CONST partition): + high byte (boot block [entry (partition) + 3]) + + 4 * (low byte (boot block [entry (partition) + 3]) AND (128 + 64)) +END PROC last track; + +INT PROC partition type (INT CONST partition): + low byte (boot block [entry (partition) + 2]) +END PROC partition type; + +BOOL PROC partition active (INT CONST partition): + low byte (boot block [entry (partition)]) = 128 +END PROC partition active; + +(****************** neu eingefügt ******************************) +PROC partition active (INT CONST partition, BOOL CONST active): + IF active THEN activate this partition + ELSE deactivate this partition + FI. + +deactivate this partition: + set bit (boot block [entry (partition)], 7); + (* first setting needed, because reset bit does xor *) + reset bit (boot block [entry (partition)], 7). + +activate this partition: + set bit (boot block [entry (partition)], 7). +END PROC partition active; + +(****************** neu eingefügt ******************************) + +PROC first track (INT CONST partition, cylinder): + boot block [entry (partition) + 1] + := cylinder code (cylinder) OR start sector. + +start sector: + IF cylinder = 0 + THEN 2 + ELSE 1 + FI. +END PROC first track; + +PROC last track (INT CONST partition, cylinder): + boot block [entry (partition) + 3] := cylinder code (cylinder). +END PROC last track; + +PROC partition type (INT CONST partition, type): + boot block [entry (partition) + 2] := type. +END PROC partition type; + +REAL PROC partition start (INT CONST partition): + unsigned low word + high word. + +unsigned low word: + real (low byte (boot block [entry (partition) + 4])) + + real (high byte (boot block [entry (partition) + 4])) * 256.0. + +high word: + real (boot block [entry (partition) + 5]) * 65536.0. +END PROC partition start; + +PROC partition start (INT CONST partition, REAL CONST sector offset): + boot block [entry (partition) + 4] := low word (sector offset); + boot block [entry (partition) + 5] := high word (sector offset) +END PROC partition start; + +REAL PROC partition size (INT CONST partition): + unsigned low word + high word. + +unsigned low word: + real (low byte (boot block [entry (partition) + 6])) + + real (high byte (boot block [entry (partition) + 6])) * 256.0. + +high word: + real (boot block [entry (partition) + 7]) * 65536.0. +END PROC partition size; + +PROC partition size (INT CONST partition, REAL CONST number of blocks): + boot block [entry (partition) + 6] := low word (number of blocks); + boot block [entry (partition) + 7] := high word (number of blocks) +END PROC partition size; + +PROC clear partition (INT CONST partition): + INT VAR i; + FOR i FROM 0 UPTO 7 REP + boot block [entry (partition) + i] := 0 + PER +END PROC clear partition; + +INT PROC entry (INT CONST partition): + get boot block; + 256 - 5 * 8 + (partition * 8) +END PROC entry; + +INT PROC cylinder code (INT CONST cylinder): + cylinder text ISUB 1. + +cylinder text: + high cylinder bits + low cylinder bits. + +high cylinder bits: + code ((cylinder AND (256 + 512)) DIV 4). + +low cylinder bits: + code (cylinder AND (128 + 64 + 32 + 16 + 8 + 4 + 2 + 1)). +END PROC cylinder code; + +INT PROC tracks: + get value (-10, fd channel) +END PROC tracks; + +INT PROC sectors: + get value (-11, fd channel) +END PROC sectors; + +INT PROC heads: + get value (-12, fd channel) +END PROC heads; + +INT PROC get value (INT CONST control code, channel for value): + enable stop; + INT VAR old channel := channel; + IF channel for value <> old channel THEN continue (channel for value) FI; + INT VAR value; + control (control code, 0, 0, value); + IF channel for value <> old channel THEN continue (old channel) FI; + value +END PROC get value; + +PROC get external block (DATASPACE VAR ds, INT CONST ds page, + archive block, get channel): + INT VAR old channel := channel; + continue (get channel); + disable stop; + read block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht gelesen werden"); + CASE 2: error stop ("Lesefehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + continue (old channel). +END PROC get external block; + +PROC put external block (DATASPACE CONST ds, INT CONST ds page, + archive block, get channel): + INT VAR old channel := channel; + continue (get channel); + disable stop; + write block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht geschrieben werden"); + CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + continue (old channel). +END PROC put external block; + +END PACKET setup eumel partitionierung; + diff --git a/system/setup/3.1/src/setup eumel 6: shardmontage b/system/setup/3.1/src/setup eumel 6: shardmontage new file mode 100644 index 0000000..cc0d475 --- /dev/null +++ b/system/setup/3.1/src/setup eumel 6: shardmontage @@ -0,0 +1,389 @@ + +(**************************************************************************) +(***** Zusammenbau eines SHards aus Modulen mit Dialog *****************) +(***** Copyright (c) 1987, 1988 by *****************) +(***** Lutz Prechelt, Karlsruhe *****************) +(**************************************************************************) + +PACKET setup eumel shardmontage (* Copyright (c) 1987 by *) +DEFINES build shard, (* Lutz Prechelt, Karlsruhe *) + add bad sector table to shard, (* Stand : 08.04.88 3.2 *) + installation nr, (* Eumel 1.8.1 *) + print configuration : + +(* Beschreibung des SHard-Hauptmodulformats siehe "modulkonfiguration" *) + +(* In diesem Paket sind viele Namenskonventionen verankert. + Das leere SHard-Hauptmodul hat den Namen "SHard leer", teilaufgebaute + SHards heissen normalerweise in der Form "SHard 07.07.87 14:34" (andere + Namen sind möglich, wenn sie mit "SHard " beginnen.) + Die Prozedur build shard bastelt in Dialogsteuerung durch den Benutzer + aus Modulen und einem leeren oder teilaufgebauten SHard-Hauptmodul einen + neuen SHard zusammen und schreibt ihn in die Datei SHARD + Die Prozedur add bad block table to shard fügt einem so zusammengebauten + SHard eine bad block tabelle gemäß dem Zustand der Partition hinzu oder + ändert die vorhandene. + Dann ist der SHard komplett fertig zum auf-die-Partition-schleudern. + (einschliesslich Installationsnummer) +*) + +LET hauptmodul namentyp = "SHard *", + (*modul namentyp = "SHardmodul *",*) + shard name = "SHARD"; + +LET bad sector table size = 1024, (* Entries *) + max sh length = 60, (* Blocks, vorläufig !!! *) + nr of channels total = 40, + offset shard length = 6, + offset bad sector table pointer = 8, + offset verbal identification = 176, (* Start Shardleiste *) + offset id 4 = 196; (* 176 + 14h *) + +INT VAR actual installation nr :: id (5); +DATASPACE VAR ds :: nilspace; + +PROC build shard (DATASPACE CONST old shard ds) : + (* Der Aufrufer muß hinterher nachsehen, ob es die Datei SHARD auch + wirklich gibt. Falls nicht, ist "Aufbau des SHards war nicht möglich" + zu melden. + *) + BOUND MODUL VAR old shard :: old shard ds, new shard; + TEXT VAR t; + INT VAR i; + THESAURUS VAR th, modules, automatic mode modules, + modules in old shard, modules in new shard; + BOOL CONST old shard valid :: int (old shard, offset id 4) = id (4) AND + verbal identification ok; + perhaps take old shard; (* ggf. LEAVE *) + get main module name in t; + copy (t, shard name); + new shard := old (shard name); + enable stop; + eliminate bad sector table from shard (new shard); + get module names; + configurate modules and build shard; + add ids. + +verbal identification ok : + text (old shard, offset verbal identification, 16) = + "SHard Schoenbeck". + +perhaps take old shard : + kopf; + forget (shard name, quiet); + IF old shard valid CAND + yes ("Wollen Sie den SHard genauso wie beim letzten Setup", FALSE) + THEN copy (old shard ds, shard name); LEAVE build shard + ELSE out (""10"") FI. + +get main module name in t : + putline (" A u s w a h l d e s S H a r d - H a u p t m o d u l s "10""); + th := all LIKE hauptmodul namentyp; + IF highestentry (th) > 1 + THEN let the user select one + ELSE take the only one FI. + +let the user select one : + putline ("Wählen Sie jetzt bitte, welches SHard-Hauptmodul Sie als"); + putline ("Ausgangspunkt der Konfiguration benutzen möchten."); + putline ("(Namen durch Zeiger auswählen dann RETURN-Taste drücken)"); + t := ONE th; + out (""4""13""10""10""10""). + +take the only one : + t := name (th, 1); + putline ("Das einzige verfügbare SHard Hauptmodul ist"); + putline (t); + pause (30). + +get module names : + (* Besorgt die Listen 1. vorhandene Module 2. Module im alten SHard + und 3. Module im SHard Hauptmodul + Liefert in modules eine Auswahl von 1. ohne 3. mit 2. als Vorschläge + und in automatic mode modules eine Auswahl von 2. (alles vorgeschlagen) + Die Liste 2. ist dabei so sortiert, daß stets eingekettete Module in der + richtigen Reihenfolge auftauchen. + *) + kopf; + put ("Ich untersuche den SHard: "); + get modules in shard (new shard, modules in new shard); + IF old shard valid + THEN get modules in shard (old shard, modules in old shard) + ELSE modules in old shard := empty thesaurus FI; + kopf; + putline ("Wählen Sie jetzt bitte mit RETURN/rauf/runter, welche Module Sie"); + putline ("mit in den SHard aufnehmen möchten."); + putline ("(Zum Verlassen ESC q)"); + modules := certain (all modules - modules in new shard, + modules in old shard); + IF old shard valid + THEN kopf; + putline ("Wählen Sie jetzt, welche der Module vollautomatisch wie im"); + putline ("Vorlage-SHard konfiguriert werden sollen (Reihenfolge egal)"); + automatic mode modules := certain (modules / modules in old shard, + modules in old shard) + ELSE automatic mode modules := empty thesaurus FI. + +configurate modules and build shard : + FOR i FROM 1 UPTO highest entry (modules) REP + page; cout (i); collect heap garbage; + t := name (modules, i); + configurate module (new shard, old shard, + modules in old shard CONTAINS t, + automatic mode modules CONTAINS t, t) + PER; + IF highest entry (automatic mode modules) < highest entry (modules) + THEN perhaps keep copy of partly build shard FI; + collect heap garbage. + +perhaps keep copy of partly build shard : + kopf; + storage info; + out (""10"Möchten Sie eine zusätzliche Kopie des SHard in dieser Version"13""10""); + IF yes ("aufheben", FALSE) + THEN TEXT CONST start :: subtext (hauptmodul namentyp, 1, + LENGTH hauptmodul namentyp - 1); + t := date; + put ("Gewünschter Name :"); out (start); editget (t); out (""13""10""); + t := start + t; + IF NOT exists (t) COR overwrite THEN copy (shard name, t) FI + FI. + +add ids : + int (new shard, offset id 4 + 2 (* ID5 *), actual installation nr); + int (new shard, offset id 4 + 4 (* ID6 *), id (6)); + int (new shard, offset id 4 + 6 (* ID7 *), id (7)). + +overwrite : + IF yes ("Existierende Datei """ + t + """ überschreiben", FALSE) + THEN forget (t, quiet); + TRUE + ELSE FALSE FI. +END PROC build shard; + +(******************** print configuration **********************************) + +PROC print configuration (DATASPACE CONST old shard ds, BOOL CONST on screen): + (* Ruft für alle Module, die in old shard ds und als Datei vorhanden sind + print configuration aus dem Paket modulkonfiguration auf. + Macht bei on screen nach jedem Modul eine Pause, andernfalls wird die + Ausgabe in einem Rutsch gemacht und mit indirect list auf den Drucker + umgeleitet. + *) + BOUND MODUL VAR old shard :: old shard ds; + THESAURUS VAR modules in old shard; + BOOL CONST old shard valid :: int (old shard, offset id 4) = id (4) AND + verbal identification ok; + enable stop; + IF NOT old shard valid + THEN errorstop ("Der SHard ist ungültig"); + LEAVE print configuration + FI; + write head ("Anzeigen der Konfiguration des SHard"); + put ("Bitte fassen Sie sich in Geduld"); + get modules in shard (old shard, modules in old shard); + out (""4""13""10""); (* clear cout, line *) + IF on screen + THEN putline ("Nach jedem Modul eine Taste drücken.") + ELSE putline ("Die Ausgabe geht zum Drucker"); + indirect list (TRUE); + putline ("***** SHardkonfiguration *****"); line; + FI; + disable stop; + do print configuration (old shard, modules in old shard, on screen); + IF is error THEN put error; pause; clear error FI; + enable stop; + IF NOT on screen THEN indirect list (FALSE) FI. + +verbal identification ok : + text (old shard, offset verbal identification, 16) = + "SHard Schoenbeck". +END PROC print configuration; + +PROC do print configuration (MODUL CONST old shard, + THESAURUS CONST modules in old shard, + BOOL CONST on screen) : + INT VAR i; + TEXT VAR t; + enable stop; + FOR i FROM 1 UPTO highest entry (modules in old shard) REP + t := name (modules in old shard, i); + print configuration (old shard, t); + collect heap garbage; + IF on screen THEN pause FI + PER. +END PROC do print configuration; + +(********************** modules in shard **********************************) + +PROC get modules in shard (MODUL CONST old shard, + THESAURUS VAR modules in old shard) : + (* Stellt einem THESAURUS zusammen, der aus den Namen aller in old shard + enthaltenen Module besteht (ohne Duplikate). + Dabei sind diejenigen Modulnamen, deren Treiber in old SHard nicht als + eingekettete Treiber vorkommen, im Resultat VOR den eingeketteten + (d.h. mit kleineren link-Nummern) zu finden, um die richtige + Konfigurationsreihenfolge vorschlagen zu können. + Es muß zuvor bereits einmal init modules list aufgerufen worden sein ! + *) + INT VAR kanal; + REAL VAR p dtcb, p ccb; + TEXT VAR type, m name; + THESAURUS VAR simple :: empty thesaurus, chained :: empty thesaurus; + FOR kanal FROM 0 UPTO nr of channels total - 1 REP + cout (kanal); + p dtcb := sh dtcb offset (old shard, kanal); + p ccb := sh ccb offset (old shard, kanal); + look at this chain + PER; + invert chained thesaurus; + modules in old shard := what comes out when i let nameset do all the hard + work for me with a little trick and knowledge of implementation. + +look at this chain : + (* Das Verfahren ist auf den ersten Blick etwas kompliziert, spart aber + einiges an Kodeduplikation + *) + m name := ""; + WHILE p dtcb <> 0.0 AND p ccb <> 0.0 REP + IF m name <> "" AND NOT (chained CONTAINS m name) + THEN insert (chained, m name) FI; + type := text (old shard, p dtcb, 4); + m name := module name (type); + p dtcb := unsigned (int (old shard, p ccb + 2.0)); (* verkettet *) + p ccb := unsigned (int (old shard, p ccb + 4.0)); + PER; + IF m name <> "" THEN insert (simple, m name) FI. + +invert chained thesaurus : + (* bis jetzt sind bei mehrfachen Verkettungen die zuletzt eingeketteten + Treiber als erstes eingetragen, das darf jedoch nicht so bleiben + *) + INT VAR i; + THESAURUS VAR help :: empty thesaurus; + FOR i FROM highest entry (chained) DOWNTO 1 REP + insert (help, name (chained, i)) + PER; + chained := help. + +what comes out when i let nameset do all the hard +work for me with a little trick and knowledge of implementation : + (* Beware of false algebraic identities ! These are neither numbers nor + sets but lists (ordered and not duplicate-free) + *) + empty thesaurus + (simple - chained) + chained. +END PROC get modules in shard; + +(*************** add bad sector table to shard ****************************) + +PROC add bad sector table to shard (INT CONST eumel type, + DATASPACE CONST shard ds, + BOOL CONST take from partition, + INT VAR bad sector count) : + (* Fügt einem SHard eine bad sector table hinzu oder ändert sie. + Ist noch keine vorhanden, so sollte der Zeiger 0 sein. + *) + ROW bad sector table size REAL VAR bst; + BOUND MODUL VAR new shard :: shard ds; + REAL VAR new shard length, offset bst; + INT VAR i; + enable stop; + IF take from partition + THEN put ("kopiere Tabelle :"); + find bst in shard on partition + ELSE put ("Spur :"); + get bad sector table (bst, bad sector count, eumel type); + FI; + eliminate bad sector table from shard (new shard); + new shard length := unsigned (int (new shard, offset shard length)); + int (new shard, new shard length, bad sector count); + int (new shard, offset bad sector table pointer, unsigned (new shard length)); + new shard length INCR 2.0; + IF take from partition + THEN copy bst from old to new shard + ELSE write bst to new shard FI; + int (new shard, offset shard length, unsigned (new shard length)). + +copy bst from old to new shard : + copy (old shard, offset bst + 2.0, new shard, new shard length, + bad sector count * 4); + cout (bad sector count * 4); + new shard length INCR real (bad sector count * 4). + +write bst to new shard : + FOR i FROM 1 UPTO bad sector count REP + cout (i); + enter bad sector low word + PER; + FOR i FROM 1 UPTO bad sector count REP + cout (i); + enter bad sector high word; + PER. + +find bst in shard on partition : + cout (0); + read file (ds, start of partition (eumel type) + 1.0, max sh length, + setup channel); + BOUND MODUL CONST old shard :: ds; + IF int (old shard, offset id 4) <> id (4) + THEN errorstop ("SHard auf Partition unbrauchbar") FI; + offset bst := unsigned (int (old shard, offset bad sector table pointer)); + bad sector count := int (old shard, unsigned (offset bst)). + +enter bad sector low word : + int (new shard, new shard length, low word (bst [i])); + new shard length INCR 2.0. + +enter bad sector high word : + int (new shard, new shard length, high word (bst [i])); + new shard length INCR 2.0. +END PROC add bad sector table to shard; + +(************ eliminate bad sector table from shard ****************) + +PROC eliminate bad sector table from shard (MODUL VAR shard) : + (* Entfernt die bad sector table (bst) aus dem shard falls sie sich am Ende + desselben befindet. Trägt korrekte neue Werte für den bst pointer und + shard laenge ein. + *) + REAL VAR shard length :: unsigned (int (shard, offset shard length)), + bst offset :: unsigned (int (shard, offset bad sector table pointer)); + LET bst entry length = 4.0; (* bst entries sind Wort-Paare *) + IF bst offset = 0.0 + THEN (* ist gar keine bst vorhanden, also schon prima eliminiert *) + ELIF bst ist am ende + THEN bst entfernen FI; + bst austragen. + +bst ist am ende : + bst offset + bst entry length * nr of bst entries + 2.0 = + shard length. + +nr of bst entries : + unsigned (int (shard, bst offset)). + +bst entfernen : + int (shard, offset shard length, unsigned (bst offset)). + +bst austragen : + int (shard, offset bad sector table pointer, 0). +END PROC eliminate bad sector table from shard; + +(******************* installation nr *************************************) + +INT PROC installation nr : + actual installation nr +END PROC installation nr; + +PROC installation nr (INT CONST new) : + actual installation nr := new +END PROC installation nr; + +(*********************** Hilfsprozeduren **********************************) + +PROC kopf : + write head ("M o d u l - S H a r d Zusammenbau eines SHard"). +END PROC kopf; + +END PACKET setup eumel shardmontage; + diff --git a/system/setup/3.1/src/setup eumel 7: setupeumel b/system/setup/3.1/src/setup eumel 7: setupeumel new file mode 100644 index 0000000..0504e97 --- /dev/null +++ b/system/setup/3.1/src/setup eumel 7: setupeumel @@ -0,0 +1,1238 @@ +(*************************************************************************) +(*** Hauptprogramm des setup-Eumel:Einstellen der EUMEL - Partitionen ***) +(*** und SHard-Installation auf einer Festplatte. ***) +(*** ***) +(*** Autor : W. Sauerwein Stand : 07.04.89 ***) +(*** I. Ley Version : 2.3 ***) +(*** Anpassung an Modul-SHard : Lutz Prechelt, Karlsruhe ***) +(*** -"- : Werner Metterhausen ***) +(*** -"- : Martin Schönbeck ***) +(*************************************************************************) +(*** V 3.1 14.04.89 shard wird immer mit 'max sh size' geschriegen ***) +(*** da mit 'ds pages' ggf teile fehlten, wenn innen ***) +(*** unbenutzte pages (buffer) waren ***) +(*** V 3.0 10.04.89 support fuer mehrere Laufwerke eingebaut ***) +(*** ausgabe der module vor loeschen etc. entfernt ***) + +PACKET setup eumel DEFINES setup eumel, setup eumel endlos, version, +show partition table: + +LET setup version = "Version 3.1"; + +TEXT VAR stand :: "Stand : 18.04.89 (mit Modul-SHard Version 4.9)"; + +PROC version (TEXT CONST vers): stand := vers END PROC version; + +PROC version: editget (stand) END PROC version; + +LET max partitions = 4, + max sh size = 128, (* Anzahl Bloecke *) + return = ""13"", + escape = ""27""; + +LET hauptmodul namentyp = "SHard *", + modul namentyp = "SHardmodul *", + sh name = "SHARD", + sh backup = "SHARD Sicherungskopie"; + +ROW max partitions INT VAR part list; +ROW max partitions INT VAR part type, part active, + part first track, part last track; +ROW max partitions REAL VAR part start, + part size; + + INT VAR zylinder, + startzeile tabelle :: 1, + startzeile menu :: 12, + active partition, + partitions, + partition, i, j, cx, cy, help; + TEXT VAR retchar, + meldung := ""; + BOOL VAR testausgabe, + mit schreibzugriff := TRUE, + meldung eingetroffen := FALSE, + endlos :: FALSE, + at version; +THESAURUS VAR minimum modulkollektion := empty thesaurus; +DATASPACE VAR ds := nilspace; + +(************************* setup eumel endlos *****************************) + +PROC setup eumel endlos (BOOL CONST b) : + endlos := b; + IF endlos + THEN line; + putline ("Bitte geben Sie nun alle die Dateien an, die der Benutzer auf"); + putline ("keinen Fall löschen darf. (Taste drücken)"); + minimum modulkollektion := certain (all, emptythesaurus); + line (3); + putline ("Der setup eumel kann nun nach dem nächsten Aufruf nicht mehr "); + putline ("verlassen werden. ") + FI. +END PROC setup eumel endlos; + +(******************** get/put actual partition data ************************) + +PROC get actual partition data : + get boot block; + zylinder := tracks; + FOR i FROM 1 UPTO max partitions REP + part type (i) := partition type (i); + part first track (i) := first track (i); + part last track (i) := last track (i); + part start (i) := partition start (i); + part size (i) := partition size (i); + part active (i) := partition word 0 (i); + IF partition active (i) THEN active partition := i FI + PER; + get number of installed partitions; + generate part list. + +get number of installed partitions : + partitions := 0; + FOR i FROM 1 UPTO max partitions REP + IF part type (i) <> 0 THEN partitions INCR 1 FI + PER. + +generate part list : + FOR i FROM 1 UPTO max partitions REP + IF part type (i) <> 0 THEN part list (i) := i + ELSE part list (i) := 0 + FI; + PER; + schiebe nullen nach hinten; + sort part list. + +schiebe nullen nach hinten : + i := 1; INT VAR k := 0; + REP k INCR 1; + IF part list (i) = 0 THEN circle + ELSE i INCR 1 + FI + UNTIL k = max partitions - 1 PER. + +circle : + FOR j FROM i UPTO max partitions - 1 REP + part list (j) := part list (j + 1) + PER; + part list (max partitions) := 0. + +sort part list : + FOR i FROM 2 UPTO partitions REP + FOR j FROM 1 UPTO i - 1 REP + IF part first track (part list (i)) < part first track (part list (j)) + THEN tausche FI + PER + PER. + +tausche : + help := part list (i); + part list (i) := part list (j); + part list (j) := help. + +END PROC get actual partition data; + +PROC put actual partition data : + FOR i FROM 1 UPTO max partitions REP + IF partition exists (i) THEN put partition + ELSE clear partition (i) + FI; + PER; + IF mit schreibzugriff THEN put boot block FI. + +put partition : + IF is eumel (i) THEN partition type (i, part type (i)); + first track (i, part first track (i)); + last track (i, part last track (i)); + partition start (i, part start (i)); + partition size (i, part size (i)) + FI; + partition word 0 (i, part active (i)); + IF active partition = i + THEN partition active (i, TRUE) + ELSE partition active (i, FALSE) + FI. + +END PROC put actual partition data; + +(*************************** setup eumel ********************************) + +PROC setup eumel : + line; command dialogue (TRUE); + at version := yes ("System für AT", TRUE); + testausgabe := FALSE; (*yes ("Testversion", FALSE); *) + pruefe ob notwendige dateien vorhanden; + init modules list; + IF yes ("Leere Floppy für Systemsicherung eingelegt", FALSE) + THEN command dialogue (FALSE); save system; command dialogue (TRUE) FI; + IF NOT endlos THEN putline ("Verlassen mit ESC."); pause (40) FI; + terminal setup; + logo; + generate eumel. + +pruefe ob notwendige dateien vorhanden: + BOUND INT VAR y; + IF mit schreibzugriff THEN y := old (sh name); + y := old ("shget.exe"); + y := old ("bootblock"); + y := old ("configuration"); + y := old ("AT-4.x") + FI. + +END PROC setup eumel; + +PROC generate eumel : + disable stop; + show partition table; + REP update table; + main menu; + action; + IF is error THEN fehler; + put line (error message); + put line ("Bitte betätigen Sie eine Taste !"); + clear error; + pause; + IF mit schreibzugriff THEN terminal setup FI + FI + PER. + +action : + INT VAR choice; + clear error; + REP + cursor (cx, cy); + IF partitions < max partitions + THEN choice := get choice (0, max, retchar) + ELSE choice := get choice (2, max, 0, retchar) + FI; + IF escaped CAND NOT endlos THEN LEAVE generate eumel FI; + UNTIL retchar = return PER; + cl eop (1, startzeile menu - 1); + INT VAR unser kanal := channel; + SELECT choice OF + CASE 0 : programm ende + CASE 1 : create partition (TRUE) + CASE 2 : create partition (FALSE) + CASE 3 : activate partition + CASE 4 : delete partition + CASE 5 : delete partition table + CASE 6 : konfiguration anzeigen + CASE 7 : shard zusammenbauen + CASE 8 : modulkollektion aendern + CASE 9 : change drive + + END SELECT; + continue (unser kanal). + +max : + 9. + +change drive: + cursor (1, startzeile menu); + put ("Bitte Laufwerksnummer angeben:"); + get cursor (cx, cy); + put (" 0 - 3"); + REP cursor (cx, cy); + INT VAR drive := get choice (0, 3, retchar); + IF sure escaped THEN LEAVE change drive FI; + UNTIL NOT escaped PER; + setup channel (28-drive); + show partition table. + + +programm ende : + cursor (1, startzeile menu); + IF keine partition aktiv + THEN IF trotz warnung beenden THEN eumel beenden FI + ELSE IF yes ("Wollen Sie die Partitionierung Ihrer Festplatte beenden", FALSE) + THEN eumel beenden + FI FI. + +keine partition aktiv : active partition = 0. + +trotz warnung beenden : + put line ("ACHTUNG : Es ist keine Partition aktiv gesetzt !"); + put line (" Sie können daher nicht von der Festplatte booten !"); + line; + yes ("Wollen Sie trotzdem die Partitionierung der Festplatte beenden", FALSE). + +eumel beenden : + cl eop (1, startzeile menu - 1); + cursor (1, startzeile menu + 3); + shutup; terminal setup; + logo; + show partition table. + +shard zusammenbauen : + cl eop (1, startzeile menu); + IF yes ("Wollen Sie Ihren SHard neu konfigurieren", FALSE) + THEN shard sichern und vorlage beschaffen; + + IF NOT is error THEN build shard (ds) FI; + IF is error OR NOT exists (sh name) + + THEN forget (sh name, quiet); rename (sh backup, sh name); + putline ("Zusammenbau fehlgeschlagen. Alter SHard erhalten."); + pause (300); + FI; + forget (sh backup, quiet); forget (ds); + show partition table + FI. + +shard sichern und vorlage beschaffen : + forget (sh backup, quiet); + IF exists (shname) + THEN copy (sh name, sh backup); + FI; + forget (ds); + line; + IF yes (""3"Ist in einer existierenden Eumel-Partition ein SHard installiert, +"13""10"der als Vorlage dienen soll", FALSE) + THEN INT VAR vorlage :: 69; + editget (1, startzeile menu + 4, "Partitiontyp: ", vorlage); + (* Das sollte man mal noch schöner machen !!! *) + read file (ds, start of partition (vorlage) + 1.0, max sh size, + setup channel) + ELSE ds := old (sh name) FI. + + +konfiguration anzeigen : + hole anzuzeigenden ds; + line; + print configuration (ds, NOT yes ("Auf dem Drucker ausgeben", FALSE)); + show partition table. + +hole anzuzeigenden ds: + forget (ds); + line; + IF yes ("Soll ein SHard aus einer Partition angezeigt werden", TRUE) + THEN INT VAR anzeige :: 69; + editget (1, startzeile menu + 4, "Partitiontyp: ", anzeige); + (* Das sollte man mal noch schöner machen !!! *) + read file (ds, start of partition (anzeige) + 1.0, max sh size, + setup channel) + ELSE ds := old (ONE ((all LIKE hauptmodul namentyp) + "SHARD")) FI. + + +modulkollektion aendern : + THESAURUS VAR th; + TEXT VAR x :: "SHard"; + INT VAR i ; + page; + th := (all LIKE hauptmodul namentyp) + (all LIKE modul namentyp) + + (all LIKE sh name) ; + (* Diese Ausgabe macht leider den Bildschirmaufbau kaputt *) + (* mit dem Erfolg, daß man dann nicht mehr sieht, was man *) + (* ankreuzt, deshalb auskommentiert *) + (******* + putline(" Alle SHards :"); + line; + FOR i FROM 1 UPTO highest entry(th) + REP + putline(name(th,i)) + PER; + *******) + putline(" Modulkollektion ändern"); + line; + IF yes ("Wollen Sie irgendwelche Module löschen", FALSE) + THEN th := (all LIKE hauptmodul namentyp) + (all LIKE modul namentyp) + + (all LIKE sh name) - minimum modulkollektion; + forget (certain (th, emptythesaurus)); + ELIF yes ("Wollen Sie Module vom Archiv holen", FALSE) + THEN put ("Archivname:"); editget (x); line; + archive (x); + th := ALL archive LIKE modul namentyp; + fetch (certain (th, emptythesaurus), archive); + release (archive) + FI; + init modules list; + show partition table. + + +END PROC generate eumel; + + +PROC show partition table : + IF NOT mit schreibzugriff THEN get actual partition data FI; + headline; + devide table; + columns; + underlines; + rows; + downline. + +head line : + cl eop (1, startzeile tabelle); + put center (startzeile tabelle, "Aktuelle Partitions - Tabelle", TRUE). + +devide table : + FOR i FROM 1 UPTO 8 + REP + cursor (45, startzeile tabelle + i); out (inverse ("")) + PER. + +columns : + cursor ( 1, startzeile tabelle + 2); + out ("Nr. System Typ Zustand Grösse Anfang Ende"); + cursor (48, startzeile tabelle + 2); + out ("Platte : Zyl. / KB"). + +underlines : + cursor ( 1, startzeile tabelle + 3); + out ("--------------------------------------------"); + cursor (47, startzeile tabelle + 3); + out ("------------------------------"). + +rows : + FOR i FROM 1 UPTO max partitions + REP cursor (2, startzeile tabelle + 3 + i); + put (text (i) + " :") + PER. + +downline : + put center (startzeile menu - 3, " EUMEL Installationssystem " + setup version + + " (IBM PC/" + rechner typ + + " und kompatible Rechner) ", TRUE); + put center (startzeile menu - 2, stand, TRUE). + +rechner typ : + IF at version THEN "AT" + ELSE "XT" + FI. + +END PROC show partition table; + +PROC main menu : + biete auswahl an; + IF meldung eingetroffen THEN melde FI; + IF testausgabe THEN ausgabe fuer test FI. + +ausgabe fuer test : + testrahmen; + test out. + +testrahmen : + FOR i FROM startzeile menu - 1 UPTO startzeile menu + 9 + REP + cl eol (45, i); + put (inverse ("")) + PER; + cursor (52, startzeile menu); + put ("Ecke für Test-Output"); + cursor (52, startzeile menu). + +test out : + FOR i FROM 1 UPTO max partitions + REP + cursor (52, startzeile menu + 1 + i); + put (text (i) + ":"); + put (part type (i)); + put (part first track (i)); + put (part last track (i)); + IF active partition = i THEN put ("aktiv") + ELSE put ("inaktiv") + FI; + PER. + +melde : + cursor (1, 24); + put (inverse ("Meldung :")); + put (meldung); + meldung eingetroffen := FALSE. + +biete auswahl an : + cl eop (1, startzeile menu - 1); line; + IF partitions < max partitions + THEN putline (" EUMEL - Partition einrichten .............. 1") + ELSE line; + putline (" EUMEL - Partition") + FI; + cursor (20, startzeile menu + 1); + putline ("erneuern (Neuer SHard) .. 2"); + putline (" aktivieren .............. 3"); + putline (" löschen ................. 4"); + putline (" Partitionstabelle löschen ................. 5"); + putline (" SHard-Konfiguration anzeigen .............. 6"); + putline (" SHard konfigurieren ....................... 7"); + putline (" SHardmodule laden oder löschen ............ 8"); + putline (" Bearbeitetes Laufwerk wechseln ............ 9"); + putline (" SETUP-EUMEL beenden ....................... 0"); + putline ("-----------------------------------------------"); + put (" Ihre Wahl >>"); + get cursor (cx, cy). + +END PROC main menu; + +PROC update table : + IF mit schreibzugriff THEN get actual partition data FI; + FOR i FROM 1 UPTO partitions REP update partition PER; + FOR i FROM partitions + 1 UPTO max partitions REP rubout partition PER; + zeige plattengroesse; + IF active partition = 0 THEN meldung := "ACHTUNG : Es ist keine Partition aktiv gesetzt !"; + meldung eingetroffen := TRUE + FI. + +update partition : + partition := part list (i); + show partition. + +rubout partition : + cursor (5, startzeile tabelle + 3 + i); + out (" "). + +show partition : + cursor (5, startzeile tabelle + 3 + i); + put (name + type + zustand + groesse + startspur + endspur). + +name : subtext (subtext (part name, 1, 7) + + " ", 1, 8). + +type : text (part type (partition), 5) + " ". + +zustand : IF active partition = partition THEN (" aktiv ") + ELSE (" ") + FI. + +startspur : " " + text (part first track (partition), 5). +endspur : text (part last track (partition), 6). +groesse : text (part groesse, 5). + +zeige plattengroesse : + put gesamt; + put noch freie; + put maximaler zwischenraum. + +put maximaler zwischenraum : + cursor (48, startzeile tabelle + 6); + put ("gr. Lücke : " + text (maximaler zwischenraum, 5) + " / " + + kilobyte(maximaler zwischenraum)). + +put gesamt : + cursor (48, startzeile tabelle + 4); + put ("Gesamt : " + text (zylinder, 5) + " / " + + kilobyte(zylinder)). + +put noch freie : + cursor (48, startzeile tabelle + 5); + put ("Frei : " + text (freie zylinder, 5) + " / " + + kilobyte( freie zylinder)). + +END PROC update table; + + +TEXT PROC kilobyte (INT CONST zylinderzahl): + TEXT VAR kb; + kb := text(round(real(zylinderzahl) * real(heads) * real(sectors) * 0.512,0)); + subtext(kb,1,length(kb)-2) + +END PROC kilobyte; + + +PROC create partition (BOOL CONST partition is new) : + IF NOT partition is new + THEN renew partition + ELIF freie part number gefunden CAND noch platz uebrig + THEN new partition + ELSE kein platz mehr FI. + +kein platz mehr : + fehler; + put ("Es kann keine neue Partition mehr eingerichtet werden."); + pause (300). + +noch platz uebrig : freie zylinder > 0. + +freie part number gefunden : + IF partitions < max partitions THEN suche nummer; + TRUE + ELSE FALSE + FI. + +suche nummer : + partition := 0; + REP partition INCR 1 UNTIL part type (partition) = 0 PER. + +new partition : + cl eop (1, startzeile menu); + IF yes ("Neue EUMEL - Partition einrichten", FALSE) + THEN INT VAR alte aktive partition := active partition; + IF NOT partition exists (partition) + THEN IF enter partition spezifikations + THEN IF mit schreibzugriff THEN check part and install FI + FI; + ELSE keine freie partition + FI FI. + +renew partition : + cl eop (1, startzeile menu); + IF yes ("Neuen SHard auf bestehende EUMEL - Partition schreiben", FALSE) + THEN enter part number; + IF mit schreibzugriff THEN check part and install FI + FI. + +enter part number : + put ("Welche Partition wollen Sie erneuern :"); + get cursor (cx, cy); + put (" Abbruch mit "); + REP + REP cursor (cx, cy); + partition := get choice (1, 4, retchar); + IF sure escaped THEN LEAVE create partition FI; + partition := part list (partition) + UNTIL NOT escaped PER; + IF NOT (partition exists (partition) AND is eumel (partition)) + THEN fehler; put ("Keine EUMEL - Partition"); + pause (300); cl eop (1, 20); + FI + UNTIL partition exists (partition) AND is eumel (partition) PER. + +check part and install: + IF partition is new THEN put actual partition data FI; + IF testausgabe THEN put ("Keine Überprüfung schlechter Sektoren, da Testversion !") + ELSE trage schlechte sektoren ein; + FI; + IF is error AND partition is new + THEN active partition := alte aktive partition; + rubout partition; + LEAVE check part and install + ELIF NOT is error + THEN line; + put ("Shard wird auf die Partition geschrieben..."); line (2); + bringe shard auf platte (part type (partition)); + ELSE line; + putline ("Fehler aufgetreten. Partition unverändert") + FI; + put ("Bitte betätigen Sie eine Taste !"); + loesche eingabepuffer; + pause. + +trage schlechte sektoren ein: + INT VAR anzahl schlechter sektoren; + line (2); + putline ("Überprüfen der Partition nach schlechten Sektoren."); + add bad sector table to shard (part type (partition), old (sh name), + NOT partition is new, anzahl schlechter sektoren); + line; + IF NOT is error THEN put ("Ich habe " + bs zahl + " gefunden.") FI. + +bs zahl: + IF anzahl schlechter sektoren = 0 + THEN "keine schlechten Sektoren" + ELIF anzahl schlechter sektoren > 1 + THEN text (anzahl schlechter sektoren) + " schlechte Sektoren" + ELSE "einen schlechten Sektor" + FI. + +keine freie partition : + fehler; + put line ("Sie können nur auf freien Partitionen 'EUMEL' einrichten."); + put ("Die Partition " + text (partition) + " ist bereits mit einem System belegt !"); + pause (300). + +END PROC create partition; + +BOOL PROC enter partition spezifikations : + cl eol (60, startzeile menu); put ("Abbruch mit "); + cl eol (1, startzeile menu + 2); + put ("Typ : EUMEL,"); + INT VAR old end := part last track (partition); + enter part size; + enter part first track; + put end track; + cl eol (60, startzeile menu); + IF NOT eingaben ok THEN LEAVE enter partition spezifikations WITH FALSE FI; + cl eol (1, startzeile menu + 4); + part first track (partition) := int (start); + part last track (partition) := int (start) + int (size) - 1; + part start (partition) := first usable sector; + part size (partition) := first sector behind partition - + part start (partition); + active partition := partition; + part type (partition) := kleinste freie eumel nummer; + add to part list; + TRUE. + +eingaben ok : + cl eop (1, startzeile menu + 4); + yes ("Sind die Partitionsangaben korrekt", FALSE). + +enter part size : + get cursor (cx, cy); + REP + REP cursor (cx, cy); + put ("Welche Grösse :"); + TEXT VAR size := groessenvorschlag; + loesche eingabepuffer; + editget (size, escape, "", retchar); + IF sure escaped + THEN LEAVE enter partition spezifikations WITH FALSE + FI + UNTIL NOT escaped PER; + IF NOT size ok THEN falsche groesse FI + UNTIL size ok AND not too big PER; + cl eol (1, y + 1); + cl eol (1, y + 2); + cl eol (cx, cy); + put ("Grösse : " + size + ";"). + +size ok : + NOT size greater maxint + CAND size positiv + AND desired size <= maximaler zwischenraum. + +not too big: + INT VAR x,y; + get cursor(x,y); + IF real(kilobyte(int(size))) >= 16196.0 + THEN line; + putline("Eine Partition grösser 16 MB ist nur bei einer + Version sinnvoll !"); + yes("Eingabe korrekt",FALSE) + ELSE TRUE + FI. + +size greater maxint : + length (size) >= 5. + +size positiv : + desired size > 0. + +falsche groesse : + fehler; + put line ("Es kann keine Partition mit " + size + " Zylindern eingerichtet werden !"); + IF NOT size greater maxint CAND size positiv + THEN put ("Die grösste zusammenhängende Anzahl Zylinder ist " + + text (maximaler zwischenraum) + ".") + ELSE put ("Bitte eine positive Grösse angeben !") + FI. + +groessenvorschlag : + text (maximaler zwischenraum). + +enter part first track : + get cursor (cx, cy); + REP + REP cursor (cx, cy); + put ("Start - Zylinder der Partition :"); + TEXT VAR start := startvorschlag; + loesche eingabepuffer; + editget (start, escape, "", retchar); + IF sure escaped THEN part last track (partition) := old end; + LEAVE enter partition spezifikations WITH FALSE + FI + UNTIL NOT escaped PER; + IF NOT start ok THEN falscher start FI + UNTIL start ok PER; + cl eol (cx, cy); + put ("Start : " + start + ";"). + +put end track : + put ("Ende : " + text (int (start) + int (size) - 1)). + +start ok : + length (start) < 5 + CAND enough room + AND NOT in existing partition + AND NOT out of volume. + +out of volume : desired start > zylinder OR desired start < 0. + +in existing partition : + IF partitions = 0 THEN FALSE + ELSE i := 0; + REP + i INCR 1 + UNTIL start of part i > desired start + OR last partition + OR error found PER; + IF error found THEN TRUE ELSE FALSE FI + FI. + +error found : + part index <> i AND + (start of part i <= desired start AND end spur i >= desired start). + +part index : + 0. + +desired start : int (start). + +start of part i : part first track (part list (i)). + +last partition : i = partitions. + +enough room : + desired start + desired size <= begin of next partition. + +desired size : int (size). + +begin of next partition : + IF partitions = 0 THEN zylinder + ELSE i := 0; + REP + i INCR 1; + UNTIL start of part i > desired start + OR last partition PER; + IF start of part i > desired start THEN start of part i + ELSE zylinder + FI + FI. + +falscher start : + fehler; + put ("Auf Zylinder " + start); + put ("kann keine Partition der Grösse " + size); + put ("beginnen !"). + +startvorschlag : + text (best start position). + +best start position : + IF partitions = 0 THEN 0 + ELSE best start spur vor und zwischen den partitionen + FI. + +best start spur vor und zwischen den partitionen : + INT VAR best start := 0, min size := zylinder; + FOR i FROM 0 UPTO partitions + REP + IF platz genug zwischen i und i plus 1 AND kleiner min size + THEN min size := platz zwischen i und i plus 1; + best start := start des zwischenraums + FI + PER; + best start. + +start des zwischenraums : + end spur i + 1. + +end spur i : + IF i = 0 THEN -1 + ELSE part last track (part list (i)) + FI. + +platz zwischen i und i plus 1 : + part first track i plus 1 - (end spur i + 1). + +part first track i plus 1 : + IF i = partitions THEN zylinder + ELSE part first track (part list (i + 1)) + FI. + +platz genug zwischen i und i plus 1 : + platz zwischen i und i plus 1 >= int (size). + +kleiner min size : platz zwischen i und i plus 1 < min size. + +first usable sector: + IF int (start) = 0 + THEN 1.0 + ELSE real (heads * sectors) * real (start) + FI. + +first sector behind partition: + real (heads * sectors) * (real(start) + real (size)). + +kleinste freie eumel nummer : + IF partitions = 0 THEN 69 + ELSE search for part type (69) + FI. + +END PROC enter partition spezifikations; + +INT PROC search for part type (INT CONST minimum) : + IF minimum exists THEN search for part type (minimum + 1) + ELSE minimum + FI. + +minimum exists : + BOOL VAR exists := FALSE; + INT VAR i; + FOR i FROM 1 UPTO partitions REP + IF part type (part list (i)) = minimum THEN exists := TRUE FI + PER; + exists. + +END PROC search for part type; + +PROC bringe shard auf platte (INT CONST eumel type): + IF mit schreibzugriff THEN + enable stop; + INT CONST old session :: session; + fixpoint; + IF session <> old session + THEN errorstop ("SHard auf Platte schreiben im RERUN !") FI; + write file ("shget.exe", start der eumel partition, 1, setup channel); + write file (sh name, start der eumel partition + 1.0, + max sh size, setup channel) + FI. + +start der eumel partition: + start of partition (eumel type). +END PROC bringe shard auf platte; + + +PROC add to part list : + IF part list leer THEN part list (1) := partition + ELIF neuer start vor letzter partition THEN fuege ein + ELSE haenge an + FI; + partitions INCR 1. + +part list leer : partitions = 0. + +neuer start vor letzter partition : + part first track (partition) < part first track (part list (partitions)). + +haenge an : part list (partitions + 1) := partition. + +fuege ein : + suche erste partition die spaeter startet; + schiebe restliste auf; + setze partition ein. + +suche erste partition die spaeter startet : + i := 0; + REP i INCR 1 + UNTIL part first track (part list (i)) > part first track (partition) PER. + +schiebe restliste auf : + FOR j FROM partitions DOWNTO i + REP + part list (j + 1) := part list (j) + PER. + +setze partition ein : + part list (i) := partition. + +END PROC add to part list ; + +INT PROC maximaler zwischenraum : + IF partitions = 0 THEN zylinder + ELSE max (maximaler platz vor und zwischen den partitionen, + platz hinter letzter partition) + FI. + +maximaler platz vor und zwischen den partitionen : + help := platz vor erster partition; + FOR i FROM 1 UPTO partitions - 1 + REP + help := max (help, begin of part i plus 1 - end of part i - 1) + PER; + help. + +platz vor erster partition : + part first track (part list (1)). + +platz hinter letzter partition : + zylinder - part last track (part list (partitions)) - 1. + +begin of part i plus 1 : + part first track (part list (i + 1)). + +end of part i : + part last track (part list (i)). + +END PROC maximaler zwischenraum; + +PROC activate partition : + enter part number; + IF NOT escaped THEN set partition active FI. + +set partition active : + IF yes ("Partition mit Typnummer " + text (part type (partition)) + " aktivieren", FALSE) + THEN active partition := partition; + put actual partition data + FI. + +enter part number : + cursor (60, startzeile menu); put ("Abbruch mit "); + cursor ( 1, startzeile menu); + put ("Welche Partition wollen Sie aktivieren :"); + get cursor (cx, cy); + REP + REP cursor (cx, cy); + partition := get choice (1, 4, retchar); + IF sure escaped THEN LEAVE activate partition FI; + partition := part list (partition) + UNTIL NOT escaped PER; + IF NOT partition exists (partition) THEN fehler melden FI + UNTIL partition exists (partition) PER; + cl eol (60, startzeile menu); + cl eop (1, cy + 2). + +fehler melden : + partition gibt es nicht. + +partition gibt es nicht : + fehler; + put ("Diese Partition gibt es nicht."). + +END PROC activate partition; + +PROC delete partition : + enter part number; + IF NOT escaped THEN + IF yes ("Partition mit Typnummer " + text (part type (partition)) + " löschen", FALSE) + AND ganz sicher + THEN rubout partition + FI FI. + +enter part number : + cursor (60, startzeile menu); put ("Abbruch mit "); + cursor ( 1, startzeile menu); + put ("Welche Partition wollen Sie löschen :"); + get cursor (cx, cy); + REP + REP cursor (cx, cy); + partition := get choice (1, 4, retchar); + IF sure escaped THEN LEAVE delete partition FI; + partition := part list (partition) + UNTIL NOT escaped PER; + IF NOT (partition exists (partition) AND is eumel (partition)) THEN fehler melden FI + UNTIL partition gueltig AND is eumel (partition) PER; + cl eol (60, startzeile menu); + cl eop (1, cy + 2). + +fehler melden : + IF NOT partition exists (partition) THEN partition gibt es nicht + ELSE keine eumel partition + FI. + +partition gibt es nicht : + fehler; + put ("Diese Partition gibt es nicht."). + +ganz sicher : + line; + yes ("Sind Sie sich ganz sicher", FALSE). + +END PROC delete partition; + +PROC delete partition table : + cursor ( 1, startzeile menu + 1); + put ("Es gehen ALLE Daten verloren, die sich auf Ihrer Platte befinden !"); + line (2); + IF yes ("Wollen Sie wirklich die ganze Partitionstabelle löschen", FALSE) + THEN line; + IF yes ("Sind Sie sich ganz sicher", FALSE) + THEN loesche ganze tabelle + FI FI. + +loesche ganze tabelle : + FOR i FROM 1 UPTO max partitions + REP part type (i) := 0; + part first track (i) := 0; + part last track (i) := 0; + part start (i) := 0.0; + part size (i) := 0.0; + part list (i) := 0 + PER; + partitions := 0; + active partition := 0; + IF mit schreibzugriff THEN clear partition table (-3475) FI. + +END PROC delete partition table; + +PROC rubout partition : + part type (partition) := 0; + part first track (partition) := 0; + part last track (partition) := 0; + IF active partition = partition THEN active partition := 0 FI; + del from part list; + put actual partition data. + +del from part list : + search for partition in part list; + delete it and set highest to 0; + partitions DECR 1. + +search for partition in part list : + i := 0; + REP i INCR 1 UNTIL part list (i) = partition PER. + +delete it and set highest to 0 : + FOR j FROM i UPTO partitions - 1 + REP + part list (j) := part list (j + 1) + PER; + part list (partitions) := 0. + +END PROC rubout partition; + +INT PROC get choice (INT CONST von, bis, TEXT VAR retchar): + get choice (von, bis, von, retchar) +END PROC get choice; + +INT PROC get choice (INT CONST von, bis, zusatz, TEXT VAR retchar): + LET return = ""13"", + escape = ""27"", + left = ""8""; + TEXT VAR buffer; + INT VAR cx, cy; + get cursor (cx, cy); out (" " + left); + REP + REP + cursor (cx, cy); buffer := incharety; + UNTIL input ok OR buffer = escape PER; + IF buffer = escape THEN retchar := escape; + LEAVE get choice WITH 0 + FI; + out (buffer); + leseschleife bis left or ret; + IF retchar = left THEN out (left + " ") FI; + IF retchar = escape THEN LEAVE get choice WITH 0 FI + UNTIL retchar = return OR retchar = escape PER; + int (buffer). + +input ok : (buffer >= text (von) AND buffer <= text (bis)) OR buffer = text (zusatz). + +leseschleife bis left or ret: + REP + inchar (retchar) + UNTIL retchar = return OR retchar = left OR retchar = escape PER. + +END PROC get choice; + +TEXT PROC inverse (TEXT CONST t): + ""15"" + t + " " + ""14"" +END PROC inverse; + +PROC put center (TEXT CONST t): + put center (t, 80) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, BOOL CONST inverse): + put center (zeile, t, 80, inverse); +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t): + put center (zeile, t, 80) +END PROC put center; + +PROC put center (TEXT CONST t, INT CONST gesamtbreite): + INT VAR cy; + get cursor (cy, cy); + put center (cy, t, gesamtbreite) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite): + put center (zeile, t, gesamtbreite, FALSE); +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite, + BOOL CONST inverse): + IF inverse + THEN cursor (1, zeile); + out (""15""); + gesamtbreite - 2 TIMESOUT " "; + FI; + cursor ((gesamtbreite - length (t)) DIV 2, zeile); + put (t); + IF inverse + THEN cursor (gesamtbreite - 1, zeile); + out (""14""); + FI +END PROC put center; + +PROC cl eol: + out (""5"") +END PROC cl eol; + +PROC cl eop: + out (""4"") +END PROC cl eop; + +PROC cl eol (INT CONST cx, cy): + cursor (cx, cy); + cl eol +END PROC cl eol; + +PROC cl eop (INT CONST cx, cy): + cursor (cx, cy); + cl eop +END PROC cl eop; + +INT PROC partition groesse (INT CONST part) : + part last track (part) - part first track (part) + 1 +END PROC partition groesse; + +BOOL PROC is eumel (INT CONST partition) : + part type (partition) >= 69 AND part type (partition) <= 72 +END PROC is eumel; + +BOOL PROC partition exists (INT CONST partition) : + IF partition > 0 AND partition <= max partitions + THEN part type (partition) <> 0 + ELSE FALSE + FI +END PROC partition exists;. + +part groesse : partition groesse (partition). + +part name : + SELECT part type (partition) OF + CASE 1, 4 : "DOS" + CASE 69, 70, 71, 72 : "EUMEL" + OTHERWISE text (part type (partition)) + END SELECT. + +escaped : retchar = escape. + +sure escaped : + IF escaped THEN cl eop (1, 20); cursor (1, 22); + yes ("Vorgang abbrechen", TRUE) + ELSE FALSE + FI. + +partition gueltig : + partition > 0 + AND partition <= max partitions. + +freie zylinder : + zylinder - belegte zylinder. + +belegte zylinder : + help := 0; + FOR i FROM 1 UPTO partitions REP + help INCR partition groesse (part list (i)) + PER; + help. + +keine eumel partition : + fehler; + put line ("Sie dürfen mit diesem System nur 'EUMEL' - Partitionen manipulieren."); + put ("Die Partition " + text (partition) + " ist nicht vom Typ 'EUMEL' !"). + +fehler : + cl eop (1, 20); + put (""7"" + inverse ("FEHLER :")); line (2). + +loesche eingabepuffer : + REP UNTIL incharety = "" PER. ; + +PROC logo : + page; + put center (3, "S E T U P - E U M E L "+ setup version); + put center (5, "für"); + put center (7, "M O D U L - S H A R D"); + put center (13, "======================================================"); + put center (15, "(für IBM " + typ + " und Kompatible)"); + put center (20, stand); + pause (50); + collect heap garbage. + +typ : + IF at version THEN "AT" ELSE "XT" FI. +END PROC logo; + +END PACKET setup eumel; + +setup eumel + + + + + + + diff --git a/system/setup/3.1/src/setup eumel erzeugen b/system/setup/3.1/src/setup eumel erzeugen new file mode 100644 index 0000000..7a50898 --- /dev/null +++ b/system/setup/3.1/src/setup eumel erzeugen @@ -0,0 +1,15 @@ +check off; +insert("setup eumel -1: mini eumel dummies"); +insert("setup eumel 0: /S"); +insert("setup eumel 1: basisoperationen"); +insert("setup eumel 2: modulzugriffe"); +insert("setup eumel 3: modulkonfiguration"); +insert("setup eumel 5: partitionierung"); +insert("setup eumel 6: shardmontage"); +insert("setup eumel 7: setupeumel"); +putline("Jetzt 'setup eumel endlos' nicht vergessen"); + + + + + diff --git a/system/setup/3.1/src/setup eumel erzeugen-M b/system/setup/3.1/src/setup eumel erzeugen-M new file mode 100644 index 0000000..ad85301 --- /dev/null +++ b/system/setup/3.1/src/setup eumel erzeugen-M @@ -0,0 +1,14 @@ +check off; +insert("setup eumel 0: /M"); +insert("setup eumel 1: basisoperationen"); +insert("setup eumel 2: modulzugriffe"); +insert("setup eumel 3: modulkonfiguration"); +insert("setup eumel 5: partitionierung"); +insert("setup eumel 6: shardmontage"); +insert("setup eumel 7: setupeumel"); +putline("Jetzt 'setup eumel endlos' nicht vergessen"); + + + + + diff --git a/system/setup/3.1/src/shget.exe b/system/setup/3.1/src/shget.exe new file mode 100644 index 0000000..902d697 Binary files /dev/null and b/system/setup/3.1/src/shget.exe differ diff --git a/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik b/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik new file mode 100644 index 0000000..36fa31e --- /dev/null +++ b/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik @@ -0,0 +1,831 @@ +#type ("trium10")##limit (13.5)# +#block##start(2.5,2.5)##pagelength(21.0)##pagenr("%",418)##setcount(22)# +#headeven# +% EUMEL-Benutzerhandbuch + + + +#end# +#headodd# + TEIL 10: Graphik % + + + +#end# +#type("triumb14")# +#ib(9)##center#TEIL 10: Graphik#ie(9)# +#type("trium10")# +#free(2.0)# +#on("bold")##ib(9)##type("triumb14")#1. Übersicht#ie(9)# +#type("trium10")# + + #limit(12.0)##on("italics")#Dieser Teil des Benutzer-Handbuchs beschreibt die Graphik- + Möglichkeiten des EUMEL-Systems. Die Graphik-Pakete ge­ + hören nicht zum EUMEL-Standard, sondern sind Anwender­ + pakete, die im Quellcode ausgeliefert und von jeder Installation + in das System aufgenommen werden können. Unter Umständen + müssen Programme erstellt werden, die die Anpassungen für + spezielle graphische Geräte einer Installation vornehmen. +#limit(13.5)##off("italics")# + +Das Graphik-System ermöglicht es, durch ELAN-Programme geräteunab­ +hängige Informationen für Zeichnungen ("#ib#Graphiken#ie#") zu erstellen. Die Graphik +erzeugenden Programme brauchen dabei keine gerätespezifischen Größen sowie +gerätespezifischen Unterprogramme zu enthalten. Sie befassen sich somit +ausschließlich mit der Erzeugung der problemorientierten Information für die +Konstruktion einer Zeichnung. Nach der geräteunabhängigen Erzeugung einer +Graphik kann diese auf unterschiedlichen Geräten ausgegeben werden (z.B. erst +auf einem Terminal zur Kontrolle und dann auf einem Plotter). + +Die EUMEL-Graphik umfaßt zwei- und dreidimensionale Graphik. Dabei +entspricht die Y-Achse bei der zweidimensionalen Graphik der Z-Achse (Höhe) +bei der dreidimensionalen Graphik. Im dreidimensionalen Fall sind perspektivi­ +sche, orthografische und schiefwinklige Projektionen mit beliebigen Betrach­ +tungswinkeln möglich. + +Bei der EUMEL-Graphik wird streng zwischen Erzeugung und Manipulation von +Graphiken (Bildern) auf der einen und Darstellung der erzeugten Bilder auf der +anderen Seite unterschieden. Für die Erzeugung und Manipulation der Graphi­ +ken existiert der Typ PICTURE, für die Darstellung der Bilder gibt es den Typ +PICFILE. Dabei müssen Ausschnitt, Maßstab, Betrachtungswinkel und Pro­ +jektionsart erst bei der Darstellung festgelegt werden. Diese Konstruktion des +Graphik-Systems hat folgende Vorteile: + +a) Programme, die Graphik-Informationen erzeugen, sind geräteunabhängig. + Das bedeutet, daß Programmierer sich ausschließlich mit einem logischen + Problem zu befassen brauchen und nicht mit gerätespezifischen Besonder­ + heiten. + +b) Graphiken können auf mehreren unterschiedlich gearteten Geräten mehrmals + dargestellt werden, ohne daß das erzeugende Programm geändert oder neu + gestartet werden muß. Z.B. kann ein Programmierer eine Graphik erst auf + dem Terminal auf Richtigkeit und Größenverhältnisse überprüfen, bevor er die + Zeichnung auf einem Plotter zeichnen läßt. + +c) Graphiken können leicht geändert (z.B. vergrößert oder in eine Richtung + gestreckt) werden, ohne daß das erzeugende Programm erneut durchlaufen + werden muß. Zudem können Graphiken aneinander oder übereinander gelegt + werden. + +d) Graphiken mit unterschiedlichen Farben, Strichen usw. können leicht erzeugt + werden. + +e) Der Anschluß von neuen Graphik-Geräten durch Benutzer ist leicht möglich, + ohne daß die Graphik erzeugenden Programme modifiziert werden müssen. + +f) Plotter können wie Drucker an einen SPOOLER gehängt werden. + +g) Bilder können als PICFILEs gespeichert und versandt werden. +#free(2.0)# +#ib(9)##type("triumb14")#Erzeugung von Bildern#ie(9)# +#type("trium10")# + +Bilder entstehen in Objekten vom Datentyp + +#type("modern12")# + PICTURE +#type("trium10")# + +Diese müssen mit der Prozedur + +#type("modern12")# + nilpicture +#type("trium10")# + +initialisiert werden. Sie enthalten dann ein leeres Bild, dessen Dimension noch +nicht festgelegt ist. Die Dimension eines PICTUREs wird mit dem ersten +Schreibzugriff ('move' oder 'draw') festgelegt. Ein PICTURE kann immer nur +entweder zwei- oder dreidimensional sein. Außerdem kann einem PICTURE mit +der Prozedur + +#type("modern12")# + pen +#type("trium10")# + +genau ein virtueller Stift zugeordnet oder der aktuelle Stift erfragt werden. + +Die Erzeugung eines Bildes basiert auf dem Modell eines Plotters. Der (virtuelle) +Zeichenstift kann mit + +#type("modern12")# + move +#type("trium10")# + +ohne zu zeichnen an beliebige Stellen gefahren werden (reine Positionierung). +Mit + +#type("modern12")# + draw +#type("trium10")# + +wird der Stift veranlaßt, eine Linie von der aktuellen zur angegebenen Zielposi­ +tion zu zeichnen. 'move' löst also Bewegungen mit gehobenem, 'draw' solche mit +gesenktem Stift aus. Um auch 'relatives' Zeichnen zu ermöglichen, existiert die +Prozedur + +#type("modern12")# + where +#type("trium10")# + +die die aktuelle Stiftposition liefert. +#free(2.0)# +#ib(9)##type("triumb14")#Manipulation von Bildern#ie(9)# +#type("trium10")# + +Erstellte Bilder können als Ganzes manipuliert werden. Die Prozeduren + +#type("modern12")# + translate (* verschieben *) + stretch (* strecken bzw. stauchen *) + rotate (* drehen *) + reflect (* spiegeln *) +#type("trium10")# + +verändern jeweils das ganze Bild. Es ist aber auch möglich, mehrere Bilder +zusammenzufügen. Mit + +#type("modern12")# + CAT +#type("trium10")# + +kann ein weiteres Bild angefügt werden. Dabei müssen allerdings beide +PICTURE die gleiche Dimension haben. In solchen als ganzes manipulierten +Bildern kann man ohne Einschränkung mit 'draw' und 'move' weiterzeichnen. +#free(2.0)# +#ib(9)##type("triumb14")#Darstellung#ie(9)# +#type("trium10")# + +Für die Darstellung der erzeugten Bilder existiert der Typ + +#type("modern12")# + PICFILE +#type("trium10")# + +Dieser besteht aus max. 128 PICTUREs, die mit den Prozeduren + +#type("modern12")# + put + get +#type("trium10")# + +eingegeben bzw. ausgegeben werden können. PICFILE wird durch Datenräume +realisiert, deshalb erfolgt die Assoziation an einen benannten Datenraum ähnlich +wie beim FILE. Dafür wird die Prozedur + +#type("modern12")# + picture file +#type("trium10")# + +verwandt. Ein neuer PICFILE enthält genau ein leeres PICTURE. Die Darstellung +der PICFILEs auf Zeichengeräten erfolgt mit der Prozedur + +#type("modern12")# + plot +#type("trium10")# + +Da die Graphiken aber in "Weltkoordinaten" erzeugt werden und die spätere +Darstellung vollkommen unbeachtet bleibt, müssen gewisse Darstellungspara­ +meter für die Zeichnung gesetzt werden. Diese Parameter werden im PICFILE +abgelegt und gelten jeweils für den gesamten PICFILE. Dadurch ist es möglich, +einen PICFILE mit spezifizierter Darstellungsart über einen SPOOLER an einen +Plotter zu senden oder die bei der letzten Betrachtung gewählte Darstellung mit +in dem PICFILE gespeichert zu halten. Für die Darstellung können den virtuellen +Stiften mit der Prozedur + +#type("modern12")# + select pen +#type("trium10")# + +reale Stifte zugeordnet werden. Voreingestellt ist für alle virtuellen Stifte: +Standardfarbe, Standardstärke, durchgängige Linie. + +Indem man einigen virtuellen Stiften den leeren Stift als realen Stift zuordnet, +kann man einzelne PICTUREs ausblenden. Sowohl bei der Darstellung von +zwei- als auch dreidimensionaler Graphik kann die gewählte Zeichenfläche auf +dem Endgerät mit der Prozedur + +#type("modern12")# + viewport +#type("trium10")# + +festgelegt werden. Voreingestellt ist das Quadrat mit der größtmöglichen Seiten­ +länge, d.h. der kürzeren Seite der hardwaremäßigen Zeichenfläche. +#free(2.0)# +#ib(9)##type("triumb14")#Darstellung zweidimensionaler Graphik#ie(9)# +#type("trium10")# + +Bei der Darstellung zweidimensionaler Bilder muß der zu zeichnende Ausschnitt +(das 'Fenster') angegeben werden. Mit der Prozedur + +#type("modern12")# + window +#type("trium10")# + +wird durch Angabe der minimalen und maximalen X- bzw. Y-Koordinaten ein +Fenster definiert. Da das so definierte Fenster auf die ganze (mit 'viewport' +definierbare) Zeichenfläche abgebildet wird, ist der Abbildungsmaßstab durch das +Zusammenspiel von 'viewport' und 'window' bestimmt. Da bei 'viewport' stan­ +dardmäßig das maximale Zeichenquadrat voreingestellt ist, wird in diesem Fall +durch gleiche X- und Y-Fenstergröße eine winkeltreue Darstellung erreicht. +#free(2.0)# +#ib(9)##type("triumb14")#Darstellung dreidimensionaler Graphik#ie(9)# +#type("trium10")# + +Im dreidimensionalen Fall wird das Fenster ebenfalls mit + +#type("modern12")# + window +#type("trium10")# + +definiert, wobei dann allerdings auch der Bereich der dritten Dimension +(Z-Koordinaten) zu berücksichtigen ist. Da die dreidimensionale Graphik auf +eine zweidimensionale Fläche projiziert wird, können aber noch weitere Darstel­ +lungsparameter angegeben werden. Der Betrachtungswinkel wird mit Hilfe der +Prozedur + +#type("modern12")# + view +#type("trium10")# + +angegeben. Zur Spezifikation der gewünschten Projektionsart gibt es + +#type("modern12")# + orthographic (* orthographische Projektion *) + perspective (* perspektivische Projektion, + der Fluchtpunkt ist frei wählbar *) + oblique (* schiefwinklige Projektion *) +#type("trium10")# +#free(2.0)# +#ib(9)##type("triumb14")#Beispiel (Sinuskurve)#ie(9)# +#type("modern12")# + + funktion zeichnen; + bild darstellen . + +funktion zeichen : + PICTURE VAR pic :: nilpicture; + REAL VAR x := -pi; + move (pic, x, sin (x)); + REP x INCR 0.1; + draw (pic, x, sin (x)) + UNTIL x >= pi PER . + +bild darstellen : + PICFILE VAR p :: picture file ("sinus"); + window (p, -pi, pi, -1.0, 1.0); + put (p, pic); + plot (p) . +#type("trium10")# +#free(2.0)# +#ib(9)##type("triumb14")#Beispiel (Würfel)#ie(9)# +#type("modern12")# + + wuerfel zeichen; + wuerfel darstellen. + +wuerfel zeichnen : + zeichne vorderseite; + zeichne rueckseite; + zeichne verbindungskanten. + +zeichne vorderseite : + PICTURE VAR vorderseite :: nilpicture; + move (vorderseite, 0.0, 0.0, 0.0); + draw (vorderseite, 1.0, 0.0, 0.0); + draw (vorderseite, 1.0, 0.0, 1.0); + draw (vorderseite, 0.0, 0.0, 1.0); + draw (vorderseite, 0.0, 0.0, 0.0). + +zeichne rueckseite : + PICTURE VAR rueckseite :: translate + (vorderseite, 0.0, 1.0, 0.0). + +zeichne verbindungskanten : + PICTURE VAR verbindungskanten :: nilpicture; + move (verbindungskanten, 0.0, 0.0, 0.0); + draw (verbindungskanten, 0.0, 1.0, 0.0); + + move (verbindungskanten, 1.0, 0.0, 0.0); + draw (verbindungskanten, 1.0, 1.0, 0.0); + + move (verbindungskanten, 1.0, 0.0, 1.0); + draw (verbindungskanten, 1.0, 1.0, 1.0); + + move (verbindungskanten, 0.0, 0.0, 1.0); + draw (verbindungskanten, 0.0, 1.0, 1.0). + +wuerfel darstellen : + PICFILE VAR p := picture file ("wuerfel"); + put (p, vorderseite); + put (p, rueckseite); + put (p, verbindungskanten); + window (p, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0); + view (p, 0.0, 40.0, 20.0); + orthographic (p); + plot (p). +#type("trium10")# +#free(2.0)# +#ib(9)##type("triumb14")#Beschreibung der Graphik-Prozeduren#ie(9)# +#type("trium10")# + + #limit(12.0)##on("italics")#Zweidimensionale PICTUREs brauchen weniger Speicherplatz + als dreidimensionale. Daher werden in einigen Fehlermeldun­ + gen unterschiedliche Größen angegeben. +#limit(13.5)##off("italics")# + +:= + OP := (PICTURE VAR dest, PICTURE CONST source) + Zweck: Zuweisung + + OP := (PICFILE VAR dest, DATASPACE CONST source) + Zweck: Assoziiert die PICFILE Variable 'dest' mit der DATASPACE CONST + 'source' und initialisiert die PICFILE Variable sofern nötig. + Fehlerfall: + * dataspace is no PICFILE + Der anzukoppelnde Datenraum hat einen falschen Typ. + +#ib#CAT#ie# + OP CAT (PICTURE VAR dest, PICTURE CONST source) + Zweck: Aneinanderfügen von zwei PICTURE's. + Fehlerfälle: + * OP CAT: left dimension <> right dimension + Es können nur PICTUREs mit gleicher Dimension angefügt werden. + * OP CAT: Picture overflow + Die beiden PICTURE überschreiten die maximale Größe eines + Pictures. + +#ib#act picture#ie# + PICTURE PROC act picture (PICFILE VAR p) + Zweck: Liefert das PICTURE des PICFILEs 'p', auf das mit 'backward' o.ä. + positioniert wurde. + +#ib#backward#ie# + PROC backward (PICFILE VAR p) + Zweck: Positioniert den PICFILE 'p' um ein PICTURE zurück. + Fehlerfall: + * backward at begin of file + Es wurde versucht vor den Anfang des PICFILEs zu positionieren. + +#ib#draw#ie# + PROC draw (PICTURE VAR pic, REAL CONST x, y) + Zweck: Die Prozedur zeichnet in dem (zweidimensionalen) Bild 'pic' eine + Linie von der aktuellen Position zur Position (x, y). + Fehlerfälle: + * picture overflow + Zu viele Befehle in einem PICTURE (z. Zeit max. 1927) + * picture is three dimensional + Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. + + PROC draw (PICTURE VAR pic, REAL CONST x, y, z) + Zweck: Die Prozedur zeichnet in dem (dreidimensionalen) Bild 'pic' eine + gerade Linie von der aktuellen Position zur Position (x, y, z). + Fehlerfälle: + * picture overflow + Zu viele Befehle in einem PICTURE (z. Zeit max. 1310) + * picture is only two dimensional + Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. + + PROC draw (PICTURE VAR pic, TEXT CONST text) + Zweck: Der angegebene Text wird in das Bild 'pic' eingetragen. Der Anfang + ist dabei die aktuelle Stiftposition. Diese wird nicht verändert. + Fehlerfall: + * picture overflow + Der Text paßt nicht mehr in das PICTURE. + + PROC draw (PICTURE VAR pic, TEXT CONST text, + REAL CONST angle, height) + Zweck: Der angegebene Text wird unter dem Winkel 'angle' gegenüber der + Waagerechten und in der Größe 'height' in das PICTURE 'pic' + eingetragen. Der Anfang ist dabei die aktuelle Stiftposition. Diese + wird nicht verändert. + Fehlerfall: + * picture overflow + Der Text paßt nicht mehr in das PICTURE. + + PROC draw (PICFILE VAR pic, REAL CONST x, y) + Zweck: Die Prozedur zeichnet in dem aktuellen (zweidimensionalen) + PICTURE des PICFILEs 'p' eine gerade Linie. Der (virtuelle) Stift wird + von der aktuellen Position zur Position (x, y) gefahren. Falls das + aktuelle PICTURE zu voll ist, wird automatisch auf das nächste + umgeschaltet. + Fehlerfälle: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128 PICTURE) + * picture is threedimensional + Das aktuelle PICTURE ist dreidimensional. + + PROC draw (PICTFILE VAR pic, REAL CONST x, y, z) + Zweck: s. o. + Fehlerfälle: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128) + * picfile is only twodimensional + Das aktuelle PICTURE ist zweidimensional. + + PROC draw (PICTFILE VAR pic, TEXT CONST text) + Zweck: Der angegebene Text wird in das aktuelle PICTURE des PICFILEs 'p' + eingetragen. Falls das aktuelle PICTURE zu voll ist, wird automatisch + auf das nächste umgeschaltet. Der Anfang ist dabei die aktuelle + Stiftposition. Diese wird nicht verändert. + Fehlerfall: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128) + + PROC draw (PICFILE VAR pic, TEXT CONST text, + REAL CONST angle, height) + Zweck: Der angegebene Text wird unter dem Winkel 'angle' gegenüber der + Waagerechten und in der Größe 'height' in das aktuelle PICTURE + des PICFILES 'p' eingetragen. Falls das aktuelle PICTURE zu voll ist, + wird automatisch auf das nächste umgeschaltet. Der Anfang ist + dabei die aktuelle Stiftposition. Diese wird nicht verändert. + Fehlerfall: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128) + +#ib#eof#ie# + BOOL PROC eof (PICFILE CONST p) + Zweck: Liefert 'TRUE' wenn hinter das Ende des PICFILEs positioniert + wurde. + +#ib#extrema#ie# + PROC extrema (PICTURE CONST p, + REAL VAR x min, x max, y min, y max) + Zweck: Die Prozedur liefert die größten und kleinsten X- und Y-Koordi­ + naten des PICTUREs 'p'. Diese werden in die Parameter 'x min', 'x + max', 'y min' und 'y max' eingetragen. + + PROC extrema (PICTURE CONST p, + REAL VAR x min, x max, y min, y max, z min, z max) + Zweck: s.o. + + PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) + Zweck: s.o. + + PROC extrema (PICFILE VAR p, + REAL VAR x min, x max, y min, y max, z min, z max) + Zweck: s.o. + +#ib#forward#ie# + PROC forward (PICFILE VAR p) + Zweck: Positioniert den PICFILE um ein PICTURE weiter. + Fehlerfall: + * picfile overflow + Es sollte hinter das Ende des PICFILEs positioniert werden. + +#ib#get#ie# + PROC get (PICFILE VAR p, PICTURE VAR pic) + Zweck: Liest ein PICTURE aus einem PICFILE und positioniert auf das + Nächste. + Fehlerfall: + * input after end of picfile + Es sollte nach dem Ende des Picfiles gelesen werden. + +#ib#move#ie# + PROC move (PICTURE VAR pic, REAL CONST x, y) + Zweck: Der (virtuelle) Stift wird zur Position (x, y) gefahren. + Fehlerfälle: + * picture overflow + Zu viele Befehle in einem PICTURE (z. Zeit max. 1927 'moves') + * picture is three dimensional + Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. + + PROC move (PICTURE VAR pic, REAL CONST x, y, z) + Zweck: Der (virtuelle) Stift wird zur Position (x, y, z) gefahren. + Fehlerfälle: + * picture overflow + Zu viele Befehle in einem PICTURE (z. Zeit max. 1310) + * picture is only twodimensional + Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. + + PROC move (PICFILE VAR p, REAL CONST x, y) + Zweck: Der (virtuelle) Stift wird zur Position (x, y) gefahren. Falls das aktuelle + PICTURE des PICFILEs 'p' zu voll ist, wird automatisch auf das + nächste umgeschaltet. + Fehlerfall: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128 PICTUREs) + + PROC move (PICFILE VAR p, REAL CONST x, y, z) + Zweck: Der (virtuelle) Stift wird zur Position (x, y, z) gefahren. Falls das + aktuelle PICTURE des PICFILEs 'p' zu voll ist, wird automatisch auf + das nächste umgeschaltet. + Fehlerfall: + * picfile overflow + Das letzte PICTURE ist voll (z. Zeit max. 128 PICTUREs) + +#ib#nilpicture#ie# + PICTURE PROC nilpicture + Zweck: Die Prozedure liefert ein leeres PICTURE zur Initialisierung. + +#ib#oblique#ie# + PROC oblique (PICFILE VAR p, REAL CONST a, b) + Zweck: Bei dem (dreidimensionalen!) Bild 'p' wird 'schiefwinklig' als + gewünschte Projektionsart eingestellt. Dabei ist (a, b) der Punkt in + der X-Y-Ebene, auf den der Einheitsvector in Z-Richtung + abgebildet werden soll. + +#ib#orthographic#ie# + PROC orthographic (PICFILE VAR p) + Zweck: Bei dem (dreidimensionalen!) Bild 'p' wird "orthografisch" als Pro­ + jektionsart eingestellt. Bei der orthografischen Projektion wird ein + dreidimensionaler Körper mit parallelen Strahlen senkrecht auf die + Projektionsebene abgebildet. + +#ib#pen#ie# + INT PROC pen (PICTURE CONST pic) + Zweck: Liefert die Nummer des 'virtuellen Stifts'. + + PICTURE PROC pen (PICTURE CONST pic, INT CONST pen) + Zweck: Liefert ein PICTURE mit dem Inhalt 'pic' und dem 'virtuellen Stift' mit + der Nummer 'pen'. Möglich sind die Nummern 1 - 16. + Fehlerfälle: + * PROC pen: pen [No] < 1 + Der gewünschte Stift ist kleiner als 1. + * PROC pen: pen [No] > 16 + Der gewünschte Stift ist größer als 16. + +#ib#perspective#ie# + PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) + Zweck: Bei den dreidimensionalen PICTUREs des PICFILE's 'p' wird + "perspektivisch" als gewünschte Projektionsart eingestellt. Der Punkt + (cx, cy, cz) ist der Fluchtpunkt der Projektion, d.h. alle Parallelen zur + Blickrichtung schneiden sich in diesem Punkt. + +#ib#pic no#ie# + INT PROC pic no (PICFILE CONST p) + Zweck: Liefert die Nummer des aktuellen PICTUREs. + +#ib#picture file#ie# + DATASPACE PROC picture file (TEXT CONST name) + Zweck: Die Prozedur dient zur Assoziation eines benannten Datenraumes mit + einem PICFILE (s. Operator ':='). + +#ib#plot#ie# + PROC plot (TEXT CONST name) + Zweck: Der PICFILE mit dem Namen 'name' wird entspechend der angege­ + benen Darstellungsart gezeichnet. Diese Parameter ('perspective', + 'orthographic', 'oblique', 'view', 'window' etc.) müssen vorher + eingestellt werden. + Fehlerfall: + * FILE does not exist + Es existiert kein PICFILE mit dem Namen 'name' + + PROC plot (PICFILE VAR p) + Zweck: Der PICFILE 'p' wird entspechend der angegebenen Darstellungsart + gezeichnet. Diese Parameter müssen vorher eingestellt werden. + + #on("bold")#Zweidimensional: +#off("bold")# + obligat: 'window' (zweidimensional) + optional: 'view' (zweidimensional) + 'select pen' + 'viewport' + + #on("bold")#Dreidimensional: +#off("bold")# + obligat: 'window' (dreidimensional) + optional: 'view' (dreidimensional) + 'orthographic', 'perspective', 'oblique' + 'viewport' + 'select pen' + +#ib#put#ie# + PROC put (PICFILE VAR p, PICTURE CONST pic) + Zweck: Schreibt ein PICTURE in einen PICFILE und positioniert um eins + vor. + Fehlerfall: + * picfile overflow + Der PICFILE ist voll. (z. Z. max. 128 PICTURE) + +#ib#reset#ie# + PROC reset (PICFILE VAR p) + Zweck: Positioniert auf den Anfang eines Picfiles. + +#ib#rotate#ie# + PICTURE PROC rotate (PICTURE CONST pic, REAL CONST alpha) + Zweck: Das PICTURE 'pic' wird um den Punkt (0, 0) um den Winkel 'alpha' + (im Gradmaß) im mathematisch positiven Sinn gedreht. + + PICTURE PROC rotate (PICTURE CONST pic, + REAL CONST alpha, beta, gamma) + Zweck: Das dreidimensionale PICTURE 'pic' wird um den Winkel 'alpha', + 'beta' oder 'gamma' im mathematisch positiven Sinn gedreht. Der + Winkel 'alpha' dreht um die X-Achse, der Winkel 'beta' um die + Y-Achse und 'gamma' um die Z-Achse. Es darf dabei nur jeweils + ein Winkel von 0.0 verschieden sein. Alle Winkel werden im + Gradmaß angegeben. + +#ib#select pen#ie# + PROC select pen (PICFILE VAR p, + INT CONST pen, colour, thickness, linetype) + Zweck: Für die Darstellung des Bildes 'p' soll dem "virtuellen Stift" 'pen' ein + realer Stift zugeordnet werden, der möglichst die Farbe 'colour' und + die Dicke 'thickness' hat und dabei Linien mit dem Typ 'line type' + zeichnet. Es wird die beste Annäherung für das Ausgabegerät für + diese Parameter genommen. Dabei gelten folgende Vereinbarun­ + gen: + + Farbe: negative Farben setzten den Hintergrund, positive Farben + zeichnen im Vordergrund. + + 0 Löschstift (falls vorhanden) + 1 Standardfarbe des Endgeräts (schwarz oder weiß) + 2 rot + 3 blau + 4 grün + 5 schwarz + 6 weiß > 20 nicht normierte Sonderfarben + + Dicke: 0 + Standardstrichstärke des Endgerätes > 0 + Strichstärke in 1/10 mm + + Typ: + 0 keine sichtbare Linie + 1 durchgängige Linie + 2 gepunktete Linie + 3 kurz gestrichelte Linie + 4 lang gestrichelte Linie + 5 Strichpunktlinie + + Die hier aufgeführten Möglichkeiten müssen nicht an allen grafischen + Endgeräten vorhanden sein. Der geräteabhängige Graphik-Treiber + wählt jeweils die für ihn bestmögliche Annäherung. + + Fehlerfälle: + * pen < 1 + * pen > 16 + +#ib#size#ie# + INT PROC size (PICFILE CONST p) + Zweck: Liefert die aktuelle Größe eines PICFILEs in Bytes. + +#ib#stretch#ie# + PICTURE PROC stretch (PICTURE CONST pic, REAL CONST xc, yc) + Zweck: Das PICTURE 'pic' wird in X-Richtung um den Faktor 'xc', in + Y-Richtung um den Faktor 'yc' gestreckt (bzw. gestaucht). Dabei + bewirkt der Faktor + c > 1 eine Streckung + 0 < c < 1 eine Stauchung + c < 0 zusätzlich eine Achsenspiegelung + + PICTURE PROC stretch (PICTURE CONST pic, REAL CONST xc, yc, zc) + Zweck: Das dreidimensionale PICTURE 'pic' wird entsprechend den + angegeben Faktoren 'xc', 'yc' und 'zc' gestreckt. Wirkung s.o. + +#ib#translate#ie# + PICTURE PROC translate (PICTURE CONST pic, REAL CONST dx, dy) + Zweck: Das PICTURE 'pic' wird um 'dx' und 'dy' verschoben. + Fehlerfall: + * picture is threedimensional + 'pic' ist dreidimensional. + + PICTURE PROC translate (PICTURE CONST pic, REAL CONST dx, dy, dz) + Zweck: Das PICTURE 'pic' wird um 'dx', 'dy' und 'dz' verschoben. + Fehlerfall: + * picture is twodimensional + Das PICTURE 'pic' ist zweidimensional + +#ib#two dimensional#ie# + PROC two dimensional (PICFILE VAR p) + Zweck: Setzt als Projektionsart zweidimensional. + +#ib#view#ie# + PROC view (PICFILE VAR p, REAL CONST alpha, phi, theta) + Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne + dargestellt, sondern für die Betrachtung gedreht. Mit der Prozedur + 'view' kann diese Betrachtungsrichtung durch die Polarwinkel 'phi' + und 'theta' angegeben werden. Mit dem Winkel 'alpha' kann dann + das Bild um den Mittelpunkt der Zeichenfläche gedreht werden. + Dadurch kann ein Bild auch auf einem Terminal hochkant gestellt + werden. Voreingestellt ist 'phi = 0, theta = 0 und alpha = 0', d.h. + direkt von oben. + + Im Gegensatz zu 'rotate' hat 'view' keine Wirkung auf das eigentli­ + che Bild (PICFILE), sondern nur auf die gewählte Darstellung. So + addieren sich zwar aufeinanderfolgende "Rotationen", 'view' aber + geht immer von der Nullstellung aus. Auch kann das Bild durch eine + "Rotation" ganz oder teilweise aus oder in das Darstellungsfenster + ('window') gedreht werden. Bei 'view' verändern sich die Koordina­ + ten der Punkte nicht, d.h. das Fenster wird mitgedreht. + +#ib#viewport#ie# + PROC viewport (PICFILE VAR p, + REAL CONST hormin, hormax, vertmin, vertmax) + Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt + werden soll, wird spezifiziert. Dabei wird sowohl die Größe als auch + die relative Lage der Zeichenfläche definiert. Der linke untere + Eckpunkt der physikalischen Zeichenfläche des Gerätes hat die + Koordinaten (0.0, 0.0). Die definierte Zeichenfläche erstreckt sich + +#type("modern12")# + 'hormin' - 'hormax' in der Horizontalen, + 'vertmin' - 'vertmax' in der Vertikalen. +#type("trium10")# + + So liegt der linke untere Eckpunkt dann bei (hormin, vertmin), der + rechte obere bei (hormax, vertmax). + + Damit sowohl geräteunabhängige als auch maßstabsgerechte + Zeichnungen möglich sind, können die Koordinaten in zwei Arten + spezifiziert werden : + + a) Gerätekoordinaten + Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei + hat die kürzere Seite der physikalischen Zeichenfläche defini­ + tionsgemäß die Länge 1.0. + + b) absolute Koordinaten + Die Werte werden in cm angegeben. Für die Maximalwerte sind + nur Werte größer als 2.0 möglich. + + Voreingestellt ist + +#type("modern12")# + viewport (0.0, 1.0, 0.0, 1.0), +#type("trium10")# + + d.h. das größtmöglichste Quadrat, beginnend in der linken unteren + Ecke der physikalischen Zeichenfläche. In vielen Fällen wird diese + Einstellung ausreichen, so daß der Anwender kein eigenes 'viewport' + definieren muß. + + Der Abbildungsmaßstab wird durch das Zusammenspiel von 'view­ + port' und 'window' festgelegt (siehe dort). Dabei ist insbesondere + darauf zu achten, daß winkeltreue Darstellungen nur bei gleichem + X- und Y-Maßstab möglich sind. Da man oft quadratische Fenster + ('window') verwendet, wurde als Standardfall auch ein quadratisches + 'viewport' gewählt. + +#ib#where#ie# + PROC where (PICTURE CONST pic, REAL VAR x, y) + Zweck: Die aktuelle Stiftposition wird in 'x' und 'y' eingetragen. + Fehlerfall: + * picture is threedimensional + Das PICTURE 'pic' ist dreidimensional + + PROC where (PICTURE CONST pic, REAL VAR x, y, z) + Zweck: Die aktuelle Stiftposition wird in 'x', 'y' und 'z' eingetragen. + Fehlerfall: + * picture is twodimensional + Das PICTURE 'pic' ist zweidimensional + +#ib#window#ie# + PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) + Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das + darzustellende Fenster definiert. Alle Bildpunkte, deren X-Koordi­ + naten im Intervall [x min, x max] und deren Y-Koordinaten im + Intervall [y min, y max] liegen, gehören zum definierten Fenster. + Vektoren, die über dieses Fenster hinausgehen, werden abge­ + schnitten. Dieses Fenster wird auf die spezifizierte Zeichenfläche + abgebildet. (Das ist standardmäßig das größtmögliche Quadrat auf + dem ausgewählten Gerät). + + Der Darstellungsmaßstab ergibt sich als + +#type("modern12")# + x max - x min + ----------------------------------------- + horizontale Seitenlänge der Zeichenfläche + + y max - y min + ----------------------------------------- + vertikale Seitenlänge der Zeichenfläche +#type("trium10")# + + Für eine winkeltreue Darstellung müssen X- und Y-Maßstab + gleich sein! Einfach können winkeltreue Darstellung erreicht + werden, wenn das Fenster eine quadratische Form hat. Die + Zeichenfläche ('viewport') ist dementsprechend als Quadrat vorein­ + gestellt. + + PROC window (PICFILE VAR p, + REAL CONST x min, x max, y min, y max, z min, z max) + Zweck: Für die Darstellung eines dreidimensionalen Bildes wird das darzu­ + stellende Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im + Intervall [x min, x max] und deren Y-Koordinaten im Intervall [y min, + y max] und deren Z-Koordinaten im Intervall [z min, z max] liegen, + gehören zum definierten Fenster. Dieses dreidimensionale Fenster + (Quader) wird entsprechend der eingestellten Projektionsart (ortho­ + grafisch, perspektivisch oder schiefwinklig) und den Betrachtungs­ + winkeln (s. 'view') auf die spezifizierte Zeichenfläche abgebildet. (Das + ist standardmäßig das größtmögliche Quadrat auf dem ausgewählten + Gerät.) Linien, die außerhalb dieses Quadrates liegen, werden + abgeschnitten. + + Anders als im zweidimensionalen Fall ist das Problem der Maßstäbe + nicht mehr nur durch das Zusammenspiel von 'window' und 'view­ + port' zu beschreiben. Hier spielen auch Projektionsart und Dar­ + stellungswinkel eine Rolle. Falls alle Darstellungswinkel den Wert 0.0 + haben, gilt das für den zweidimensionalen Fall gesagte für die Ebene + (y = 0.0) entsprechend. + +#ib#write is possible#ie# + BOOL PROC write is possible (PICTURE CONST pic, INT CONST space) + Zweck: Liefert 'TRUE', falls 'space' Bytes Platz in 'pic' vorhanden ist. + + + + + + diff --git a/system/std.graphik/1.8.7/doc/GRAPHIK.book b/system/std.graphik/1.8.7/doc/GRAPHIK.book new file mode 100644 index 0000000..435d9e4 --- /dev/null +++ b/system/std.graphik/1.8.7/doc/GRAPHIK.book @@ -0,0 +1,897 @@ +#type ("times8")##limit (11.0)##start (2.2, 1.5)##pagelength (17.4)##block# + +#head# +#type ("triumb14")# +#center#EUMEL-Grafik-System + +#type ("times8")# +#end# +#type ("triumb14")# Teil 10: Graphik#type ("times8")# + + +#type ("trium12")# +#on("b")#1. Übersicht#off("b")# +#type ("times8")# + +#limit (7.0)##type("times6")# + #on("i")#Dieser Teil des Benutzer-Handbuchs beschreibt die Graphik- + Fähigkeiten des EUMEL-Systems. Die Graphik-Pakete gehö­ + ren nicht zum Eumel-Standard, sondern sind Anwenderpake­ + te, die im Quellcode ausgeliefert und von jeder Installation in das + System aufgenommen werden können. #off("i")# +#limit (11.0)# +#foot# + Eventuell müssen Programme erstellt werden, die die Anpassungen für spezielle graphische Geräte einer Installation + vornehmen, soweit diese nicht von den EUMEL-Anbietern bezogen werden können. +#end# + +#type("times8")# + Das #on("b")#Graphik-System#off("b")# ermöglicht es, durch ELAN-Programme geräteunabhängige Infor­ + mationen für Zeichnungen (#on("i")#Graphiken#off("i")#) zu erstellen. Die Graphik erzeugenden Programme + brauchen dabei keine geräteabhängigen Größen oder Unterprogramme zu enthalten. Sie + befassen sich somit ausschließlich mit der Erzeugung der problemorientierten Information + für die Konstruktion einer Zeichnung. Nach der geräteunabhängigen Erzeugung einer + Graphik kann diese auf unterschiedlichen Geräten ausgegeben werden (z.B. erst auf einem + Terminal zur Kontrolle und dann auf einem Plotter). + + Die EUMEL-Graphik umfaßt zwei- und dreidimensionale Graphik. Im dreidimensiona­ + len Fall sind perspektivische, orthografische und schiefwinklige Projektionen mit beliebi­ + gen Betrachtungswinkeln möglich. + + Bei der EUMEL-Graphik wird streng zwischen Erzeugung und Manipulation von Gra­ + phiken auf der einen und der Darstellung der erzeugten Bilder auf der anderen Seite + unterschieden. Für die Erzeugung und Manipulation der Graphiken wird von den Paketen + #on("i")#picture#off("i")# und #on("i")#picfile#off("i")# der Datentype #on("b")#PICTURE#off("b")# bzw. #on("b")#PICFILE#off("b")# zur Verfügung gestellt. Dabei + müssen Ausschnitt, Maßstab, Betrachtungswinkel und Projektionsart erst bei der Darstel­ + lung festgelegt werden. Diese Konstruktion des Graphik-Systems hat folgende Vorteile: + + a) Programme, die Graphik-Information erzeugen, sind geräteunabhängig. Das bedeu­ + tet, das der Programmierer sich ausschließlich mit einem logischen Problem befassen + muß und nicht mit gerätespezifischen Besonderheiten. + + b) Graphiken können auf mehreren unterschiedlich gearteten Geräten mehrmals darge­ + stellt werden, ohne daß das erzeugende Programm geändert oder neu gestartet werden + muß. Z.B. kann ein Programmierer eine Graphik erst auf dem Terminal überprüfen, + bevor er die Graphik auf einem Plotter zeichnen läßt. + + c) Graphiken können leicht geändert (z. B. vergrößert oder in eine Richtung gestreckt + o.ä.) werden, ohne daß sie erneut erzeugt werden müssen. Zudem können Graphiken + aneinander oder übereinander gelegt werden. + + d) Graphiken mit unterschiedlichen Farben, Strichen usw. können leicht erzeugt werden. + + e) Der Anschluß von neuen Graphik.Geräten durch Benutzer ist leicht möglich, ohe daß + die Graphik-Programme geändert werden müssen. + + f) Plotter können wie Drucker an einen Spooler gehängt werden. + + g) Bilder können als PICFILEs gespeichert und versandt werden. + + h) Es können auch auf Systemen ohne graphische Ausgabegeräte Graphiken erzeugt + werden. + + i) Es können mit einfachen Mitteln universelle Unterprogrammpakete erstellt werden, + um die Standardzeichnungen (Darstellen einer Funktion, Balken oder Liniendiagram­ + me, Achsen etc.) zu erstellen. + + +#type ("trium12")# +#on("b")#2. Erzeugung von Bildern#off("b")# +#type ("times8")# + + Bilder entstehen in Objektion vom Datentyp #on("b")#PICTURE#off("b")#. Diese müssen mit der Prozedur + #on("i")#nilpicture#off("i")# initialisiert werden. Sie enthalten dann ein leeres Bild, dessen Dimension noch + nicht festgelegt ist. Die Dimension eines #on("i")#PICTURE#off("i")#s wird mit dem ersten Schreibzugriff + (#on("i")#move, draw#off("i")# o.ä.) festgelegt. Ein #on("i")#PICTURE#off("i")# kann immer nur entweder zwei- oder + dreidimensional sein. + Außerdem kann einem #on("i")#PICTURE#off("i")# mit der Prozedur #on("i")#pen#off("i")# genau ein virtueller Stift zugeord­ + net oder der aktuelle Stift erfragt werden (Standardeinstellung: 1). + + Für Erzeugung eines Bildes wird ein virtueller Zeichenstift benutzt, dem bei der Darstel­ + lung jeweils genau ein realer Stift zugeordnet wird. Dieser Stift kann mit der Prozedur + #on("b")#move#off("b")# oder #on("b")#move r #off("b")#auf eine bestimmte Stelle positioniert werden ohne zu zeichnen. Mit + #on("b")#draw#off("b")# oder #on("b")#draw r#off("b")# wird eine Linie von der letzten Position zur angegebene Position + gezeichnet. Die aktuelle Stiftposition kann dabei mit #on("b")#where#off("b")# abgefragt werden. + Außerdem existiert noch die Prozedur #on("b")#draw#off("b")# die einen Text zur Beschriftung der Zeich­ + nung darstellt, sowie #on("b")#bar#off("b")# zum Zeichnen eines Balkens für Balkendiagramme, #on("b")#circle#off("b")# zum + Zeichnen eines Kreisbogens für Kreisdiagramme und #on("b")#mark#off("b")# zum Markiern von Positionen. + Dabei wird die aktuelle Stiftposition aber nicht verändert. + +#type ("trium12")# +#on("b")#3. Manipulation von PICTUREs#off("b")# +#type ("times8")# + + Erstellte PICTUREs können auch als Ganzes manipuliert werde. Dazu dienen die Prozedu­ + ren #on("b")#translate, stretch#off("b")# und #on("b")#rotate#off("b")#. Es ist auch möglich mehrere PICTURE mit dem Opera­ + tor #on("b")#CAT#off("b")# aneinanderzufügen, wenn beide PICTURE die gleiche Dimension haben. In + solcherart manipulierten Bildern kann ohne Einschränkung weitergezeichnet werden, + solange die maximale Größe nicht überschritten wird. + +#type ("trium12")# +#on("b")#4. Darstellung und Speicherung #off("b")# +#type ("times8")# + + Für die Darstellung und Speicherung der erzeugten Bilder existiert der Typ #on("b")#PICFILE#off("b")#. + Dieser besteht aus eienm Datenraum mit max. 1024 PICTUREs, die mit den Prozeduren #on("b")# + delete picture, insert picture, read picture, write picture, get picture#off("b")# und #on("b")#put picture#off("b")# einge­ + geben bzw. ausgegeben werden können. + Für die Positionierung innerhalb eines PICFILES stehen die Prozeduren #on("b")#to pic, up, down, + eof, picture no, pictures#off("b")# zur Verfügung. + Für die Assoziation mit einem benannten Datenraum existiert ähnlich wie beim Datentyp + FILE die Prozedur #on("b")#picture file#off("b")#; unbenannte Datenräume können mit dem Operator #on("b")#:=#off("b")# + assoziert werden. + Die Darstellung des PICFILES auf einem Zeichengerät erfolgt mit der Prozdur #on("b")#plot#off("b")#. + Da die Graphiken aber in #on("i")#Weltkoordinaten#off("i")# erzeugt werden und die spätere Darstellung + vollkommen unbeachtet bleibt, müssen gewisse Darstellungsparameter für die Zeichnung + gesetzt werden. Dies Parameter werden im PICFILE abgelegt und gelten jeweils für alle + darin enthaltenen PICTURE. Dadurch ist es möglich, einen PICFILE mit spezifierter + Darstellungsart über einen SPOOLER an einen Plotter zu senden oder die bei der letzten + Betrachtung gewählte Darstellung beizubehalten oder zu ändern. + Für die Darstellung können den virtuellen Stiften mit der Prozedur #on("b")#select pen#off("b")# reale Stifte + zugeordnet werden. Voreingestellt ist für alle virtuellen Stifte die Standardfarbe, Standard­ + stärke und durchgängige Linie. Mit #on("b")#background#off("b")# kann eine bestimmte Hintergrundfarbe + gewählt werden. + Indem man einem PICTURE den Stift 0 zuordnet, kann man dieses auch Ausblenden + wenn es bei dieser Darstellung stört. + Die Größe der realen Zeichenfläche kann mit #on("b")#viewport#off("b")# eingestellt werden, wobei die + gesamte Zeichenfäche voreingestellt ist. Dadurch können auch mehrere PICFILE auf ein + Blatt oder einen Bildschirm gezeichnet werden, wenn man durch Angabe von #on("i")#background +  (0)#off("i")# das Löschen der Zeichenfläche unterdrückt. + + +#type ("trium12")# +#on("b")#5. Darstellung zweidimensionaler Graphik#off("b")# +#type ("times8")# + + Bei der Darstellung zweidimensionaler Bilder muß der zu zeichnende Ausschnitt (das + #on("i")#Fenster#off("i")#) angegeben werden. Mit der Prozedur #on("b")#window#off("b")# wird durch Angabe der minimalen + und maximalen X- bzw. Y-Koordinaten ein Fenster definiert. Linien, die über dieses + Fenster hinausgehen, werden abgeschnitten. Dadurch kann man einen beliebigen Detailaus­ + schnitt eines Bildes ausgeben, ohne das Bild neu generieren zu müssen. + Da das so definierte Fenster auf die mit #on("i")#viewport#off("i")# definierte Zeichenfläche abgebildet wird, + ist der Abbildungsmaßstab durch das Zusammenspiel von #on("i")#viewport#off("i")# und #on("i")#window#off("i")# bestimmt. + Wenn eine Winkeltreue Darstellung erreicht werdenn soll, muß das Verhältnis der durch + #on("i")#viewport#off("i")# eingestellten Breite und Höhe und das Verhältnis des durch #on("i")#window#off("i")# eingestellten + Ausschnitts gleich sein. + +#type ("trium12")# +#on("b")#6. Darstellung dreidimensionaler Graphik#off("b")# +#type ("times8")# + + Bei dreidimensionalen Zeichnungen wird das Fenster ebenfalls mit #on("b")#window#off("b")# definiert, + wobei dann allerdings auch der Wertebereich der dritten Dimension (Z-Koordinaten) zu + berücksichtigen ist. Auch hierbei werden Linien, die über die spezifierte Darstellungs­ + fläche hinausgehen abgeschnitten. Das Abschneiden erfolgt allerdings erst nach der Projek­ + tion auf die Darstellungsfläche, so daß auch Vektoren zu sehen sind, die über das mit + #on("i")#window#off("i")# angegebene Quader hinausgehen, wenn ihre Projektion innerhalb der Zeichen­ + fläche liegt. + Da die dreidimensionale Graphik auf eine zweidimensionale Fläche projeziert wird, + können aber noch weitere Darstellungsparameter angegeben werden. Der Betrachtungswin­ + kel wird mit Hilfe der Prozedur #on("b")#view#off("b")# angegeben. Ebenfalls kann mit #on("b")#view#off("b")# der Winkel der + Y-Achse zur Horizontalen angegeben werden. + Zur Spezifikation der gewünschten Projektionsart existieren #on("b")#orthographic#off("b")# (orthographische + Projektion), #on("b")#perspective#off("b")# (perspektivische Projektion, der Fluchtpunkt ist frei wählbar) und + #on("b")#oblique#off("b")# (schiefwinklige Projektion). + +#page# +#type ("trium12")# +#on("b")#7. Beispiele#off("b")# +#type ("times8")# + + #on("u")#Sinuskurve#off("u")# + +#type("micro")# +initialisiere picfile; +zeichne überschrift; +zeichne achsen; +zeichne sinuskurve; +wähle darstellung; +plot (p) . + +initialisiere picfile: + PICFILE VAR p :: picture file ("SINUS") . + +zeichne überschrift: + PICTURE VAR überschrift :: nilpicture; + move (überschrift, -pi/2.0, 1.0); + draw (überschrift, "sinus (x) [-pi, +pi]", 0.0, 1.0, 0.6); + put picture (p, überschrift) . + + zeichne achsen: + PICTURE VAR achsen :: nilpicture; + zeichne x achse; + zeichne y achse; + put picture (p, achsen) . + + zeichne x achse: + move (achsen, -pi, 0.0); + draw (achsen, pi, 0.0) . + + zeichne y achse: + move (achsen, 0.0, -1.0); + draw (achsen, 0.0, +1.0) . + + zeichne sinuskurve: + PICTURE VAR sinus :: nilpicture; + REAL VAR x :: -pi; + + move (sinus, x, sin (x)); + REP x INCR 0.1; + draw (sinus, x, sin (x)) + UNTIL x >= pi PER; + + put picture (p, sinus) . + + wähle darstellung: + window (p, -pi, pi, -1.0, 1.3); + viewport (p, 0.0, 0.0, 0.0, 0.0) . + +#page# +#type ("times8")# + #on("u")#Achsenkreuz#off("u")# + +#type("micro")# +initialisiere picfile; +zeichne die x achse; +zeichne die y achse; +zeichne die z achse; +stelle das achsenkreuz dar . + +initialisiere picfile: + PICFILE VAR p :: picture file ("KREUZ") . + + zeichne die x achse: + PICTURE VAR x achse := nilpicture; + move (x achse, -1.0, 0.0, 0.0); + draw (x achse, "-X", 0.0, 0.0, 0.0); + draw (x achse, 1.0, 0.0, 0.0); + draw (x achse, "+X", 0.0, 0.0, 0.0); + put picture (p, x achse) . + + zeichne die y achse: + PICTURE VAR y achse := nilpicture; + move (y achse, 0. 0, -1.0, 0.0); + draw (y achse, "-Y", 0.0, 0.0, 0.0); + draw (y achse, 0.0, 1.0, 0.0); + draw (y achse, "+Y", 0.0, 0.0, 0.0); + put picture (p, y achse) . + + zeichne die z achse: + PICTURE VAR z achse := nilpicture; + move (z achse, 0. 0, 0.0, -1.0); + draw (z achse, "-Z", 0.0, 0.0, 0.0); + draw (z achse, 0.0, 0.0, 1.0); + draw (z achse, "+Z", 0.0, 0.0, 0.0); + put picture (p, z achse) . + + stelle das achsenkreuz dar: + viewport (p, 0. 0, 1.0, 0.0, 1.0); + window (p, -1.1, 1.1, -1.1, 1.1); + oblique (p, 0.25, 0.15); + plot (p) . + +#foot# + #type("times6")# + Diese beiden Beispielprogramme befinden sich ebenfalls auf dem STD-Archive unter dem Namen #on("i")#Beispiel.Sinus#off("i")# und + #on("i")#Beispiel.Kreuz#off("i")#. +#end# + +#page# +#type ("triumb14")# Beschreibung der Graphik-Prozeduren +#type ("times8")# + + +#type ("trium12")# +#on("b")#1. PICTURE-Prozeduren#off("b")# +#type ("times8")# + +#limit (7.0)##type("times6")# + #on("i")#Zweidimensionale PICTURES brauchen weniger Speicherplatz + als dreidimensionale. Daher werden in einigen Fehlermeldungen + unterschiedliche Größen angegeben. + +#limit (11.0)##type("times8")# + +#type("times10")##on("b")#:=#off("b")##type("times8")# + OP := (PICTURE VAR l, PICTURE CONST r) + Zweck: Zuweisung + +#type("times10")##on("b")#CAT#off("b")##type("times8")# + OP CAT (PICTURE VAR l, PICTURE CONST r) + Zweck: Aneinanderfügen von zwei PICTURE. + Fehlerfälle: + * left dimension <> right dimension + Es können nur PICTURE mit gleicher Dimension angefügt werden. + * Picture overflow + Die beiden PICTURE überschreiten die maximale Größe eines PICTURE. + +#type("times10")##on("b")#nilpicture#off("b")##type("times8")# + PICTURE PROC nilpicture + Zweck: Die Prozedur liefert ein leeres PICTURE zur Initialisierung. + + PICTURE PROC nilpicture (INT CONST pen) + Zweck: Die Prozedur liefert ein leeres PICTURE mit dem Stift #on("i")#pen#off("i")# zur Initialisierung. + +#type("times10")##on("b")#draw#off("b")##type("times8")# + PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, ­ + width) + Zweck: Der angegebene Text wird unter dem Winkel #on("i")#angle#off("i")# gegenüber der Waagerech­ + ten mit der Zeichenhöhe #on("i")#hight#off("i")# und der Breite #on("i")#width#off("i")# gezeichnet. #on("i")#angle#off("i")# wird in + Winkelgrad angegeben. #on("i")#height#off("i")# und #on("i")#width#off("i")# werden in #on("i")#Prozenten#off("i")# der Breite bzw. + Höhe der Zeichenfläche angegeben, bei 0 wird + die Standardhöhe- und breite angenommen. + Der Anfang ist dabei die aktuelle Stiftposition, die nicht verändert wird. Es könne + auch die Steuerzeichen ""1"", ""2"", ""3"", ""10"", ""13"" benutzt werden, + wobei sie immer in der Richtung #on("i")#angle#off("i")# wirken. + Fehlerfälle: + * Picture overflow + Der Text paßt nicht mehr in das PICTURE. + +#type("times10")##on("b")#draw#off("b")##type("times8")# + PROC draw (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y, z). + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC draw (PICTURE VAR p, REAL CONST x, y) + Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y). + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +#type("times10")##on("b")#draw r#off("b")##type("times8")# + PROC draw r (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Zeichnen einer Linie der Länge (x, y, z) relativ zur aktuellen Position. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC draw r (PICTURE VAR p, REAL CONST x, y) + Zweck: Zeichnen einer Linie der Länge (x, y) relativ zur aktuellen Position. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +#type("times10")##on("b")#move#off("b")##type("times8")# + PROC move (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Die aktuelle Position wird auf (x, y, z) gesetzt. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC move (PICTURE VAR p, REAL CONST x, y) + Zweck: Die aktuelle Position wird auf (x, y) gesetzt. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +#type("times10")##on("b")#move r#off("b")##type("times8")# + PROC move r (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Die aktuelle Position wird um (x, y, z) erhöht. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC move r (PICTURE VAR p, REAL CONST x, y) + Zweck: Die aktuelle Position wird um (x, y) erhöht. + Position. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + + +#type("times10")##on("b")#bar#off("b")##type("times8")# + PROC bar (PICTURE VAR p, REAL CONST width, hight, INT CONST pattern): + Zweck: Die Prozedur zeichnet an der aktuellen Position einen Balken mit dem Muster + #on("i")#pattern#off("i")#: + 0 = Leerer Balken + 1 = Gepunkteter Balken + 2 = Gefüllter Balken + 3 = Horizontale Linien + 4 = Vertikale Linien + 5 = Gekreuzte Linien + 6 = Diagonale Linien von Links nach Rechts + 7 = Diagonale Linien von Rechts nach Links + 8 = Gekreuzte diagonale Linien + > 8 = nicht normiertes Sondermuster + Die aktuelle Stiftposition wird dabei nicht verändert. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + + PROC bar (PICTURE VAR p, REAL CONST from, to, hight, INT CONST pattern): + Zweck: Die Prozedur zeichnet einen Balken von der Position #on("i")#from#off("i")# zur Position #on("i")#to#off("i")# und der + Höhe #on("i")#height#off("i")# mit dem Muster #on("i")#pattern#off("i")#. + s.o. + +#type("times10")##on("b")#circle#off("b")##type("times8")# + PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern) + Zweck: Die Prozedur zeichnet an der aktuellen Position ein Kreissegment vom Winkel + #on("i")#from#off("i")# bis #on("i")#to#off("i")# (im Gradmaß) mit dem Muster #on("i")#pattern#off("i")# (s.o.). Der #on("i")#radius#off("i")# wird in + Prozenten der Diagonalen der Zeichenfläche angegeben. + Die aktuelle Stiftposition wird dabei nicht verändert. Dieses Kreissegment ist in + jedem Fall 2-dimensional, so das es durch Drehungen nicht verändert wird. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +#type("times10")##on("b")#mark#off("b")##type("times8")# + PROC mark (PICTURE VAR p, REAL CONST size, INT CONST no) + Zweck: Es wird ein Marker mit der Größe #on("i")#size#off("i")# in Prozenten der Diagonalen der Zeichen­ + fläche an der aktuellen Stiftposition ausgegeben, ohne diese zu verändern. Es + sollten dabei mindestens 10 verschiedene Marker gewählt werden können. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + +#type("times10")##on("b")#dim#off("b")##type("times8")# + INT PROC dim (PICTURE CONST pic) + Zweck: Liefert die Dimension eines PICTURE. + +#type("times10")##on("b")#pen#off("b")##type("times8")# + INT PROC pen (PICTURE CONST p) + Zweck: Liefert den virtuellen Stift des PICTURE + + PICTURE PROC pen (PICTURE CONST p, INT CONST pen) + Zweck: Setzen des (virtuellen) Stiftes eines PICTURE. + Bei #on("i")#pen#off("i")# = 0 wird das Picture nicht gezeichnet. + Fehlerfälle: + * pen out of range + Der gewünschte Stift ist kleiner als 0 oder größer als 16. + +#type("times10")##on("b")#extrema#off("b")##type("times8")# + PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max) + Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE. + Fehlerfälle: + * Picture is three dimensional + + PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max,   + z min, z max) + Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE. + Fehlerfälle: + * Picture is two dimensional + +#type("times10")##on("b")#where#off("b")##type("times8")# + PROC where (PICTURE CONST p, REAL VAR x, y, z) + Zweck: Die Prozedur liefert die aktuelle Stiftposition. + Fehlerfälle: + * Picture is two dimensional + + PROC where (PICTURE CONST p, REAL VAR x, y, z) + Zweck: Die Prozedur liefert die aktuelle Stiftposition. Fehlerfälle: + * Picture is three dimensional + +#type("times10")##on("b")#rotate#off("b")##type("times8")# + PROC rotate (PICTURE VAR p, REAL CONST angle) + Zweck: Das PICTURE wird um den Punkt (0, 0) um den Winkel #on("i")#angle#off("i")# (im Gradmaß) im + mathematisch positiven Sinn gedreht. + + PROC rotate (PICTURE CONST p, REAL CONST phi, theta, lambda) + Zweck: Das PICTURE wird um den Winkel #on("i")#lambda#off("i")# um die Drehachse #on("i")#(phi, theta)#off("i")# ge­ + dreht. + +#type("times10")##on("b")#stretch#off("b")##type("times8")# + PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) + Zweck: Das PICTURE wird in X-Richtung um den Faktor #on("i")#sx#off("i")#, in Y-Richtung um den + Faktor #on("i")#sy#off("i")# gestreckt (bzw. gestaucht). Dabei bewirkt der Faktor + s > 1 eine Streckung + 0 < s < 1 eine Stauchung + s < 0 zusätzlich eine Achsenspiegelung. + Fehlerfälle: + * Picture is three dimensional + + PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) + Zweck: s. o. + Fehlerfälle: + * Picture is two dimensional + +#type("times10")##on("b")#translate#off("b")##type("times8")# + PROC translate (PICTURE VAR p, REAL CONST dx, dy) + Zweck: Das PICTURE wird um #on("i")#dx#off("i")# und #on("i")#dy#off("i")# verschoben. Fehlerfälle: + * Picture is three dimensional + + PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) + Zweck: Das PICTURE wird um #on("i")#dx, dy#off("i")# und #on("i")#dz#off("i")# verschoben. Fehlerfälle: + * Picture is two dimensional + + +#type ("trium12")# +#on("b")#2. PICFILE-Prozeduren#off("b")# +#type ("times8")# + +#type("times10")##on("b")#plot#off("b")##type("times8")# + PROC plot (TEXT CONST name) + Zweck: Der PICFILE mit dem Namen #on("i")#name#off("i")# wird entsprechend der angegebenen Dar­ + stellungsart gezeichnet. Diese Parameter (#on("i")#perspective, orthographic, oblique, view, + window etc.#off("i")#) müssen vorher eingestellt werden. + Fehlerfälle: + * PICFILE does not exist + Es existiert kein PICFILE mit dem Namen #on("i")#name#off("i")# + + PROC plot (PICFILE VAR p) + Zweck: Der PICFILE #on("i")#p#off("i")# wird entsprechend der angegebenen Darstellungsart gezeichnet. + Diese Parameter müssen vorher eingestellt werden: + + #on("b")#zweidimensional:#off("b")# + obligat: #on("i")#window#off("i")# (zweidimensional) + optional: #on("i")#view#off("i")# (zweidimensional) + #on("i")#viewport#off("i")# + #on("i")#select pen#off("i")# + + #on("b")#dreidimensional:#off("b")# + obligat: #on("i")#window#off("i")# (dreidimensional) + optional: #on("i")#view#off("i")# (dreidimensional) + #on("i")#orthographic | perspective | oblique#off("i")# + #on("i")#viewport#off("i")# + #on("i")#select pen#off("i")# + + +#type("times10")##on("b")#select pen#off("b")##type("times8")# + PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type) + Zweck: Für die Darstellung des Bildes #on("i")#p#off("i")# soll dem #on("i")#virtuellen#off("i")# Stift #on("i")#pen#off("i")# ein realer Stift + zugeordnet werden, der möglichst die Farbe #on("i")#colour#off("i")# und die Dicke #on("i")#thickness#off("i")# hat + und dabei Linien mit dem Typ #on("i")#line type#off("i")# zeichnet. Es wird die beste Annäherung + für das Ausgabegerät genommen. + Dabei gelten folgende Vereinbarungen: + + #on("b")#Farbe:#off("b")# Negative Farben werden XOR gezeichnet (dunkel wird hell und hell wird + dunkel), Farbe 0 ist der Löschstift und positive Farben überschreiben + (ersetzen) den alten Punkt mit folgenden Werten: + + 1 Standardfarbe des Endgerätes + 2 rot + 3 blau + 4 grün + 5 schwarz + 6 weiß + > 6 nicht normierte Sonderfarben + + + #on("b")#Dicke:#off("b")# 0 Standardstrichstärke des Endgerätes + > 0 Strichstärke in 1/10 mm. + + + #on("b")#Linientyp:#off("b")# + 0 keine sichtbare Linie + 1 durchgängige Linie + 2 gepunktete Linie + 3 kurz gestrichelte Linie + 4 lang gestrichelte Linie + 5 Strichpunktlinie + > 5 nicht normierte Linie + + + Die hier aufgeführten Möglichkeiten müssen nicht an allen graphischen Endge­ + räten vorhanden sein. Der geräteabhängige Graphik-Treiber wählt jeweils die + bestmögliche Annäherung. + + Fehlerfälle: + * pen out of range + #on("i")#pen#off("i")# muss im Bereich 1-16 sein. + +#type("times10")##on("b")#background#off("b")##type("times8")# + PROC background (PICFILE VAR p, INT CONST colour) + Zweck: Der Hintergrund wird auf die Farbe #on("i")#colour#off("i")# (s.o.) gesetzt wenn möglich. + Bei der Angabe #on("i")#background (p, 0)#off("i")# wird das Löschen des Bildschirms unterdrückt, + so daß das Zeichen mehrerer PICFILE auf einem Blatt möglich wird. + + INT PROC background (PICFILE CONST p): + Zweck: Liefert die eingestellte Hintergrundfarbe. + +#type("times10")##on("b")#view#off("b")##type("times8")# + PROC view (PICFILE VAR p, REAL CONST alpha) + Zweck: Setzt den Winkel der Y-Achse zur Senkrechten auf #on("i")#alpha#off("i")# Grad, falls diese nicht + senkrecht auf der Betrachtungsebene steht. + + PROC view (PICFILE VAR p, REAL CONST phi, theta) + Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne dargestellt, son­ + dern für die Betrachtung gedreht. Mit der Prozedur #on("i")#view#off("i")# kann die Betrachtungs­ + richtung durch die Polarwinkel #on("i")#phi#off("i")# und #on("i")#theta#off("i")# (im Gradmass) angegeben werden. + Voreingestellt ist #on("i")#phi#off("i")# = 0 und #on("i")#theta#off("i")# = 0, d.h. senkrecht von oben (Die #on("i")#X- + Achse#off("i")# bildet die Horizontale und die #on("i")#Y-Achse#off("i")# bildet die Vertikale). + Im Gegensatz zu #on("i")#rotate#off("i")# hat #on("i")#view#off("i")# keine Wirkung auf das eigentliche Bild (die + PICTURE werden nicht verändert), sondern nur auf die gewählte Darstellung. So + addieren sich zwar aufeinanderfolgende #on("i")#Rotationen#off("i")#, #on("i")#view#off("i")# aber geht immer von der + Nullstellung aus. Auch kann das Bild durch eine #on("i")#Rotation#off("i")# ganz oder teilweise aus + oder in das Darstellungsfenster (#on("i")#window#off("i")# gedreht werden. Bei #on("i")#view#off("i")# verändern sich + die Koordinaten der Punkte nicht, d. h. das Fenster wird mitgedreht. + + PROC view (PICFILE VAR p, REAL CONST x, y, z) + Zweck: Wie oben, nur werden die Winkel nicht in Polarkoordinaten angegeben, sondern + es wird die Blickrichtung als Vektor in Karthesischen Koordinaten angegeben. + (Der Betrachtungsvektor muß nicht normiert sein). + +#type("times10")##on("b")#viewport#off("b")##type("times8")# + PROC viewport (PICFILE VAR p, REAL CONST hormin, hormax, vertmin, vertmax) + Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt werden soll, + wird spezifiziert. Dabei wird sowohl die Größe als auch die relative Lage der + Zeichenfläche definiert. Der linke untere Eckpunkt der physikalischen Zeichen­ + fläche des Gerätes hat die Koordinaten (0, 0). Die definierte Zeichenfläche er­ + streckt sich + + #on("i")#hormin - hormax#off("i")# in der Horizontalen, + #on("i")#vertmin - vertmax#off("i")# in der Vertikalen. + + So liegt der linke untere Eckpunkt dann bei (#on("i")#hormin, hormax#off("i")#), der rechte obere + Eckpunkt bei (#on("i")#hormax, vertmax#off("i")#). + + Damit sowohl geräteunabhängige als auch maßstabgetreue Zeichnungen möglich + sind, können die Koordinaten in drei Arten spezifiziert werden: + a) #on("b")#Gerätekoordinaten#off("b")# + Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei hat die + kürzere Seite der physikalischen Zeichenfläche definitionsgemäß die Länge + 1.0. + b) #on("b")#Absolute Koordinaten#off("b")# + Die Werte werden in #on("i")#cm#off("i")# angegeben. Dabei müssen die Maximalwerte aber + größer als 2.0 sein, da sonst Fall a) angenommen wird. + c) #on("b")#Maximale Zeichenfläche#off("b")# Bei der Angabe (0.0, 0.0, 0.0, 0.0) wird die maxi­ + male physikalische Zeichenfläche eingestellt. + + Voreingestellt ist + viewport (0.0, 0.0, 0.0, 0.0) + d.h. die größtmögliche physikalische Zeichenfläche, beginnend mit der linken + unteren Ecke. + Der Abbildungsmaßstab wird durch das Zusammenspiel von #on("i")#viewport#off("i")# und + #on("i")#window#off("i")# festgelegt (s. dort). Dabei ist insbesondere darauf zu achten, daß winkel­ + treue Darstellung nur bei gleichen Verhältnissen von X-Bereich und Breite bzw. + von Y-Bereich und Höhe möglich ist. + + +#type("times10")##on("b")#window#off("b")##type("times8")# + PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) + Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das darzustellende + Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("i")#x min, x + max#off("i")#] und deren Y-Koordinaten im Bereich [#on("i")#y min, y max#off("i")#] liegen, gehören zum + definierten Fenster.Vektoren, die außerhalb dieses Fensters liegen, gehen über die + durch #on("i")#viewport#off("i")# Fläche hinaus und werden abgeschnitten. + + Der Darstellungsmaßstab ergibt sich als + + #ub#               x max - x min               #ue# + horizontale Seitenlänge der Zeichenfläche + + + #ub#               y max - y min               #ue# + vertikale Seitenlänge der Zeichenfläche + + PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max,   + z min, z max) + + Zweck: Für die darstellung eines dreidimensionalen Bildes wird das darzustellende Fenster + definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("i")#x min, x max#off("i")#], + deren Y-Koordinaten im Bereich [#on("i")#y min, y max#off("i")#] und deren Z-Koordinaten im + Bereich [#on("i")#z min, z max#off("i")#] liegen, gehören zum definierten Fenster. Dieses dreidi­ + mensionale Fenster (#on("i")#Quader#off("i")#) wird entsprechend der eingestellten Projektionsart + (orthographisch, perspektivisch oder schiefwinklig) und den Betrachtungswinkeln + (s. #on("i")#view#off("i")#) auf die spezifizierte Zeichenfläche abgebildet. + Anders als im zweidimensionalen Fall ist das Problem der Maßstaäbe nicht mehr + nur durch das Zusammenspiel von #on("i")#window#off("i")# und #on("i")#viewport#off("i")# zu beschreiben. Hier + spielen auch die Projektionsart und Darstellungswinkel herein. + +#type("times10")##on("b")#oblique#off("b")##type("times8")# + PROC oblique (PICFILE VAR p, REAL CONST a, b) + Zweck: Bei dem (dreidimensionalen) Bild #on("i")#p#off("i")# wird #on("u")#schiefwinklig#off("u")# als gewünschte Projek­ + tionsart eingestellt. Dabei ist (#on("i")#a, b#off("i")#) der Punkt auf der X-Y-Ebene, auf den der + EinheitsVektor der Z-Richtung abgebildet werden soll. + +#type("times10")##on("b")#orthographic#off("b")##type("times8")# + PROC orthographic (PICFILE VAR p) + Zweck: Bei dem (dreidimensionalen) Bild #on("i")#p#off("i")# wird #on("u")#orthographisch#off("u")# als gewünschte Projek­ + tionsart eingestellt. Bei der orthographischen Projektion wird ein dreidimensio­ + naler Körper mit parallelen Strahlen senkrecht auf der Projektionsebene abge­ + bildet. + +#type("times10")##on("b")#perpective#off("b")##type("times8")# + PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) + Zweck: Bei dem (dreidimensionalen) Bild #on("i")#p#off("i")# wird #on("u")#perspektivisch#off("u")# als gewünschte Projek­ + tionsart eingestellt. Der Punkt (#on("i")#cx, 1/cy, cz#off("i")#) ist der Fluchtpunkt der Projektion, + d. h. alle Parallen zur Z-Achse schneiden sich in diesem Punkt. + +#type("times10")##on("b")#extrema#off("b")##type("times8")# + PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) + Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE. + + PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) + Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE. + +#type ("trium12")# +#on("b")#3. Prozeduren zur Manipulation von PICFILE#off("b")# +#type("times 8")# + +#type("times10")##on("b")#:=#off("b")##type("times8")# + OP := (PICFILE VAR l, PICFILE CONST r) + Zweck: Zuweisung des PIFILEs #on("i")#r#off("i")# an das PICFILE #on("i")#l#off("i")# + + OP := (PICFILE VAR p, DATASPACE CONST d) + Zweck: Assoziert die PICFILE Variable #on("i")#p#off("i")# mit dem Datenraum #on("i")#d#off("i")# und initialisiert die + Variable, wenn nötig. + Fehlerfälle: + * dataspace is no PICFILE + Der anzukoppelnde Datenraum hat einen unzulässigen Typ + +#type("times10")##on("b")#picture file#off("b")##type("times8")# + DATASPACE PROC picture file (TEXT CONST name) + Zweck: Assoziaten eines benannten Datenraumes mit einem PICFILE (s.o.). + +#type("times10")##on("b")#to pic#off("b")##type("times8")# + PROC to pic (PICFILE VAR p, INT CONST pos) + Zweck: Positioniert auf das PICTURE Nummer #on("i")#pos#off("i")#. + Fehlerfälle: + * Position underflow + Es wurde eine Position kleiner Null angegeben. + * Position after eof + Es wurde versucht, hinter das Ende eines PICFILE zu positionieren. Die letzte + erlaubte Position ist #on("i")#pictures (p)+1#off("i")#. + +#type("times10")##on("b")#up#off("b")##type("times8")# + PROC up (PICFILE VAR p) + Zweck: Positioniert genau ein PICTURE zurück. + Fehlerfall: + * Position underflow + Es wurde versucht, vor das erste PICTURE zu positionieren + + PROC up (PICFILE VAR p, INT CONST n) + Zweck: Positioniert genau #on("i")#n#off("i")# Picture zurück. + Fehlerfall: + * Position underflow + Es wurde versucht, vor das erste PICTURE zu positionieren + +#type("times10")##on("b")#down#off("b")##type("times8")# + PROC down (PICFILE VAR p) + Zweck: Positioniert genau ein PICTURE vorwärts. + Fehlerfall: + * Position after eof + Es wurde versucht, hinter das Ende eines PICFILE zu positionieren. Die letzte + erlaubte Position ist #on("i")#pictures (p)+1#off("i")#. + + PROC down (PICFILE VAR p, INT CONST n) + Zweck: Positioniert genau #on("i")#n#off("i")# Picture vorwärts. + Fehlerfall: + * Position after eof + Es wurde versucht, hinter das Ende eines PICFILE zu positionieren Die letzte + erlaubte Position ist #on("i")#pictures (p)+1#off("i")#. + +#type("times10")##on("b")#delete picture#off("b")##type("times8")# + PROC delete picture (PICFILE VAR p) + Zweck: Löscht das aktuelle PICTURE + +#type("times10")##on("b")#insert picture#off("b")##type("times8")# + PROC insert picture (PICFILE VAR p) + Zweck: Fügt ein PICTURE #on("u")#vor#off("u")# der aktuellen Position ein. + +#type("times10")##on("b")#read picture#off("b")##type("times8")# + PROC read picture (PICFILE CONST p, PICTURE VAR pic) + Zweck: Liest das aktuelle PICTURE. + +#type("times10")##on("b")#write picture#off("b")##type("times8")# + PROC write picture (PICFILE VAR p, PICTURE CONST pic) + Zweck: Schreibt das PICTURE #on("i")#pic#off("i")# auf der aktuellen Position. + +#type("times10")##on("b")#put picture#off("b")##type("times8")# + PROC put picture (PICFILE VAR p, PICTURE CONST pic) + Zweck: Schreibt das PICTURE #on("i")#pic#off("i")# an die aktuelle Position und erhöht diese um 1. + +#type("times10")##on("b")#get picture#off("b")##type("times8")# + PROC get picture (PICFILE VAR p, PICTURE VAR pic) + Zweck: Liest das PICTURE #on("i")#pic#off("i")# an dir aktuellen Position und erhöht diese um 1. + +#type("times10")##on("b")#eof#off("b")##type("times8")# + BOOL PROC eof (PICFILE CONST p) + Zweck: Liefert genau dann #on("i")#TRUE#off("i")#, wenn das Ende eines PICFILE erreicht ist. + +#type("times10")##on("b")#picture no#off("b")##type("times8")# + INT PROC picture no (PICFILE CONST p) + Zweck: Liefert die Nummer des aktuellen PICTURE. + +#type("times10")##on("b")#pictures#off("b")##type("times8")# + INT PROC pictures (PICFILE CONST p) + Zweck: Liefert die Anzahl PICTURE eines PICFILE. + + +#page# +#type ("trium12")# +#on("b")#4. Auslieferungsumfang#off("b")# +#type ("times8")# + + Die EUMEL-GRAPHIK wird auf einer Diskette mit folgendem Inhalt ausgeliefert. + Archive #on("i")#Graphik#off("i")#: + + "gen Graphik" + "gen Plotter" + "GRAPHIK.book" + "GRAPHIK.Picfile" + "GRAPHIK.Transform" + "GRAPHIK.Plot" + "GRAPHIK.Plotter" + "GRAPHIK.Server" + "GRAPHIK.vektor plot" + "ZEICHENSATZ" + "PC.plot" + "HP7475.plot" + "Beispiel.Kreuz" + "Beispiel.Sinus" + + + + #on("u")#Dateiinhalte#off("u")# + + 1. "gen Graphik" Installationsprogramm für Terminals + 2. "gen Plotter" Installationsprogramm für Plotter + 3. "GRAPHIK.book" enthält diese Beschreibung. + 4. "GRAPHIK.Picfile" enthält die Pakete #on("i")#picture#off("i")# und #on("i")#picfile#off("i")#. + 5. "GRAPHIK.Transform" stellt das Paket #on("i")#transformation#off("i")# zur Verfügung, in dem + interne Prozeduren zur Projektion definiert werden. + 6. "GRAPHIK.Plot" definiert die Prozedur #on("i")#plot#off("i")# zur Darstellung eines + PICFILES auf dem Terminal + 7. "GRAPHIK.Plotter" definiert die Prozedur #on("i")#plotter#off("i")# zur Darstellung eines + PICFILES auf dem Plotter + 8. "GRAPHIK.Server" Server für einen Plotter-Spool + 9. "GRAPHIK.vektor plot" enthält Hilfsprogramme, die bei der Erstellung einer + eigenen Terminalanpassung benutzt werden können. + 10. "ZEICHENSATZ" enthält einen Zeichensatz für Terminals die im Graphik + Modus keinen Text ausgeben können. + 11. "PC.plot" Terminalanpassung für IBM-PC und ähnliche. + 12. "HP7475.plot" Terminalanpassung für HP7474-Plotter und Geräte mit + HP-GL. + 13. "Beispiel.Kreuz" Beispielprogramm + 14. "Beispiel.Sinus" Beispielprogramm + +#type ("trium12")# +#on("b")#5. Installation#off("b")# +#type ("times8")# + + + In der Datei #on("i")#gen Graphik#off("i")# ist ein Installationspragramm enthalten. Nach dem Starten des + Programms mit #on("i")#run ("gen Graphik")#off("i")# fragt es nach dem Dateinamen der Terminalanpas­ + sung. + Steht keine Terminalanpassung für ein Endgerät zur Verfügung (und kann auch nicht + beschafft werden) so kann man durch Insertieren der Datei #on("i")#GRAPHIK.Picfile#off("i")# lediglich die + Leistungen der Pakete #on("i")#Picture#off("i")# und #on("i")#Picfile#off("i")# nutzen, ohne die erzeugten Graphiken darstellen + zu können. + Zur Benutzung eines #on("i")#Plotters#off("i")# über einen Spooler wird die Datei #on("i")#gen Plotter#off("i")# gestartet. + + + Beispiel: + 1. archive ("Graphik") + 2. fetch all (archive) + 3. release (archive) + 4. run ("gen Graphik") + <-- PC.Plot + + +#type ("trium12")# +#on("b")#6. Besonderheiten der PC.plot-Anpassung#off("b")# +#type ("times8")# + + + Da der IBM-PC verschiedene Graphik- und Text-Modi kennt, wird durch das Pro­ + gramm #on("i")#PC.plot#off("i")# die Prozedur #on("i")#graphik#off("i")# zusätzlich zur Verfügung gestellt. Sie erlaubt es den + PC in verschiedenen Graphik-Modi zu betreiben. + + PROC graphik (INT CONST modus, pause) + + Modus: 0 --- Keine Graphik (normaler Textmodus) + 1 --- hochauflösende Graphik, 50 Zeilen, + 640 * 400 Punkte, einfarbig + 2 --- hochauflösende Graphik, 25 Zeilen, + 640 * 400 Punkte, einfarbig + 3 --- mittlere Auflösung, 640 * 200 Punkte, 3 Farben + 4 --- IBM-PC Auflösung, 320 * 200 Punkte, 3 Farben. + + Pause: Da der PC bei #on("i")#end plot#off("i")# wieder in den Normalmodus umschaltet und die Graphik + dann nicht mehr zu sehen ist, kann man eine #on("i")#pause#off("i")# angeben. Die hier eingestellte + Zeit ist aber nicht die Länge der Pause, sondern der Kehrwert der Blinkfrequenz + proportional. + + diff --git a/system/std.graphik/1.8.7/doc/graphik beschreibung b/system/std.graphik/1.8.7/doc/graphik beschreibung new file mode 100644 index 0000000..53ebe49 --- /dev/null +++ b/system/std.graphik/1.8.7/doc/graphik beschreibung @@ -0,0 +1,661 @@ +#type ("basker12")##limit (16.0)##block# + +#head# +#type ("triumb18")# +#center#EUMEL-Grafik-System +#type ("basker12")# +#end# + #on("italics")#gescheit, gescheiter, + gescheitert#off("italics")# + +#type ("basker14")# +#on("bold")#Beschreibung der Graphik-Prozeduren#off("bold")# +#type ("basker12")# + + #on("italics")#Zweidimensionale PICTURE brauchen weniger Speicherplatz als dreidimen­ + sionale. Daher werden in einigen Fehlermeldungen unterschiedliche Größen + angegeben.#off("italics")# + +#on("underline")#Picture-Prozeduren#off("underline")# +PICTURE + + +:= + OP := (PICTURE VAR l, PICTURE CONST r) + Zweck: Zuweisung + +CAT + OP CAT (PICTURE VAR l, PICTURE CONST r) + Zweck: Aneinanderfügen von zwei PICTURE. + Fehlerfälle: + * left dimension <> right dimension + Es können nur PICTURE mit gleicher Dimension angefügt werden. + * Picture overflow + Die beiden PICTURE überschreiten die maximale Größe eines + PICTURE. + +nilpicture + PICTURE PROC nilpicture + Zweck: Die Prozedur liefert ein leeres PICTURE zur Initialisierung. + +draw + PROC draw (PICTURE VAR p, TEXT CONST text) + Zweck: Der angegebene Text wird gezeichnet. Der Anfang ist dabei die aktuelle + Stiftposition, die nicht verändert wird. + Fehlerfälle: + * Picture overflow + Der Text paßt nicht mehr in das PICTURE. + + PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, + height, bright) + Zweck: Der angegebene Text wird unter dem Winkel #on("italics")#angle#off("italics")# gegenüber der + Waagerechten mit der Zeichenhöhe #on("italics")#hight#off("italics")# und der Breite #on("italics")#bright#off("italics")# gezeich­ + net. Der Anfang ist dabei die aktuelle Stiftposition, die nicht verändert + wird. + Fehlerfälle: + * Picture overflow + Der Text paßt nicht mehr in das PICTURE. + + PROC draw (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y, z). + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC draw (PICTURE VAR p, REAL CONST x, y) + Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y). + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +draw r PROC draw r (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Zeichnen einer Linie der Länge (x, y, z) relativ zur aktuellen Position. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC draw r (PICTURE VAR p, REAL CONST x, y) + Zweck: Zeichnen einer Linie der Länge (x, y) relativ zur aktuellen Position. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +draw cm + PROC draw cm (PICTURE VAR p, REAL CONST x, y) + Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y) cm. + Dabei werden die angegebenen Projektionsparameter nicht beachtet, + sondern die Angaben in #on("bold")#Zentimeter#off("bold")# berechnet. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + +draw cm r + PROC draw cm r (PICTURE VAR p, REAL CONST x, y) + Zweck: Zeichnen einer Linie der Länge (x, y) cm relativ zur aktuellen Position. + Dabei werden die angegebenen Projektionsparameter nicht beachtet, + sondern die Angaben in #on("bold")#Zentimeter#off("bold")# berechnet. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + +move + PROC move (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Die aktuelle Position wird auf (x, y, z) gesetzt. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC move (PICTURE VAR p, REAL CONST x, y) + Zweck: Die aktuelle Position wird auf (x, y) gesetzt. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +move r + PROC move r (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Die aktuelle Position wird um (x, y, z) erhöht. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC move r (PICTURE VAR p, REAL CONST x, y) + Zweck: Die aktuelle Position wird um (x, y) erhöht. + Position. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +move cm + PROC move cm (PICTURE VAR p, REAL CONST x, y) + Zweck: Die aktuelle Position wird auf (x, y) cm gesetzt. Dabei werden die an­ + gegebenen Projektionsparameter nicht beachtet, sondern die Angaben in #on("bold")# + Zentimeter#off("bold")# berechnet. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + +move cm r + PROC move cm r (PICTURE VAR p, REAL CONST x, y) + Zweck: Die aktuelle Position wird um (x, y) cm erhöht. Dabei werden die an­ + gegebenen Projektionsparameter nicht beachtet, sondern die Angaben in #on("bold")# + Zentimeter#off("bold")# berechnet. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + +bar + PROC bar (PICTURE VAR p, REAL CONST width, hight, INT CONST + pattern): + Zweck: Die Prozedur zeichnet an der aktuellen Position einen Balken mit dem + Muster #on("italics")#pattern#off("italics")#: 0 = Leerer Balken + 1 = Gepunkteter Balken + 2 = Gefüllter Balken + 3 = Horizontale Linien + 4 = Vertikale Linien + 5 = Gekreuzte Linien + 6 = Diagonale Linien von Links nach Rechts + 7 = Diagonale Linien von Rechts nach Links + 8 = Gekreuzte diagonale Linien. + Die aktuelle Stiftposition wird dabei nicht verändert. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + * Unknown pattern + Das angegebene Muster liegt nicht im Bereich 0-8 + +circle + PROC circle (PICTURE VAR p, REAL CONST from, to, INT CONST + pattern) + Zweck: Die Prozedur zeichnet an der aktuellen Position ein Kreissegment vom + Winkel #on("italics")#from#off("italics")# bis #on("italics")#to#off("italics")# (im Gradmaß) mit dem Muster #on("italics")#pattern#off("italics")# (s.o.). Die + aktuelle Stiftposition wird dabei nicht verändert. + Fehlerfälle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + * Unknown pattern + Das angegebene Muster liegt nicht im Bereich 0-8 + +dim + INT PROC dim (PICTURE CONST pic) + Zweck: Liefert die Dimension eines PICTURE. + +pen + INT PROC pen (PICTURE CONST p) + Zweck: Liefert den virtuellen Stift des PICTURE + + PROC pen (PICTURE VAR p, INT CONST pen) + Zweck: Setzen des (virtuellen) Stiftes eines PICTURE. Bei pen=0 wird das + Picture nicht gezeichnet. + Fehlerfälle: + * pen out of range + Der gewünschte Stift ist kleiner als 0 oder größer als 16. + +extrema + PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y + max) + Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE. + Fehlerfälle: + * Picture is three dimensional + + PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y + max, z min, z max) + Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE. + Fehlerfälle: + * Picture is two dimensional + +where + PROC where (PICTURE CONST p, REAL VAR x, y, z) + Zweck: Die Prozedur liefert die aktuelle Stiftposition (Angaben mit #on("italics")#cm#off("italics")# werden + dabei nicht berücksichtigt). + Fehlerfälle: + * Picture is two dimensional + + PROC where (PICTURE CONST p, REAL VAR x, y, z) + Zweck: Die Prozedur liefert die aktuelle Stiftposition (Angaben mit #on("italics")#cm#off("italics")# werden + dabei nicht berücksichtigt). + Fehlerfälle: + * Picture is three dimensional + +rotate: + PROC rotate (PICTURE VAR p, REAL CONST angle) + Zweck: Das PICTURE wird um den Punkt (0, 0) um den Winkel #on("italics")#angle#off("italics")# (im + Gradmaß) im mathematisch positiven Sinn gedreht. + Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")# + verändert. + + PROC rotate (PICTURE CONST p, REAL CONST phi, theta, lambda ) : + PICTURE 1-397 + Zweck: Das PICTURE wird um den Winkel #on("italics")#lambda#off("italics")# um die Drehachse #on("italics")#(phi, + theta)#off("italics")# gedreht. + Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")# + verändert. + +stretch + PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) + Zweck: Das PICTURE wird in X-Richtung um den Faktor #on("italics")#sx#off("italics")#, in Y-Rich­ + tung um den Faktor #on("italics")#sy#off("italics")# gestreckt (bzw. gestaucht). Dabei bewirkt der + Faktor + s > 1 eine Streckung + 0 < s < 1 eine Stauchung + s < 0 zusätzlich eine Achsenspiegelung. + Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")# + verändert. + Fehlerfälle: + * Picture is three dimensional + + PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) + Zweck: s. o. + Fehlerfälle: + * Picture is two dimensional + +translate + PROC translate (PICTURE VAR p, REAL CONST dx, dy) + Zweck: Das PICTURE wird um #on("italics")#dx#off("italics")# und #on("italics")#dy#off("italics")# verschoben. + Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")# + verändert. + Fehlerfälle: + * Picture is three dimensional + + PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) + Zweck: s. o. + Fehlerfälle: + * Picture is two dimensional + +plot PROC plot (PICTURE CONST p) + Zweck: Das Picfile wird gezeichnet. + Achtung: Es wird kein #on("italics")#begin plot#off("italics")# oder #on("italics")#end plot#off("italics")# durchgeführt. Es wird + auch kein Stift gsetzt und die Projektionsparameter bleiben + unverändert. + + +#on("underline")#Graphische PICFILE-Prozeduren#off("underline")# +plot + PROC plot (TEXT CONST name) + Zweck: Der PICFILE mit dem Namen #on("italics")#name#off("italics")# wird entsprechend der angegebenen + Darstellungsart gezeichnet. Diese Parameter (#on("italics")#perspective, orthographic, + oblique, view, window etc.#off("italics")#) müssen vorher eingestellt werden. + Fehlerfälle: + * PICFILE does not exist + Es existiert kein PICFILE mit dem Namen #on("italics")#name#off("underline")# + + PROC plot (PICFILE VAR p) + Zweck: Der PICFILE #on("italics")#p#off("italics")# wird entsprechend der angegebenen Darstellungsart ge­ + zeichnet. Diese Parameter müssen vorher eingestellt werden: + + #on("bold")#zweidimensional:#off("bold")# + obligat: #on("italics")#window#off("italics")# (zweidimensional) + optional: #on("italics")#view#off("italics")# (zweidimensional) + #on("italics")#viewport#off("italics")# + #on("italics")#select pen#off("italics")# + + #on("bold")#dreidimensional:#off("bold")# + obligat: #on("italics")#window#off("italics")# (dreidimensional) + optional: #on("italics")#view#off("italics")# (dreidimensional) + #on("italics")#orthographic | perspective | oblique#off("italics")# + #on("italics")#viewport#off("italics")# + #on("italics")#select pen#off("italics")# + + +select pen + PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line + type, + BOOL VAR hidden lines) Zweck: Für die + Darstellung des Bildes #on("italics")#p#off("italics")# soll dem #on("italics")#virtuellen#off("italics")# Stift #on("italics")#pen#off("italics")# ein realer Stift + zugeordnet werden, der möglichst die Farbe #on("italics")#colour#off("italics")# und die Dicke #on("italics")#thick­ + ness#off("italics")# hat und dabei Linien mit dem Typ #on("italics")#line type#off("italics")# zeichnet. Es wird die + beste Annäherung für das Ausgabegerät genommen. + Wenn #on("italics")#hidden lines#off("italics")# auf TRUE gesetzt wird, werden bei dreidimensionalen + Zeichnungen die verdeckten Linien mitgezeichnet, ansonsten werden sie + unterdrückt. Um sicherzustellen, das der Algorithmus auch funktioniert, + müssen die Linien allerdings von vorn nach hinten gezeichnet werden. Es + ist also nicht möglich, das Bild so zu drehen, das die hinteren Linien + zuerst gezeichnet werden. + Dabei gelten folgende Vereinbarungen: + + #on("bold")#Farbe:#off("bold")# Negative Farben werden XOR gezeichnet (dunkel wird hell und + hell wird dunkel), Farbe 0 ist der Löschstift und positive Farben + überschreiben (ersetzen) den alten Punkt mit folgenden Werten: + + 1 Standardfarbe des Endgerätes + 2 rot + 3 blau + 4 grün + 5 schwarz + 6 weiß + > 6 nicht normierte Sonderfarben + + + #on("bold")#Dicke:#off("bold")# 0 Standardstrichstärke des Endgerätes, ansonsten Strichstärke in + 1/10 mm. + + + #on("bold")#Linientyp:#off("bold")# + 0 keine sichtbare Linie + 1 durchgängige Linie + 2 gepunktete Linie + 3 kurz gestrichelte Linie + 4 lang gestrichelte Linie + 5 Strichpunktlinie + > 5 nicht normierte Linie + + #on("bold")#Verdeckte Linien:#off("bold")# + TRUE Verdeckte Linien werden mitgezeichnet + FALSE Verdeckte Linien werden unterdrückt (nur bei drei­ + dimensionalen PICTURE) + + Die hier aufgeführten Möglichkeiten müssen nicht an allen graphischen + Endgeräten vorhanden sein. Der geräteabhängige Graphik-Treiber wählt + jeweils die bestmögliche Annäherung. + + Fehlerfälle: + * pen out of range + #on("italics")#pen#off("italics")# muss im Bereich 1-16 sein. + +background + PROC background (PICFILE VAR p, INT CONST colour) + Zweck: Der Hintergrund wird auf die Farbe #on("italics")#colour#off("italics")# (s.o.) gesetzt wenn möglich. + + INT PROC background (PICFILE CONST p): + Zweck: Liefert die eingestellte Hintergrundfarbe. + +view + PROC view (PICFILE VAR p, REAL CONST alpha) + Zweck: Setzt den Winkel der Y-Achse zur Senkrechten auf #on("italics")#alpha#off("italics")# Grad, falls + diese nicht senkrecht zur Betrachtungsebene steht. + + PROC view (PICFILE VAR p, REAL CONST phi, theta) + Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne dargestellt, + sondern für die Betrachtung gedreht. Mit der Prozedur #on("italics")#view#off("italics")# kann die + Betrachtungsrichtung durch die Polarwinkel #on("italics")#phi#off("italics")# und #on("italics")#theta#off("italics")# (im Gradmass) + angegeben werden. Voreingestellt ist #on("italics")#phi#off("italics")# = 0 und #on("italics")#theta#off("bold")# = 0, d.h. senk­ + recht von oben. + + Im Gegensatz zu #on("italics")#rotate#off("italics")# hat #on("italics")#view#off("italics")# keine Wirkung auf das eigentliche Bild + (PICFILE), sondern nur auf die gewählte Darstellung. So addieren sich + zwar aufeinanderfolgende #on("italics")#Rotationen#off("italics")#, #on("italics")#view#off("italics")# aber geht immer von der + Nullstellung aus. Auch kann das Bild durch eine #on("italics")#Rotation#off("italics")# ganz oder + teilweise aus oder in das Darstellungsfenster (#on("italics")#window#off("italics")# gedreht werden. Bei + #on("italics")#view#off("italics")# verändern sich die Koordinaten der Punkte nicht, d. h. das Fenster + wird mitgedreht. + + PROC view (PICFILE VAR p, REAL CONST x, y, z) + Zweck: Wie oben, nur werden die Winkel nicht in Polarkoordinaten angegeben, + sondern es wird die Blickrichtung als Vektor in Karthesischen Koordina­ + ten angegeben. (Die Länge darf ungleich 1 sein). + +viewport + PROC viewport (PICFILE VAR p, REAL CONST hormin, hormax, vertmin, + vertmax) : 1-709 + Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt werden + soll, wird spezifiziert. Dabei wird sowohl die Größe als auch die relative + Lage der Zeichenfläche definiert. Der linke untere Eckpunkt der physi­ + kalischen Zeichenfläche des Gerätes hat die Koordinaten (0, 0). Die + definierte Zeichenfläche erstreckt sich + + #on("italics")#hormin - hormax#off("italics")# in der Horizontalen, + #on("italics")#vertmin - vertmax#off("italics")# in der Vertikalen. + + So liegt der linke untere Eckpunkt dann bei (#on("italics")#hormin, hormax#off("italics")#), der rechte + obere Eckpunkt bei (#on("italics")#hormax, vertmax#off("italics")#). + + Damit sowohl geräteunabhängige als auch maßstabgetreue Zeichnungen + möglich sind, können die Koordinaten in zwei Arten spezifiziert werden: + a) #on("bold")#Gerätekoordinaten#off("bold")# + Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei + hat die kürzere Seite der physikalischen Zeichenfläche definitionsge­ + mäß die Länge 1.0. + b) #on("bold")#Absolute Koordinaten#off("bold")# + Die Werte werden in #on("italics")#cm#off("italics")# angegeben. Dabei müssen die Maximal­ + werte aber größer als 2.0 sein, da sonst Fall a) angenommen wird. + + Voreingestellt ist + + viewport (0.0, 1.0, 0.0, 1.0) + + d.h. das größtmögliche Quadrat, beginnend mit der linken unteren Ecke + der physikalischen Zeichenfläche. In vielen Fällen wird diese Einstellung + ausreichen, so daß der Anwender kein eigenes #on("italics")#viewport#off("italics")# definieren muss. + + Der Abbildungsmaßstab wird durch das Zusammenspiel von #on("italics")#viewport#off("italics")# und + #on("italics")#window#off("italics")# festgelegt (s. dort). Dabei ist insbesondere darauf zu achten, daß + winkeltreue Darstellung nur bei gleichen X- und Y-Maßstab möglich + ist. Da man oft quadratische Fenster (#on("italics")#window#off("italics")#) verwendet, wurde als + Standardeinstellung auch ein quadratisches #on("italics")#viewport#off("italics")# gewählt. + + Hinweis: Mit der Prozedur #on("italics")#check limit#off("italics")# aus dem PACKET #on("italics")#basis plot#off("italics")# kann die + Überprüfung der Grenzen des eingestellten #on("italics")#viewport#off("italics")#-Bereiches ein- + bzw. ausgeschaltet werden. Bei eingeschateter Überprüfung, werden + Linien, die den Bereich überschreiten, am Rand abgetrennt. + + +window + PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) + Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das darzustel­ + lende Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im In- + tervall [#on("italics")#x min, x max#off("italics")#] und deren Y-Koordinaten im Bereich [#on("italics")#y min, y + max#off("italics")#] liegen, gehören zum definierten Fenster.Vektoren, die außerhalb + dieses Fensters liegen, gehen über die durch #on("italics")#viewport#off("italics")# Fläche hinaus + (s.dort). + + Der Darstellungsmaßstab ergibt sich als + + #ub#               x max - x min               #ue# + horizontale Seitenlänge der Zeichenfläche + + + #ub#               y max - y min               #ue# + vertikale Seitenlänge der Zeichenfläche + + PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, + z min, z max) + + Zweck: Für die darstellung eines dreidimensionalen Bildes wird das darzustellende + Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("italics")#x + min, x max#off("italics")#], deren Y-Koordinaten im Bereich [#on("italics")#y min, y max#off("italics")#] und + deren Z-Koordinaten im Bereich [#on("italics")#z min, z max#off("italics")#] liegen, gehören zum + definierten Fenster. Dieses dreidimensionale Fenster (#on("italics")#Quader#off("italics")#) wird ent­ + sprechend der eingestellten Projektionsart (orthographisch, perspektivisch + oder schiefwinklig) und den Betrachtungswinkeln (s. #on("italics")#view#off("italics")#) auf die spezi­ + fizierte Zeichenfläche abgebildet. + Anders als im zweidimensionalen Fall ist das Problem der Maßstaäbe + nicht mehr nur durch das Zusammenspiel von #on("italics")#window#off("italics")# und #on("italics")#viewport#off("italics")# zu + beschreiben. Hier spielen auch die Projektionsart und Darstellungswinkel + herein. + +oblique: + PROC oblique (PICFILE VAR p, REAL CONST a, b) + Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#schiefwinklig#off("underline")# als gewünschte + Projektionsart eingestellt. Dabei ist (#on("italics")#a, b#off("italics")#) der Punkt auf der X-Y- + Ebene, auf den der Einheitsvektor der Z-Richtung abgebildet werden + soll. + +orthographic + PROC orthographic (PICFILE VAR p) + Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#orthographisch#off("underline")# als gewünschte + Projektionsart eingestellt. Bei der orthographischen Projektion wird ein + dreidimensionaler Körper mit parallelen Strahlen senkrecht auf der Pro­ + jektionsebene dabgebildet. + +perpective + PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) + Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#perspectivisch#off("underline")# als gewünschte + Projektionsart eingestellt. Der Punkt (#on("italics")#cx, 1/cy, cz#off("underline")#) ist der Fluchtpunkt der + Projektion, d. h. alle Parallen zur Z-Achse schneiden sich in diesem + Punkt. + +extrema + PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) + Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE. + + PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z + min,z max) : 1-651 + Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE. + + +#on("underline")#Prozeduren zur Manipulation von PICFILE#off("underline")# +:= + OP := (PICFILE VAR p, DATASPACE CONST d) + Zweck: Assoziert die PICFILE Variable #on("italics")#p#off("italics")# mit dem Datenraum #on("italics")#d#off("italics")# und initialisiert + die Variable, wenn nötig. + Fehlerfälle: + * dataspace is no PICFILE + Der anzukoppelnde Datenraum hat einen unzulässigen Typ + +picture file + DATASPACE PROC picture file (TEXT CONST name) + Zweck: Assoziaten eines benannten Datenraumes mit einem PICFILE (s.o.). + +put + PROC put (FILE VAR f, PICFILE VAR p) + Zweck: Schreibt den Inhalt eines PICFILE in ein FILE. Die Informationen + werden im internen Format abgelegt. + +get + PROC get (PICFILE VAR p, FILE VAR f) + Zweck: Liest den Inhalt eines PICFILE aus einem FILE. Die Informationen + müssen mit #on("italics")#put#off("italics")# geschrieben worden sein. + Fehlerfall: + * Picfile overflow + Es können nur maximal 1024 Picture (Sätze) in einem PICFILE abgelegt + werden. + +to first pic + PROC to first pic (PICFILE VAR p) + Zweck: Positioniert auf das erste PICTURE. + +to eof + PROC to last pic (PICFILE VAR p) + Zweck: Positioniert hinter das letzte PICTURE. + +to pic + PROC to pic (PICFILE VAR p, INT CONST pos) + Zweck: Positioniert auf das PICTURE Nummer #on("italics")#pos#off("italics")#. + Fehlerfälle: + * Position underflow + Es wurde eine Position kleiner Null angegeben. * Position after + eof Es wurde versucht, hinter das Ende eines PICFILE zu positionieren + +up + PROC up (PICFILE VAR p) + Zweck: Positioniert genau ein PICTURE zurück. + Fehlerfall: + * Position underflow + Es wurde versucht, vor das erste PICTURE zu positionieren + + PROC up (PICFILE VAR p, INT CONST n) + Zweck: Positioniert genau #on("italics")#n#off("italics")# Picture zurück. + Fehlerfall: + * Position underflow + Es wurde versucht, vor das erste PICTURE zu positionieren + +down + PROC down (PICFILE VAR p) + Zweck: Positioniert genau ein PICTURE vorwärts. + Fehlerfall: + * Position after eof + Es wurde versucht, hinter das Ende eines PICFILE zu positionieren + + PROC down (PICFILE VAR p, INT CONST n) + Zweck: Positioniert genau #on("italics")#n#off("italics")# Picture vorwärts. + Fehlerfall: + * Position after eof + Es wurde versucht, hinter das Ende eines PICFILE zu positionieren + +is first picture + BOOL PROC is first picture (PICFILE CONST p) + Zweck: Liefert genau dann #on("italics")#TRUE#off("italics")#, wenn das erste PICTURE erreicht ist. + +eof + BOOL PROC eof (PICFILE CONST p) + Zweck: Liefert genau dann #on("italics")#TRUE#off("italics")#, wenn das Ende eines PICFILE erreicht ist. + +picture no + INT PROC picture no (PICFILE CONST p) + Zweck: Liefert die Nummer des aktuellen PICTURE. + +pictures + INT PROC pictures (PICFILE CONST p) + Zweck: Liefert die Anzahl PICTURE eines PICFILE. + +delete picture + PROC delete picture (PICFILE VAR p) + Zweck: Löscht das aktuelle PICTURE + +insert picture + PROC insert picture (PICFILE VAR p) + Zweck: Fügt ein PICTURE #on("underline")#vor#off("underline")# der aktuellen Position ein. + +read picture + PROC read picture (PICFILE CONST p, PICTURE VAR pic) + Zweck: Liest das aktuelle PICTURE. + +write picture + PROC write picture (PICFILE VAR p, PICTURE CONST pic) + Zweck: Schreibt das PICTURE #on("italics")#pic#off("italics")# auf der aktuellen Position. + +put picture + PROC write picture (PICFILE VAR p, PICTURE CONST pic) + Zweck: Schreibt das PICTURE #on("italics")#pic#off("italics")# hinter das letzte PICTURE des PICFILE. + Die aktuelle Position wird nicht verändert. + +#page# + #on("italics")#Wo wir sind, da klappt nichts, + aber wir können nicht überall sein !#off("italics")# + +#type ("basker14")# +#on("bold")#Kurzbeschreibung des Graphik-Editors#off("bold")# +#type ("basker12")# + +In der Kommondozeile werden folgende Informationen angezeigt: + +#on("revers")#LEN nnnnn <...Name...> DIM n PEN nn Picture nnnn +#off("revers")# + + +Folgende Kommandos stehen zur Verfügung: + + PICTURE PROC pic neu + PICFILE PROC picfile neu + PROC neu zeichnen + + OP UP n (n PICTURE up) + OP DOWN n (n PICTURE down) + OP T n (to PICTURE n) + + PROC oblique (REAL CONST a, b) + PROC orthographic + PROC perspective (REAL CONST cx, cy, cz) + PROC window (BOOL CONST dev) + PROC window (REAL CONST x min, x max, y min, y max) + PROC window (REAL CONST x min, x max, y min, y max, z min, z max) + PROC viewport (REAL CONST h min, h max, v min, v max) + PROC view (REAL CONST alpha) + PROC view (REAL CONST phi, theta) + PROC view (REAL CONST x, y, z) + + PROC pen (INT CONST n) + PROC select pen (INT CONST pen, colour, thickness, line type, BOOL CONST + hidden) + PROC background (INT CONST colour) + + PROC extrema pic + PROC extrema picfile + PROC selected pen + + PROC rotate (REAL CONST angle) + PROC rotate (REAL CONST phi, theta, lambda ) + PROC stretch (REAL CONST sx, sy) + PROC stretch (REAL CONST sx, sy, sz) + PROC translate (REAL CONST dx, dy) + PROC translate (REAL CONST dx, dy, dz) + diff --git a/system/std.graphik/1.8.7/source-disk b/system/std.graphik/1.8.7/source-disk new file mode 100644 index 0000000..8e7ff34 --- /dev/null +++ b/system/std.graphik/1.8.7/source-disk @@ -0,0 +1 @@ +grundpaket/05_std.graphik.img diff --git a/system/std.graphik/1.8.7/src/Beispiel.Kreuz b/system/std.graphik/1.8.7/src/Beispiel.Kreuz new file mode 100644 index 0000000..e29f24a --- /dev/null +++ b/system/std.graphik/1.8.7/src/Beispiel.Kreuz @@ -0,0 +1,41 @@ +initialisiere picfile; +zeichne die x achse; +zeichne die y achse; +zeichne die z achse; +stelle das achsenkreuz dar . + +initialisiere picfile: + PICFILE VAR p :: picture file ("KREUZ") . + +zeichne die x achse: + PICTURE VAR x achse := nilpicture; + move (x achse, -1.0, 0.0, 0.0); + draw (x achse, "-X", 0.0, 0.0, 0.0); + draw (x achse, 1.0, 0.0, 0.0); + draw (x achse, "+X", 0.0, 0.0, 0.0); + put picture (p, x achse) . + +zeichne die y achse: + PICTURE VAR y achse := nilpicture; + move (y achse, 0.0, -1.0, 0.0); + draw (y achse, "-Y", 0.0, 0.0, 0.0); + draw (y achse, 0.0, 1.0, 0.0); + draw (y achse, "+Y", 0.0, 0.0, 0.0); + put picture (p, y achse) . + +zeichne die z achse: + PICTURE VAR z achse := nilpicture; + move (z achse, 0.0, 0.0, -1.0); + draw (z achse, "-Z", 0.0, 0.0, 0.0); + draw (z achse, 0.0, 0.0, 1.0); + draw (z achse, "+Z", 0.0, 0.0, 0.0); + put picture (p, z achse) . + +stelle das achsenkreuz dar: + viewport (p, 0.0, 1.0, 0.0, 1.0); + window (p, -1.1, 1.1, -1.1, 1.1); + oblique (p, 0.25, 0.15); + plot (p) . + + + diff --git a/system/std.graphik/1.8.7/src/Beispiel.Sinus b/system/std.graphik/1.8.7/src/Beispiel.Sinus new file mode 100644 index 0000000..beac7cd --- /dev/null +++ b/system/std.graphik/1.8.7/src/Beispiel.Sinus @@ -0,0 +1,45 @@ +initialisiere picfile; +zeichne überschrift; +zeichne achsen; +zeichne sinuskurve; +wähle darstellung; +plot (p) . + +initialisiere picfile: + PICFILE VAR p :: picture file ("SINUS") . + +zeichne überschrift: + PICTURE VAR überschrift :: nilpicture; + move (überschrift, -pi/2.0, 1.0); + draw (überschrift, "sinus (x) [-pi, +pi]", 0.0, 1.0, 0.6); + put picture (p, überschrift) . + +zeichne achsen: + PICTURE VAR achsen :: nilpicture; + zeichne x achse; + zeichne y achse; + put picture (p, achsen) . + +zeichne x achse: + move (achsen, -pi, 0.0); + draw (achsen, pi, 0.0) . + +zeichne y achse: + move (achsen, 0.0, -1.0); + draw (achsen, 0.0, +1.0) . + +zeichne sinuskurve: + PICTURE VAR sinus :: nilpicture; + REAL VAR x :: -pi; + + move (sinus, x, sin (x)); + REP x INCR 0.1; + draw (sinus, x, sin (x)) + UNTIL x >= pi PER; + + put picture (p, sinus) . + +wähle darstellung: + window (p, -pi, pi, -1.0, 1.3); + viewport (p, 0.0, 0.0, 0.0, 0.0) . + diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Picfile b/system/std.graphik/1.8.7/src/GRAPHIK.Picfile new file mode 100644 index 0000000..3accf52 --- /dev/null +++ b/system/std.graphik/1.8.7/src/GRAPHIK.Picfile @@ -0,0 +1,738 @@ +PACKET picture DEFINES (*Autor: Heiko.Indenbirken *) + PICTURE, (*Stand: 12.03.1985 *) + :=, CAT, nilpicture, (*Änderung: 20.08.85/10:38 *) + draw, draw r, (*Änderung: 05.08.86/12:21 *) + move, move r, + mark, bar, circle, + length, dim, pen, where, + extrema, rotate, stretch, translate, + picture: + +LET draw key = 1, + move key = 2, + text key = 3, + move r key = 4, + draw r key = 5, + bar 2 key = 6, + bar 3 key = 7, + circle key = 8, + mark key = 9, + max length = 31974; + +LET overflow = "Picture overflow", + pen range = "pen out of range [0-16]", + dim 3 = "Picture is 3 dimensional", + dim 2 = "Picture is 2 dimensional", + dim init = "Picture isn't initialized", + wrong key = "wrong key code", + nil = "", + zero = ""0""; + +TYPE PICTURE = STRUCT (INT dim, pen, TEXT points); + + +INT VAR read pos; +REAL VAR x, y, z; +TEXT VAR r1 :: 8*zero, r2 :: 16*zero, r3 :: 24*zero, i1 :: 2*zero; + +OP := (PICTURE VAR l, PICTURE CONST r) : + CONCR (l) := CONCR (r) +END OP :=; + +OP CAT (PICTURE VAR l, PICTURE CONST r) : + check dim (l, r.dim); + IF length (l.points) > max length - length (r.points) + THEN errorstop (overflow) FI; + + l.points CAT r.points +END OP CAT; + +PICTURE PROC nilpicture : + PICTURE : (0, 1, nil) +END PROC nilpicture; + +PICTURE PROC nilpicture (INT CONST pen): + PICTURE : (0, pen, nil) +END PROC nilpicture; + +PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, bright): + write (p.points, 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.points, x, y, z, draw key) +END PROC draw; + +PROC draw (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p.points, x, y, draw key) +END PROC draw; + +PROC draw r (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p.points, 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.points, x, y, draw r key) +END PROC draw r; + +PROC move (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p.points, x, y, z, move key) +END PROC move; + +PROC move (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p.points, x, y, move key) +END PROC move; + +PROC move r (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p.points, 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.points, x, y, move r key) +END PROC move r; + +PROC bar (PICTURE VAR p, REAL CONST width, height, INT CONST pattern): + check dim (p, 2); + write (p.points, width, height, pattern, bar 2 key) +END PROC bar; + +PROC bar (PICTURE VAR p, REAL CONST from, to, height, INT CONST pattern): + check dim (p, 2); + write (p.points, from, to, height, pattern, bar 3 key) +END PROC bar; + +PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern): + check dim (p, 2); + write (p.points, radius, from, to, pattern, circle key) +END PROC circle; + +PROC mark (PICTURE VAR p, REAL CONST size, INT CONST no): + write (p.points, size, no, mark key) +END PROC mark; + +PROC write (TEXT VAR points, REAL CONST x, y, z, INT CONST key) : + IF length (points) < max length + THEN points CAT code (key); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + points CAT r3 + ELSE errorstop (overflow) FI +END PROC write; + +PROC write (TEXT VAR points, REAL CONST x, y, INT CONST key) : + IF length (points) < max length + THEN points CAT code (key); + replace (r2, 1, x); + replace (r2, 2, y); + points CAT r2 + ELSE errorstop (overflow) FI +END PROC write; + +PROC write (TEXT VAR points, REAL CONST x, y, INT CONST n, key) : + IF length (points) < max length + THEN points CAT code (key); + replace (r2, 1, x); + replace (r2, 2, y); + points CAT r2; + replace (i1, 1, n); + points CAT i1 + ELSE errorstop (overflow) FI +END PROC write; + +PROC write (TEXT VAR points, REAL CONST x, y, z, INT CONST n, key) : + IF length (points) < max length + THEN points CAT code (key); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + points CAT r3; + replace (i1, 1, n); + points CAT i1 + ELSE errorstop (overflow) FI +END PROC write; + +PROC write (TEXT VAR points, TEXT CONST t, REAL CONST angle, height, bright, + INT CONST key) : + IF max length - length (points) >= length (t) + THEN points CAT code (key); + replace (i1, 1, length (t)); + points CAT i1; + points CAT t; + replace (r3, 1, angle); + replace (r3, 2, height); + replace (r3, 3, bright); + points CAT r3 + FI; +END PROC write; + +PROC write (TEXT VAR points, REAL CONST size, INT CONST no, key) : + IF length (points) < max length + THEN points CAT code (key); + replace (r1, 1, size); + points CAT r1; + replace (i1, 1, no); + points CAT i1; + ELSE errorstop (overflow) FI +END PROC write; + +PROC check dim (PICTURE VAR p, INT CONST dim): + IF p.dim = dim + THEN + ELIF p.dim = 0 + THEN p.dim := dim + ELSE errorstop (dimension) FI . + +dimension: + IF p.dim = 2 + THEN dim 2 + ELIF p.dim = 3 + THEN dim 3 + ELSE dim init 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; + +PICTURE PROC pen (PICTURE CONST p, INT CONST pen) : + IF pen < 0 OR pen > 16 + THEN errorstop (pen range) FI; + + PICTURE:(p.dim, pen, p.points) +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 (dim 3) + 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 (dim 2) + 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 text key : read pos INCR next int + 24 + CASE bar 2 key : read pos INCR 18 + CASE bar 3 key, circle key : read pos INCR 26 + CASE mark key: read pos INCR 4 + OTHERWISE errorstop (wrong key) 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 text key : read pos INCR next int + 24 + CASE bar 2 key : read pos INCR 18 + CASE bar 3 key, circle key : read pos INCR 26 + CASE mark key: read pos INCR 4 + OTHERWISE errorstop (wrong key) 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) : + 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 rotate (PICTURE VAR p, REAL CONST phi, theta, lambda ) : + REAL CONST s :: sind ( theta ), c :: cosd ( theta ), + s p :: sind ( phi ), s l :: sind ( lambda ), + ga :: cosd ( phi ), c l :: cosd ( lambda ), + be :: s p * s l, al :: s p * c l, c1 :: 1.0 - c; + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( al*al*c1 + c , be*al*c1+ga*s, ga*al*c1-be*s ), + ROW 3 REAL : ( al*be*c1-ga*s, be*be*c1 + c , ga*be*c1+al*s ), + ROW 3 REAL : ( al*ga*c1+be*s, be*ga*c1-al*s, ga*ga*c1 + c ), + ROW 3 REAL : ( 0.0 , 0.0 , 0.0 ))) +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 text key : read pos INCR next int + 24 + CASE bar 2 key : read pos INCR 18 + CASE bar 3 key, circle key : read pos INCR 26 + CASE mark key: read pos INCR 4 + OTHERWISE errorstop (wrong key) 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 text key : read pos INCR next int + 24 + CASE bar 2 key : read pos INCR 18 + CASE bar 3 key, circle key : read pos INCR 26 + CASE mark key: read pos INCR 4 + OTHERWISE errorstop (wrong key) 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; + +PROC picture (PICTURE CONST pic, TEXT VAR points, INT VAR dim, pen): + dim := pic.dim; + pen := pic.pen; + points := pic.points; +END PROC picture; + +END PACKET picture; + +PACKET picfile DEFINES (*Autor: Heiko Indenbirken *) + (*Stand: 23.02.1985 *) + PICFILE, :=, picture file, (*Änderung: 13.10.89/23:11 *) + select pen, selected pen, background, + set values, get values, + view, viewport, window, + oblique, orthographic, perspective, + extrema, + + to pic, up, down, + eof, picture no, pictures, + delete picture, insert picture, + read picture, write picture, + get picture, put picture: + + +LET no picfile = "dataspace is no PICFILE", + pen range = "pen out of range", + pos under = "Position underflow", + pos over = "Position overflow", + pic over = "PICFILE overflow"; + +LET max pics = 1024, + pic dataspace = 1103; + + +TYPE PICFILE = BOUND STRUCT (INT size, pos, background, + ROW 16 ROW 3 INT pens, + 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); + +INT VAR i; + +OP := (PICFILE VAR l, PICFILE CONST r): + 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 (no picfile) FI . + +init picfile dataspace : + r.size := 0; + r.pos := 1; + r.background := 0; + r.sizes := 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)); + r.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (0.0, 0.0), + ROW 2 REAL : (0.0, 0.0)); + r.angles := ROW 4 REAL : (0.0, 0.0, 0.0, 0.0); + r.obliques := ROW 2 REAL : (0.0, 0.0); + r.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0); + FOR i FROM 1 UPTO 16 + REP r.pens [i] := ROW 3 INT : (1, 0, 1) 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): + IF pen < 1 OR pen > 16 + THEN errorstop (pen range) FI; + p.pens [pen] := ROW 3 INT : (colour, thickness, line type) +END PROC select pen; + +PROC selected pen (PICFILE CONST p, INT CONST pen, + INT VAR colour, thickness, line type): + IF pen < 1 OR pen > 16 + THEN errorstop (pen range) FI; + colour := p.pens [pen][1]; + thickness := p.pens [pen][2]; + line type := p.pens [pen][3]; +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 := ROW 2 ROW 2 REAL : (ROW 2 REAL : (hor min, hor max), + ROW 2 REAL : (vert min, 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 := 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)) +END PROC window; + +PROC oblique (PICFILE VAR p, REAL CONST a, b) : + p.obliques := ROW 2 REAL : (a, b); + p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0) +END PROC oblique; + +PROC orthographic (PICFILE VAR p) : + p.obliques := ROW 2 REAL : (0.0, 0.0); + p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0) +END PROC orthographic; + +PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) : + p.obliques := ROW 2 REAL : (0.0, 0.0); + p.perspectives := ROW 3 REAL : (cx, cy, 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 to pic (PICFILE VAR p, INT CONST n): + IF n < 1 + THEN errorstop (pos under) + ELIF n <= p.size+1 AND n <= max pics + THEN p.pos := n + ELSE errorstop (pos over) 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 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 (pic over) + 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 get picture (PICFILE VAR p, PICTURE VAR pic) : + IF p.pos > p.size + THEN errorstop (pos over) + ELSE pic := p.pic [p.pos]; + p.pos INCR 1; + FI +END PROC get picture; + +PROC put picture (PICFILE VAR p, PICTURE CONST pic) : + IF p.pos > max pics + THEN errorstop (pic over) + ELSE p.pic [p.pos] := pic; + + IF p.pos > p.size + THEN p.size INCR 1 FI; + p.pos INCR 1 + FI +END PROC put picture; + +END PACKET picfile + diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Plot b/system/std.graphik/1.8.7/src/GRAPHIK.Plot new file mode 100644 index 0000000..5087abb --- /dev/null +++ b/system/std.graphik/1.8.7/src/GRAPHIK.Plot @@ -0,0 +1,285 @@ +PACKET basis plot DEFINES (* Autor: Heiko Indenbirken*) + (* Stand: 12.04.85 *) + (*Änderung: 06.08.86/10:03 *) +(* ****************** Hardwareunabhängiger Teil ********************* *) +(* *) +(* *) +(* Im Harwareunabhängigen Paket 'basis plot' werden folgende *) +(* Prozeduren definiert: *) +(* Procedure : Bedeutung *) +(* ---------------------------------------------------------------- *) +(* move : Positioniert auf (x, y,[z]) in Weltkoordinaten*) +(* draw : Zeichnet eine Linie bis zum Punkt (x, y, [z]).*) +(* move r : Positioniert (x, y, [z]) weiter *) +(* draw r : Zeichnet (x, y, [z]) weiter *) +(* *) +(* draw : Zeichnet einen Text *) +(* *) +(* mark : Marker mit (no, size) *) +(* bar : Balken mit (width, height, pattern) *) +(* bar : Balken mit (from, to, width, pattern) *) +(* circle : Kreis(segment) mit (radius, from, to, pattern)*) +(* *) +(* where : Gibt die aktuelle Stiftposition (x, y, [z]) *) +(* *) +(*************************************************************************) + + move, draw, + move r, draw r, + mark, bar, circle, + where: + +LET POS = STRUCT (REAL x, y, z); + +POS VAR pos :: POS : (0.0, 0.0, 0.0); +INT VAR h :: 0, v :: 0; + +PROC move (REAL CONST x, y) : + 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) : + transform (x, y, z, h, v); + move (h, v); + pos := POS : (x, y, z) +END PROC move; + +PROC draw (REAL CONST x, y) : + transform (x, y, 0.0, h, v); + draw (h, v); + pos := POS : (x, y, 0.0) +END PROC draw; + +PROC draw (REAL CONST x, y, z) : + transform (x, y, z, h, v); + draw (h, v); + pos := POS : (x, y, z) +END PROC draw; + +PROC move r (REAL CONST x, 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 PROC move r; + +PROC move r (REAL CONST x, y, z) : + 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 draw r (REAL CONST x, 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 PROC draw r; + +PROC draw r (REAL CONST x, y, z) : + transform (pos.x+x, pos.y+y, pos.z+z, h, v); + draw (h, v); + pos := POS : (pos.x+x, pos.y+y, pos.z+z) +END PROC draw r; + +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 draw (TEXT CONST msg, REAL CONST angle, height percent, width percent): + draw (msg, angle, height (height percent), width (width percent)) . +END PROC draw; + +PROC mark (REAL CONST size, INT CONST no): + marker (h, v, no, diagonal (size)) +END PROC mark; + +PROC bar (REAL CONST width, height, INT CONST pattern): + INT VAR diff, up, zero x, zero y; + transform (0.0, 0.0, 0.0, zero x, zero y); + transform (width*0.5, height, 0.0, diff, up); + bar (h-(diff-zero x), v, h+(diff-zero x), v+(up-zero y), pattern); + move (h, v) + +END PROC bar; + +PROC bar (REAL CONST from, to, height, INT CONST pattern): + INT VAR from h, to h, up; + transform (from, height, 0.0, from h, up); + transform (to, height, 0.0, to h, up); + bar (from h, v, to h, up, pattern); + move (h, v) + +END PROC bar; + +PROC circle (REAL CONST rad, from, to, INT CONST pattern): + circle (h, v, diagonal (rad), from, to, pattern) . + +END PROC circle; + +ENDPACKET basis plot; + +PACKET plot DEFINES plot: (*Autor: Heiko Indenbirken *) + (*Stand: 13.10.89/22:31 *) + +LET draw key = 1, + move key = 2, + text key = 3, + move r key = 4, + draw r key = 5, + bar 2 key = 6, + bar 3 key = 7, + circle key = 8, + mark key = 9; + +LET dim error = "PICTURE not initialized", + key error = "wrong key code: "; + +TEXT VAR points; +INT VAR pic length, pic pen, pic dim, read pos; +PICTURE VAR pic; + +PROC plot (PICTURE CONST pic): + init plot; + IF pic dim = 2 + THEN plot two dim pic + ELIF pic dim = 3 + THEN plot three dim pic + ELIF NOT (pic dim = 0 AND pic length = 0) + THEN errorstop (dim error) FI; + points := "" . + +init plot: + picture (pic, points, pic dim, pic pen); + pic length := length (points); + read pos := 0 . + +plot two dim pic: + WHILE read pos < pic length + REP plot two dim position PER . + +plot two dim position : + read pos INCR 1; + SELECT key 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 text key: draw (next text, next real, next real, next real) + CASE bar 2 key: bar (next real, next real, next int) + CASE bar 3 key: bar (next real, next real, next real, next int) + CASE circle key: circle (next real, next real, next real, next int) + CASE mark key: mark (next real, next int) + OTHERWISE errorstop (key error + text (key)) 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 key 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 text key: draw (next text, next real, next real, next real) + CASE bar 2 key: bar (next real, next real, next int) + CASE bar 3 key: bar (next real, next real, next real, next int) + CASE circle key: circle (next real, next real, next real, next int) + CASE mark key: mark (next real, next int) + OTHERWISE errorstop (key error + text (key)) END SELECT . + +key: + code (points SUB read pos) . + +END PROC plot; + +REAL PROC next real: + read pos INCR 8; + subtext (points, read pos-7, read pos) RSUB 1 . +END PROC next real; + +INT PROC next int: + read pos INCR 2; + subtext (points, read pos-1, read pos) ISUB 1 . +END PROC next int; + +TEXT PROC next text: + INT CONST text length :: next int; + read pos INCR text length; + subtext (points, read pos-text length+1, read pos) . +END PROC next text; + +PROC plot (TEXT CONST name) : + PICFILE VAR p :: old (name); + plot (p); +END PROC plot; + +PROC plot (PICFILE VAR p) : + set projektion; + disable stop; + begin plot; + clear screen; + plot pictures (p); + errorcheck; + end plot . + +set projektion: + ROW 3 ROW 2 REAL VAR size; + ROW 2 ROW 2 REAL VAR limit; + ROW 4 REAL VAR angles; + ROW 2 REAL VAR oblique; + ROW 3 REAL VAR perspective; + + get values (p, size, limit, angles, oblique, perspective); + set values (size, limit, angles, oblique, perspective) . + +clear screen: + INT VAR x0, y0, x1, y1, h max, v max; + REAL VAR x cm, y cm; + + IF background (p) > -1 + THEN clear + ELSE drawing area (x cm, y cm, h max, v max); + new values (x cm, y cm, h max, v max, x0, x1 , y0, y1); + set range (max (0, x0), max (0, y0), min (h max, x1), min (v max, y1)) + FI . + +errorcheck: + IF is error + THEN line; + put line ("Erorr at PICTURE No " + text (picture no (p))); + FI . + +END PROC plot; + +PROC plot pictures (PICFILE VAR p): + INT VAR back :: abs (background (p)), no; + enable stop; + FOR no FROM 1 UPTO pictures (p) + REP to pic (p, no); + read picture (p, pic); + + IF this picture is ok + THEN set pen of pic; + plot (pic) + FI + PER . + +this picture is ok: + pen (pic) <> 0 AND length (pic) > 0 . + +set pen of pic: + INT VAR colour, thick, type; + selected pen (p, pen (pic), colour, thick, type); + set pen (back, colour, thick, type) . + +END PROC plot pictures; + +END PACKET plot + diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Plotter b/system/std.graphik/1.8.7/src/GRAPHIK.Plotter new file mode 100644 index 0000000..a55e515 --- /dev/null +++ b/system/std.graphik/1.8.7/src/GRAPHIK.Plotter @@ -0,0 +1,247 @@ +PACKET plotter DEFINES plotter: (*Autor: Heiko Indenbirken *) + (*Stand: 13.10.89/22:31 *) + (*Änderung: 08.09.86/15:47 *) + +LET POS = STRUCT (REAL x, y, z); + +POS VAR pos :: POS : (0.0, 0.0, 0.0); +INT VAR h :: 0, v :: 0; + +PROC move (REAL CONST x, y) : + 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) : + transform (x, y, z, h, v); + move (h, v); + pos := POS : (x, y, z) +END PROC move; + +PROC draw (REAL CONST x, y) : + transform (x, y, 0.0, h, v); + draw (h, v); + pos := POS : (x, y, 0.0) +END PROC draw; + +PROC draw (REAL CONST x, y, z) : + transform (x, y, z, h, v); + draw (h, v); + pos := POS : (x, y, z) +END PROC draw; + +PROC move r (REAL CONST x, 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 PROC move r; + +PROC move r (REAL CONST x, y, z) : + 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 draw r (REAL CONST x, 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 PROC draw r; + +PROC draw r (REAL CONST x, y, z) : + transform (pos.x+x, pos.y+y, pos.z+z, h, v); + draw (h, v); + pos := POS : (pos.x+x, pos.y+y, pos.z+z) +END PROC draw r; + +PROC draw (TEXT CONST msg, REAL CONST angle, height percent, width percent): + draw (msg, angle, height (height percent), width (width percent)) . +END PROC draw; + +PROC mark (REAL CONST size, INT CONST no): + marker (h, v, no, diagonal (size)) +END PROC mark; + +PROC bar (REAL CONST width, height, INT CONST pattern): + INT VAR diff, up, zero x, zero y; + transform (0.0, 0.0, 0.0, zero x, zero y); + transform (width*0.5, height, 0.0, diff, up); + bar (h-(diff-zero x), v, h+(diff-zero x), v+(up-zero y), pattern); + move (h, v) + +END PROC bar; + +PROC bar (REAL CONST from, to, height, INT CONST pattern): + INT VAR from h, to h, up; + transform (from, height, 0.0, from h, up); + transform (to, height, 0.0, to h, up); + bar (from h, v, to h, up, pattern); + move (h, v) + +END PROC bar; + +PROC circle (REAL CONST rad, from, to, INT CONST pattern): + circle (h, v, diagonal (rad), from, to, pattern) . + +END PROC circle; + + +(* *) +LET draw key = 1, + move key = 2, + text key = 3, + move r key = 4, + draw r key = 5, + bar 2 key = 6, + bar 3 key = 7, + circle key = 8, + mark key = 9; + +LET dim error = "PICTURE not initialized", + key error = "wrong key code: "; + +TEXT VAR points; +INT VAR pic length, pic pen, pic dim, read pos; +PICTURE VAR pic; + +PROC plot (PICTURE CONST pic): + init plot; + IF pic dim = 2 + THEN plot two dim pic + ELIF pic dim = 3 + THEN plot three dim pic + ELIF NOT (pic dim = 0 AND pic length = 0) + THEN errorstop (dim error) FI; + points := "" . + +init plot: + picture (pic, points, pic dim, pic pen); + pic length := length (points); + read pos := 0 . + +plot two dim pic: + WHILE read pos < pic length + REP plot two dim position PER . + +plot two dim position : + read pos INCR 1; + SELECT key 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 text key: draw (next text, next real, next real, next real) + CASE bar 2 key: bar (next real, next real, next int) + CASE bar 3 key: bar (next real, next real, next real, next int) + CASE circle key: circle (next real, next real, next real, next int) + CASE mark key: mark (next real, next int) + OTHERWISE errorstop (key error + text (key)) 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 key 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 text key: draw (next text, next real, next real, next real) + CASE bar 2 key: bar (next real, next real, next int) + CASE bar 3 key: bar (next real, next real, next real, next int) + CASE circle key: circle (next real, next real, next real, next int) + CASE mark key: mark (next real, next int) + OTHERWISE errorstop (key error + text (key)) END SELECT . + +key: + code (points SUB read pos) . + +END PROC plot; + +REAL PROC next real: + read pos INCR 8; + subtext (points, read pos-7, read pos) RSUB 1 . +END PROC next real; + +INT PROC next int: + read pos INCR 2; + subtext (points, read pos-1, read pos) ISUB 1 . +END PROC next int; + +TEXT PROC next text: + INT CONST text length :: next int; + read pos INCR text length; + subtext (points, read pos-text length+1, read pos) . +END PROC next text; + +PROC plotter (TEXT CONST name) : + PICFILE VAR p :: old (name); + plotter (p); +END PROC plotter; + +PROC plotter (PICFILE VAR p) : + set projektion; + disable stop; + begin plot; + clear screen; + plot pictures (p); + errorcheck; + end plot . + +set projektion: + ROW 3 ROW 2 REAL VAR size; + ROW 2 ROW 2 REAL VAR limit; + ROW 4 REAL VAR angles; + ROW 2 REAL VAR oblique; + ROW 3 REAL VAR perspective; + get values (p, size, limit, angles, oblique, perspective); + set values (size, limit, angles, oblique, perspective) . + +clear screen: + INT VAR x0, y0, x1, y1, h max, v max; + REAL VAR x cm, y cm; + + IF background (p) > -1 + THEN clear + ELSE drawing area (x cm, y cm, h max, v max); + new values (x cm, y cm, h max, v max, x0, x1 , y0, y1); + set range (max (0, x0), max (0, y0), min (h max, x1), min (v max, y1)) + FI . + +errorcheck: + IF is error + THEN line; + put line ("Erorr at PICTURE No " + text (picture no (p))); + FI . + +END PROC plotter; + +PROC plot pictures (PICFILE VAR p): + INT VAR back :: abs (background (p)), no; + enable stop; + FOR no FROM 1 UPTO pictures (p) + REP to pic (p, no); + read picture (p, pic); + + IF this picture is ok + THEN set pen of pic; + plot (pic) + FI + PER . + +this picture is ok: + pen (pic) <> 0 AND length (pic) > 0 . + +set pen of pic: + INT VAR colour, thick, type; + selected pen (p, pen (pic), colour, thick, type); + set pen (back, colour, thick, type) . + +END PROC plot pictures; + +END PACKET plotter + + diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Server b/system/std.graphik/1.8.7/src/GRAPHIK.Server new file mode 100644 index 0000000..dfe5f62 --- /dev/null +++ b/system/std.graphik/1.8.7/src/GRAPHIK.Server @@ -0,0 +1,97 @@ +PACKET multi user plotter: (* Autor : Rudolf Ruland *) + (* Stand : 24.03.86 *) + (*Änderung: 09.09.86/15:32 *) + +INT VAR c; +put ("gib Plotterkanal : "); get (c); + + server channel (c); + station only (FALSE) ; + spool duty ("Ausgabe mit dem Plotter"); + spool control task (myself); + +LET ack = 0 , + + fetch code = 11 , + param fetch code = 21 , + picfile type = 1103 ; + +INT VAR reply, old heap size, sender station; +TEXT VAR picfile name, userid, password, sendername; +PICFILE VAR picfile ; + +DATASPACE VAR ds, picfile ds; + +BOUND STRUCT (TEXT picfile name, userid, password, sendername, INT station) VAR msg; +BOUND TEXT VAR error msg ; + +spool manager (PROC plotter); + +PROC plotter : + + disable stop ; + command dialogue (FALSE); + ds := nilspace; picfile ds := nilspace; + continue (server channel) ; + check error ("Kanal belegt"); + + old heap size := heap size ; + REP + execute plot ; + + IF is error + THEN put error; + clear error; + FI ; + + IF heap size > old heap size + 4 + THEN collect heap garbage ; + old heap size := heap size + FI + PER + +ENDPROC plotter ; + + +PROC execute plot : + + enable stop ; + forget (picfile ds) ; picfile ds := nilspace ; + call (father, fetch code, picfile ds, reply) ; + IF reply = ack CAND type (picfile ds) = picfile type + THEN get picfile params; + plot picfile + FI ; + +. get picfile params : + forget (ds); ds := nilspace; + call (father, param fetch code, ds, reply); + IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE msg := ds; + picfile name := msg. picfile name; + userid := msg. userid; + password := msg. password; + sendername := msg. sender name; + sender station := msg. station; + FI; + +. plot picfile : + picfile := picfile ds; + plotter (picfile) . + +ENDPROC execute plot ; + + +PROC check error (TEXT CONST message) : + IF is error + THEN clear error; + rename myself (message); + IF is error THEN clear error; end (myself) FI; + pause (18000); + end (myself); + FI; +END PROC check error; + +ENDPACKET multi user plotter ; + diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Transform b/system/std.graphik/1.8.7/src/GRAPHIK.Transform new file mode 100644 index 0000000..54690cc --- /dev/null +++ b/system/std.graphik/1.8.7/src/GRAPHIK.Transform @@ -0,0 +1,366 @@ +PACKET transformation DEFINES transform, (* Autor: Heiko Indenbirken*) + diagonal, (* Stand: 12.04.85 *) + height, width, (*Änderung: 05.08.86/13:14 *) + set values, (*Änderung: 17.09.86/19:57 *) + get values, + new values, + projektion, + window, + viewport, + view, + oblique, + orthographic, + perspective: +(* ******************* Hardwareunabhängiger Teil ********************* *) +(* transform: Die Prozedur projeziert einen 3-dimensionalen Vektor *) +(* ---------- (x, y, z) auf einen 2-dimensionalen (h, v) *) +(* diagonal Die Prozedur berechnet die Pixel als Prozent der *) +(* ---------- Diagonalen der Zeichenfläche *) +(* height Die Prozedur berechnet die Pixel als Prozent der *) +(* ---------- Höhe der Zeichenfläche *) +(* width Die Prozedur berechnet die Pixel als Prozent der *) +(* ---------- Breite der Zeichenfläche *) +(* *) +(* set values: Mit dieser Prozedur werden die Projektionsparameter *) +(* ----------- gesetzt. *) +(* size: Weltkoordinatenbereich *) +(* ((xmin,xmax),(ymin,ymax),(zmin,zmax)) *) +(* limits: Zeichenfläche *) +(* ((h min, h max), (v min, v max)) *) +(* Bei Werten < 2.0 werden die Werte als *) +(* Prozente interpretiert, ansonsten als *) +(* cm-Grössen. *) +(* get values: Übergibt die aktuellen Werte *) +(* ----------- *) +(* new values: Berechnet die neue Projektionsmatrix *) +(* ----------- *) +(*=======================================================================*) + +BOOL VAR perspective projektion :: FALSE; +INT VAR hor pixel, vert pixel, i; +REAL VAR hor cm, vert cm, + h min limit, h max limit, v min limit, v max limit; +ROW 5 ROW 5 REAL VAR p; +ROW 3 ROW 2 REAL VAR size; +ROW 2 ROW 2 REAL VAR limits; +ROW 4 REAL VAR angles; +ROW 2 REAL VAR obliques; +ROW 3 REAL VAR perspectives; + +(* Initialisieren der Projektionsmatrizen *) +INT VAR d; +window (0.0, 1.0, 0.0, 1.0, 0.0, 1.0); +viewport (0.0, 0.0, 0.0, 0.0); +view (0.0, 0.0, 1.0); +view (0.0); +orthographic; +new values (27.46, 19.21, 274, 192, d, d, d, d); + +PROC projektion (ROW 5 ROW 5 REAL VAR matrix): + matrix := p +END PROC projektion; + +PROC oblique (REAL CONST a, b) : + set values (size, limits, angles, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0)) +END PROC oblique; + +PROC orthographic : + set values (size, limits, angles, 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, limits, angles, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy, cz)) +END PROC perspective; + +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, angles, obliques, perspectives) +END PROC window; + +PROC viewport (REAL CONST h min, h max, v min, v max) : + set values (size, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max), + ROW 2 REAL : (v min, v max)), + angles, obliques, perspectives) +END PROC view port; + +PROC view (REAL CONST alpha) : + set values (size, limits, ROW 4 REAL : (alpha, angles(2), angles (3), angles (4)), + obliques, perspectives) +END PROC view; + +PROC view (REAL CONST phi, theta): + set values (size, limits, ROW 4 REAL : (angles (1), sind (theta) * cosd (phi), + sind (theta) * sind (phi), cosd (theta)), + obliques, perspectives) +END PROC view; + +PROC view (REAL CONST x, y, z) : + set values (size, limits, ROW 4 REAL : (angles (1), x, y, z), obliques, perspectives) +END PROC view; + +PROC get values (ROW 3 ROW 2 REAL VAR act size, + ROW 2 ROW 2 REAL VAR act limits, + ROW 4 REAL VAR act angles, + ROW 2 REAL VAR act obliques, + ROW 3 REAL VAR act perspectives) : + act size := size; + act limits := limits; + act angles := angles; + act obliques := obliques; + act perspectives := perspectives; + +END PROC get values; + +PROC set values (ROW 3 ROW 2 REAL CONST new size, + ROW 2 ROW 2 REAL CONST new limits, + ROW 4 REAL CONST new angles, + ROW 2 REAL CONST new obliques, + ROW 3 REAL CONST new perspectives) : + size := new size; + limits := new limits; + angles := new angles; + obliques := new obliques; + perspectives := new perspectives + +END PROC set values; + +PROC new values (INT VAR h min range, h max range, v min range, v max range): + new values (hor cm, vert cm, hor pixel, vert pixel, + h min range, h max range, v min range, v max range) +END PROC new values; + +PROC new values (REAL CONST size hor, size vert, + INT CONST pixel hor, pixel vert, + INT VAR h min range, h max range, + v min range, v max range): + remember screensize; + calc views; + calc projektion; + calc limits; + calc projection frame; + normalize projektion; + set picture range; + set perspective mark . + +remember screensize: + hor cm := size hor; + vert cm := size vert; + hor pixel := pixel hor; + vert pixel := pixel vert . + +calc views : + calc diagonale; + calc projektion; + calc angles; + calc normale; + calc matrix; + calc alpha angle . + +calc diagonale: + REAL VAR diagonale := sqrt (angles [2] * angles [2] + + angles [3] * angles [3] + + angles [4] * angles [4]) . + +calc projektion: + REAL VAR projektion := sqrt (angles [2] * angles [2] + + angles [4] * angles [4]) . + +calc angles: + REAL VAR 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 . + +calc normale: + 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 := obliques [1] , + norm bz := obliques [2] , + norm cx := perspectives [1] / dx, + norm cy := perspectives [2] / dy, + norm cz := perspectives [3] / dz . + +calc matrix: +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)) . + +calc alpha angle: + IF angles (1) = 0.0 + THEN set alpha as y vertical + ELSE sin a := sind (angles (1)); + cos a := cosd (angles (1)) + FI . + +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 . + +calc limits : + IF limits as percent + THEN calc percent limits + ELSE calc centimeter limits FI . + +limits as percent: + limits [1][2] < 2.0 AND limits [2][2] < 2.0 . + +max limits: + h min limit := 0.0; + + v min limit := 0.0; + v max limit := real (pixel vert) . + +calc percent limits: + h min limit := real (pixel hor) * limits (1)(1)*size vert / size hor; + v min limit := limits (2)(1) * real (pixel vert); + + IF limits [1][2] = 0.0 + THEN h max limit := real (pixel hor) + ELSE h max limit := real (pixel hor) * limits [1][2]*size vert / size hor FI; + + IF limits [2][2] = 0.0 + THEN v max limit := real (pixel vert) + ELSE v max limit := limits (2)(2) * real (pixel vert) FI . + +calc centimeter limits: + h min limit := real (pixel hor) * (limits (1)(1)/size hor); + v min limit := real (pixel vert) * (limits (2)(1)/size vert); + + IF limits [1][2] = 0.0 + THEN h max limit := real (pixel hor) + ELSE h max limit := real (pixel hor) * (limits (1)(2)/size hor) FI; + + IF limits [2][2] = 0.0 + THEN v max limit := real (pixel vert) + ELSE v max limit := real (pixel vert) * (limits (2)(2)/size vert) FI . + +calc projection frame: + REAL VAR 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) . + +normalize 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 i FROM 1 UPTO 5 + REP REAL CONST p i 1 := p (i)(1); + p (i)(1) := (p i 1 * cos a - p (i)(2) * sin a) * sh; + p (i)(2) := (p i 1 * sin a + p (i)(2) * cos a) * sv + PER; + p (5)(1) := dh; + p (5)(2) := dv . + +set picture range: + h min range := int (h min limit-0.5); + h max range := int (h max limit+0.5); + v min range := int (v min limit-0.5); + v max range := int (v max limit+0.5) . + +set perspective mark: + perspective projektion := perspectives [3] <> 0.0 . + +END PROC new values; + +PROC transform (REAL CONST x, y, z, INT 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 := 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; +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; + +INT PROC diagonal (REAL CONST percent): + int (percent * 0.01 * diagonale + 0.5) . + +diagonale: + sqrt ((h max limit-h min limit) ** 2 + (v max limit-v min limit) ** 2) . + +END PROC diagonal; + +INT PROC height (REAL CONST percent): + int (percent * 0.01 * (v max limit-v min limit) + 0.5) +END PROC height; + +INT PROC width (REAL CONST percent): + int (percent * 0.01 * (h max limit-h min limit) + 0.5) +END PROC width; + +END PACKET transformation + diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot b/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot new file mode 100644 index 0000000..8bef1e4 --- /dev/null +++ b/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot @@ -0,0 +1,506 @@ +PACKET clipping DEFINES set range, (*Autor: Heiko Indenbirken *) + get range, (*Stand: 27.06.85/12:39 *) + clip: (*Änderung: 11.08.86/15:02 *) + +INT VAR x min :: 0, x max :: 1024, y min :: 0, y max :: 1024; + +PROC set range (INT CONST h min, v min, h max, v max): + IF h min >= h max OR v min >= v max + THEN errorstop ("Incorrect Range") FI; + x min := h min; x max := h max; + y min := v min; y max := v max +END PROC set range; + +PROC get range (INT VAR h min, v min, h max, v max): + h min := x min; h max := x max; + v min := y min; v max := y max +END PROC get range; + +PROC clip (INT CONST from x, from y, to x, to y, + PROC (INT CONST, INT CONST) move, + PROC (INT CONST, INT CONST) draw): + INT VAR x, y; + calculate parts of line; + IF both points inside + THEN draw (to x, to y) + ELIF both points outside + THEN + ELIF first point outside + THEN intersection (to x, to y, from x, from y, from part, x, y); + move (x, y); + draw (x, y); (* Macke im SHARD *) + draw (to x, to y) + ELIF second point outside + THEN intersection (from x, from y, to x, to y, to part, x, y); + draw (x, y) + ELSE intersection (to x, to y, from x, from y, from part, x, y); + move (x, y); + draw (x, y); (* Macke im SHARD *) + clip (x, y, to x, to y, PROC (INT CONST, INT CONST) move, + PROC (INT CONST, INT CONST) draw) + FI . + +calculate parts of line: + INT CONST from part :: part (from x, from y), + to part :: part (to x, to y) . + +both points inside: + from part = 0 AND to part = 0 . + +both points outside: + (from part AND to part) <> 0 . + +first point outside: + from part <> 0 AND to part = 0 . + +second point outside: + to part <> 0 AND from part = 0 . + +END PROC clip; + +INT PROC part (INT CONST x, y): + INT VAR index :: 0; + IF x > x max + THEN set bit (index, 0) + ELIF x < x min + THEN set bit (index, 1) FI; + + IF y > y max + THEN set bit (index, 2) + ELIF y < y min + THEN set bit (index, 3) FI; + + index + +END PROC part; + +PROC intersection (INT CONST from x, from y, to x, to y, to part, INT VAR x, y): + SELECT to part OF + CASE 1: right side + CASE 2: left side + CASE 4: up side + CASE 5: upright side + CASE 6: upleft side + CASE 8: down side + CASE 9: downright side + CASE 10: downleft side + OTHERWISE errorstop ("wrong partno.:" + text (to part)) ENDSELECT . + +right side: + y := from y + int (real (x max-from x)*(dy/dx)); + x := x max . + +left side: + y := from y + int (real (x min-from x)*(dy/dx)); + x := x min . + +up side: + x := from x + int (real (y max-from y)*(dx/dy)); + y := y max . + +down side: + x := from x + int (real (y min-from y)*(dx/dy)); + y := y min . + +upright side: + right side; + IF y > y max + THEN up side FI . + +downright side: + right side; + IF y < y min + THEN down side FI . + +upleft side: + left side; + IF y > y max + THEN up side FI . + +downleft side: + left side; + IF y < y min + THEN down side FI . + +dx: real (to x-from x) . +dy: real (to y-from y) . + +END PROC intersection; + +END PACKET clipping; + +PACKET thick line DEFINES thick: (*Autor: Heiko Indenbirken *) + (*Stand: 02.07.85/15:07 *) + (*Änderung: 05.08.86/15:52 *) +PROC thick (INT CONST x0, y0, x1, y1, thick, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + IF is point + THEN draw point + ELIF is horizontal line + THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + x0, y0, x1, y1, thick) + ELSE vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + x0, y0, x1, y1, thick) + FI . + +is point: + x0 = x1 AND y0 = y1 . + +is horizontal line: + abs (x0-x1) >= abs (y0-y1) . + +draw point: + INT VAR i; + FOR i FROM -thick UPTO thick + REP line (x0-thick, y0+i, x0+thick, y0+i) PER . + +END PROC thick; + +PROC horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + INT CONST from x, from y, to x, to y, thick): + IF from x > to x + THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + to x, to y, from x, from y, thick) + ELSE draw line FI . + +draw line: + INT VAR i; + calculate increase; + calculate limit points; + FOR i FROM -thick UPTO thick + REP calculate delta x; + line (x start+delta x, y start+i, x end+delta x, y end+i) + PER . + +calculate increase: + REAL VAR increase :: -dy / dx . + +calculate limit points: + INT CONST x start :: from x - thick, + x end :: to x + thick, + y start :: from y + int (increase * real (thick)), + y end :: to y - int (increase * real (thick)) . + +calculate delta x: + INT CONST delta x :: int (increase*real (i)) . + +dx: real (to x-from x) . +dy: real (to y-from y) . + +END PROC horizontal line; + +PROC vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + INT CONST from x, from y, to x, to y, thick): + IF from y > to y + THEN vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + to x, to y, from x, from y, thick) + ELSE draw line FI . + +draw line: + INT VAR i; + calculate increase; + calculate limit points; + FOR i FROM -thick UPTO thick + REP calculate delta y; + line (x start+i, y start+delta y, x end+i, y end+delta y) + PER . + +calculate increase: + REAL VAR increase :: -dx / dy . + +calculate limit points: + INT CONST x start :: from x + int (increase * real (thick)), + x end :: to x - int (increase * real (thick)), + y start :: from y - thick, + y end :: to y + thick . + +calculate delta y: + INT CONST delta y :: int (increase*real (i)) . + +dx: real (to x-from x) . +dy: real (to y-from y) . + +END PROC vertical line; + +END PACKET thick line; + +PACKET graphik text DEFINES draw char, (*Autor: Heiko Indenbirken *) + zeichensatz: (*Stand: 27.06.85/16:03 *) + (*Änderung: 28.06.85/19:06 *) + (*Änderung: 05.08.86/16:00 *) +LET ZEICHENSATZ = ROW 255 TEXT; +ZEICHENSATZ VAR zeichen; +INT CONST char x :: 6, char y :: 10; + +zeichensatz ("ZEICHENSATZ"); + +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 draw char (INT CONST char no, INT CONST x, y, x size, y size, direction, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + TEXT CONST character :: zeichen [char no]; + INT VAR n :: 1, x0, y0, x1, y1; + INT CONST len :: length (character); + WHILE n < len + REP value (character, n, x0, y0, x1, y1); + transform (x0, y0, x, y, x size, y size, direction); + transform (x1, y1, x, y, x size, y size, direction); + line (x0, y0, x1, y1); + 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 (INT VAR x, y, INT CONST x0, y0, x size, y size, direction): + INT CONST old x :: x, old y :: y; + SELECT direction OF + CASE 0: x := x0 + x vektor; y := y0 + y vektor + CASE 1: x := x0 - y vektor; y := y0 + x vektor + CASE 2: x := x0 - x vektor; y := y0 - y vektor + CASE 3: x := x0 + y vektor; y := y0 - x vektor + ENDSELECT . + +x vektor: + IF x size = 0 + THEN old x + ELSE (old x*x size) DIV char x FI . + +y vektor: + IF y size = 0 + THEN old y + ELSE (old y*y size) DIV char y FI . + +END PROC transform; + +END PACKET graphik text; + +PACKET graphik text DEFINES draw text: (*Autor: Heiko Indenbirken *) + (*Stand: 03.07.85/11:55 *) + (*Änderung: 05.08.86/16:04 *) +PROC draw text (INT CONST x pos, y pos, + TEXT CONST msg, REAL CONST angle, INT CONST height, width, + PROC (INT CONST, INT CONST, + INT CONST, INT CONST, INT CONST, INT CONST) draw char): + INT CONST dir :: int (((angle MOD 360.0)+45.0) / 90.0); + INT VAR i; + REAL VAR x :: real (x pos), y :: real (y pos), + x step :: cosd (angle)*real (width), + y step :: sind (angle)*real (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 := real (x pos); + y := real (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 := real (x pos) . + +execute normal char: + draw char (code (akt char), dir, int (x+0.5), int (y+0.5), height, width); + x INCR x step; + y INCR y step . + +akt char: + msg SUB i . + +END PROC draw text; + +END PACKET graphik text; + +PACKET comercial plot DEFINES bar, (*Autor: Heiko Indenbirken *) + circle: (*Stand: 03.04.1985 *) + (*Änderung: 03.07.85/15:37 *) +PROC bar (INT CONST from x, from y, to x, to y, pattern, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + IF from x > to x + THEN bar (to x, from y, from x, to y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + ELIF from y > to y + THEN bar (from x, to y, to x, from y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + ELSE draw frame; + fill frame with pattern + FI . + +draw frame: + line (from x, from y, from x, to y); + line (from x, to y, to x, to y); + line (to x, to y, to x, from y); + line (to x, from y, from x, from y) . + +fill frame with pattern: + SELECT pattern OF + CASE 1: fill right (from x, to x, from y, to y, 2, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 2: fill hor (from x, to x, from y, to y, 1, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 3: fill hor (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 4: fill vert (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 5: fill hor (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line); + fill vert (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 6: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 7: fill left (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 8: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line); + fill left (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + ENDSELECT . + +END PROC bar; + +PROC fill hor (INT CONST from x, to x, from y, to y, step, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + INT VAR y :: from y; + REP line (from x, y, to x, y); + y INCR step + UNTIL y > to y PER . + +END PROC fill hor; + +PROC fill vert (INT CONST from x, to x, from y, to y, step, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + INT VAR x :: from x; + REP line (x, from y, x, to y); + x INCR step + UNTIL x > to x PER . + +END PROC fill vert; + +PROC fill right (INT CONST from x, to x, from y, to y, step, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + INT CONST width :: to x - from x, + height :: to y - from y, + length :: width + height, + height step :: height + step, + width step :: width + step; + + INT VAR t :: step, left :: from x, right :: from x, + lower :: from y, upper :: from y; +(* Ausfüllen von links unten nach rechts oben *) + WHILE t < length + REP calc start point; + calc end point; + line (left, upper, right, lower); + t INCR step + PER . + +calc start point: + IF t < height + THEN upper INCR step + ELIF t < height step + THEN left := from x + t - height; + upper := to y + ELSE left INCR step FI . + +calc end point: + IF t < width + THEN right INCR step + ELIF t < width step + THEN lower := from y + t - width; + right := to x + ELSE lower INCR step FI . + +END PROC fill right; + +PROC fill left (INT CONST from x, to x, from y, to y, step, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + INT CONST width :: to x - from x, + height :: to y - from y, + length :: width + height, + height step :: height + step, + width step :: width + step; + + INT VAR t :: step, left :: to x, right :: to x, + lower :: from y, upper :: from y; +(* Ausfüllen von rechts unten nach links oben *) + WHILE t < length + REP calc start point; + calc end point; + line (right, upper, left, lower); + t INCR step + PER . + +calc start point: + IF t < height + THEN upper INCR step + ELIF t < height step + THEN right := to x - t + height; + upper := to y + ELSE right DECR step FI . + +calc end point: + IF t < width + THEN left DECR step + ELIF t < width step + THEN lower := from y + t - width; + left := from x + ELSE lower INCR step FI . + +END PROC fill left; + +PROC circle (INT CONST x, y, REAL CONST rad, from, to, INT CONST pattern, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + REAL VAR t :: from; + INT VAR last x :: x, last y :: y; + WHILE t <= to + REP calc circle; + draw step; + t INCR 1.0 + PER; + line (x rad, y rad, x, y) . + +draw step: + IF pattern = 0 + THEN line (last x, last y, x rad, y rad); + last x := x rad; + last y := y rad + ELSE line (x, y, x rad, y rad) FI . + +calc circle: + INT CONST x rad :: int (cosd (t)*rad+0.5)+x, + y rad :: int (sind (t)*rad+0.5)+y . + +END PROC circle; + +END PACKET comercial plot; + diff --git a/system/std.graphik/1.8.7/src/HP7475.plot b/system/std.graphik/1.8.7/src/HP7475.plot new file mode 100644 index 0000000..860dd03 --- /dev/null +++ b/system/std.graphik/1.8.7/src/HP7475.plot @@ -0,0 +1,254 @@ +PACKET hp7475 plot DEFINES set range, (*Autor: Heiko Indenbirken *) + get range, (*Stand: 03.09.86/15:09 *) + drawing area, + begin plot, + end plot, + clear, + + set pen, get pen, + move, + draw, + marker, + bar, circle, + where: + +(* *) +(* Hardware Anschluß des HP7475A: *) +(* 9600 Baud, 8 Bit, no parity, RTS/CTS *) +(* Leitungen 1 ----- 1 *) +(* gekreuzt: 2 --x-- 3 *) +(* 3 --x-- 2 *) +(* *) + + +LET POS = STRUCT (INT x, y); +LET RANGE = STRUCT (POS min, max); +LET PEN = STRUCT (INT back, fore, thick, line); + +LET width scale = 0.002690217391304, + height scale = 0.002728921124206; + +LET term = ";", + comma = ",", + point = ".", + zero = "0", + nil = "", + etx = ""3""; + + +POS VAR old :: POS:(0, 0); +RANGE VAR area :: RANGE:(POS:(0,0), POS:(11040, 7721)); +PEN VAR pen :: PEN : (0, 1, 0, 1); +TEXT VAR result; + +ROW 16 TEXT VAR mark := ROW 16 TEXT: +("99,0,2,-2,0,0,-4,4,0,0,4,-2,0;", +"99,0,2,-1,0,-1,-1,0,-2,1,-1,2,0,1,1,0,2,-1,1,-1,0;", +"99,0,2,-2,-3,4,0,-2,3;", +"-99,-2,0,99,4,0,-99,-2,2,99,0,-4;", +"-99,-2,-2,99,4,4,-99,-4,0,99,4,-4;", +"99,0,2,-2,-2,2,-2,2,2,-2,2;", +"-99,0,-2,99,0,4,-2,-2,4,0,-2,2;", +"-99,-2,0,99,4,0,-99,-2,2,99,0,-4,2,2,-2,2,-2,-2,2,-2;", +"-99,-2,-2,99,4,4,-4,0,4,-4;", +"-99,-2,2,99,4,0,-4,-4,4,0;", +"99,0,-2,-99,-2,4,99,2,-2,2,2;", +"99,1,1,-2,0,0,-2,2,0,0,2,1,1,-99,-4,0,99,1,-1,-99,0,-2,99,-1,-1,-99,4,0,99,-1,1;", +"-99,-2,0,99,4,0,-99,-1,1,99,-2,-2,-99,1,-1,99,0,4,-99,-1,-1,99,2,-2;", +"-99,-2,2,99,4,0,-4,-4,4,0,-4,4;", +"-99,-2,0,99,4,0;", +"-99,0,299,0,-4;"); + +ROW 5 TEXT CONST line pattern := ROW 5 TEXT:("LT;", "LT1;", "LT2;", "LT3;", "LT4;"); +ROW 8 TEXT CONST fill pattern := ROW 8 TEXT:("FT4,25,45;", "FT1,0,0;", "FT3,50,0;", + "FT3,50,90;", "FT4,50,0;", "FT3,50,-45;", + "FT3,50,45;", "FT4,50,45;"); + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 29.7; y cm := 21.07; + x pixel := 11040; y pixel := 7721; +END PROC drawing area; + + +PROC set range (INT CONST h min, v min, h max, v max): + IF h min >= h max OR v min >= v max + THEN errorstop ("Incorrect Range") FI; + area := RANGE:(POS:(h min, v min), POS:(h max, v max)) +END PROC set range; + +PROC get range (INT VAR h min, v min, h max, v max): + h min := area.min.x; v min := area.min.y; + h max := area.max.x; v max := area.max.y +END PROC get range; + +PROC begin plot: + out ("IN;") +ENDPROC begin plot; + +PROC end plot: + TEXT VAR rec; + out ("IN;SP;PA22040,7721;DP;"); + REP pause (10); + out ("OS;"); + input (rec, ""13"", 600) + UNTIL enter pressed PER; + out ("IN;") . + +enter pressed: + (int (rec) AND 4) > 0 . + +ENDPROC end plot; + +PROC clear: + new values (29.7, 21.07, 11040, 7721, area.min.x, area.max.x, area.min.y, area.max.y); + pen := PEN : (0, 1, 0, 1); + old := area.min; + out ("DF;IP;"); (* Default *) + out ("IW" + text (area.min.x, area.min.y) + ", " + (* Clipping *) + text (area.max.x, area.max.y) + term); + out ("SP1;"); (* Pen 1 *) + out ("LT;"); (* durchgehend *) + out ("PU;PA" + text (old.x, old.y)); (* Startpunkt *) + +END PROC clear; + +PROC set pen (INT CONST back, fore, thick, type): + set colour; + set linetype . + +set colour: + IF abs (fore) >= 1 AND abs (fore) <= 6 + THEN out ("SP" + text (abs (fore)) + term); + pen.fore := abs (fore); + FI . + +set linetype: + IF type >= 1 AND type <= 5 + THEN out (line pattern [type]); + pen.line := type + ELSE out ("SP;"); + pen.line := 0 + FI . + +END PROC set pen; + +PROC get pen (INT VAR back, fore, thick, line): + back := pen.back; + fore := pen.fore; + thick := pen.thick; + line := pen.line +END PROC get pen; + +PROC move (INT CONST x, y) : + out ("PU;PA" + text (x, y) + term); + old := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y): + out ("PD;PA" + text (x, y) + term); + old := POS : (x, y) +END PROC draw; + +PROC draw (TEXT CONST msg, REAL CONST angle, INT CONST height, width): + set angle; + set height and width; + plot msg . + +set angle: + out ("DI " + text (cosd (angle), sind (angle)) + term) . + +set height and width: + IF width = 0 AND height = 0 + THEN out ("SR;") + ELSE out ("SI" + text (real (width) * width scale, + real (height) * height scale) + term) + FI . + +plot msg: + out ("LB" + msg + etx) . + +END PROC draw; + +PROC bar (INT CONST from x, from y, to x, to y, pattern): + out ("PU;PA" + text (from x, from y) + term); + out ("LT;EA" + text (to x, to y) + term); + IF pattern > 0 AND pattern <= 8 + THEN out (fill pattern [pattern]); + out ("RA" + text (to x, to y) + term); + FI; + out ("PU;PA" + text (old.x, old.y) + term); + out (line pattern [pen.line]) . + +END PROC bar; + +PROC circle (INT CONST x, y, rad, REAL CONST from, to, INT CONST pattern): + out ("LT;PU;PA" + text (x, y) + term); + IF (from MOD 360.0) = 0.0 AND (to MOD 360.0) = 0.0 + THEN out ("CI" + text (rad) + term) + ELSE out ("EW" + text (rad) + comma + text (from, to-from) + term) FI; + + IF pattern > 0 AND pattern <= 6 + THEN out (fill pattern [pattern]); + out ("WG" + text (rad) + comma + text (from, to-from) + term) + FI; + out ("PU;PA" + text (old.x, old.y) + term); + out (line pattern [pen.line]) . + +END PROC circle; + +PROC marker (INT CONST x, y, no, size): + out ("LT;PU;PA" + text (x, y) + term); + out ("DI1,0;"); + IF size = 0 + THEN out ("SI0.25,0.5;") + ELSE out ("SI" + text (real (size)*0.001, real (size)*0.002) + term) FI; + out ("UC" + mark [mark no]); + out ("PU;PA" + text (old.x, old.y) + term); + out (line pattern [pen.line]) . + +mark no: + IF no >= 1 AND no <= 16 + THEN no + ELSE 1 FI . + +END PROC marker; + +PROC where (INT VAR x, y): + x := old.x; y := old.y +END PROC where; + +TEXT PROC text (INT CONST x, y): + text (x) + comma + text (y) +END PROC text; + +TEXT PROC text (REAL CONST x, y): + text (x) + comma + text (y) +END PROC text; + +TEXT PROC text (REAL CONST x): + result := compress (text (x, 9, 4)); + + IF (result SUB 1) = point + THEN insert char (result, zero, 1) + ELIF (result SUB LENGTH result) = point + THEN result CAT zero FI; + result +END PROC text; + +PROC input (TEXT VAR rec, TEXT CONST del, INT CONST time): + enable stop; + rec := nil; + REP TEXT CONST char := incharety (time); + + IF char = nil + THEN errorstop ("Timeout after " + text (time)) + ELIF pos (del, char) > 0 + THEN LEAVE input + ELSE rec CAT char FI + + PER . + +END PROC input; + +END PACKET hp7475 plot + diff --git a/system/std.graphik/1.8.7/src/PC.plot b/system/std.graphik/1.8.7/src/PC.plot new file mode 100644 index 0000000..712f5ea --- /dev/null +++ b/system/std.graphik/1.8.7/src/PC.plot @@ -0,0 +1,758 @@ +PACKET clipping DEFINES set range, (*Autor: Heiko Indenbirken *) + get range, (*Stand: 27.06.85/12:39 *) + clip: (*Änderung: 11.08.86/15:02 *) + +INT VAR x min :: 0, x max :: 1024, y min :: 0, y max :: 1024; + +PROC set range (INT CONST h min, v min, h max, v max): + IF h min >= h max OR v min >= v max + THEN errorstop ("Incorrect Range") FI; + x min := h min; x max := h max; + y min := v min; y max := v max +END PROC set range; + +PROC get range (INT VAR h min, v min, h max, v max): + h min := x min; h max := x max; + v min := y min; v max := y max +END PROC get range; + +PROC clip (INT CONST from x, from y, to x, to y, + PROC (INT CONST, INT CONST) move, + PROC (INT CONST, INT CONST) draw): + INT VAR x, y; + calculate parts of line; + IF both points inside + THEN draw (from x, from y); (* Macke im SHARD *) + draw (to x, to y) + ELIF both points outside + THEN + ELIF first point outside + THEN intersection (to x, to y, from x, from y, from part, x, y); + move (x, y); + draw (x, y); (* Macke im SHARD *) + draw (to x, to y) + ELIF second point outside + THEN intersection (from x, from y, to x, to y, to part, x, y); + draw (x, y) + ELSE intersection (to x, to y, from x, from y, from part, x, y); + move (x, y); + draw (x, y); (* Macke im SHARD *) + clip (x, y, to x, to y, PROC (INT CONST, INT CONST) move, + PROC (INT CONST, INT CONST) draw) + FI . + +calculate parts of line: + INT CONST from part :: part (from x, from y), + to part :: part (to x, to y) . + +both points inside: + from part = 0 AND to part = 0 . + +both points outside: + (from part AND to part) <> 0 . + +first point outside: + from part <> 0 AND to part = 0 . + +second point outside: + to part <> 0 AND from part = 0 . + +END PROC clip; + +INT PROC part (INT CONST x, y): + INT VAR index :: 0; + IF x > x max + THEN set bit (index, 0) + ELIF x < x min + THEN set bit (index, 1) FI; + + IF y > y max + THEN set bit (index, 2) + ELIF y < y min + THEN set bit (index, 3) FI; + + index + +END PROC part; + +PROC intersection (INT CONST from x, from y, to x, to y, to part, INT VAR x, y): + SELECT to part OF + CASE 1: right side + CASE 2: left side + CASE 4: up side + CASE 5: upright side + CASE 6: upleft side + CASE 8: down side + CASE 9: downright side + CASE 10: downleft side + OTHERWISE errorstop ("wrong partno.:" + text (to part)) ENDSELECT . + +right side: + y := from y + int (real (x max-from x)*(dy/dx)); + x := x max . + +left side: + y := from y + int (real (x min-from x)*(dy/dx)); + x := x min . + +up side: + x := from x + int (real (y max-from y)*(dx/dy)); + y := y max . + +down side: + x := from x + int (real (y min-from y)*(dx/dy)); + y := y min . + +upright side: + right side; + IF y > y max + THEN up side FI . + +downright side: + right side; + IF y < y min + THEN down side FI . + +upleft side: + left side; + IF y > y max + THEN up side FI . + +downleft side: + left side; + IF y < y min + THEN down side FI . + +dx: real (to x-from x) . +dy: real (to y-from y) . + +END PROC intersection; + +END PACKET clipping; + +PACKET thick line DEFINES thick: (*Autor: Heiko Indenbirken *) + (*Stand: 02.07.85/15:07 *) + (*Änderung: 05.08.86/15:52 *) +PROC thick (INT CONST x0, y0, x1, y1, thick, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + IF is point + THEN draw point + ELIF is horizontal line + THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + x0, y0, x1, y1, thick) + ELSE vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + x0, y0, x1, y1, thick) + FI . + +is point: + x0 = x1 AND y0 = y1 . + +is horizontal line: + abs (x0-x1) >= abs (y0-y1) . + +draw point: + INT VAR i; + FOR i FROM -thick UPTO thick + REP line (x0-thick, y0+i, x0+thick, y0+i) PER . + +END PROC thick; + +PROC horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + INT CONST from x, from y, to x, to y, thick): + IF from x > to x + THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + to x, to y, from x, from y, thick) + ELSE draw line FI . + +draw line: + INT VAR i; + calculate increase; + calculate limit points; + FOR i FROM -thick UPTO thick + REP calculate delta x; + line (x start+delta x, y start+i, x end+delta x, y end+i) + PER . + +calculate increase: + REAL VAR increase :: -dy / dx . + +calculate limit points: + INT CONST x start :: from x - thick, + x end :: to x + thick, + y start :: from y + int (increase * real (thick)), + y end :: to y - int (increase * real (thick)) . + +calculate delta x: + INT CONST delta x :: int (increase*real (i)) . + +dx: real (to x-from x) . +dy: real (to y-from y) . + +END PROC horizontal line; + +PROC vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + INT CONST from x, from y, to x, to y, thick): + IF from y > to y + THEN vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, + to x, to y, from x, from y, thick) + ELSE draw line FI . + +draw line: + INT VAR i; + calculate increase; + calculate limit points; + FOR i FROM -thick UPTO thick + REP calculate delta y; + line (x start+i, y start+delta y, x end+i, y end+delta y) + PER . + +calculate increase: + REAL VAR increase :: -dx / dy . + +calculate limit points: + INT CONST x start :: from x + int (increase * real (thick)), + x end :: to x - int (increase * real (thick)), + y start :: from y - thick, + y end :: to y + thick . + +calculate delta y: + INT CONST delta y :: int (increase*real (i)) . + +dx: real (to x-from x) . +dy: real (to y-from y) . + +END PROC vertical line; + +END PACKET thick line; + +PACKET graphik text DEFINES draw char, (*Autor: Heiko Indenbirken *) + zeichensatz: (*Stand: 27.06.85/16:03 *) + (*Änderung: 28.06.85/19:06 *) + (*Änderung: 05.08.86/16:00 *) +LET ZEICHENSATZ = ROW 255 TEXT; +ZEICHENSATZ VAR zeichen; +INT CONST char x :: 6, char y :: 10; + +zeichensatz ("ZEICHENSATZ"); + +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 draw char (INT CONST char no, INT CONST x, y, x size, y size, direction, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + TEXT CONST character :: zeichen [char no]; + INT VAR n :: 1, x0, y0, x1, y1; + INT CONST len :: length (character); + WHILE n < len + REP value (character, n, x0, y0, x1, y1); + transform (x0, y0, x, y, x size, y size, direction); + transform (x1, y1, x, y, x size, y size, direction); + line (x0, y0, x1, y1); + 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 (INT VAR x, y, INT CONST x0, y0, x size, y size, direction): + INT CONST old x :: x, old y :: y; + SELECT direction OF + CASE 0: x := x0 + x vektor; y := y0 + y vektor + CASE 1: x := x0 - y vektor; y := y0 + x vektor + CASE 2: x := x0 - x vektor; y := y0 - y vektor + CASE 3: x := x0 + y vektor; y := y0 - x vektor + ENDSELECT . + +x vektor: + IF x size = 0 + THEN old x + ELSE (old x*x size) DIV char x FI . + +y vektor: + IF y size = 0 + THEN old y + ELSE (old y*y size) DIV char y FI . + +END PROC transform; + +END PACKET graphik text; + +PACKET graphik text DEFINES draw text: (*Autor: Heiko Indenbirken *) + (*Stand: 03.07.85/11:55 *) + (*Änderung: 05.08.86/16:04 *) +PROC draw text (INT CONST x pos, y pos, + TEXT CONST msg, REAL CONST angle, INT CONST height, width, + PROC (INT CONST, INT CONST, + INT CONST, INT CONST, INT CONST, INT CONST) draw char): + INT CONST dir :: int (((angle MOD 360.0)+45.0) / 90.0); + INT VAR i; + REAL VAR x :: real (x pos), y :: real (y pos), + x step :: cosd (angle)*real (width), + y step :: sind (angle)*real (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 := real (x pos); + y := real (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 := real (x pos) . + +execute normal char: + draw char (code (akt char), dir, int (x+0.5), int (y+0.5), height, width); + x INCR x step; + y INCR y step . + +akt char: + msg SUB i . + +END PROC draw text; + +END PACKET graphik text; + +PACKET comercial plot DEFINES bar, (*Autor: Heiko Indenbirken *) + circle: (*Stand: 03.04.1985 *) + (*Änderung: 03.07.85/15:37 *) +PROC bar (INT CONST from x, from y, to x, to y, pattern, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + IF from x > to x + THEN bar (to x, from y, from x, to y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + ELIF from y > to y + THEN bar (from x, to y, to x, from y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + ELSE draw frame; + fill frame with pattern + FI . + +draw frame: + line (from x, from y, from x, to y); + line (from x, to y, to x, to y); + line (to x, to y, to x, from y); + line (to x, from y, from x, from y) . + +fill frame with pattern: + SELECT pattern OF + CASE 1: fill right (from x, to x, from y, to y, 2, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 2: fill hor (from x, to x, from y, to y, 1, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 3: fill hor (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 4: fill vert (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 5: fill hor (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line); + fill vert (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 6: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 7: fill left (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + CASE 8: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line); + fill left (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line) + ENDSELECT . + +END PROC bar; + +PROC fill hor (INT CONST from x, to x, from y, to y, step, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + INT VAR y :: from y; + REP line (from x, y, to x, y); + y INCR step + UNTIL y > to y PER . + +END PROC fill hor; + +PROC fill vert (INT CONST from x, to x, from y, to y, step, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + INT VAR x :: from x; + REP line (x, from y, x, to y); + x INCR step + UNTIL x > to x PER . + +END PROC fill vert; + +PROC fill right (INT CONST from x, to x, from y, to y, step, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + INT CONST width :: to x - from x, + height :: to y - from y, + length :: width + height, + height step :: height + step, + width step :: width + step; + + INT VAR t :: step, left :: from x, right :: from x, + lower :: from y, upper :: from y; +(* Ausfüllen von links unten nach rechts oben *) + WHILE t < length + REP calc start point; + calc end point; + line (left, upper, right, lower); + t INCR step + PER . + +calc start point: + IF t < height + THEN upper INCR step + ELIF t < height step + THEN left := from x + t - height; + upper := to y + ELSE left INCR step FI . + +calc end point: + IF t < width + THEN right INCR step + ELIF t < width step + THEN lower := from y + t - width; + right := to x + ELSE lower INCR step FI . + +END PROC fill right; + +PROC fill left (INT CONST from x, to x, from y, to y, step, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + INT CONST width :: to x - from x, + height :: to y - from y, + length :: width + height, + height step :: height + step, + width step :: width + step; + + INT VAR t :: step, left :: to x, right :: to x, + lower :: from y, upper :: from y; +(* Ausfüllen von rechts unten nach links oben *) + WHILE t < length + REP calc start point; + calc end point; + line (right, upper, left, lower); + t INCR step + PER . + +calc start point: + IF t < height + THEN upper INCR step + ELIF t < height step + THEN right := to x - t + height; + upper := to y + ELSE right DECR step FI . + +calc end point: + IF t < width + THEN left DECR step + ELIF t < width step + THEN lower := from y + t - width; + left := from x + ELSE lower INCR step FI . + +END PROC fill left; + +PROC circle (INT CONST x, y, rad, REAL CONST from, to, INT CONST pattern, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) line): + REAL VAR t :: from; + INT VAR last x :: x, last y :: y; + WHILE t <= to + REP calc circle; + draw step; + t INCR 5.0 + PER; + line (x rad, y rad, x, y) . + +draw step: + IF pattern = 0 + THEN line (last x, last y, x rad, y rad); + last x := x rad; + last y := y rad + ELSE line (x, y, x rad, y rad) FI . + +calc circle: + INT CONST x rad :: int (cosd (t)*real (rad)+0.5)+x, + y rad :: int (sind (t)*real (rad)+0.5)+y . + +END PROC circle; + +END PACKET comercial plot; + +PACKET pc plot DEFINES drawing area, (*Autor: Heiko Indenbirken *) + begin plot, (*Stand: 20.05.85 *) + end plot, (*Änderung: 27.06.85/16:17 *) + clear, (*Änderung: 03.07.85/15:59 *) + (*Änderung: 06.08.86/10:03 *) + graphik, + set pen, get pen, + + move, + draw, + draw line, + marker, + bar, circle, + where: + + +LET POS = STRUCT (INT x, y); +LET PEN = STRUCT (INT back, fore, thick, line); +INT CONST back code :: -4, + modus code :: -5, + draw code :: -6, + move code :: -7, + pen code :: -8, + full line :: -1; + +INT VAR d, y, pause time :: 10, + resolution :: 4, max x :: 319, max y :: 199; +BOOL VAR is clear := FALSE; +POS VAR old :: POS : (0, 0); +PEN VAR pen :: PEN : (0, 1, 0, full line); + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 22.0; y cm := 13.7; + x pixel := max x; y pixel := max y; +END PROC drawing area; + +PROC graphik (INT CONST modus, pause): + pause time := pause; + SELECT modus OF + CASE 0: resolution := 3; + CASE 1: resolution := 72; + max x := 639; + max y := 399 + CASE 2: resolution := 64; + max x := 639; + max y := 399 + CASE 3: resolution := 6; + max x := 639; + max y := 199 + CASE 4: resolution := 4; + max x := 319; + max y := 199 + OTHERWISE errorstop ("Nur Modi 0-4") ENDSELECT; + + set range (0, 0, max x, max y); +END PROC graphik; + +PROC begin plot : + control (modus code, resolution, 0, d); + is clear := TRUE; +ENDPROC begin plot ; + +PROC end plot : + IF pause time > 0 + THEN indicate end plot FI; + control (modus code, 3, 0, d) . + +indicate end plot: + control (pen code, full line, full line, d); + REP set indicator; + UNTIL incharety (pause time) <> "" PER . + +set indicator: + control (move code, 0, max y, d); + control (draw code, max x, max y, d) . + +ENDPROC end plot ; + +PROC clear: + INT VAR x0, x1, y0, y1; + new values (22.0, 13.7, max x, max y, x0, x1, y0, y1); + set range (x0, y0, x1, y1); + clear screen; + clear pen; + clear pos; + is clear := FALSE . + +clear screen: + IF is clear OR full screen + THEN control (modus code, resolution, 0, d) + ELSE draw frame; + clear frame + FI . + +full screen: + x0 < 10 AND x1 > (max x-10) AND + y0 < 10 AND y1 > (max y-10) . + +draw frame: + control (move code, x0, y0, d); + control (draw code, x1, y0, d); + control (draw code, x1, y1, d); + control (draw code, x0, y1, d); + control (draw code, x0, y0, d) . + +clear frame: + control (pen code, full line, 0, d); + FOR y FROM max y-y1 UPTO max y-y0 + REP control (move code, x0, y, d); + control (draw code, x1, y, d); + PER . + +clear pen: + pen := PEN : (0, 1, 0, full line); + control (pen code, full line, 1, d) . + +clear pos: + old := POS : (x0, y0); + control (move code, x0, max y-y0, d) . + +END PROC clear; + +PROC set pen (INT CONST back, fore, thick, type): + set background; + set foreground and linetype; + set thickness . + +set background: + pen.back := back; (*Hintergrund über niederwertiges *) + control (back code, 0, back no, d) .(*Byte von colour code *) + (*Höherwetiges Byte regelt die *) +back no: (*Farbpalette *) + IF back = 0 + THEN std background + ELSE back FI . + +std background: + IF resolution = 4 + THEN 16 + ELSE 15 FI . + +set foreground and linetype: (*0, 1, 2, 3 Farben: löschend,*) + pen.fore := possible colour; (*ändernd oder überschreibend *) + pen.line := type; (* in allen Linientypen. *) + control (pen code, line (type), pen.fore, d) . + +possible colour: + IF fore <= full line + THEN full line + ELIF fore > 3 OR (fore > 1 AND resolution <> 4) + THEN 1 + ELSE fore FI . + +set thickness: + pen.thick := thick DIV 10 . + +END PROC set pen; + +PROC get pen (INT VAR back, fore, thick, line): + back := pen.back; + fore := pen.fore; + thick := pen.thick; + line := pen.line +END PROC get pen; + +INT PROC line (INT CONST type): + SELECT type OF + CASE 0: 0 + CASE 1: full line + CASE 2: 21845 + CASE 3: 3855 + CASE 4: 255 + CASE 5: 4351 + OTHERWISE type END SELECT +END PROC line; + +PROC int move (INT CONST x, y): + control (move code, x, max y-y, d); +END PROC int move; + +PROC int draw (INT CONST x, y): + control (draw code, x, max y-y, d); +END PROC int draw; + +PROC draw line (INT CONST from x, from y, to x, to y): + control (move code, from x, max y-from y, d); + clip (from x, from y, to x, to y, PROC int move, PROC int draw) +END PROC draw line; + +PROC move (INT CONST x, y) : + control (move code, x, max y-y, d); + old := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y): + IF std thickness + THEN clip (old.x, old.y, x, y, PROC int move, PROC int draw) + ELSE thick (old.x, old.y, x, y, pen.thick, PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line) FI; + old := POS : (x, y) . + +std thickness: pen.thick = 0 . +END PROC draw; + +PROC draw (TEXT CONST msg, REAL CONST angle, INT CONST height, width): + control (pen code, full line, pen.fore, d); + draw text (old.x, old.y, msg, angle, y size, x size, + PROC (INT CONST, INT CONST, INT CONST, INT CONST, INT CONST, INT CONST) draw char); + control (move code, old.x, max y-old.y, d); + control (pen code, line (pen.line), pen.fore, d) . + +x size: IF width = 0 + THEN 6 + ELSE width FI . +y size: IF height = 0 + THEN 10 + ELSE height FI . + +END PROC draw; + +PROC draw char (INT CONST char, direction, x, y, INT CONST height, width): + draw char (char, x, y, width, height, direction, + PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line) +END PROC draw char; + +PROC bar (INT CONST from x, from y, to x, to y, pattern): + control (pen code, full line, pen.fore, d); + bar (from x, from y, to x, to y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line); + control (move code, old.x, max y-old.y, d); + control (pen code, line (pen.line), pen.fore, d) . +END PROC bar; + +PROC circle (INT CONST x, y, rad, REAL CONST from, to, INT CONST pattern): + control (pen code, full line, pen.fore, d); + circle (x, y, rad, from, to, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line); + control (move code, old.x, max y-old.y, d); + control (pen code, line (pen.line), pen.fore, d) . +END PROC circle; + +PROC marker (INT CONST x, y, no, size): + control (pen code, full line, pen.fore, d); + draw char (no, 0, x, y, size, size); + control (move code, old.x, max y-old.y, d); + control (pen code, line (pen.line), pen.fore, d) . +END PROC marker; + +PROC where (INT VAR x, y): + x := old.x; y := old.y +END PROC where; + +END PACKET pc plot + diff --git a/system/std.graphik/1.8.7/src/ZEICHENSATZ b/system/std.graphik/1.8.7/src/ZEICHENSATZ new file mode 100644 index 0000000..9866ec2 Binary files /dev/null and b/system/std.graphik/1.8.7/src/ZEICHENSATZ differ diff --git a/system/std.graphik/1.8.7/src/gen Graphik b/system/std.graphik/1.8.7/src/gen Graphik new file mode 100644 index 0000000..f70cc66 --- /dev/null +++ b/system/std.graphik/1.8.7/src/gen Graphik @@ -0,0 +1,16 @@ +TEXT VAR geraet; +page; +out ("Bitte den Namen der Hardwareanpassung (z.B. 'PC.plot') eingeben: "); +get line (geraet); +IF NOT exists (geraet) +THEN errorstop ("Endgerät nicht vorhanden") FI; + +insert ("GRAPHIK.Picfile"); +insert ("GRAPHIK.Transform"); +insert (geraet); +insert ("GRAPHIK.Plot"); + + + + + diff --git a/system/std.graphik/1.8.7/src/gen Plotter b/system/std.graphik/1.8.7/src/gen Plotter new file mode 100644 index 0000000..73d7b2f --- /dev/null +++ b/system/std.graphik/1.8.7/src/gen Plotter @@ -0,0 +1,16 @@ +TEXT VAR geraet; +page; +out ("Bitte den Namen der Hardwareanpassung (z.B. 'PC.plot') eingeben: "); +get line (geraet); +IF NOT exists (geraet) +THEN errorstop ("Endgerät nicht vorhanden") FI; + +insert ("GRAPHIK.Picfile"); +insert ("GRAPHIK.Transform"); +insert (geraet); +insert ("GRAPHIK.Plotter"); +insert ("GRAPHIK.Server") + + + + diff --git a/system/std.graphik/1.8.7/src/graphik editor b/system/std.graphik/1.8.7/src/graphik editor new file mode 100644 index 0000000..7aa6e33 --- /dev/null +++ b/system/std.graphik/1.8.7/src/graphik editor @@ -0,0 +1,324 @@ +PACKET graphic editor DEFINES graphic, (*Autor: H.Indenbirken *) + picfile, picture, (*Stand: 26.02.1985 *) + + neu zeichnen, + + UP, DOWN, T, + + pen, select pen, selected pen, background, + extrema pic, extrema picfile: + + + +LET norm cmd = ""1""27""3""10""9"epb"16"", + hop cmd = ""2""10""12""1"", + bell = ""7"", + esc = ""27""; + +PICFILE VAR p; +PICTURE VAR pic; +TEXT VAR command :: "", old command :: "", char, headline :: ""; +BOOL VAR within edit :: FALSE, new plot :: FALSE; +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; + +PROC open graphic (TEXT CONST name, DATASPACE CONST ds): + p := ds; + get values (p, size, limits, angles, oblique, perspective); + head line := ""1""15"LEN ................................ DIM PEN .."14" Picture "15""14""; + replace (head line, 32-LENGTH name DIV 2, name); + new plot := TRUE; + within edit := TRUE +END PROC open graphic; + +PROC graphic: + graphic (last param) +END PROC graphic; + +PROC graphic (TEXT CONST name) : + IF NOT exists (name) + THEN IF yes ("Soll ein neuer Picfile eingerichtet werden") + THEN graphic (new (name), name) FI + ELSE graphic (old (name), name) FI + +END PROC graphic; + +PROC graphic (DATASPACE CONST f, TEXT CONST name) : + open graphic (name, f); + reset; + kommandos bearbeiten; + within edit := FALSE . + +kommandos bearbeiten : + REP IF new plot + THEN plot (p); + new plot := FALSE + FI; + read picture (p, pic); + out head line; + inchar (command); + do command + PER . + +out head line: + replace (headline, 7, text (length (pic), 5)); + replace (headline, 50, text (dim (pic), 1)); + replace (headline, 57, text (pen (pic), 2)); + replace (headline, 72, text (picture no (p), 4)); + out (head line) . + +do command: + SELECT pos (norm cmd, command) OF + CASE 1: hop commands + CASE 2: escape commands + CASE 3: position up + CASE 4: position down + CASE 5: position direct + CASE 6: extrema pic + CASE 7: selected pen (pen (pic)); + CASE 8: out (1, 2, ""15""5"Hintergrundfarbe: " + + colour of (background (p)) + " "14"") + CASE 9: identify (pic); + OTHERWISE out (bell) ENDSELECT . + +position up : + IF is first picture (p) + THEN out (bell); + ELSE up (p) FI . + +position down : + IF eof (p) + THEN out (bell) + ELSE down (p) FI . + +position direct: + out (1, 68, ""); + edit get (command, 4, 4); + to pic (p, int (command)) . + +hop commands : + inchar (command); + SELECT pos (hop cmd, command) OF + CASE 1: to first pic (p) + CASE 2: to eof (p) + CASE 3: delete picture (p); + IF NOT new plot + THEN erase (pic) FI + CASE 4: new plot := TRUE + OTHERWISE out (bell) ENDSELECT . + +escape commands : + inchar (command); + IF command = "q" + THEN LEAVE kommandos bearbeiten + ELIF command = "f" + THEN do (old command) + ELIF command = esc + THEN kommandomodus + ELSE do (kommando auf taste (command)) FI . + +END PROC graphic; + +PROC kommandomodus: + command := ""; + disable stop; + REP get command; + do (command) + UNTIL command executed PER; + + IF new values + THEN get values (size, limits, angles, oblique, perspective); + set values (p, size, limits, angles, oblique, perspective); + new plot := new plot OR new values + FI . + +get command: + REP out (1, 2, ""15"Gib Graphikkommando: "); + edit get (command, 0, 54, "", "k", char); + out (""14""); + out (1, 2, ""5""); + + IF char = ""13"" + THEN LEAVE get command + ELIF char = ""27"k" + THEN command := old command FI + PER . + +command executed: + IF is error + THEN out (1, 1, error message); + clear error; + FALSE + ELSE old command := command; + TRUE + FI . + +END PROC kommandomodus; + +PROC out (INT CONST x, y, TEXT CONST t): + cursor (x, y); + out (t) +END PROC out; + +TEXT PROC colour of (INT CONST colour): + SELECT colour OF + CASE 0: "löschen" + CASE 1: "std" + CASE 2: "rot" + CASE 3: "blau" + CASE 4: "grün" + CASE 5: "schwarz" + CASE 6: "weiß" + OTHERWISE text (colour) ENDSELECT . +END PROC colour of; + +TEXT PROC linetype of (INT CONST linetype): + SELECT linetype OF + CASE 0: "unsichtbar" + CASE 1: "durchgehend" + CASE 2: "gepunktet" + CASE 3: "kurz gestrichelt" + CASE 4: "lang gestrichelt" + CASE 5: "strichpunkt" + OTHERWISE text (linetype) ENDSELECT . +END PROC linetype of; + +PICFILE PROC picfile : + IF NOT within edit + THEN errorstop ("Not within editmode") FI; + p +END PROC picfile; + +PICTURE PROC picture : + IF NOT within edit + THEN errorstop ("Not within editmode") FI; + pic +END PROC picture; + +PROC neu zeichnen: + new plot := TRUE +END PROC neu zeichnen; + +OP UP (INT CONST distance): + up (p, distance); + read picture (p, pic) +END OP UP; + +OP DOWN (INT CONST distance): + down (p, distance); + read picture (p, pic) +END OP DOWN; + +OP T (INT CONST n): + to pic (p, n); + read picture (p, pic) +END OP T; + +PROC pen (INT CONST n): + IF NOT new plot + THEN erase (pic) FI; + + pen (pic, n); + write picture (p, pic); + + IF NOT new plot + THEN show (pic) FI +END PROC pen; + +PROC select pen (INT CONST n, colour, thickness, linetype, BOOL CONST hidden): + select pen (p, n, colour, thickness, linetype, hidden); + new plot := TRUE +END PROC select pen; + +PROC select pen (INT CONST n, colour, thickness, linetype): + select pen (p, n, colour, thickness, linetype, FALSE); + new plot := TRUE +END PROC select pen; + +PROC selected pen (INT CONST n, INT VAR colour, thickness, linetype, + BOOL VAR hidden): + selected pen (p, n, colour, thickness, linetype, hidden); +END PROC selected pen; + +PROC selected pen (INT CONST n): + INT VAR colour, thickness, linetype; + BOOL VAR hidden; + selected pen (p, n, colour, thickness, linetype, hidden); + out (1, 2, ""5""15"PEN #" + text (n) + ": Farbe: " + colour of (colour) + + ", Dicke " + text (thickness) + ", Linientyp " + linetype of (linetype) + + hidden text + " "14"") . + +hidden text: + IF hidden + THEN ". " + ELSE ", nicht sichtbare Linien werden unterdrückt." FI . + +END PROC selected pen; + +INT PROC background: + background (p) +END PROC background; + +PROC background (INT CONST n): + new plot := n <> background (p); + background (p, n) +END PROC background; + +PROC extrema pic: + REAL VAR x min, x max, y min, y max, z min, z max; + IF dim (pic) = 2 + THEN extrema (pic, x min, x max, y min, y max); + out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + + "] [" + text (y min) + "," + text (y max) + "] "14"") + ELSE extrema (pic, x min, x max, y min, y max, z min, z max); + out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + + "] [" + text (y min) + "," + text (y max) + + "] [" + text (z min) + "," + text (z max) +"] "14"") + FI +END PROC extrema pic; + +PROC extrema picfile: + REAL VAR x min, x max, y min, y max, z min, z max; + extrema (p, x min, x max, y min, y max, z min, z max); + out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + + "] [" + text (y min) + "," + text (y max) + + "] [" + text (z min) + "," + text (z max) +"] "14"") +END PROC extrema picfile; + +PROC identify (PICTURE CONST pic): + begin plot; + hidden lines (TRUE); + pen (background (p), 1, 1, 2); + plot (pic); + end plot +END PROC identify; + +PROC erase (PICTURE CONST pic): + INT VAR colour, thickness, linetype; + BOOL VAR hidden; + + selected pen (p, pen (pic), colour, thickness, linetype, hidden); + begin plot; + hidden lines (TRUE); + pen (background (p), 0, thickness, linetype); + plot (pic); + end plot +END PROC erase; + +PROC show (PICTURE CONST pic): + INT VAR colour, thickness, linetype; + BOOL VAR hidden; + + selected pen (p, pen (pic), colour, thickness, linetype, hidden); + begin plot; + hidden lines (TRUE); + pen (background (p), colour, thickness, linetype); + plot (pic); + end plot +END PROC show; + +END PACKET graphic editor; + diff --git a/system/std.zusatz/1.8.7/source-disk b/system/std.zusatz/1.8.7/source-disk new file mode 100644 index 0000000..085c0a7 --- /dev/null +++ b/system/std.zusatz/1.8.7/source-disk @@ -0,0 +1 @@ +grundpaket/04_std.zusatz.img diff --git a/system/std.zusatz/1.8.7/src/AT Generator b/system/std.zusatz/1.8.7/src/AT Generator new file mode 100644 index 0000000..d3bfd6d --- /dev/null +++ b/system/std.zusatz/1.8.7/src/AT Generator @@ -0,0 +1,135 @@ +(*************************************************************************) +(*** Generiert Für IBM-AT einen neuen SYSUR-Zweig. ***) +(*** Danach wird die eingebaute Hardwareuhr für die Systemzeit benutzt ***) +(*** und andere Partitionen können mit neuem 'shutup' gebootet werden. ***) +(*** ***) +(*** Autor : W. Sauerwein Stand : 15.07.86 ***) +(*************************************************************************) + +LET ack = 0, + nak = 1; + +cl eop (1, 4); +erzeuge collector; +erzeuge archive manager; +erzeuge operator; +erzeuge configurator; +loesche collector; +forget ("AT Generator", quiet); +break. + +loesche collector : + end (/"colly"); + put ("Collector gelöscht."); + line (2). + +erzeuge collector : + put line ("Generating 'Collector'..."); + begin ("colly", PROC generate collector, t); + warte auf meldung; + IF answer = nak THEN end (/"colly"); + errorstop (meldung) + FI. + TASK VAR t. + +erzeuge archive manager : + put line ("Generating 'ARCHIVE'..."); + end (/"ARCHIVE"); + begin ("ARCHIVE", PROC archive manager, t). + +erzeuge operator : + put line ("Generating 'OPERATOR'..."); + end (/"OPERATOR"); + begin ("OPERATOR", PROC monitor, t). + +erzeuge configurator : + put line ("Generating 'configurator'..."); + end (/"configurator"); + begin ("configurator", PROC generate configurator, t); + warte auf meldung; + IF answer = nak THEN errorstop (meldung) FI. + +warte auf meldung : + DATASPACE VAR ds; INT VAR answer; + wait (ds, answer, t); + BOUND TEXT VAR m := ds; + TEXT VAR meldung := m; + forget (ds). + +PROC generate collector : + + disable stop; + fetch all (/"configurator"); + DATASPACE VAR ds := nilspace; + BOUND TEXT VAR m := ds; m := ""; + send (father, mess, ds); + forget (ds); + free global manager. + +mess : IF is error THEN m := error message; + nak + ELSE ack FI. + +END PROC generate collector; + +PROC generate configurator : + + disable stop; + fetch all (/"colly"); + DATASPACE VAR ds := nilspace; + BOUND TEXT VAR m := ds; m := ""; + send (father, mess, ds); + forget (ds); + enable stop; + new configuration; + setup; + global manager (PROC ( DATASPACE VAR, INT CONST, INT CONST, TASK CONST) + configuration manager with time). + +mess : IF is error THEN m := error message; + nak + ELSE ack FI. + +END PROC generate configurator; + +TEXT PROC inverse (TEXT CONST t): + ""15"" + t + " " + ""14"" +END PROC inverse; + +PROC put center (TEXT CONST t): + put center (t, 80) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t): + put center (zeile, t, 80) +END PROC put center; + +PROC put center (TEXT CONST t, INT CONST gesamtbreite): + INT VAR cy; + get cursor (cy, cy); + put center (cy, t, gesamtbreite) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite): + cursor ((gesamtbreite - length (t)) DIV 2, zeile); + put (t). +END PROC put center; + +PROC cl eol: + out (""5"") +END PROC cl eol; + +PROC cl eop: + out (""4"") +END PROC cl eop; + +PROC cl eol (INT CONST cx, cy): + cursor (cx, cy); + cl eol +END PROC cl eol; + +PROC cl eop (INT CONST cx, cy): + cursor (cx, cy); + cl eop +END PROC cl eop; + diff --git a/system/std.zusatz/1.8.7/src/AT Utilities b/system/std.zusatz/1.8.7/src/AT Utilities new file mode 100644 index 0000000..760e728 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/AT Utilities @@ -0,0 +1,1057 @@ +(*************************************************************************) +(*** AT-spezifische Software, die zum Lesen der Hardwareuhr und ***) +(*** Booten in anderen Partitionen benötigt wird. ***) +(*** ***) +(*** Zusammengestellt und geändert : Werner Sauerwein, GMD ***) +(*** Stand : 31.10.86 ***) +(*************************************************************************) + +PACKET splitting DEFINES low byte, (* Copyright (C) 1985 *) + high byte, (* Martin Schönbeck, Spenge *) + low word, (* Stand: 13.09.85 *) + high word: + +INT PROC high byte (INT CONST value): + + TEXT VAR x := " "; + replace (x, 1, value); + code (x SUB 2) + +END PROC high byte; + +INT PROC low byte (INT CONST value): + + TEXT VAR x := " "; + replace (x, 1, value); + code (x SUB 1) + +END PROC low byte; + +INT PROC high word (REAL CONST double precission int): + + int (double precission int / 65536.0) + +END PROC high word; + +INT PROC low word (REAL CONST double precission int): + + string of low bytes ISUB 1. + +string of low bytes: + code (int (double precission int MOD 256.0)) + + code (int ((double precission int MOD 65536.0) / 256.0)). + +END PROC low word; + +END PACKET splitting; + + +PACKET basic block io DEFINES + + read block, + write block: + +PROC read block (DATASPACE VAR ds, + INT CONST ds page no, + INT CONST block no, + INT VAR return code): + read block; + retry if read error. + +read block: + block in (ds, ds page no, 0, block no, return code). + +retry if read error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + read block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN block in (ds, ds page no, 0, 0, return code) + FI. + +END PROC read block; + +PROC write block (DATASPACE CONST ds, + INT CONST ds page no, + INT CONST block no, + INT VAR return code): + write block; + retry if write error. + +write block: + block out (ds, ds page no, 0, block no, return code). + +retry if write error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + write block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN disable stop; + DATASPACE VAR dummy ds := nilspace; + block in (dummy ds, 2, 0, 0, return code); + forget (dummy ds); + enable stop + FI. + +END PROC write block; + +PROC read block (DATASPACE VAR ds, INT CONST ds page, + REAL CONST archive block): + + enable stop; + read block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht gelesen werden"); + CASE 2: error stop ("Lesefehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + +END PROC read block; + +PROC write block (DATASPACE CONST ds, INT CONST ds page, + REAL CONST archive block): + + enable stop; + write block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht geschrieben werden"); + CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + +END PROC write block; + +PROC read block (DATASPACE VAR ds, + INT CONST ds page no, + REAL CONST block no, + INT VAR return code): + read block; + retry if read error. + +read block: + block in (ds, ds page no, high word (block no), + low word (block no), return code). + +retry if read error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + read block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN block in (ds, ds page no, 0, 0, return code) + FI. + +END PROC read block; + +PROC write block (DATASPACE CONST ds, + INT CONST ds page no, + REAL CONST block no, + INT VAR return code): + write block; + retry if write error. + +write block: + block out (ds, ds page no, high word (block no), + low word (block no), return code). + +retry if write error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + write block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN disable stop; + DATASPACE VAR dummy ds := nilspace; + block in (dummy ds, 2, 0, 0, return code); + forget (dummy ds); + enable stop + FI. + +END PROC write block; + +END PACKET basic block io; + + +PACKET utilities DEFINES getchoice, cleol, cleop, inverse, put center: + +INT PROC get choice (INT CONST von, bis, TEXT VAR retchar): + get choice (von, bis, von, retchar) +END PROC get choice; + +INT PROC get choice (INT CONST von, bis, zusatz, TEXT VAR retchar): + LET return = ""13"", + escape = ""27"", + left = ""8""; + TEXT VAR buffer; + INT VAR cx, cy; + get cursor (cx, cy); out (" " + left); + REP + REP + cursor (cx, cy); buffer := incharety; + UNTIL input ok OR buffer = escape PER; + IF buffer = escape THEN retchar := escape; + LEAVE get choice WITH 0 + FI; + out (buffer); + leseschleife bis left or ret; + IF retchar = left THEN out (left + " ") FI; + IF retchar = escape THEN LEAVE get choice WITH 0 FI + UNTIL retchar = return OR retchar = escape PER; + int (buffer). + +input ok : (buffer >= text (von) AND buffer <= text (bis)) OR buffer = text (zusatz). + +leseschleife bis left or ret: + REP + inchar (retchar) + UNTIL retchar = return OR retchar = left OR retchar = escape PER. + +END PROC get choice; + +PROC cl eol (INT CONST cx, cy): + cursor (cx, cy); + cl eol +END PROC cl eol; + +PROC cl eop (INT CONST cx, cy): + cursor (cx, cy); + cl eop +END PROC cl eop; + + +PROC cl eol: + out (""5"") +END PROC cl eol; + +PROC cl eop: + out (""4"") +END PROC cl eop; + +TEXT PROC inverse (TEXT CONST t): + ""15"" + t + " " + ""14"" +END PROC inverse; + +PROC put center (TEXT CONST t): + put center (t, 80) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t): + put center (zeile, t, 80) +END PROC put center; + +PROC put center (TEXT CONST t, INT CONST gesamtbreite): + INT VAR cy; + get cursor (cy, cy); + put center (cy, t, gesamtbreite) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite): + cursor ((gesamtbreite - length (t)) DIV 2, zeile); + put (t). +END PROC put center; + +END PACKET utilities + + +PACKET part DEFINES activate, show actual partition table: + (* Copyright (C) 1985 *) + (* Martin Schönbeck, Spenge *) + (* Stand : 02.02.86 *) + (* Changed by : W.Sauerwein *) + (* I.Ley *) + (* Stand : 03.10.86 *) + LET fd channel = 28; + +ROW 256 INT VAR boot block; +INT VAR boot block session := session - 1; + +PROC get boot block: + IF boot block session <> session + THEN hole aktuellen boot block + FI. + +hole aktuellen boot block: + disable stop; + DATASPACE VAR dummy ds := nilspace; + BOUND STRUCT (ALIGN dummy, + ROW 256 INT block) VAR partition table := dummy ds; + get external block (dummy ds, 2, 0, fd channel); + IF NOT is error + THEN transfer data to boot block + FI; + forget (dummy ds). + +transfer data to boot block: + IF not valid boot block + THEN try to get valid boot block from file + FI; + boot block := partition table. block; + boot block session := session. + +not valid boot block: + partition table. block [256] <> boot indicator OR + it is an old boot block of eumel. + +boot indicator: -21931. + +it is an old boot block of eumel: + partition table. block [1] = 1514. + +try to get valid boot block from file: + forget (dummy ds); + partition table := old ("bootblock"); + IF is error THEN LEAVE transfer data to boot block FI. + +END PROC get boot block; + +PROC put boot block: + IF boot block ist uptodate + THEN schreibe block auf platte + ELSE errorstop ("boot block nicht uptodate") + FI. + +boot block ist uptodate: + boot block session = session. + +schreibe block auf platte: + disable stop; + DATASPACE VAR dummy ds := nilspace; + BOUND STRUCT (ALIGN dummy, + ROW 256 INT block) VAR partition table := dummy ds; + transfer data to dataspace; + put external block (dummy ds, 2, 0, fd channel); + forget (dummy ds). + +transfer data to dataspace: + partition table. block := boot block. + +END PROC put boot block; + +INT PROC partition type (INT CONST partition): + low byte (boot block [entry (partition) + 2]) +END PROC partition type; + +REAL PROC partition start (INT CONST partition): + unsigned low word + high word. + +unsigned low word: + real (low byte (boot block [entry (partition) + 4])) + + real (high byte (boot block [entry (partition) + 4])) * 256.0. + +high word: + real (boot block [entry (partition) + 5]). + +END PROC partition start; + +INT PROC partition word 0 (INT CONST partition): + boot block (entry (partition)) +END PROC partition word 0; + +INT PROC first track (INT CONST partition): + high byte (boot block [entry (partition) + 1]) + + 4 * (low byte (boot block [entry (partition) + 1]) AND (128 + 64)) +END PROC first track; + +INT PROC last track (INT CONST partition): + high byte (boot block [entry (partition) + 3]) + + 4 * (low byte (boot block [entry (partition) + 3]) AND (128 + 64)) +END PROC last track; + +BOOL PROC partition activ (INT CONST partition): + low byte (boot block [entry (partition)]) = 128 +END PROC partition activ; + +REAL PROC partition size (INT CONST partition): + unsigned low word + high word. + +unsigned low word: + real (low byte (boot block [entry (partition) + 6])) + + real (high byte (boot block [entry (partition) + 6])) * 256.0. + +high word: + real (boot block [entry (partition) + 7]). + +END PROC partition size; + +INT PROC tracks: + get value (-10, fd channel) +END PROC tracks; + +PROC activate (INT CONST part type): + IF partition type exists AND is possible type + THEN deactivate all partitions and + activate desired partition + ELSE errorstop ("Gewünschte Partitionart gibt es nicht") + FI. + +is possible type: + part type > 0 AND + part type < 256. + +partition type exists: + INT VAR partition; + FOR partition FROM 1 UPTO 4 REP + IF partition type (partition) = part type + THEN LEAVE partition type exists WITH TRUE + FI; + PER; + FALSE. + +deactivate all partitions and activate desired partition: + FOR partition FROM 1 UPTO 4 REP + deactivate this partition; + IF partition type (partition) = part type + THEN activate partition + FI + PER; + put boot block. + +deactivate this partition: + set bit (boot block [entry (partition)], 7); + (* first setting needed, because reset bit does xor *) + reset bit (boot block [entry (partition)], 7). + +activate partition: + set bit (boot block [entry (partition)], 7) + +END PROC activate; + +INT PROC entry (INT CONST partition): + get boot block; + 256 - 5 * 8 + (partition * 8) +END PROC entry; + +INT PROC get value (INT CONST control code, channel for value): + enable stop; + INT VAR old channel := channel; + continue (channel for value); + INT VAR value; + control (control code, 0, 0, value); + continue (old channel); + value +END PROC get value; + +PROC get external block (DATASPACE VAR ds, INT CONST ds page, + archive block, get channel): + INT VAR old channel := channel; + continue (get channel); + disable stop; + read block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht gelesen werden"); + CASE 2: error stop ("Lesefehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + continue (old channel). +END PROC get external block; + +PROC put external block (DATASPACE CONST ds, INT CONST ds page, + archive block, get channel): + INT VAR old channel := channel; + continue (get channel); + disable stop; + write block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht geschrieben werden"); + CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + continue (old channel). +END PROC put external block; + +(**************************************************************************) + + LET max partitions = 4; + ROW max partitions INT VAR part list; + ROW max partitions INT VAR part type, part active, + part first track, part last track; + ROW max partitions REAL VAR part start, + part size; + INT VAR zylinder, + startzeile tabelle :: 1, + active partition, + partitions, + partition, i, j, help; + + +PROC get actual partition data : + get boot block; + zylinder := tracks; + FOR i FROM 1 UPTO max partitions REP + part type (i) := partition type (i); + part first track (i) := first track (i); + part last track (i) := last track (i); + part start (i) := partition start (i); + part size (i) := partition size (i); + part active (i) := partition word 0 (i); + IF partition activ (i) THEN active partition := i FI + PER; + get number of installed partitions; + generate part list. + +get number of installed partitions : + partitions := 0; + FOR i FROM 1 UPTO max partitions REP + IF part type (i) <> 0 THEN partitions INCR 1 FI + PER. + +generate part list : + FOR i FROM 1 UPTO max partitions REP + IF part type (i) <> 0 THEN part list (i) := i + ELSE part list (i) := 0 + FI; + PER; + schiebe nullen nach hinten; + sort part list. + +schiebe nullen nach hinten : + i := 1; INT VAR k := 0; + REP k INCR 1; + IF part list (i) = 0 THEN circle + ELSE i INCR 1 + FI + UNTIL k = max partitions - 1 PER. + +circle : + FOR j FROM i UPTO max partitions - 1 REP + part list (j) := part list (j + 1) + PER; + part list (max partitions) := 0. + +sort part list : + FOR i FROM 2 UPTO partitions REP + FOR j FROM 1 UPTO i - 1 REP + IF part first track (part list (i)) < part first track (part list (j)) + THEN tausche FI + PER + PER. + +tausche : + help := part list (i); + part list (i) := part list (j); + part list (j) := help. + +END PROC get actual partition data; + + +PROC show partition table : + headline; + devide table; + columns; + underlines; + rows; + footlines. + +head line : + cl eop (1, startzeile tabelle); + put center (inverse (" " + + "Aktuelle Partitions - Tabelle" + + " ")). + +devide table : + FOR i FROM 1 UPTO 8 + REP + cursor (50, startzeile tabelle + i); out (inverse ("")) + PER. + +columns : + cursor ( 1, startzeile tabelle + 2); + out (" Nr. System Typ-Nr. Zustand Größe Start Ende"); + cursor (54, startzeile tabelle + 2); + out ("Plattengröße / Zylinder "). + +underlines : + cursor ( 1, startzeile tabelle + 3); + out ("-------------------------------------------------"); + cursor (52, startzeile tabelle + 3); + out ("--------------------------"). + +rows : + FOR i FROM 1 UPTO max partitions + REP cursor (2, startzeile tabelle + 3 + i); + put (text (i) + " :") + PER. + +footlines: + cursor (1, startzeile tabelle + 9); + put center (inverse (75 * " ")). + +END PROC show partition table; + +PROC update table : + get actual partition data; + FOR i FROM 1 UPTO partitions REP update partition PER; + FOR i FROM partitions + 1 UPTO max partitions REP rubout partition PER; + zeige plattengroesse. + +update partition : + partition := part list (i); + show partition. + +rubout partition : + cursor (6, startzeile tabelle + 3 + i); + out (" "). + +show partition : + cursor (6, startzeile tabelle + 3 + i); + put (name + type + zustand + groesse + startspur + endspur). + +name : subtext (subtext (part name, 1, 9) + + " ", 1, 10). + +type : text (part type (partition), 5) + " ". + +zustand : IF active partition = partition THEN (" aktiv ") + ELSE (" ") + FI. + +startspur : " " + text (part first track (partition), 5). +endspur : text (part last track (partition), 6). +groesse : text (part groesse, 5). + +zeige plattengroesse : + put gesamt; + put noch freie; + put maximaler zwischenraum. + +put maximaler zwischenraum : + cursor (54, startzeile tabelle + 6); + put ("max. zusammenh. : " + text (maximaler zwischenraum, 4)). + +put gesamt : + cursor (54, startzeile tabelle + 4); + put ("insgesamt : " + text (zylinder, 4)). + +put noch freie : + cursor (54, startzeile tabelle + 5); + put ("davon noch frei : " + text (freie zylinder, 4)). + +part groesse : + partition groesse (partition). + +part name : + SELECT part type (partition) OF + CASE 1 : "DOS" + CASE 69, 70, 71, 72 : "EUMEL" + OTHERWISE text (part type (partition)) + END SELECT. + +freie zylinder : + zylinder - belegte zylinder. + +belegte zylinder : + help := 0; + FOR i FROM 1 UPTO partitions REP + help INCR partition groesse (part list (i)) + PER; + help. + +END PROC update table; + +INT PROC maximaler zwischenraum : + IF partitions = 0 THEN zylinder + ELSE max (maximaler platz vor und zwischen den partitionen, + platz hinter letzter partition) + FI. + +maximaler platz vor und zwischen den partitionen : + help := platz vor erster partition; + FOR i FROM 1 UPTO partitions - 1 + REP + help := max (help, begin of part i plus 1 - end of part i - 1) + PER; + help. + +platz vor erster partition : + part first track (part list (1)). + +platz hinter letzter partition : + zylinder - part last track (part list (partitions)) - 1. + +begin of part i plus 1 : + part first track (part list (i + 1)). + +end of part i : + part last track (part list (i)). + +END PROC maximaler zwischenraum; + +INT PROC partition groesse (INT CONST part) : + part last track (part) - part first track (part) + 1 +END PROC partition groesse; + +PROC show actual partition table: + show partition table; + update table; + line (4) +END PROC show actual partition table; + +PROC show actual partition table (ROW max partitions INT VAR typnr): + show actual partition table; + FOR i FROM 1 UPTO max partitions REP + typnr (i) := partition type (part list (i)) + PER; +END PROC show actual partition table; + +END PACKET part; + + +PACKET hw clock DEFINES hw clock: (* Copyright (C) 1985 *) + (* Martin Schönbeck, Spenge *) +LET clock length = 7, (* Stand: 06.11.85 *) + clock command = 4; + +BOUND STRUCT (ALIGN dummy, + ROW clock length INT clock field) VAR clock data; + +REAL PROC hw clock: + + disable stop; + get clock; + hw date + hw time. + +get clock: + DATASPACE VAR ds := nilspace; + clock data := ds; + INT VAR return code, actual channel := channel; + go to shard channel; + blockin (ds, 2, -clock command, 0, return code); + IF actual channel = 0 THEN break (quiet) + ELSE continue (actual channel) + FI; + IF return code <> 0 + THEN errorstop ("Keine Hardware Uhr vorhanden"); + FI; + put clock into text; + forget (ds). + +put clock into text: + TEXT VAR clock text := clock length * " "; + INT VAR i; + FOR i FROM 1 UPTO clock length REP + replace (clock text, i, clock data. clock field [i]); + PER. + +go to shard channel: + INT VAR retry; + FOR retry FROM 1 UPTO 20 REP + continue (32); + IF is error + THEN clear error; + pause (30) + FI; + UNTIL channel = 32 PER. + +hw date: + date (day + "." + month + "." + year). + +day: subtext (clock text, 7, 8). + +month: subtext (clock text, 5, 6). + +year: subtext (clock text, 1, 4). + +hw time: + time (hour + ":" + minute + ":" + second). + +hour: subtext (clock text, 9, 10). + +minute: subtext (clock text, 11, 12). + +second: subtext (clock text, 13, 14). + +END PROC hw clock; + +END PACKET hw clock + + +PACKET old shutup DEFINES old shutup, (* Copyright (C) 1985 *) + old save system: (* Martin Schönbeck, Spenge *) + (* Stand: 06.11.85 *) +PROC old shutup : shutup END PROC old shutup; + +PROC old save system : save system END PROC old save system; + +END PACKET old shutup; + + +PACKET new shutup DEFINES shutup, + shutup dialog, + save system, + generate shutup manager, + generate shutup dialog manager: + +LET ack = 0; + +PROC shutup: + + system down (PROC old shutup) + +END PROC shutup; + +PROC shutup (INT CONST new system): + + IF new system <> 0 + THEN prepare for new system + FI; + system down (PROC old shutup). + +prepare for new system: + activate (new system); + prepare for rebooting. + +prepare for rebooting: + INT VAR old channel := channel; + continue (32); + INT VAR dummy; + control (-5, 0, 0, dummy); + break (quiet); + continue (old channel). + +END PROC shutup; + +PROC save system: + + IF yes ("Leere Floppy eingelegt") + THEN system down (PROC old save system) + FI + +END PROC save system; + +PROC system down (PROC operation): + + BOOL VAR dialogue :: command dialogue; + command dialogue (FALSE); + operation; + command dialogue (dialogue); + IF command dialogue + THEN wait for configurator; + show date; + FI. + +show date: + page; + line (2); + put (" Heute ist der"); putline (date); + put (" Es ist"); put (time of day); putline ("Uhr"); + line (2). + +END PROC system down; + +DATASPACE VAR ds := nilspace; + +PROC wait for configurator: + + INT VAR i, receipt; + FOR i FROM 1 UPTO 20 WHILE configurator exists REP + pause (30); + forget (ds); + ds := nilspace; + ping pong (configurator, ack, ds, receipt) + UNTIL receipt >= 0 PER. + +configurator exists: + disable stop; + TASK VAR configurator := task ("configurator"); + clear error; + NOT is niltask (configurator). + +END PROC wait for configurator; + +PROC generate shutup manager: + + generate shutup manager ("shutup", 0); + +END PROC generate shutup manager; + +PROC generate shutup manager (TEXT CONST name, INT CONST new system): + + TASK VAR son; + shutup question := name; + new system for manager := new system; + begin (name, PROC shutup manager, son) + +END PROC generate shutup manager; + +INT VAR new system for manager; +TEXT VAR shutup question; + +PROC shutup manager: + + disable stop; + command dialogue (TRUE); + REP + break; + line ; + IF yes (shutup question) + THEN clear error; + shutup (new system for manager); + pause (300); + FI; + PER + +END PROC shutup manager; + +PROC shutup dialog: + init; + show actual partition table (typnr); + REP + enter part number; + get cursor (cx, cy); + IF NOT escaped CAND yes (shutup question) + THEN message; + shutup (partition type); + LEAVE shutup dialog + FI; + PER. + +shutup question: + IF partition null + THEN "Shutup ausführen" + ELSE "Shutup nach Partition mit Typnummer " + text (typnr (partition)) + " ausführen" + FI. + +message: + cl eol (1, cy); + put line ("Bitte auf ENDE - Meldung warten !"). + +partition type: + IF partition = 0 + THEN 0 + ELSE typnr (partition) + FI. + +init: + LET startzeile menu = 12, + escape = ""27"", + max partitions = 4; + + ROW max partitions INT VAR typnr; + INT VAR partition, cx, cy; + TEXT VAR retchar. + +partition null: + partition = 0 COR typnr (partition) = 0. + +enter part number : + cl eop (1, startzeile menu); + cursor (54, startzeile menu ); put ("Abbruch mit "); + cursor (54, startzeile menu + 1); put ("Shutup ohne Wechsel mit <0>"); + cursor ( 1, startzeile menu); + put ("Zu welcher Partition wollen Sie wechseln :"); + get cursor (cx, cy); + REP + REP cursor (cx, cy); + partition := get choice (0, 4, retchar); + IF sure escaped THEN LEAVE shutup dialog FI; + UNTIL NOT escaped PER; + IF partition <> 0 CAND NOT partition exists + THEN fehler; + put ("Diese Partition gibt es nicht") + FI; + UNTIL partition = 0 OR partition exists PER; + cl eol (54, startzeile menu); + cl eol (54, startzeile menu + 1); + cl eop (1, cy + 2). + +partition exists: + typnr (partition) <> 0. + +escaped : + retchar = escape. + +sure escaped : + IF escaped THEN cl eop (1, 20); cursor (1, 22); + IF yes ("Shutup-Dialog abbrechen") THEN TRUE + ELSE cl eop (1, 20); + FALSE + FI + ELSE FALSE + FI. + +fehler : + cl eop (1, 20); + put (""7"" + inverse ("FEHLER :")); line (2). + +END PROC shutup dialog; + +PROC generate shutup dialog manager: + TASK VAR son; + begin ("shutup dialog", PROC shutup dialog manager, son) +END PROC generate shutup dialog manager; + +PROC shutup dialog manager: + disable stop; + command dialogue (TRUE); + REP + break; line; + clear error; + INT VAR sess := session; + shutup dialog; + IF sess <> session THEN pause (300) FI; + PER; +END PROC shutup dialog manager; + +END PACKET new shutup + + +PACKET config manager with time DEFINES configuration manager , + configuration manager with time : + (* Copyright (C) 1985 *) +INT VAR old session := 0; (* Martin Schönbeck, Spenge *) + (* Stand: 06.11.85 *) +PROC configuration manager: + + configurate; + break; + global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) + configuration manager with time) + +END PROC configuration manager; + +PROC configuration manager with time (DATASPACE VAR ds, INT CONST order, + phase, TASK CONST order task): + + IF old session <> session + THEN + disable stop; + set clock (hw clock); + set clock (hw clock); (* twice, to avoid all paging delay *) + IF is error THEN IF online THEN put error; clear error; pause (100) + ELSE clear error + FI FI; + old session := session; + set autonom; + FI; + configuration manager (ds, order, phase, order task); + +END PROC configuration manager with time; + +END PACKET config manager with time; + diff --git a/system/std.zusatz/1.8.7/src/AT install b/system/std.zusatz/1.8.7/src/AT install new file mode 100644 index 0000000..11f9b55 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/AT install @@ -0,0 +1,93 @@ +(*************************************************************************) +(*** Insertiert alle notwendigen Pakete, damit ein AT-System generiert ***) +(*** werden kann, das die Hardwareuhr lesen und Partitionen bedienen ***) +(*** kann. Startet den "AT Generator". ***) +(*** ***) +(*** Autor : W. Sauerwein Stand : 15.07.86 ***) +(*************************************************************************) + +erste bildschirmmeldung; +IF ich bin single THEN putline ("Die AT-spezifische Software ist nur auf Multi-User-Systemen benutzbar !") + ELSE hole dateien vom archiv; + insertiere alle pakete; + put line ("Running ""AT Generator""..."); + run ("AT Generator") +FI; +forget ("AT install", quiet). + +ich bin single : (pcb (9) AND 255) <= 1. + +insertiere alle pakete : + insert and say ("AT Utilities"). + +erste bildschirmmeldung : + page; + put center (" Generator für AT-spezifische Software gestartet."); line; + put center ("--------------------------------------------------"); + line (2). + +hole dateien vom archiv : + TEXT VAR datei; + datei := "AT Utilities"; hole wenn noetig; + datei := "AT Generator"; hole wenn noetig; + release (archive); + line. + +hole wenn noetig : + IF NOT exists (datei) THEN + put line ("Loading """ + datei + """..."); + fetch (datei, archive) + FI. + +PROC insert and say (TEXT CONST datei) : + + INT VAR cx, cy; + put line ("Inserting """ + datei + """..."); + get cursor (cx, cy); + insert (datei); + cl eop (cx, cy); line; + forget (datei, quiet). + +END PROC insert and say; + +TEXT PROC inverse (TEXT CONST t): + ""15"" + t + " " + ""14"" +END PROC inverse; + +PROC put center (TEXT CONST t): + put center (t, 80) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t): + put center (zeile, t, 80) +END PROC put center; + +PROC put center (TEXT CONST t, INT CONST gesamtbreite): + INT VAR cy; + get cursor (cy, cy); + put center (cy, t, gesamtbreite) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite): + cursor ((gesamtbreite - length (t)) DIV 2, zeile); + put (t). +END PROC put center; + +PROC cl eol: + out (""5"") +END PROC cl eol; + +PROC cl eop: + out (""4"") +END PROC cl eop; + +PROC cl eol (INT CONST cx, cy): + cursor (cx, cy); + cl eol +END PROC cl eol; + +PROC cl eop (INT CONST cx, cy): + cursor (cx, cy); + cl eop +END PROC cl eop; + diff --git a/system/std.zusatz/1.8.7/src/complex b/system/std.zusatz/1.8.7/src/complex new file mode 100644 index 0000000..e2139d0 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/complex @@ -0,0 +1,115 @@ + +PACKET complex DEFINES COMPLEX,:=,complex zero,complex one,complex i, + complex,realpart,imagpart,CONJ,+,-,*,/,=,<>, + put,get, ABS, sqrt, phi, dphi : + +TYPE COMPLEX = STRUCT(REAL re,im); +COMPLEX PROC complex zero: COMPLEX :(0.0,0.0). END PROC complex zero; +COMPLEX PROC complex one : COMPLEX :(1.0,0.0). END PROC complex one; +COMPLEX PROC complex i : COMPLEX :(0.0,1.0). END PROC complex i; + +OP := (COMPLEX VAR dest, COMPLEX CONST source) : + + CONCR (dest) := CONCR (source) + +ENDOP := ; + +COMPLEX PROC complex(REAL CONST re,im): + COMPLEX :(re,im). +END PROC complex; + +REAL PROC realpart(COMPLEX CONST number): + number.re. +END PROC realpart; + +REAL PROC imagpart(COMPLEX CONST number): + number.im. +END PROC imagpart ; + +COMPLEX OP CONJ(COMPLEX CONST number): + COMPLEX :( number.re,- number.im). +END OP CONJ; + +BOOL OP =(COMPLEX CONST a,b): + IF a.re=b.re + THEN a.im=b.im + ELSE FALSE + FI. +END OP =; + +BOOL OP <>(COMPLEX CONST a,b): + IF a.re=b.re + THEN a.im<>b.im + ELSE TRUE + FI. +END OP <>; + +COMPLEX OP +(COMPLEX CONST a,b): + COMPLEX :(a.re+b.re,a.im+b.im). +END OP +; + +COMPLEX OP -(COMPLEX CONST a,b): + COMPLEX :(a.re-b.re,a.im-b.im). +END OP -; + +COMPLEX OP *(COMPLEX CONST a,b): + REAL VAR re of a::a.re,im of a ::a.im, + re of b::b.re,im of b ::b.im; + COMPLEX :(re of a*re of b- im of a *im of b, + re of a*im of b+ im of a*re of b). +END OP *; + +COMPLEX OP /(COMPLEX CONST a,b): + REAL VAR re of a::a.re,im of a::a.im, + re of b::b.re,im of b::b.im; + REAL VAR sqare sum of re and im ::b.re*b.re+b.im*b.im; + COMPLEX :( (re of a * re of b + im of a * im of b)/sqare sum of re and im, + (im of a *re of b - re of a*im of b)/sqare sum of re and im). +END OP /; + +PROC get(COMPLEX VAR a): + REAL VAR realpart,imagpart; + get(realpart);get(imagpart); + a:= COMPLEX :(realpart,imagpart); +END PROC get; + +PROC put(COMPLEX CONST a): + put(a.re);put(" ");put(a.im); +END PROC put; + +REAL PROC dphi(COMPLEX CONST x): + IF imagpart(x)=0.0 THEN reell + ELIF realpart(x)=0.0 THEN imag + ELIF realpart(x)>0.0 THEN realpositiv + ELSE realnegativ + FI. +reell: IF sign(realpart(x)) < 0 THEN 180.0 ELSE 0.0 FI. +imag: IF imagpart(x)>0.0 THEN 90.0 ELSE 270.0 FI. +realpositiv:IF imagpart(x)>0.0 THEN arctand(realpart(x)/imagpart(x)) + ELSE +arctand(realpart(x)/imagpart(x))+360.0 FI. +realnegativ: arctand(realpart(x)/imagpart(x))+180.0. +END PROC dphi; + +REAL PROC phi(COMPLEX CONST x): +dphi(x)*3.141592653689793/180.0. +END PROC phi; + +COMPLEX PROC sqrt(COMPLEX CONST x): +IF x=complex zero THEN x +ELIF realpart(x)<0.0 THEN +complex(imagpart(x)/(2.0*real(sign(imagpart(x))) + *sqrt((ABSx-realpart(x))/2.0)), + real(sign(imagpart(x)))*sqrt((ABS x-realpart(x))/2.0)) +ELSE complex(sqrt((ABS x+realpart(x))/2.0), + imagpart(x)/(2.0*sqrt((ABS x+realpart(x))/2.0))) +FI. + +END PROC sqrt; + +REAL OP ABS(COMPLEX CONST x): + sqrt(realpart(x)*realpart(x)+imagpart(x)*imagpart(x)). +END OP ABS; + +END PACKET complex; + diff --git a/system/std.zusatz/1.8.7/src/crypt b/system/std.zusatz/1.8.7/src/crypt new file mode 100644 index 0000000..b04728a --- /dev/null +++ b/system/std.zusatz/1.8.7/src/crypt @@ -0,0 +1,138 @@ +(* ------------------- VERSION 2 vom 21.04.86 ------------------- *) +PACKET cryptograf DEFINES (* Autor: J.Liedtke *) + + crypt , + decrypt : + +TEXT VAR char , in buffer, out buffer ; +INT VAR in pos , key index ; +DATASPACE VAR scratch space ; +FILE VAR in, out; + +PROC crypt (TEXT CONST file, key) : + + open (file) ; + initialize crypt (key) ; + WHILE NOT eof REP + read char ; + crypt char ; + write char + PER ; + close (file) . + +crypt char : + char := code (( character + random char + key char ) MOD 250) ; + IF key index = LENGTH key + THEN key index := 1 + ELSE key index INCR 1 + FI . + +character : code (char) . + +random char : random (0,250). + +key char : code (key SUB key index) . + +ENDPROC crypt ; + +PROC decrypt (TEXT CONST file, key) : + + open (file) ; + initialize crypt (key) ; + WHILE NOT eof REP + read char ; + decrypt char ; + write char + PER ; + close (file) . + +decrypt char : + char := code (( character - random char - key char ) MOD 250) ; + IF key index = LENGTH key + THEN key index := 1 + ELSE key index INCR 1 + FI . + +character : code (char) . + +random char : random (0,250) . + +key char : code (key SUB key index) . + +ENDPROC decrypt ; + +PROC initialize crypt (TEXT CONST key) : + + INT VAR random key := 0 ; + FOR key index FROM 1 UPTO LENGTH key REP + random key := (random key + code (key SUB key index)) MOD 32000 + PER ; + initialize random (random key) ; + key index := 1 + +ENDPROC initialize crypt ; + +PROC open (TEXT CONST source file) : + + in := sequential file (input, source file) ; + getline (in, in buffer) ; + in pos := 1 ; + forget (scratch space) ; + scratch space := nilspace ; + out := sequential file (output, scratch space) ; + out buffer := "" . + +ENDPROC open ; + +PROC close (TEXT CONST source file) : + + IF out buffer <> "" + THEN putline (out, out buffer) + FI ; + forget (source file, quiet) ; + copy (scratch space, source file) ; + forget (scratch space) . + +ENDPROC close ; + +BOOL PROC eof : + + IF in pos > LENGTH in buffer + THEN eof (in) + ELSE FALSE + FI + +ENDPROC eof ; + +PROC read char : + + IF in pos > 250 + THEN getline (in, in buffer) ; + in pos := 1 ; + read char + ELIF in pos > LENGTH in buffer + THEN in pos := 1 ; + getline (in, in buffer) ; + char := ""13"" + ELSE char := in buffer SUB in pos ; + in pos INCR 1 + FI . + +ENDPROC read char ; + +PROC write char : + + IF char = ""13"" + THEN putline (out, out buffer) ; + out buffer := "" + ELSE out buffer CAT char + FI ; + IF LENGTH out buffer = 250 + THEN putline (out, out buffer) ; + out buffer := "" + FI . + +ENDPROC write char ; + +ENDPACKET cryptograf ; + diff --git a/system/std.zusatz/1.8.7/src/eumel printer.5 b/system/std.zusatz/1.8.7/src/eumel printer.5 new file mode 100644 index 0000000..e61a073 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/eumel printer.5 @@ -0,0 +1,3473 @@ +PACKET eumel printer (* Autor : Rudolf Ruland *) + (* Version : 5 *) + (* Stand : 25.04.88 *) + DEFINES print, + with elan listings, + is elan source, + bottom label for elan listings, + x pos, + y pos, + y offset index, + line type, + material, + pages printed, + +(* >>> ***************************************************************** <<< *) +(* >>> Aus Kompatibilitätsgründen zur Textverarbeitung der Version 1.8.0 <<< *) +(* >>> siehe bei 'Berechnung des Zeilenvorschubs' <<< *) + + old linefeed : + +BOOL VAR old linefeed calculation := TRUE; + +PROC old linefeed (BOOL CONST value) : old linefeed calculation := value END PROC old linefeed; + +BOOL PROC old linefeed : old linefeed calculation END PROC old linefeed; + +(* >>> ***************************************************************** <<< *) + +INT CONST int length := length of one int; + +. length of one int : + INT VAR int counter := 0, int value := max int; + REP int counter INCR 1; + int value := int value DIV 256; + UNTIL int value = 0 PER; + int counter +.; + +(* >>> ***************************************************************** <<< *) + +LET std x wanted = 2.54, + std y wanted = 2.35, + std limit = 16.0, + std pagelength = 25.0, + std linefeed faktor = 1.0, + std material = ""; + +LET blank = " ", + blank code 1 = 33, + geschuetztes blank = ""223"", + keine blankanalyse = 0, + einfach blank = 1, + doppel blank = 2, + + anweisungszeichen = "#", + anweisungszeichen code 1 = 36, + geschuetztes anweisungszeichen = ""222"", + druckerkommando zeichen = "/", + quote = """", + kommentar zeichen = "-", + + punkt = ".", + + leer = 0, + + kommando token = 0, + text token = 1, + + underline linetype = 1, +(* fraction linetype = 2, + root linetype = 3, +*) + underline bit = 0, + bold bit = 1, + italics bit = 2, + modifikations liste = "ubir", + anzahl modifikationen = 4, + + document = 1, + page = 2, + + write text = 1, + write cmd = 2, + carriage return = 3, + move = 4, + draw = 5, + on = 6, + off = 7, + type = 8, + + text code = 1, +(* error code = 2, *) + token code = 3, + + tag type = 1, + bold type = 2, + number type = 3, + text type = 4, + delimiter type = 6, + eof type = 7; + + +INT CONST null ausgang := minint, + erweiterungs ausgang := maxint, + blank ausgang := maxint - 1, + anweisungs ausgang := maxint - 2, + d code ausgang := maxint - 3, + max breite := maxint - 4, + + linien token := -1; + +ROW anzahl modifikationen INT CONST modifikations werte := + ROW anzahl modifikationen INT : (1, 2, 4, 8); + +TEXT CONST anweisungsliste := + "type:1.1on:2.1off:3.1center:4.0right:5.0u:6.0d:7.0e:8.0b:9.0" + + "fillchar:10.1mark:11.2markend:12.0" + + "ub:13.0ue:14.0fb:15.0fe:16.0" + + "block:20.0columns:21.2columnsend:22.0free:23.1limit:24.1linefeed:25.1" + + "material:26.1page:27.01pagelength:29.1start:30.2" + + "table:31.0tableend:32.0clearpos:33.01" + + "lpos:35.1rpos:36.1cpos:37.1dpos:38.2bpos:39.2" + + "textbegin:40.02textend:42.0" + + "indentation:43.1ytab:44.1"; + +LET a type = 1, a block = 20, + a on = 2, a columns = 21, + a off = 3, a columnsend = 22, + a center = 4, a free = 23, + a right = 5, a limit = 24, + a up = 6, a linefeed = 25, + a down = 7, a material = 26, + a end up or down = 8, a page0 = 27, + a bsp = 9, a page1 = 28, + a fill char = 10, a pagelength = 29, + a mark = 11, a start = 30, + a markend = 12, a table = 31, + a ub = 13, a tableend = 32, + a ue = 14, a clearpos0 = 33, + a fb = 15, a clearpos1 = 34, + a fe = 16, a lpos = 35, + a rpos = 36, + a cpos = 37, + a dpos = 38, + a bpos = 39, + a textbegin0 = 40, + a textbegin2 = 41, + a textend = 42, + a indentation = 43, + a y tab = 44; + +INT VAR a xpos, a breite, a font, a modifikationen, + a modifikationen fuer x move, a ypos, aktuelle ypos, + letzter font, letzte modifikationen, + d ypos, d xpos, d font, d modifikationen, + + zeilenpos, alte zeilenpos, zeilen laenge, anzahl zeichen, ausgang, + anzahl einrueck blanks, blankbreite, fuehrende anweisungen, + einrueckbreite, aktuelle einrueckbreite, alte einrueckbreite, + aktuelle zeilentiefe der letzten zeile, + blankmodus, alter blankmodus, + token zeiger, erstes token der zeile, + + erstes tab token, tab anfang, anzahl blanks, + d code 1, d pitch, fuell zeichen breite, erstes fuell token, + letztes fuell token, + + x size, y size, x wanted, y wanted, x start, y start, + pagelength, limit, indentation, + left margin, top margin, seitenlaenge, + papierlaenge, papierbreite, + luecke, anzahl spalten, aktuelle spalte, + + verschiebung, linien verschiebung, + rest, neue modifikationen, modifikations modus, pass, + + int param, anweisungs index, anzahl params, + + gedruckte seiten; + +BOOL VAR zeile ist absatzzeile, letzte zeile war absatzzeile, + zeile muss geblockt werden, rechts, a block token, offsets, + tabellen modus, block modus, center modus, right modus, + seite ist offen, vor erster seite; + +REAL VAR linefeed faktor, real param; + +TEXT VAR zeile, anweisung, par1, par2, material wert, replacements, + fuell zeichen, d string, font offsets; + +ROW 256 INT VAR zeichenbreiten, replacement tabelle, zeichen zaehler; + +INITFLAG VAR in dieser task := FALSE; + +. zeile ist zu ende : zeilenpos > zeilen laenge + +. zeilen breite : a xpos - left margin + +. naechstes zeichen ist blank : pos (zeile, blank, zeilenpos + 1, zeilenpos + 1) <> 0 + +. naechstes nicht blankes zeichen : pos (zeile, ""33"", ""255"", zeilenpos) + +. in letzter spalte : aktuelle spalte >= anzahl spalten + +. anfangs blankmodus : + INT VAR dummy; + IF center modus OR right modus + THEN dummy + ELIF index zaehler = 0 + THEN blankmodus + ELSE alter blankmodus + FI + +. initialisiere tab variablen : + erstes tab token := token index f + 1; + tab anfang := zeilen breite; + anzahl blanks := 0; + a block token := FALSE; +.; + +(******************************************************************) + +LET zeilen nr laenge = 4, + teil einrueckung = 5, + + headline pre = "Zeile **** E L A N EUMEL 1.8.2 **** ", + headline post = " **** "; + +INT VAR zeilen nr, rest auf seite, + max zeichen zeile, max zeichen fuss, layout laenge, layout laenge name, + symbol type, naechster symbol type, select counter; + +BOOL VAR vor erstem packet, innerhalb einer liste; + +TEXT VAR bottom label, dateiname, layout blanks, refinement layout zeile; + + +. symbol : fuell zeichen +. naechstes symbol : d string +. elan text : d token. text +.; + +(******************************************************************) +(*** Berechnung des Zeilenvorschubs ***) + +INT VAR fonthoehe, fonttiefe, fontdurchschuss, + groesste fonthoehe, groesste fonttiefe, + groesste analysatorhoehe, groesste analysatortiefe, + letzte zeilenhoehe, letzte zeilentiefe, + aktuelle zeilenhoehe, aktuelle zeilentiefe; +REAL VAR real fontgroesse; + +. fontgroesse : fonthoehe + fonttiefe +. groesste fontgroesse : groesste fonthoehe + groesste fonttiefe +. letzte zeilengroesse : letzte zeilenhoehe + letzte zeilentiefe +. aktuelle zeilengroesse : aktuelle zeilenhoehe + aktuelle zeilentiefe + +. + initialisiere zeilenvorschub : + aktuelle zeilenhoehe := letzte zeilenhoehe; + aktuelle zeilentiefe := letzte zeilentiefe; + groesste fonthoehe := fonthoehe; + groesste fonttiefe := fonttiefe; + groesste analysatorhoehe := 0; + groesste analysatortiefe := 0; + +. + ueberpruefe groesste fontgroesse : + IF old linefeed calculation + THEN +(* >>> Maximumsbestimmung über Fontgröße ******************************* <<< *) + IF fontgroesse >= groesste fontgroesse + THEN groesste fonthoehe := fonthoehe; + groesste fonttiefe := fonttiefe; + FI; + ELSE +(* >>> Maximumsbestimmung über Fonthöhe und Fonttiefe ****************** <<< *) + groesste fonthoehe := max (fonthoehe, groesste fonthoehe); + groesste fonttiefe := max (fonttiefe, groesste fonttiefe); + FI; + +. + berechne fontgroesse : + fonthoehe INCR (fontdurchschuss DIV 2 + fontdurchschuss MOD 2); + fonttiefe INCR fontdurchschuss DIV 2; + real fontgroesse := real (fontgroesse); + +. + berechne letzte zeilengroesse : + REAL CONST zeilengroesse := real fontgroesse * linefeed faktor; + letzte zeilenhoehe := int (real (fonthoehe) * zeilengroesse / real fontgroesse + 0.5); + letzte zeilentiefe := int (zeilengroesse + 0.5) - letzte zeilenhoehe; +.; + +PROC berechne aktuelle zeilengroesse : + + IF linefeed faktor >= 1.0 + THEN aktuelle zeilenhoehe := max (groesste fonthoehe, letzte zeilenhoehe); + aktuelle zeilentiefe := max (groesste fonttiefe, letzte zeilentiefe); + ELSE + IF old linefeed calculation + THEN +(* >>> Maximumsbestimmung über Fontgröße ******************************* <<< *) + IF letzte zeilengroesse >= aktuelle zeilengroesse + THEN aktuelle zeilenhoehe := letzte zeilenhoehe; + aktuelle zeilentiefe := letzte zeilentiefe; + FI; + ELSE +(* >>> Maximumsbestimmung über Fonthöhe und Fonttiefe ****************** <<< *) + aktuelle zeilenhoehe := max (letzte zeilenhoehe, aktuelle zeilenhoehe); + aktuelle zeilentiefe := max (letzte zeilentiefe, aktuelle zeilentiefe); + FI; + FI; + aktuelle zeilenhoehe := max (groesste analysatorhoehe, aktuelle zeilenhoehe); + aktuelle zeilentiefe := max (groesste analysatortiefe, aktuelle zeilentiefe); + +END PROC berechne aktuelle zeilengroesse; + +(******************************************************************) +(*** tokenspeicher ***) + +LET max number token = 3000, + max number ypos = 1000, + + TOKEN = STRUCT (TEXT text, + INT xpos, breite, font, modifikationen, + modifikationen fuer x move, + offset index, naechster token index, + BOOL block token ), + + YPOS = STRUCT (INT ypos, vorheriger ypos index, naechster ypos index, + erster token index, letzter token index ), + + TOKENLISTE = STRUCT (ROW max number token TOKEN token liste, + ROW max number ypos YPOS ypos liste ); + +DATASPACE VAR ds; + +BOUND TOKENLISTE VAR tokenspeicher; + +TOKEN VAR d token, offset token; + +INT VAR erster ypos index a, letzter ypos index a, + erster ypos index d, letzter ypos index d, + ypos index, ypos index f, ypos index a, ypos index d, + token index, token index f; + +. t : tokenspeicher. token liste (token index) +. tf : tokenspeicher. token liste (token index f) + +. y : tokenspeicher. ypos liste (ypos index) +. yf : tokenspeicher. ypos liste (ypos index f) +. ya : tokenspeicher. ypos liste (ypos index a) +. yd : tokenspeicher. ypos liste (ypos index d) + +. loesche druckspeicher : + erster ypos index d := 0; + ypos index f := 0; + token index f := 0; + +. druckspeicher ist nicht leer : + erster ypos index d <> 0 + +. loesche analysespeicher : + erster ypos index a := 0; + +. analysespeicher ist nicht leer : + erster ypos index a <> 0 +.; + +(******************************************************************) +(*** anweisungsspeicher ***) + +INT VAR anweisungszaehler; +TEXT VAR anweisungs indizes, params1 zeiger, params2 zeiger; +THESAURUS VAR params1, params2; + +PROC loesche anweisungsspeicher : + + anweisungs zaehler := 0; + anweisungs indizes := ""; + params1 zeiger := ""; + params2 zeiger := ""; + params1 := empty thesaurus; + params2 := empty thesaurus; + +END PROC loesche anweisungsspeicher; + +(******************************************************************) +(*** indexspeicher ***) + +INT VAR index zaehler, hoechster index zaehler; +TEXT VAR letzte index breite, xpos vor index, zeilenpos nach index, grosse fonts, + index verschiebung; + +PROC loesche indexspeicher : + + index zaehler := 0; + hoechster index zaehler := 0; + letzte index breite := ""; + xpos vor index := ""; + zeilenpos nach index := ""; + index verschiebung := ""; + grosse fonts := ""; + +END PROC loesche indexspeicher; + + +PROC loesche hoehere index level : + + IF hoechster index zaehler > index zaehler + THEN letzte index breite := subtext (letzte index breite, 1, int length * index zaehler); + xpos vor index := subtext (xpos vor index, 1, int length * index zaehler); + zeilenpos nach index := subtext (zeilenpos nach index, 1, int length * index zaehler); + index verschiebung := subtext (index verschiebung, int length * index zaehler); + grosse fonts := subtext (grosse fonts, 1, int length * index zaehler); + hoechster index zaehler := index zaehler; + FI; + +END PROC loesche hoehere index level; + +(******************************************************************) +(*** tabellenspeicher ***) + +LET max tabs = 30, + TABELLENEINTRAG = STRUCT (INT tab typ, tab position, tab param); + +TEXT VAR tab liste, fill char; +THESAURUS VAR d strings; +ROW max tabs TABELLENEINTRAG VAR tabspeicher; + +INT VAR tab index; + +. tab typ : tab speicher (tab liste ISUB tab index). tab typ +. tab position : tab speicher (tab liste ISUB tab index). tab position +. tab param : tab speicher (tab liste ISUB tab index). tab param +. anzahl tabs : LENGTH tab liste DIV int length +.; + +PROC loesche tabellenspeicher : + + fill char := " "; + tabliste := ""; + d strings := empty thesaurus; + FOR tab index FROM 1 UPTO max tabs + REP tab speicher (tab index). tab typ := leer PER; + +END PROC loesche tabellenspeicher; + +(******************************************************************) +(*** markierungsspeicher ***) + +INT VAR mark index l, mark index r, alter mark index l, alter mark index r; + +ROW 4 TOKEN VAR mark token; + +. markierung links : mark index l > 0 +. markierung rechts : mark index r > 0 +.; + +PROC loesche markierung : + + mark index l := 0; + mark index r := 0; + +END PROC loesche markierung; + + +PROC loesche alte markierung : + + alter mark index l := 0; + alter mark index r := 0; + +END PROC loesche alte markierung; + + +PROC initialisiere markierung : + + FOR mark index l FROM 1 UPTO 4 + REP mark token (mark index l). modifikationen fuer x move := 0; + mark token (mark index l). offset index := text token; + mark token (mark index l). block token := FALSE; + mark token (mark index l). naechster token index := 0; + PER; + +END PROC initialisiere markierung; + +(******************************************************************) +(*** durchschuss ***) + +INT VAR durchschuss 1, durchschuss 2, anzahl durchschuss 1, + anzahl durchschuss, zeilen zaehler; + +BOOL VAR wechsel := TRUE; + +INT PROC durchschuss : + + zeilen zaehler INCR 1; + IF zeilen zaehler <= anzahl durchschuss 1 + THEN durchschuss 1 + ELIF zeilen zaehler <= anzahl durchschuss + THEN durchschuss 2 + ELSE 0 + FI + +END PROC durchschuss; + + +PROC neuer durchschuss (INT CONST anzahl, rest l) : + + zeilen zaehler := 0; + anzahl durchschuss := anzahl; + IF anzahl > 0 + THEN IF wechsel + THEN durchschuss 1 := rest l DIV anzahl durchschuss; + durchschuss 2 := durchschuss 1 + sign (rest l); + anzahl durchschuss 1 := anzahl durchschuss - + abs (rest l) MOD anzahl durchschuss; + wechsel := FALSE; + ELSE durchschuss 2 := rest l DIV anzahl durchschuss; + durchschuss 1 := durchschuss 2 + sign (rest l); + anzahl durchschuss 1 := abs (rest l) MOD anzahl durchschuss; + wechsel := TRUE; + FI; + ELSE loesche durchschuss + FI; + +END PROC neuer durchschuss; + + +PROC loesche durchschuss : + + durchschuss 1 := 0; + durchschuss 2 := 0; + anzahl durchschuss 1 := 0; + anzahl durchschuss := 0; + zeilen zaehler := 0; + +END PROC loesche durchschuss; + +(****************************************************************) + +PROC initialisierung : + + INT VAR index; + forget (ds); + ds := nilspace; tokenspeicher := ds; + loesche druckspeicher; + loesche anweisungsspeicher; + loesche indexspeicher; + initialisiere markierung; + right modus := FALSE; + center modus := FALSE; + seite ist offen := FALSE; + pass := 0; + a breite := 0; + a modifikationen fuer x move := 0; + aktuelle zeilentiefe der letzten zeile := 0; + d code 1 := leer; + erstes fuell token := leer; + IF two bytes + THEN FOR index FROM 1 UPTO 129 REP zeichen zaehler (index) := 1 PER; + FOR index FROM 130 UPTO 160 REP zeichen zaehler (index) := - maxint PER; + FOR index FROM 161 UPTO 224 REP zeichen zaehler (index) := 1 PER; + FOR index FROM 225 UPTO 240 REP zeichen zaehler (index) := - maxint PER; + FOR index FROM 241 UPTO 256 REP zeichen zaehler (index) := 1 PER; + ELSE FOR index FROM 1 UPTO 256 REP zeichen zaehler (index) := 1 PER; + FI; + +END PROC initialisierung; + +(****************************************************************) +(*** print - Kommando ***) + +BOOL VAR elan listings erlaubt; +FILE VAR eingabe; +THESAURUS VAR elan bolds := empty thesaurus; + +insert (elan bolds, "PACKET"); insert (elan bolds, "PROC"); +insert (elan bolds, "PROCEDURE"); insert (elan bolds, "OP"); +insert (elan bolds, "OPERATOR"); insert (elan bolds, "LET"); +insert (elan bolds, "ROW"); insert (elan bolds, "STRUCT"); +insert (elan bolds, "TYPE"); insert (elan bolds, "BOUND"); +insert (elan bolds, "IF"); insert (elan bolds, "REP"); +insert (elan bolds, "REPEAT"); insert (elan bolds, "FOR"); +insert (elan bolds, "WHILE"); insert (elan bolds, "SELECT"); + +with elan listings (TRUE); + +PROC with elan listings (BOOL CONST flag) : + elan listings erlaubt := flag; +END PROC with elan listings; + +BOOL PROC with elan listings : elan listings erlaubt END PROC with elan listings; + + +PROC print (FILE VAR file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + eingabe := file; + input (eingabe); + print (PROC (TEXT VAR) lese zeile, BOOL PROC is eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) std analysator, + elan listings erlaubt CAND is elan source (eingabe), + headline (eingabe) ); + +END PROC print; + + +PROC print (FILE VAR file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator ) : + + eingabe := file; + input (eingabe); + print (PROC (TEXT VAR) lese zeile, BOOL PROC is eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator, + elan listings erlaubt CAND is elan source (eingabe), + headline (eingabe) ); + +END PROC print; + +PROC lese zeile (TEXT VAR zeile l) : getline (eingabe, zeile l) END PROC lese zeile; + +BOOL PROC is eof : eof (eingabe) END PROC is eof; + + +BOOL PROC is elan source (FILE VAR eingabe l) : + +hole erstes symbol; +elan programm tag COR elan programm bold COR kommentar COR elanlist anweisung + +. elan programm tag : + symbol type = tag type CAND pos (zeile, ";") > 0 + +. elan programm bold : + symbol type = bold type CAND is elan bold + + . is elan bold : + (elan bolds CONTAINS symbol) COR deklaration COR proc oder op (naechstes symbol) + + . deklaration : + next symbol (naechstes symbol); + naechstes symbol = "VAR" OR naechstes symbol = "CONST" + +. kommentar : + pos (zeile, "(*") > 0 OR pos (zeile, "{") > 0 + +. elanlist anweisung : + symbol = "#" AND elanlist folgt + + . elanlist folgt : + next symbol (naechstes symbol); + naechstes symbol = "elanlist" + +. + hole erstes symbol : + hole erstes nicht blankes symbol; + scan (zeile); + next symbol (symbol, symbol type); + + . hole erstes nicht blankes symbol : + IF eof (eingabe l) THEN LEAVE is elan source WITH FALSE FI; + REP getline (eingabe l, zeile); + UNTIL pos (zeile, ""33"",""254"", 1) > 0 OR eof (eingabe l) PER; + reset (eingabe l); + +END PROC is elan source; + +(****************************************************************) + +bottom label for elan listings (""); + +PROC bottom label for elan listings (TEXT CONST label) : + bottom label := label; +END PROC bottom label for elan listings; + +TEXT PROC bottom label for elan listings : bottom label END PROC bottom label for elan listings; + + +PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator, + BOOL CONST elan listing, TEXT CONST file name) : + +disable stop; +gedruckte seiten := 0; +drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator, + elan listing, file name ); +IF is error THEN behandle fehlermeldung FI; + +. behandle fehlermeldung : + TEXT CONST fehler meldung := error message; + INT CONST fehler zeile := error line, + fehler code := error code; + clear error; + IF NOT vor erster seite + THEN IF seite ist offen + THEN schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ) + FI; + clear error; + close (document, 0); + clear error; + FI; + initialisierung; + errorstop (fehler code, fehler meldung (* + " -> " + text (fehler zeile) *) ); + +END PROC print; + +d xpos := 0; +d ypos := 0; +d token. offset index := 1; +material wert := ""; +gedruckte seiten := 0; + +INT PROC x pos : d xpos END PROC x pos; +INT PROC y pos : d ypos END PROC y pos; +INT PROC y offset index : d token. offset index END PROC y offset index; +INT PROC linetype : - d token. offset index END PROC linetype; +TEXT PROC material : material wert END PROC material; +INT PROC pages printed : gedruckte seiten END PROC pages printed; + +(****************************************************************) + +PROC drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator, + BOOL CONST elan listing, TEXT CONST file name ) : + + +enable stop; +IF elan listing + THEN dateiname := file name; + drucke elan listing; + ELSE drucke text datei; +FI; + +. + drucke text datei : + initialisiere druck; + WHILE NOT eof + REP next line (zeile); + analysiere zeile (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + drucke token soweit wie moeglich; + werte anweisungsspeicher aus; + PER; + schliesse druck ab; + +. + initialisiere druck : + IF NOT initialized (in dieser task) + THEN ds := nilspace; + initialisierung + FI; + vor erster seite := TRUE; + tabellen modus := FALSE; + block modus := FALSE; + zeile ist absatzzeile := TRUE; + x wanted := x step conversion (std x wanted); + y wanted := y step conversion (std y wanted); + limit := x step conversion (std limit); + pagelength := y step conversion (std pagelength); + linefeed faktor := std linefeed faktor; + material wert := std material; + indentation := 0; + modifikations modus := maxint; + seitenlaenge := maxint; + papierlaenge := maxint; + left margin := 0; + top margin := 0; + a ypos := top margin; + a font := -1; + a modifikationen := 0; + aktuelle spalte := 1; + anzahl spalten := 1; + stelle neuen font ein (1); + loesche tabellenspeicher; + loesche markierung; + loesche alte markierung; + loesche durchschuss; + +. + schliesse druck ab : + IF NOT vor erster seite + THEN IF seite ist offen + THEN schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ) + FI; + close (document, 0); + FI; + +. + drucke token soweit wie moeglich : + IF analysespeicher ist nicht leer + THEN letztes token bei gleicher ypos; + IF NOT seite ist offen + THEN eroeffne seite (x wanted, y wanted, + PROC (INT CONST, INT VAR, INT VAR) open); + FI; + IF seitenlaenge ueberschritten OR papierlaenge ueberschritten + THEN neue seite oder spalte; + analysiere zeile nochmal; + ELSE sortiere neue token ein; + IF in letzter spalte + THEN drucke tokenspeicher (a ypos, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + FI; + FI; + + . seitenlaenge ueberschritten : + a ypos + aktuelle zeilentiefe > seitenlaenge + + . papierlaenge ueberschritten : + a ypos + aktuelle zeilentiefe > papierlaenge + + . neue seite oder spalte : + IF in letzter spalte + THEN INT CONST aktuelles y wanted := y wanted bei seitenwechel ohne page; + schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + eroeffne seite (x wanted, aktuelles y wanted, + PROC (INT CONST, INT VAR, INT VAR) open); + ELSE neue spalte; + FI; + + . y wanted bei seitenwechel ohne page : + IF seitenlaenge ueberschritten + THEN y wanted + ELSE 0 + FI + + . analysiere zeile nochmal : + setze auf alte werte zurueck; + loesche anweisungsspeicher; + analysiere zeile (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + letztes token bei gleicher ypos; + sortiere neue token ein; + + . setze auf alte werte zurueck : + zeile ist absatzzeile := letzte zeile war absatzzeile; + a modifikationen := letzte modifikationen; + stelle neuen font ein (letzter font); + +. + werte anweisungsspeicher aus : + INT VAR index; + FOR index FROM 1 UPTO anweisungszaehler + REP + SELECT anweisungs indizes ISUB index OF + CASE a block : block anweisung + CASE a columns : columns anweisung + CASE a columnsend : columnsend anweisung + CASE a free : free anweisung + CASE a limit : limit anweisung + CASE a linefeed : linefeed anweisung + CASE a material : material anweisung + CASE a page0, a page1 : page anweisung + CASE a pagelength : pagelength anweisung + CASE a start : start anweisung + CASE a table : table anweisung + CASE a tableend : tableend anweisung + CASE a clearpos0 : clearpos0 anweisung + CASE a clearpos1 : clearpos1 anweisung + CASE a lpos, a rpos, a cpos, a dpos + : lpos rpos cpos dpos anweisung + CASE a bpos : bpos anweisung + CASE a fillchar : fillchar anweisung + CASE a textbegin0 : textbegin0 anweisung + CASE a textbegin2 : textbegin2 anweisung + CASE a textend : textend anweisung + CASE a indentation : indentation anweisung + CASE a y tab : y tab anweisung + END SELECT + PER; + loesche anweisungsspeicher; + + . block anweisung : + blockmodus := TRUE; + + . columns anweisung : + IF anzahl spalten = 1 AND int conversion ok (param1) + AND real conversion ok (param2) + THEN anzahl spalten := max (1, int param); + luecke := x step conversion (real param); + FI; + + . columnsend anweisung : + anzahl spalten := 1; + aktuelle spalte := 1; + left margin := x wanted - x start + indentation; + + . free anweisung : + IF real conversion ok (param1) THEN a ypos INCR y step conversion (real param) FI; + + . limit anweisung : + IF real conversion ok (param1) THEN limit := x step conversion (real param) FI; + + . linefeed anweisung : + IF real conversion ok (param1) + THEN linefeed faktor := real param; + berechne letzte zeilengroesse; + FI; + + . material anweisung : + material wert := param1; + + . page anweisung : + IF seite ist offen + THEN IF NOT in letzter spalte + THEN neue spalte + ELSE schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + papier laenge := maxint; + FI; + ELSE a ypos := top margin; + papier laenge := maxint; + FI; + + . pagelength anweisung : + IF real conversion ok (param1) + THEN pagelength := y step conversion (real param); + FI; + + . start anweisung : + IF real conversion ok (param1) THEN x wanted := x step conversion (real param) FI; + IF real conversion ok (param2) THEN y wanted := y step conversion (real param) FI; + + . table anweisung : + tabellenmodus := TRUE; + + . tableend anweisung : + tabellenmodus := FALSE; + + . clearpos0 anweisung : + loesche tabellenspeicher; + + . clearpos1 anweisung : + IF real conversion ok (param1) + THEN int param := x step conversion (real param); + FOR tab index FROM 1 UPTO anzahl tabs + REP IF tab position = int param + THEN tab typ := leer; + delete int (tab liste, tab index); + LEAVE clearpos1 anweisung; + FI; + PER; + FI; + + . lpos rpos cpos dpos anweisung : + IF real conversion ok (param1) + THEN neuer tab eintrag (anweisungs indizes ISUB index, param2) FI; + + . bpos anweisung : + IF real conversion ok (param2) CAND real conversion ok (param1) + CAND real (param2) > real param + THEN neuer tab eintrag (a bpos, param2) FI; + + . fillchar anweisung : + fill char := param1; + + . textbegin0 anweisung : + aktuelle einrueckbreite := alte einrueckbreite; + mark index l := alter mark index l; + mark index r := alter mark index r; + loesche alte markierung; + + . textbegin2 anweisung : + aktuelle einrueckbreite := alte einrueckbreite; + mark index l := alter mark index l; + mark index r := alter mark index r; + loesche alte markierung; + neuer durchschuss (int (param1), y step conversion (real (param 2))); + + . textend anweisung : + alte einrueckbreite := aktuelle einrueckbreite; + alter mark index l := mark index l; + alter mark index r := mark index r; + loesche markierung; + loesche durchschuss; + + . indentation anweisung : +(**) IF real conversion ok (param1) + THEN int param := x step conversion (real param); + left margin INCR (int param - indentation); + indentation := int param; + FI; +(**) + . y tab anweisung : +(**) IF real conversion ok (param1) + THEN int param := y step conversion (real param); + IF int param <= seitenlaenge THEN a ypos := int param FI; + FI; +(**) + . param1 : + IF (params1 zeiger ISUB index) <> 0 + THEN name (params1, params1 zeiger ISUB index) + ELSE "" + FI + + . param2 : + IF (params2 zeiger ISUB index) <> 0 + THEN name (params2, params2 zeiger ISUB index) + ELSE "" + FI + + +. + drucke elan listing : + initialisiere elan listing; + WHILE NOT eof + REP next line (zeile); + zeilen nr INCR 1; + drucke elan zeile; + PER; + schliesse elan listing ab; + +. + initialisiere elan listing : + open document cmd; + hole elan list font; + initialisiere variablen; + elan fuss und kopf (1, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + + . open document cmd : + material wert := ""; + d token. offset index := 1; + erster ypos index d := 0; + vor erster seite := FALSE; + seite ist offen := TRUE; + open (document, x size, y size); + vor erster seite := FALSE; + + . hole elan list font : + d font := max (1, font ("elanlist")); + get replacements (d font, replacements, replacement tabelle); + einrueckbreite := indentation pitch (d font) ; + font hoehe := font lead (d font) + font height (d font) + font depth (d font); + + . initialisiere variablen : + innerhalb einer liste := FALSE; + vor erstem packet := TRUE; + zeilen nr := 0; + select counter := 0; + y wanted := y size DIV 23; + pagelength := y size - y wanted - y wanted; + x wanted := (min (x size DIV 10, x step conversion (2.54)) + DIV einrueckbreite) * einrueckbreite; + max zeichen zeile := (x size - x wanted - (x wanted DIV 3)) DIV einrueckbreite; + max zeichen fuss := fusszeilenbreite; + layout laenge := min (38, max zeichen zeile DIV 3); + layout laenge name := layout laenge - zeilen nr laenge - 8; + layout blanks := (layout laenge - zeilen nr laenge - 1) * " "; + refinement layout zeile := (layout laenge - 1) * " " ; + refinement layout zeile CAT "|" ; + IF pagelength DIV fonthoehe - 6 < 35 OR max zeichen zeile < 65 + THEN errorstop ("Schreibfeld fuer 'elan listing' zu klein") FI; + + . fusszeilenbreite : + INT CONST dina 4 breite := x step conversion (21.0); + IF x size <= dina 4 breite + THEN (x size - 2 * x wanted) DIV einrueckbreite + ELIF 120 * einrueckbreite <= dina 4 breite - 2 * x wanted + THEN (dina 4 breite - 2 * x wanted) DIV einrueckbreite + ELSE min (120, (x size - 2 * x wanted) DIV einrueckbreite) + FI + +. + schliesse elan listing ab : + elan fuss und kopf (-1, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + close (document, 0); + +. + drucke elan zeile : + IF pos (zeile, "#page#") = 1 + THEN IF nicht am seiten anfang THEN seiten wechsel FI; + ELIF pos (zeile, "#elanlist#") <> 1 + THEN bestimme elan layout; + bestimme elan zeile; + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + seitenwechsel wenn noetig; + FI; + + . nicht am seitenanfang : + rest auf seite < pagelength - 3 * font hoehe + + . seiten wechsel : + elan fuss und kopf (0, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +. + bestimme elan layout : + IF innerhalb einer liste + THEN leeres layout; + pruefe ende der liste + ELIF pos (zeile, "P") <> 0 COR pos (zeile, ":") <> 0 + THEN analysiere elan zeile + ELIF innerhalb einer select kette + THEN leeres layout; + pruefe ende der select kette + ELIF pos (zeile, "SELECT") <> 0 + THEN analysiere select kette + ELSE leeres layout + FI; + elan text CAT "|"; + + . leeres layout : + elan text := text (zeilen nr, zeilen nr laenge); + elan text CAT layout blanks; + + . analysiere elan zeile : + scan (zeile); + next symbol (symbol, symbol type); + next symbol (naechstes symbol, naechster symbol type); + IF packet anfang + THEN packet layout + ELIF type anfang + THEN type layout + ELIF proc op anfang + THEN proc op layout + ELSE IF innerhalb einer select kette + THEN pruefe ende der select kette; + leeres layout + ELIF refinement anfang + THEN refinement layout + ELSE leeres layout + FI; + FI; + + + . packet anfang : + symbol = "PACKET" + + . type anfang : + symbol = "TYPE" + + . proc op anfang : + IF proc oder op (symbol) + THEN naechster symbol type <> delimiter type + ELIF (symbol <> "END") AND proc oder op (naechstes symbol) + THEN symbol := naechstes symbol; + next symbol (naechstes symbol, naechster symbol type); + naechster symbol type <> delimiter type + ELSE FALSE + FI + + . refinement anfang : + symbol type = tag type AND naechstes symbol = ":" + + . packet layout : + IF nicht am seiten anfang AND + (NOT vor erstem packet OR gedruckte seiten > 1) + THEN seiten wechsel + FI; + layout (" ", naechstes symbol, "*") ; + vor erstem packet := FALSE; + select counter := 0; + innerhalb einer liste := TRUE; + pruefe ende der liste; + + . type layout : + layout (" ", naechstes symbol, "."); + select counter := 0; + + . proc op layout : + IF keine vier zeilen mehr + THEN seiten wechsel + ELIF nicht am seitenanfang + THEN cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI ; + layout (" ", naechstes symbol, "."); + select counter := 0; + innerhalb einer liste := TRUE; + pruefe ende der liste; + + . keine vier zeilen mehr : + rest auf seite <= 8 * font hoehe + + . refinement layout : + IF keine drei zeilen mehr + THEN seiten wechsel + ELIF nicht am seitenanfang + THEN elan text := refinement layout zeile; + gib elan text aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI ; + layout (" ", symbol, " "); + + . keine drei zeilen mehr : + rest auf seite <= 7 * font hoehe + + . pruefe ende der liste : + IF pos (zeile, ":") <> 0 + THEN scan (zeile); + WHILE innerhalb einer liste + REP next symbol (symbol); + IF symbol = ":" THEN innerhalb einer liste := FALSE FI; + UNTIL symbol = "" PER; + FI; + + . innerhalb einer select kette : + select counter > 0 + + . analysiere select kette : + scan (zeile); + naechstes symbol := ""; + REP symbol := naechstes symbol; + next symbol (naechstes symbol); + IF naechstes symbol = "SELECT" CAND symbol <> "END" + THEN select counter := 1; + untersuche select kette; + FI; + UNTIL naechstes symbol = "" PER; + leeres layout; + + . pruefe ende der select kette : + IF pos (zeile, "SELECT") <> 0 + THEN scan (zeile); + naechstes symbol := ""; + untersuche select kette; + FI; + + . untersuche select kette : + REP symbol := naechstes symbol; + next symbol (naechstes symbol); + IF naechstes symbol = "SELECT" + THEN select counter INCR select step + ELIF naechstes symbol = "ENDSELECT" + THEN select counter DECR 1 + FI; + UNTIL naechstes symbol = "" PER; + + . select step : + IF symbol = "END" THEN -1 ELSE 1 FI + +. + bestimme elan zeile : + IF zeile ist nicht zu lang + THEN elan text CAT zeile; + ELSE drucke zeile in teilen + FI; + + . zeile ist nicht zu lang : + zeilen laenge := LENGTH zeile; + zeilen laenge <= rest auf zeile + + . rest auf zeile : + max zeichen zeile - LENGTH elan text + + . drucke zeile in teilen : + zeilen pos := 1; + bestimme einrueckung; + WHILE zeile noch nicht ganz gedruckt REP teil layout PER; + + . bestimme einrueckung : + anzahl einrueck blanks := naechstes nicht blankes zeichen - 1; + IF anzahl einrueck blanks > rest auf zeile - 20 + THEN anzahl einrueck blanks := 0 FI; + + . zeile noch nicht ganz gedruckt : + bestimme zeilenteil; + NOT zeile ist zu ende + + . bestimme zeilenteil : + bestimme laenge; + zeilen teil := subtext (zeile, zeilen pos, zeilen pos + laenge - 1); + elan text CAT zeilen teil; + zeilen pos INCR laenge; + + . zeilen teil : par1 + + . bestimme laenge : + INT VAR laenge := zeilen laenge - zeilen pos + 1; + IF laenge > rest auf zeile + THEN laenge := rest auf zeile; + WHILE (zeile SUB (zeilen pos + laenge - 1)) <> " " + REP laenge DECR 1 UNTIL laenge = 0 PER; + IF laenge = 0 THEN laenge := rest auf zeile FI; + FI; + + . teil layout : + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + elan text := (zeilen nr laenge - 1) * " "; + elan text CAT "+"; + elan text CAT layout blanks; + elan text CAT "|"; + elan text cat blanks (anzahl einrueck blanks + teil einrueckung); + +. + seiten wechsel wenn noetig : + IF keine zeilen mehr AND NOT eof THEN seiten wechsel FI; + + . keine zeilen mehr : + rest auf seite <= 4 * font hoehe + +END PROC drucke datei; + + +BOOL PROC real conversion ok (TEXT CONST param) : + real param := real (param); + last conversion ok AND real param >= 0.0 +END PROC real conversion ok; + + +BOOL PROC int conversion ok (TEXT CONST param) : + int param := int (param); + last conversion ok AND int param >= 0 +END PROC int conversion ok; + + +PROC neuer tab eintrag (INT CONST typ, TEXT CONST param) : + + suche neuen eintrag; + sortiere neue tab position ein; + tab typ := typ; + tab position := neue tab position; + tab param := eventueller parameter; + + . suche neuen eintrag : + INT VAR index := 0; + REP index INCR 1; + IF tab speicher (index). tab typ = leer + THEN LEAVE suche neuen eintrag FI; + UNTIL index = max tabs PER; + LEAVE neuer tab eintrag; + + . sortiere neue tab position ein : + INT VAR neue tab position := x step conversion (real param); + FOR tab index FROM 1 UPTO anzahl tabs + REP IF tab position = neue tab position + THEN LEAVE neuer tab eintrag + ELIF tab position > neue tab position + THEN insert int (tab liste, tab index, index); + LEAVE sortiere neue tab position ein; + FI; + PER; + tab liste CAT index; + tab index := anzahl tabs; + + . eventueller parameter : + INT VAR link; + SELECT typ OF + CASE a dpos : insert (d strings, param, link); link + CASE a bpos : x step conversion (real(param)) + OTHERWISE : 0 + END SELECT + +END PROC neuer tab eintrag; + + +PROC neue spalte : + a ypos := top margin; + aktuelle zeilentiefe der letzten zeile := 0; + left margin INCR (limit + luecke); + aktuelle spalte INCR 1; +END PROC neue spalte ; + + +BOOL PROC proc oder op (TEXT CONST symbol) : + + symbol = "PROC" OR symbol = "PROCEDURE" + OR symbol = "OP" OR symbol = "OPERATOR" + +ENDPROC proc oder op ; + + +PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) : + +name := subtext (name, 1, layout laenge name) ; +elan text := text (zeilen nr, zeilen nr laenge); +elan text CAT pre; +elan text CAT name; +elan text CAT " "; +generiere strukturiertes layout; + +. generiere strukturiertes layout : + INT VAR index; + FOR index FROM 1 UPTO layout laenge - LENGTH elan text - 1 + REP elan text CAT post PER; + +END PROC layout ; + + +PROC elan text cat blanks (INT CONST anzahl) : + + par2 := anzahl * " "; + elan text CAT par2; + +END PROC elan text cat blanks; + + +(***********************************************************************) + +PROC analysiere zeile (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator) : + +loesche analysespeicher; +behandle fuehrende blanks; +pruefe ob markierung links; + +IF tabellen modus + THEN analysiere tabellenzeile +ELIF letzte zeile war absatzzeile + THEN analysiere zeile nach absatzzeile + ELSE analysiere zeile nach blockzeile +FI; + +pruefe center und right modus; +pruefe ob tabulation vorliegt; +werte indexspeicher aus; +IF zeile ist keine anweisungszeile + THEN berechne zeilenvorschub; + pruefe ob markierung rechts; + ELSE behandle anweisungszeile; +FI; + +. + analysiere zeile nach absatzzeile : + test auf aufzaehlung; + IF zeile muss geblockt werden + THEN analysiere blockzeile nach absatzzeile + ELSE analysiere absatzzeile nach absatzzeile + FI; +. + analysiere zeile nach blockzeile : + IF zeile muss geblockt werden + THEN analysiere blockzeile nach blockzeile + ELSE analysiere absatzzeile nach blockzeile + FI; + + +. + behandle fuehrende blanks : + zeilenpos := 1; + zeilenpos := naechstes nicht blankes zeichen; + letzte zeile war absatzzeile := zeile ist absatzzeile; + IF letzte zeile war absatzzeile THEN neue einrueckung FI; + IF zeilenpos = 0 + THEN behandle leerzeile; + LEAVE analysiere zeile; + ELSE initialisiere analyse; + FI; + + . behandle leerzeile : + a ypos INCR (letzte zeilenhoehe + + aktuelle zeilentiefe der letzten zeile + durchschuss); + aktuelle zeilentiefe der letzten zeile := letzte zeilentiefe; + zeile ist absatzzeile := LENGTH zeile > 0; + pruefe ob markierung links; + pruefe ob markierung rechts; + + . neue einrueckung : + aktuelle einrueckbreite := einrueckbreite; + + . initialisiere analyse : + zeile ist absatzzeile := (zeile SUB LENGTH zeile) = blank; + zeile muss geblockt werden := block modus AND NOT zeile ist absatzzeile; + erstes token der zeile := token index f + 1; + zeilen laenge := laenge der zeile; + anzahl einrueck blanks := zeilen pos - 1; + anzahl zeichen := anzahl einrueck blanks; + a xpos := left margin + anzahl zeichen * aktuelle einrueckbreite; + a modifikationen fuer x move := 0; + letzter font := a font; + letzte modifikationen := a modifikationen; + fuehrende anweisungen := 0; + initialisiere zeilenvorschub; + IF zeile muss geblockt werden THEN initialisiere tab variablen FI; + IF hoechster index zaehler > 0 THEN loesche index speicher FI; + + . laenge der zeile : + IF zeile ist absatzzeile + THEN LENGTH zeile - 1 + ELSE LENGTH zeile + FI + +. + pruefe ob markierung links : + INT VAR linkes markierungs token; + IF markierung links + THEN mark token (mark index l). xpos := + left margin - mark token (mark index l). breite; + linkes markierungs token := token index f + 1; + lege markierungs token an (mark index l); + erstes token der zeile := token index f + 1; + initialisiere tab variablen; + ELSE linkes markierungs token := 0; + FI; + +. + analysiere tabellenzeile : + anfangs blankmodus := doppel blank; + alte zeilenpos := zeilen pos; + a xpos := left margin; + FOR tab index FROM 1 UPTO anzahl tabs + REP lege fuell token an wenn noetig; + initialisiere tab variablen; + SELECT tab typ OF + CASE a lpos : linksbuendige spalte + CASE a rpos : rechtsbuendige spalte + CASE a cpos : zentrierte spalte + CASE a dpos : dezimale spalte + CASE a bpos : geblockte spalte + END SELECT; + berechne fuell token wenn noetig; + tabulation; + PER; + analysiere rest der zeile; + + . lege fuell token an wenn noetig : + IF fill char <> blank + THEN fuellzeichen := fill char; + fuellzeichen breite := string breite (fuellzeichen); + token zeiger := zeilen pos; + erstes fuell token := token index f + 1; + lege token an (zeile, token zeiger, zeilen pos - 1, text token); + letztes fuell token := token index f; + a modifikationen fuer x move := a modifikationen + FI; + + . berechne fuell token wenn noetig : + IF erstes fuell token <> leer + THEN IF letztes fuell token <> token index f + THEN berechne fuell token; + ELSE loesche letzte token; + FI; + erstes fuell token := leer + FI; + + . berechne fuell token : + INT VAR anzahl fuellzeichen, fuell breite; + token index := erstes fuell token; + anzahl fuellzeichen := (tab anfang - t. xpos + left margin) + DIV fuellzeichen breite; + rest := (tab anfang - t. xpos + left margin) + MOD fuellzeichen breite; + IF anzahl fuell zeichen > 0 + THEN fuell text := anzahl fuellzeichen * fuellzeichen; + fuell breite := anzahl fuellzeichen * fuellzeichen breite; + FOR token index FROM erstes fuell token UPTO letztes fuell token + REP t. text := fuell text; + t. breite := fuell breite; + IF erstes fuell token <> erstes token der zeile + THEN t. xpos INCR rest DIV 2; + t. modifikationen fuer x move := t. modifikationen; + FI; + PER; + FI; + + . fuell text : par1 + + . loesche letzte token : + FOR token index FROM letztes fuell token DOWNTO erstes fuell token + REP loesche letztes token PER; + + . tabulation : + alte zeilenpos := zeilenpos; + zeilenpos := naechstes nicht blankes zeichen; + IF zeilenpos = 0 + THEN zeilenpos := zeilenlaenge + 1; + LEAVE analysiere tabellenzeile; + FI; + anzahl zeichen INCR zeilenpos - alte zeilenpos; + + . linksbuendige spalte : + a xpos := left margin + tab position; + tab anfang := tab position; + bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + + . rechtsbuendige spalte : + bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + schreibe zeile rechtsbuendig (tab position); + + . zentrierte spalte : + bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + zentriere zeile (tab position); + + . dezimale spalte : + d string := name (d strings, tab param); + d code 1 := code (d string SUB 1) + 1; + d pitch := zeichenbreiten (d code 1); + zeichenbreiten (d code 1) := d code ausgang; + bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + zeichenbreiten (d code 1) := d pitch; + d code 1 := leer; + schreibe zeile rechtsbuendig (tab position); + IF zeichen ist dezimal zeichen + THEN IF tab position <> zeilen breite + THEN a xpos := left margin + tab position; + tab anfang := tab position; + FI; + bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + FI; + + . zeichen ist dezimal zeichen : + pos (zeile, d string, zeilen pos) = zeilen pos + + . geblockte spalte : + blankmodus := einfach blank; + a xpos := left margin + tab position; + tab anfang := tab position; + REP bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + IF zeile ist zu ende OR naechstes zeichen ist blank + THEN blocke spalte wenn noetig; + LEAVE geblockte spalte; + ELSE dehnbares blank gefunden; + FI; + PER; + + . blocke spalte wenn noetig : + IF letztes zeichen ist kein geschuetztes blank + THEN blocke zeile (tab param) FI; + blank modus := doppel blank; + + . letztes zeichen ist kein geschuetztes blank : + pos (zeile, geschuetztes blank, zeilen pos - 1, zeilen pos - 1) = 0 + AND NOT within kanji (zeile, zeilen pos - 2) + + . analysiere rest der zeile : + blankmodus := keine blankanalyse; + zeilen pos := alte zeilenpos; + bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + +. + test auf aufzaehlung : + anfangs blankmodus := einfach blank; + bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + IF zeile ist zu ende + THEN LEAVE analysiere zeile nach absatzzeile + ELSE aufzaehlung moeglich + FI; + + . aufzaehlung moeglich : + bestimme letztes zeichen; + IF (anzahl zeichen bei aufzaehlung < 2 AND letztes zeichen = "-") + OR (anzahl zeichen bei aufzaehlung < 20 AND letztes zeichen = ":") + OR (anzahl zeichen bei aufzaehlung < 7 + AND pos (".)", letztes zeichen) <> 0) + OR naechstes zeichen ist blank + THEN tabulator position gefunden; + ELIF zeile muss geblockt werden + THEN dehnbares blank gefunden; + FI; + + . bestimme letztes zeichen : + token index := token index f; + WHILE token index >= erstes token der zeile + REP IF token ist text token + THEN letztes zeichen := t. text SUB LENGTH t. text; + LEAVE bestimme letztes zeichen; + FI; + token index DECR 1; + PER; + letztes zeichen := ""; + + . letztes zeichen : par1 + + . anzahl zeichen bei aufzaehlung : + anzahl zeichen - anzahl einrueck blanks + + . token ist text token : + t. offset index >= text token +. + analysiere blockzeile nach absatzzeile : + REP bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + IF zeile ist zu ende + THEN blocke zeile (limit); + LEAVE analysiere blockzeile nach absatzzeile + ELSE analysiere blank in blockzeile nach absatzzeile + FI; + PER; + + . analysiere blank in blockzeile nach absatzzeile : + IF naechstes zeichen ist blank + THEN tabulator position gefunden; + ELSE dehnbares blank gefunden; + FI; + +. + analysiere absatzzeile nach absatzzeile : + blankmodus := doppel blank; + REP bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + IF zeile ist zu ende + THEN LEAVE analysiere absatzzeile nach absatzzeile + ELSE tabulator position gefunden + FI; + PER; + +. + analysiere blockzeile nach blockzeile : + anfangs blankmodus := einfach blank; + REP bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + IF zeile ist zu ende + THEN blocke zeile (limit); + LEAVE analysiere blockzeile nach blockzeile + ELSE dehnbares blank gefunden + FI; + PER; + +. + analysiere absatzzeile nach blockzeile : + anfangs blankmodus := keine blankanalyse; + bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + + +. + dehnbares blank gefunden : + anzahl zeichen INCR 1; + zeilenpos INCR 1; + a xpos INCR blankbreite; + a modifikationen fuer x move := a modifikationen; + IF NOT a block token + THEN anzahl blanks INCR 1; + a block token := TRUE; + FI; +. + tabulator position gefunden : + alte zeilenpos := zeilenpos; + zeilenpos := naechstes nicht blankes zeichen; + IF zeilenpos = 0 + THEN zeilenpos := zeilen laenge + 1; + ELSE IF erstes token der zeile > token index f + THEN token zeiger := zeilen pos; + lege token an (zeile, token zeiger, zeilen pos - 1, text token); + FI; + anzahl zeichen INCR (zeilenpos - alte zeilenpos); + a xpos := left margin + anzahl zeichen * aktuelle einrueckbreite; + a modifikationen fuer x move := a modifikationen; + IF zeile muss geblockt werden THEN initialisiere tab variablen FI; + FI; + +. + pruefe center und right modus : + IF center modus THEN zentriere zeile (limit DIV 2) FI; + IF right modus THEN schreibe zeile rechtsbuendig (limit) FI; +. + pruefe ob tabulation vorliegt: + IF analyse speicher ist nicht leer CAND a xpos > tf. xpos + tf. breite + THEN a modifikationen fuer x move := a modifikationen; + token zeiger := zeilen pos; + lege token an (zeile, token zeiger, zeilen pos - 1, text token); + FI; +. + werte indexspeicher aus : + INT VAR index; + IF index zaehler > 0 + THEN FOR index FROM index zaehler DOWNTO 1 + REP a ypos DECR (index verschiebung ISUB index); + IF (letzte index breite ISUB index) <> 0 + THEN a xpos := (xpos vor index ISUB index) + + min (a xpos - (xpos vor index ISUB index), + letzte index breite ISUB index); + FI; + PER; + stelle neuen font ein (grosse fonts ISUB 1); + FI; +. + zeile ist keine anweisungszeile : + fuehrende anweisungen <> zeilen laenge +. + berechne zeilenvorschub : + verschiebung := aktuelle zeilenhoehe + + aktuelle zeilentiefe der letzten zeile + durchschuss; + aktuelle zeilentiefe der letzten zeile := aktuelle zeilentiefe; + a ypos INCR verschiebung; + verschiebe token ypos (verschiebung); + +. + pruefe ob markierung rechts : + IF markierung rechts + THEN mark token (mark index r). xpos := left margin + limit; + lege markierungs token an (mark index r); + FI; +. + behandle anweisungszeile : + IF linkes markierungs token > 0 + THEN IF erstes token der zeile = token index f + 1 + THEN loesche analysespeicher; + ELSE FOR token index FROM linkes markierungs token + UPTO erstes token der zeile - 1 + REP t. text := ""; + t. xpos := 0; + t. breite := 0; + PER; + FI; + FI; + +END PROC analysiere zeile; + + +PROC blocke zeile (INT CONST rechter rand) : + +rest := rechter rand - zeilen breite; +IF rest > 0 AND anzahl blanks > 0 + THEN INT CONST schmaler schritt := rest DIV anzahl blanks, + breiter schritt := schmaler schritt + 1, + anzahl breite schritte := rest MOD anzahl blanks; + IF rechts + THEN blocke token xpos (breiter schritt, schmaler schritt, + anzahl breite schritte); + rechts := FALSE; + ELSE blocke token xpos (schmaler schritt, breiter schritt, + anzahl blanks - anzahl breite schritte); + rechts := TRUE; + FI; + a xpos INCR ( breiter schritt * anzahl breite schritte + + schmaler schritt * (anzahl blanks - anzahl breite schritte) ); +FI; + +END PROC blocke zeile; + + +PROC zentriere zeile (INT CONST zentrier pos) : + +IF erstes tab token <= token index f + THEN verschiebung := zentrier pos - tab anfang - + (zeilen breite - tab anfang) DIV 2; + verschiebe token xpos (verschiebung); + a xpos INCR verschiebung; + tab anfang INCR verschiebung; +FI; +center modus := FALSE; + +END PROC zentriere zeile; + + +PROC schreibe zeile rechtsbuendig (INT CONST rechte pos) : + +IF erstes tab token <= token index f + THEN verschiebung := rechte pos - zeilen breite; + verschiebe token xpos (verschiebung); + a xpos INCR verschiebung; + tab anfang INCR verschiebung; +FI; +right modus := FALSE; + + +END PROC schreibe zeile rechtsbuendig; + + +PROC bestimme token bis terminator oder zeilenende + (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator): + +token zeiger := zeilen pos; +REP stranalyze (zeichenbreiten, a breite, max breite, + zeile, zeilen pos, zeilen laenge, + ausgang); + zeilen pos INCR 1; + IF ausgang = blank ausgang + THEN analysiere blank + ELIF ausgang = anweisungs ausgang + THEN anweisung gefunden + ELIF ausgang = d code ausgang + THEN analysiere d string + ELIF ausgang = erweiterungs ausgang + THEN erweiterung gefunden + ELSE terminator oder zeilenende gefunden + FI; +PER; + +. analysiere blank : + IF blankmodus = einfach blank OR + (blankmodus = doppel blank AND naechstes zeichen ist blank) + THEN terminator oder zeilenende gefunden + ELSE a breite INCR blankbreite; + zeilenpos INCR 1; + FI; + +. analysiere d string : + IF pos (zeile, d string, zeilen pos) = zeilen pos + THEN terminator oder zeilenende gefunden + ELSE IF d pitch = maxint + THEN erweiterung gefunden + ELIF d pitch < 0 + THEN a breite INCR (d pitch XOR - maxint - 1); + zeilen pos INCR 2; + ELSE a breite INCR d pitch; + zeilenpos INCR 1; + FI; + FI; + +. erweiterung gefunden : + a breite INCR extended char pitch (a font, zeile SUB zeilen pos, + zeile SUB zeilen pos + 1); + zeilen pos INCR 2; + +. anweisung gefunden : + gegebenfalls neues token gefunden; + analysiere anweisung (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator); + IF zeile ist zu ende + THEN LEAVE bestimme token bis terminator oder zeilenende FI; + token zeiger := zeilenpos; + +. terminator oder zeilenende gefunden : + IF ausgang = null ausgang THEN zeilen laenge DECR 1 FI; + gegebenfalls neues token gefunden; + LEAVE bestimme token bis terminator oder zeilenende; + + . gegebenfalls neues token gefunden : + IF token zeiger < zeilenpos + THEN lege token an (zeile, token zeiger, zeilen pos - 1, text token) FI; + +END PROC bestimme token bis terminator oder zeilen ende; + + +PROC analysiere anweisung (PROC (INT CONST, TEXT VAR, + INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR, INT VAR) analysator) : + + bestimme anweisung; + IF anweisung ist kommando + THEN lege token an (anweisung, 1, maxint, kommando token); + ELIF anweisung ist kein kommentar + THEN werte anweisung aus; + FI; + + . anweisungsende : zeilen pos - 2 + + . erstes zeichen : par1 + +. bestimme anweisung : + INT CONST anweisungsanfang := zeilenpos + 1; + zeilen pos := pos (zeile, anweisungszeichen, anweisungsanfang, zeilenlaenge); + IF zeilenpos = 0 + THEN zeilenpos := anweisungsanfang - 1; + replace (zeile, zeilenpos, geschuetztes anweisungszeichen); + LEAVE analysiere anweisung; + FI; + IF fuehrende anweisungen = anweisungsanfang - 2 THEN fuehrende anweisungen := zeilen pos FI; + zeilen pos INCR 1; + anweisung := subtext (zeile, anweisungsanfang, anweisungsende); + erstes zeichen := anweisung SUB 1; + +. anweisung ist kommando : + IF erstes zeichen = quote + THEN scan (anweisung); + next symbol (anweisung, symbol type); + next symbol (par2, naechster symbol type); + IF symbol type <> text type OR naechster symbol type <> eof type + THEN LEAVE analysiere anweisung FI; + TRUE + ELIF erstes zeichen = druckerkommando zeichen + THEN delete char (anweisung, 1); + TRUE + ELSE FALSE + FI + +. anweisung ist kein kommentar : + erstes zeichen <> kommentar zeichen + +. + werte anweisung aus : + analyze command (anweisungs liste, anweisung, number type, + anweisungs index, anzahl params, par1, par2); + SELECT anweisungs index OF + CASE a type : type anweisung + CASE a on : on anweisung + CASE a off : off anweisung + CASE a ub, a fb : ub fb anweisung + CASE a ue, a fe : ue fe anweisung + CASE a center : center anweisung + CASE a right : right anweisung + CASE a up, a down : index anweisung + CASE a end up or down : end index anweisung + CASE a bsp : bsp anweisung + CASE a fillchar : fillchar anweisung + CASE a mark : mark anweisung + CASE a markend : markend anweisung + OTHERWISE : IF anweisungs index > 0 + THEN speichere anweisung + ELSE rufe analysator + FI; + END SELECT; + + . type anweisung : + change all (par1, " ", ""); + stelle neuen font ein (font (par1)); + a modifikationen := 0; + ueberpruefe groesste fontgroesse; + IF nicht innerhalb eines indexes + THEN berechne aktuelle zeilengroesse FI; + + . nicht innerhalb eines indexes : + index zaehler = 0 + + . on anweisung : + par1 := par1 SUB 1; + IF pos (modifikations liste, par1) > 0 + THEN set bit (a modifikationen, pos (modifikations liste, par1) - 1 ); + FI; + + . off anweisung : + par1 := par1 SUB 1; + IF pos (modifikations liste, par1) > 0 + THEN reset bit (a modifikationen, pos (modifikations liste, par1) - 1 ); + FI; + + . ub fb anweisung : + IF anweisungs index = a ub + THEN par1 := "u" + ELSE par1 := "b" + FI; + on anweisung; + + . ue fe anweisung : + IF anweisungs index = a ue + THEN par1 := "u" + ELSE par1 := "b" + FI; + off anweisung; + + . center anweisung : + IF NOT zeile muss geblockt werden AND NOT tabellen modus + AND NOT right modus + THEN center modus := TRUE; + blankmodus := keine blankanalyse; + initialisiere tab variablen; + FI; + + . right anweisung : + IF NOT zeile muss geblockt werden AND NOT tabellen modus + THEN IF center modus THEN zentriere zeile (limit DIV 2) FI; + right modus := TRUE; + blankmodus := keine blankanalyse; + initialisiere tab variablen; + FI; + + . index anweisung : + INT CONST grosser font := a font, + grosse fonthoehe := fonthoehe, grosse fonttiefe := fonttiefe; + INT VAR kleiner font; + IF next smaller font exists (grosser font, kleiner font) + THEN stelle neuen font ein (kleiner font) FI; + IF font hoehe < grosse fonthoehe + THEN verschiebung := verschiebung fuer kleinen font + ELSE verschiebung := verschiebung fuer grossen font + FI; + a ypos INCR verschiebung; + merke index werte; + + . verschiebung fuer kleinen font : + IF anweisungs index = a down + THEN 15 PROZENT (grosse fonthoehe + grosse fonttiefe) + ELSE - ( 4 PROZENT (grosse fonthoehe + grosse fonttiefe) ) + - (grosse fonthoehe + grosse fonttiefe - fonthoehe - fonttiefe) + FI + + . verschiebung fuer grossen font : + IF anweisungs index = a down + THEN 25 PROZENT (fonthoehe + fonttiefe) + ELSE - (50 PROZENT (fonthoehe + fonttiefe) ) + FI + + . merke index werte : + index zaehler INCR 1; + IF hoechster index zaehler < index zaehler + THEN neues index level + ELSE altes index level + FI; + IF index zaehler = 1 + THEN alter blankmodus := blankmodus; + blankmodus := keine blankanalyse; + FI; + + . neues index level : + hoechster index zaehler := index zaehler; + letzte index breite CAT 0; + xpos vor index CAT a xpos; + zeilenpos nach index CAT -1; + index verschiebung CAT verschiebung; + grosse fonts CAT grosser font; + + . altes index level : + IF (zeilenpos nach index ISUB index zaehler) = anweisungsanfang - 1 + AND sign (index verschiebung ISUB index zaehler) <> sign (verschiebung) + THEN doppelindex gefunden; + ELSE replace (xpos vor index, index zaehler, a xpos); + FI; + replace (index verschiebung, index zaehler, verschiebung); + replace (grosse fonts, index zaehler, grosser font); + + . doppelindex gefunden : + replace (letzte index breite, index zaehler, + a xpos - (xpos vor index ISUB index zaehler)); + a xpos := xpos vor index ISUB index zaehler; + + . end index anweisung : + IF index zaehler > 0 + THEN schalte auf alte index werte zurueck; + FI; + + . schalte auf alte index werte zurueck : + IF index zaehler = 1 THEN blankmodus := alter blankmodus FI; + a ypos DECR (index verschiebung ISUB index zaehler); + stelle neuen font ein (grosse fonts ISUB index zaehler); + IF (letzte index breite ISUB index zaehler) <> 0 + THEN berechne doppelindex + ELSE replace (zeilenpos nach index, index zaehler, zeilenpos); + FI; + index zaehler DECR 1; + + . berechne doppelindex : + a xpos := (xpos vor index ISUB index zaehler) + + max (a xpos - (xpos vor index ISUB index zaehler), + letzte index breite ISUB index zaehler); + replace (zeilenpos nach index, index zaehler, -1); + replace (letzte index breite, index zaehler, 0); + + . bsp anweisung : + INT VAR breite davor, breite dahinter; + IF anweisungs anfang - 2 >= 1 AND anweisungs ende + 2 <= zeilen laenge + THEN IF is kanji esc (zeile SUB anweisungs anfang - 3) + THEN zeichen davor := subtext (zeile, anweisungs anfang - 3, + anweisungs anfang - 2); + ELSE zeichen davor := zeile SUB anweisungs anfang - 2; + FI; + IF is kanji esc (zeile SUB anweisungs ende + 2) + THEN zeichen dahinter := subtext (zeile, anweisungs ende + 2, + anweisungs ende + 3 ); + ELSE zeichen dahinter := zeile SUB anweisungs ende + 2; + FI; + IF pos (" #", zeichen davor) = 0 AND pos (" #", zeichen dahinter) = 0 + THEN breite davor := char pitch (a font, zeichen davor); + breite dahinter := char pitch (a font, zeichen dahinter); + IF breite davor < breite dahinter THEN vertausche zeichen FI; + lege token fuer zeichen dahinter an; + a xpos INCR (breite davor - breite dahinter) DIV 2; + FI; + FI; + + . zeichen davor : par1 + . zeichen dahinter : par2 + + . vertausche zeichen : + change (zeile, anweisungs anfang - 2 - LENGTH zeichen davor + 1, + anweisungs anfang - 2, zeichen dahinter); + change (zeile, anweisungs ende + 2, + anweisungs ende + 2 + LENGTH zeichen dahinter - 1, zeichen davor); + change (tf. text, LENGTH tf. text - LENGTH zeichen davor + 1, + LENGTH tf. text, zeichen dahinter); + tf. breite INCR (breite dahinter - breite davor); + a xpos INCR (breite dahinter - breite davor); + int param := breite davor; + breite davor := breite dahinter; + breite dahinter := int param; + + . lege token fuer zeichen dahinter an : + token zeiger := zeilen pos; + a breite := breite dahinter; + zeilen pos INCR LENGTH zeichen dahinter; + a xpos DECR (breite davor + breite dahinter) DIV 2; + lege token an (zeile, token zeiger, zeilen pos - 1, text token); + anzahl zeichen DECR 1; + + . fillchar anweisung : + IF par1 = "" THEN par1 := " " FI; + fill char := par1; + speichere anweisung; + + . mark anweisung : + IF par1 <> "" + THEN mark index l := (alter mark index l MOD 2) + 1; + neue markierung (par1, mark index l); + ELSE mark index l := 0; + FI; + IF par2 <> "" + THEN mark index r := (alter mark index r MOD 2) + 3; + neue markierung (par2, mark index r); + ELSE mark index r := 0; + FI; + + . markend anweisung : + loesche markierung; + + . speichere anweisung : + anweisungs zaehler INCR 1; + anweisungs indizes CAT anweisungs index; + IF par1 <> "" + THEN insert (params1, par1); + params1 zeiger CAT highest entry (params1); + ELSE params1 zeiger CAT 0; + FI; + IF par2 <> "" + THEN insert (params2, par2); + params2 zeiger CAT highest entry (params2); + ELSE params2 zeiger CAT 0; + FI; + + . rufe analysator : + INT CONST alte xpos := a xpos, alte y pos := a ypos; + INT VAR analysatorbreite, analysatorhoehe, analysatortiefe, + analysator font := a font, + analysator modifikationen := a modifikationen; + zeilen pos := anweisungsanfang - 1; +disable stop; + analysator (text code, zeile, zeilen pos, + analysator font, analysator modifikationen, + analysatorbreite, analysatorhoehe, analysatortiefe, dummy); +IF is error + THEN par1 := error message; + par1 CAT " a1-> "; + par1 CAT text (errorline); + clear error; + errorstop (par1); +FI; +enable stop; + hole token der analyse; + a xpos := alte xpos + analysatorbreite; + a ypos := alte ypos; + a modifikationen := analysator modifikationen; + groesste analysatorhoehe := max (analysatorhoehe, groesste analysator hoehe); + groesste analysatortiefe := max (analysatortiefe, groesste analysator tiefe); + IF analysator font <> a font + THEN stelle neuen font ein (analysator font); + ueberpruefe groesste fontgroesse; + IF nicht innerhalb eines indexes + THEN berechne aktuelle zeilengroesse FI; + ELSE aktuelle zeilenhoehe := max (groesste analysatorhoehe, + aktuelle zeilenhoehe); + aktuelle zeilentiefe := max (groesste analysatortiefe, + aktuelle zeilentiefe); + FI; + + . hole token der analyse : + INT VAR token nr := 0, token font, token xpos, token ypos, token typ; + BOOL VAR font changed := FALSE; + token text := ""; + REP +disable stop; + analysator (token code, token text, token nr, + token font, a modifikationen, a breite, + token xpos, token ypos, token typ); +IF is error + THEN par1 := error message; + par1 CAT " a2-> "; + par1 CAT text (errorline); + clear error; + errorstop (par1); +FI; +enable stop; + IF token nr = 0 + THEN IF font changed THEN a font := -1 FI; + LEAVE hole token der analyse + FI; + IF token font <> a font + THEN a font := token font; + font offsets := y offsets (a font); + offsets := LENGTH font offsets > 2; + font changed := TRUE; + FI; + a xpos := alte xpos + token xpos; + a ypos := alte ypos + token ypos; + lege token an (token text, 1, max int, token typ) + PER; + + . token text : par1 + +END PROC analysiere anweisung; + + +PROC stelle neuen font ein (INT CONST font nr ) : + + IF font nr <> a font THEN neuer font FI; + + . neuer font : + a font := max (1, font nr); + get font (a font, einrueckbreite, fontdurchschuss, fonthoehe, fonttiefe, + zeichenbreiten); + blankbreite := zeichenbreiten (blank code 1); + zeichenbreiten (blank code 1) := blank ausgang; + zeichenbreiten (anweisungs zeichen code 1) := anweisungs ausgang; + font offsets := y offsets (a font); + offsets := LENGTH font offsets > int length; + berechne fontgroesse; + berechne letzte zeilengroesse; + IF d code 1 <> leer + THEN d pitch := zeichenbreiten (d code 1); + zeichenbreiten (d code 1) := d code ausgang; + FI; + +END PROC stelle neuen font ein; + + +INT OP PROZENT (INT CONST prozent, wert) : + + (wert * prozent + 99) DIV 100 + +END OP PROZENT; + + +PROC neue markierung (TEXT CONST text, INT CONST mark index) : + + mark token (mark index). text := text; + mark token (mark index). breite := string breite (text); + mark token (mark index). font := a font; + mark token (mark index). modifikationen := a modifikationen; + +END PROC neue markierung; + + +INT PROC string breite (TEXT CONST string) : + + INT VAR summe := 0, pos := 1; + REP stranalyze (zeichenbreiten, summe, max breite, string, pos, maxint, ausgang); + IF ausgang = erweiterungs ausgang + THEN summe INCR extended char pitch (a font, + string SUB pos+1, string SUB pos+2); + pos INCR 3; + ELIF ausgang = blank ausgang + THEN summe INCR blankbreite; + pos INCR 2; + ELIF ausgang = anweisungs ausgang + THEN summe INCR char pitch (a font, anweisungszeichen); + pos INCR 2; + ELSE LEAVE string breite WITH summe + FI; + PER; + 0 + +END PROC string breite; + +(*******************************************************************) + +PROC lege token an (TEXT CONST token text, + INT CONST token anfang, token ende, token typ) : + + INT VAR anfang := token anfang; + aktuelle ypos := a ypos + (font offsets ISUB 1); + neuer token index; + uebertrage token (tf, token text, token anfang, token ende, token typ); + IF token typ >= text token + THEN IF offsets THEN lege offsets an (font offsets) FI; + stranalyze (zeichen zaehler, anzahl zeichen, max int, + token text, anfang, token ende, ausgang); + a xpos INCR a breite; + FI; + a breite := 0; + a modifikationen fuer x move := 0; + a block token := FALSE; + +END PROC lege token an; + + +PROC uebertrage token (TOKEN VAR tf, TEXT CONST token text, + INT CONST token anfang, token ende, token typ) : + + tf. text := subtext (token text, token anfang, token ende); + tf. xpos := a xpos; + tf. breite := a breite; + tf. font := a font; + tf. modifikationen := a modifikationen; + tf. modifikationen fuer x move := a modifikationen fuer x move; + tf. offset index := token typ; + tf. block token := a block token; + +END PROC uebertrage token; + + +PROC lege markierungs token an (INT CONST mark index) : + + aktuelle ypos := a ypos + (mark font offsets ISUB 1); + neuer token index; + tf := mark token (mark index); + IF mark offsets THEN lege offsets an (mark font offsets) FI; + + . mark font offsets : y offsets (mark token (mark index). font) + + . mark offsets : LENGTH mark font offsets > int length + +END PROC lege markierungs token an; + + +PROC lege offsets an (TEXT CONST offsets l) : + + INT CONST anzahl offsets := LENGTH offsets l DIV int length; + INT VAR index; + offset token := tf; + offset token. block token := FALSE; + reset bit (offset token. modifikationen, underline bit); + reset bit (offset token. modifikationen fuer x move, underline bit); + FOR index FROM 2 UPTO anzahl offsets + REP aktuelle ypos := a ypos + (offsets l ISUB index); + neuer token index; + tf := offset token; + tf. offset index := index; + PER; + +END PROC lege offsets an; + + +PROC neuer token index : + +IF erster ypos index a = 0 + THEN erste ypos +ELIF ya. ypos = aktuelle ypos + THEN neues token bei gleicher ypos + ELSE fuege neue ypos ein +FI; + + . erste ypos : + ypos index f INCR 1; + erster ypos index a := ypos index f; + letzter ypos index a := ypos index f; + yf. vorheriger ypos index := 0; + yf. naechster ypos index := 0; + erstes token bei neuer ypos; + + . fuege neue ypos ein : + letztes token bei gleicher ypos; + IF ya. ypos > aktuelle ypos + THEN richtige ypos ist oberhalb + ELSE richtige ypos ist unterhalb + FI; + + . richtige ypos ist oberhalb : + REP ypos index a := ya. vorheriger ypos index; + IF ypos index a = 0 + THEN fuege ypos vor erstem ypos index ein; + LEAVE richtige ypos ist oberhalb; + ELIF ya. ypos = aktuelle ypos + THEN neues token bei neuer ypos; + LEAVE richtige ypos ist oberhalb; + ELIF ya. ypos < aktuelle ypos + THEN fuege ypos nach ypos index ein; + LEAVE richtige ypos ist oberhalb; + FI; + PER; + + . richtige ypos ist unterhalb : + REP ypos index a := ya. naechster ypos index; + IF ypos index a = 0 + THEN fuege ypos nach letztem ypos index ein; + LEAVE richtige ypos ist unterhalb; + ELIF ya. ypos = aktuelle ypos + THEN neues token bei neuer ypos; + LEAVE richtige ypos ist unterhalb; + ELIF ya. ypos > aktuelle ypos + THEN fuege ypos vor ypos index ein; + LEAVE richtige ypos ist unterhalb; + FI; + PER; + + . fuege ypos vor erstem ypos index ein : + ypos index f INCR 1; + yf. vorheriger ypos index := 0; + yf. naechster ypos index := erster ypos index a; + erster ypos index a := ypos index f; + ypos index a := yf. naechster ypos index; + ya. vorheriger ypos index := ypos index f; + erstes token bei neuer ypos; + + . fuege ypos nach ypos index ein : + ypos index f INCR 1; + yf. vorheriger ypos index := ypos index a; + yf. naechster ypos index := ya. naechster ypos index; + ya. naechster ypos index := ypos index f; + ypos index a := yf. naechster ypos index; + ya. vorheriger ypos index := ypos index f; + erstes token bei neuer ypos; + + . fuege ypos vor ypos index ein : + ypos index f INCR 1; + yf. naechster ypos index := ypos index a; + yf. vorheriger ypos index := ya. vorheriger ypos index; + ya. vorheriger ypos index := ypos index f; + ypos index a := yf. vorheriger ypos index; + ya. naechster ypos index := ypos index f; + erstes token bei neuer ypos; + + . fuege ypos nach letztem ypos index ein : + ypos index f INCR 1; + yf. naechster ypos index := 0; + yf. vorheriger ypos index := letzter ypos index a; + letzter ypos index a := ypos index f; + ypos index a := yf. vorheriger ypos index; + ya. naechster ypos index := ypos index f; + erstes token bei neuer ypos; + +END PROC neuer token index; + + +PROC erstes token bei neuer ypos : + token index f INCR 1; + ypos index a := ypos index f; + ya. erster token index := token index f; + ya. ypos := aktuelle ypos; +END PROC erstes token bei neuer ypos; + + +PROC neues token bei neuer ypos : + token index f INCR 1; + ya. ypos := aktuelle ypos; + token index := ya. letzter token index; + t. naechster token index := token index f; +END PROC neues token bei neuer ypos; + + +PROC neues token bei gleicher ypos : + tf. naechster token index := token index f + 1; + token index f INCR 1; +END PROC neues token bei gleicher ypos; + + +PROC letztes token bei gleicher ypos : + tf. naechster token index := 0; + ya. letzter token index := token index f; +END PROC letztes token bei gleicher ypos; + + +PROC loesche letztes token : + + IF token index f = ya. erster token index + THEN loesche ypos + ELSE token index f DECR 1; + FI; + + . loesche ypos : + kette vorgaenger um; + kette nachfolger um; + bestimme letzten ypos index; + + . kette vorgaenger um : + ypos index := ya. vorheriger ypos index; + IF ypos index = 0 + THEN erster ypos index a := ya. naechster ypos index; + ELSE y. naechster ypos index := ya. naechster ypos index; + FI; + + . kette nachfolger um : + ypos index := ya. naechster ypos index; + IF ypos index = 0 + THEN letzter ypos index a := ya. vorheriger ypos index; + ELSE y. vorheriger ypos index := ya. vorheriger ypos index; + FI; + + . bestimme letzten ypos index : + IF ypos index a = ypos index f THEN ypos index f DECR 1 FI; + token index f DECR 1; + ypos index a := letzter ypos index a; + WHILE ypos index a <> 0 + CAND ya. letzter token index <> token index f + REP ypos index a := ya. vorheriger ypos index PER; + +END PROC loesche letztes token; + + +PROC blocke token xpos (INT CONST dehnung 1, dehnung 2, + anzahl dehnungen fuer dehnung 1 ) : + + INT VAR dehnung := 0, anzahl dehnungen := 0; + token index := erstes tab token; + WHILE token index <= token index f + REP erhoehe token xpos bei block token; + t. xpos INCR dehnung; + token index INCR 1; + PER; + + . erhoehe token xpos bei block token : + IF t. block token + THEN IF anzahl dehnungen < anzahl dehnungen fuer dehnung 1 + THEN anzahl dehnungen INCR 1; + dehnung INCR dehnung 1; + ELSE dehnung INCR dehnung 2; + FI; + FI; + +END PROC blocke token xpos; + + +PROC verschiebe token xpos (INT CONST verschiebung l) : + + token index := erstes tab token; + WHILE token index <= token index f + REP t. xpos INCR verschiebung l; + token index INCR 1; + PER; + +END PROC verschiebe token xpos; + + +PROC verschiebe token ypos (INT CONST verschiebung l) : + + ypos index := erster ypos index a; + WHILE ypos index <> 0 + REP y. ypos INCR verschiebung l; + ypos index := y. naechster ypos index; + PER; + +END PROC verschiebe token ypos; + + +PROC sortiere neue token ein : + +INT VAR index; +IF analysespeicher ist nicht leer + THEN IF druckspeicher ist nicht leer + THEN sortiere neue token in sortierte liste ein + ELSE sortierte liste ist leer + FI; +FI; + +. sortierte liste ist leer : + IF erster ypos index a <> 0 + THEN erster ypos index d := erster ypos index a; + letzter ypos index d := letzter ypos index a; + ypos index d := letzter ypos index a; + FI; + +. sortiere neue token in sortierte liste ein : + gehe zum ersten neuen token; + bestimme erste einsortierposition; + WHILE es gibt noch neue token + REP IF ypos index d = 0 + THEN haenge neue token ans ende der sortierten liste + ELIF ya. ypos > yd. ypos + THEN naechste ypos der sortierten liste + ELIF ya. ypos = yd. ypos + THEN neues token auf gleicher ypos + ELSE neue token vor ypos + FI; + PER; + + . gehe zum ersten neuen token : + ypos index a := erster ypos index a; + + . bestimme erste einsortierposition : + WHILE ypos index d <> 0 CAND ya. ypos < yd. ypos + REP ypos index d := yd. vorheriger ypos index PER; + IF ypos index d = 0 THEN erste neue token vor listen anfang FI; + + . erste neue token vor listen anfang : + ypos index d := erster ypos index d; + erster ypos index d := erster ypos index a; + REP ypos index a := ya. naechster ypos index; + IF ypos index a = 0 + THEN verkette letztes ya mit yd; + LEAVE sortiere neue token in sortierte liste ein + ELIF ya. ypos = yd. ypos + THEN verkette ya mit yd; + LEAVE erste neue token vor listen anfang + ELIF ya. ypos > yd. ypos + THEN verkette vorheriges ya mit yd; + ypos index d := yd. naechster ypos index; + LEAVE erste neue token vor listen anfang + FI; + PER; + + . es gibt noch neue token : + ypos index a <> 0 + + . haenge neue token ans ende der sortierten liste : + ypos index d := letzter ypos index d; + yd. naechster ypos index := ypos index a; + ya. vorheriger ypos index := ypos index d; + letzter ypos index d := letzter ypos index a; + ypos index d := letzter ypos index a; + ypos index a := 0; + + . naechste ypos der sortierten liste : + ypos index d := yd. naechster ypos index; + + . neues token auf gleicher ypos : + token index := yd. letzter token index; + t . naechster token index := ya. erster token index; + yd. letzter token index := ya. letzter token index; + ypos index a := ya. naechster ypos index; + ypos index d := yd. naechster ypos index; + IF ypos index d = 0 THEN ypos index d := letzter ypos index d FI; + + . neue token vor ypos : + verkette ya mit vorherigem yd; + REP ypos index a := ya. naechster ypos index; + IF ypos index a = 0 + THEN verkette letztes ya mit yd; + LEAVE sortiere neue token in sortierte liste ein + ELIF ya. ypos = yd. ypos + THEN verkette ya mit yd; + LEAVE neue token vor ypos + ELIF ya. ypos > yd. ypos + THEN verkette vorheriges ya mit yd; + ypos index d := yd. naechster ypos index; + LEAVE neue token vor ypos + FI; + PER; + + +. verkette ya mit vorherigem yd : + index := ypos index d; + ypos index d := yd. vorheriger ypos index; + yd. naechster ypos index := ypos index a; + ya. vorheriger ypos index := ypos index d; + ypos index d := index; + +. verkette letztes ya mit yd : + ypos index a := letzter ypos index a; + yd. vorheriger ypos index := ypos index a; + ya. naechster ypos index := ypos index d; + ypos index a := 0; + +. verkette vorheriges ya mit yd : + index := ypos index a; + ypos index a := ya. vorheriger ypos index; + yd. vorheriger ypos index := ypos index a; + ya. naechster ypos index := ypos index d; + ypos index a := index; + +. verkette ya mit yd : + verkette vorheriges ya mit yd; + neues token auf gleicher ypos; + +END PROC sortiere neue token ein; + +(***************************************************************) + +PROC drucke tokenspeicher + (INT CONST max ypos, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +IF druckspeicher ist nicht leer + THEN gehe zur ersten ypos; + WHILE yd. ypos <= max ypos + REP drucke token bei ypos; + gehe zur naechsten ypos; + PER; + loesche gedruckte token; +FI; + +. gehe zur ersten ypos : + ypos index d := erster ypos index d; + +. drucke token bei ypos : + IF yd. ypos >= - y start + THEN druck durchgang; + IF bold pass THEN fett durchgang FI; + IF underline pass THEN unterstreich durchgang FI; + FI; + + . bold pass : bit (pass, bold bit) + + . underline pass : bit (pass, underline bit) + +. gehe zur naechsten ypos : + IF ypos index d = letzter ypos index d + THEN loesche druckspeicher; + LEAVE drucke tokenspeicher; + FI; + ypos index d := yd. naechster ypos index; + +. loesche gedruckte token : + erster ypos index d := ypos index d; + yd. vorheriger ypos index := 0; + +. + druck durchgang : + verschiebung := yd. ypos - d ypos; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + gehe zum ersten token dieser ypos; + REP drucke token UNTIL kein token mehr vorhanden PER; + + . drucke token : + IF NOT token passt in zeile + THEN IF token ist text token + THEN berechne token teil + ELSE LEAVE drucke token + FI; + FI; + font wechsel wenn noetig; + x move mit modifikations ueberpruefung; + IF token ist text token + THEN gib text token aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + ELIF token ist linien token + THEN gib linien token aus + ELSE gib kommando token aus + FI; + + . gib linien token aus : + linien verschiebung := d token. breite; + ziehe horizontale linie (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + + . gib kommando token aus : + execute (write cmd, d token. text, 1, LENGTH d token. text) + + . berechne token teil : + INT CONST fuenf punkte := 5 * char pitch (d token. font, punkt); + INT VAR token pos, token breite, anzahl punkte, zeichen laenge, zeichen breite; + IF d token. xpos < - x start + AND d token. xpos + d token. breite > - x start + THEN berechne token teil von links + ELIF d token. xpos < papierbreite + AND d token. xpos + d token. breite > papierbreite + THEN berechne token teil nach rechts + ELSE LEAVE drucke token + FI; + + . berechne token teil von links : + rest := min (x size, d token. xpos + d token. breite + x start); + d token. xpos := - x start; + IF rest <= fuenf punkte + THEN anzahl punkte := rest DIV char pitch (d token. font, punkt); + d token. text := anzahl punkte * punkt; + d token. breite := anzahl punkte * char pitch (d token. font, punkt); + ELSE token pos := LENGTH d token. text + 1; + token breite := fuenf punkte; + berechne token teil breite von hinten; + change (d token. text, 1, token pos - 1, 5 * punkt); + d token. breite := token breite; + FI; + + . berechne token teil breite von hinten : + WHILE naechstes zeichen passt noch davor + REP token breite INCR zeichen breite; + token pos DECR zeichen laenge; + PER; + + . naechstes zeichen passt noch davor : + IF within kanji (d token. text, token pos - 1) + THEN zeichen laenge := 2 + ELSE zeichen laenge := 1 + FI; + zeichen breite := char pitch (d token. font, + subtext (d token. text, token pos - zeichen laenge, token pos - 1)); + token breite + zeichen breite < rest + + . berechne token teil nach rechts : + rest := papier breite - d token. xpos; + IF rest <= fuenf punkte + THEN anzahl punkte := rest DIV char pitch (d token. font, punkt); + d token. text := anzahl punkte * punkt; + d token. breite := anzahl punkte * char pitch (d token. font, punkt); + ELSE token pos := 0; + token breite := fuenf punkte; + berechne token teil breite von vorne; + change (d token. text, token pos + 1, LENGTH d token. text, 5 * punkt); + d token. breite := token breite; + FI; + + . berechne token teil breite von vorne : + WHILE naechstes zeichen passt noch dahinter + REP token breite INCR zeichen breite; + token pos INCR zeichen laenge; + PER; + + . naechstes zeichen passt noch dahinter : + IF is kanji esc (d token. text SUB token pos + 1) + THEN zeichen laenge := 2 + ELSE zeichen laenge := 1 + FI; + zeichen breite := char pitch (d token. font, + subtext (d token. text, token pos + 1, token pos + zeichen laenge)); + token breite + zeichen breite < rest + +. + fett durchgang : + reset bit (pass, bold bit); + gib cr aus; + gehe zum ersten token dieser ypos; + REP gib token nochmal aus UNTIL kein token mehr vorhanden PER; + schalte modifikationen aus wenn noetig; + + . gib token nochmal aus : + INT CONST min verschiebung := bold offset (d token. font); + d token. xpos INCR min verschiebung; + IF bit (d token. modifikationen, bold bit) AND + token passt in zeile AND token ist text token + THEN verschiebung := d token. xpos - d xpos; + font wechsel wenn noetig; + schalte italics ein wenn noetig; + x move wenn noetig; + gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + d token. xpos DECR min verschiebung; + + . schalte italics ein wenn noetig : + IF bit (d token. modifikationen, italics bit) + THEN neue modifikationen := modifikations werte (italics bit + 1); + schalte modifikationen ein wenn noetig; + ELSE schalte modifikationen aus wenn noetig; + FI; + +. + unterstreich durchgang : + INT VAR l xpos := 0; + reset bit (pass, underline bit); + gib cr aus; + schalte modifikationen aus wenn noetig; + gehe zum ersten token dieser ypos; + REP unterstreiche token UNTIL kein token mehr vorhanden PER; + + . unterstreiche token : + IF token muss unterstrichen werden AND + token passt in zeile AND token ist text token + THEN font wechsel wenn noetig; + berechne x move laenge; + x move wenn noetig; + berechne unterstreich laenge; + ziehe horizontale linie (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + l xpos := d token. xpos + d token. breite; + + . token muss unterstrichen werden : + bit (d token. modifikationen, underline bit) OR + bit (d token. modifikationen fuer x move, underline bit) + + . berechne x move laenge : + IF bit (d token. modifikationen fuer x move, underline bit) + THEN verschiebung := l xpos - d xpos + ELSE verschiebung := d token. xpos - d xpos + FI; + + . berechne unterstreich laenge : + IF bit (d token. modifikationen, underline bit) + THEN linien verschiebung := d token. xpos + + d token. breite - d xpos + ELSE linien verschiebung := d token. xpos - d xpos + FI; + d token. offset index := - underline line type; + + +. gehe zum ersten token dieser ypos : + token index := yd. erster token index; + d token := t; + +. kein token mehr vorhanden : + token index := d token. naechster token index; + IF token index = 0 + THEN TRUE + ELSE d token := t; + FALSE + FI + +. token ist text token : + d token. offset index >= text token + +. token ist linien token : + d token. offset index <= linien token + +. token passt in zeile : + d token. xpos >= - x start AND + d token. xpos + d token. breite <= papier breite + +. font wechsel wenn noetig : + IF d token. font <> d font + THEN font wechsel (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. schalte modifikationen ein wenn noetig : + IF d modifikationen <> neue modifikationen + THEN schalte modifikationen ein (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. schalte modifikationen aus wenn noetig : + IF d modifikationen <> 0 + THEN schalte modifikationen aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. x move wenn noetig : + IF verschiebung <> 0 + THEN x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. + x move mit modifikations ueberpruefung : + verschiebung := d token. xpos - d xpos; + IF verschiebung <> 0 + THEN neue modifikationen := d token. modifikationen fuer x move; + schalte modifikationen ein wenn noetig; + x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + neue modifikationen := d token. modifikationen; + schalte modifikationen ein wenn noetig; + +. gib cr aus : + IF d xpos <> 0 + THEN execute (carriage return, "", d xpos, 0); + d xpos := 0; + FI; + +END PROC drucke tokenspeicher; + + +PROC ziehe horizontale linie (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + IF linien verschiebung > 0 + THEN disable stop; + d xpos INCR linien verschiebung; + execute (draw, "", linien verschiebung, 0); + IF is error + THEN ziehe horizontale linie nach cr; + FI; + enable stop; + FI; + + . ziehe horizontale linie nach cr : + clear error; + d xpos DECR linien verschiebung; + verschiebung := d xpos; + gib cr aus; + x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + d xpos INCR linien verschiebung; + execute (draw, "", linien verschiebung, 0); + IF is error + THEN clear error; + d xpos DECR linien verschiebung; + FI; + + . gib cr aus : + IF d xpos <> 0 + THEN execute (carriage return, "", d xpos, 0); + d xpos := 0; + FI; + +END PROC ziehe horizontale linie; + + +PROC y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + IF verschiebung <> 0 + THEN gib cr aus; + disable stop; + d ypos INCR verschiebung; + execute (move, "", 0, verschiebung); + IF is error + THEN clear error; + d ypos DECR verschiebung; + verschiebung := 0; + FI; + enable stop; + FI; + + . gib cr aus : + IF d xpos <> 0 + THEN execute (carriage return, "", d xpos, 0); + d xpos := 0; + FI; + +END PROC y move; + + +PROC x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + d xpos INCR verschiebung; + execute (move, "", verschiebung, 0); + IF is error + THEN fuehre x move nach cr aus + FI; + + . fuehre x move nach cr aus : + clear error; + schalte modifikationen aus wenn noetig; + gib cr bei x move aus; + IF d xpos <> 0 + THEN execute (move, "", d xpos, 0); + IF is error + THEN clear error; + d xpos := 0; + FI + FI; + schalte modifikationen ein wenn noetig; + + . gib cr bei x move aus : + execute (carriage return, "", d xpos - verschiebung, 0); + + . schalte modifikationen aus wenn noetig : + neue modifikationen := d modifikationen; + IF d modifikationen <> 0 + THEN schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + + . schalte modifikationen ein wenn noetig : + IF d modifikationen <> neue modifikationen + THEN schalte modifikationen ein + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + +END PROC x move; + + +PROC schalte modifikationen ein + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + INT VAR index; + IF d modifikationen <> 0 + THEN schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + d modifikationen := neue modifikationen; + FOR index FROM 1 UPTO anzahl modifikationen + REP IF bit (d modifikationen, modifikations bit) + THEN modifikation muss eingeschaltet werden + FI; + PER; + + . modifikations bit : index - 1 + + . modifikation muss eingeschaltet werden : + IF bit (modifikations modus, modifikations bit) + THEN execute (on, "", modifikations werte (index), 0); + IF is error + THEN clear error; + reset bit (modifikations modus, modifikations bit); + set bit (pass, modifikations bit); + FI; + ELSE set bit (pass, modifikations bit); + FI; + +END PROC schalte modifikationen ein; + + +PROC schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + INT VAR index; + FOR index FROM 1 UPTO anzahl modifikationen + REP IF bit (d modifikationen, modifikations bit) + THEN modifikation muss ausgeschaltet werden + FI; + PER; + d modifikationen := 0; + + . modifikations bit : index - 1 + + . modifikation muss ausgeschaltet werden : + IF bit (modifikations modus, modifikations bit) + THEN execute (off, "", modifikations werte (index), 0); + IF is error THEN clear error FI; + FI; + +END PROC schalte modifikationen aus; + + +PROC font wechsel + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + d font := d token. font; + get replacements (d font, replacements, replacement tabelle); + execute (type, "", d font, 0); + IF is error THEN font wechsel nach cr FI; + enable stop; + + . font wechsel nach cr : + clear error; + verschiebung := d xpos; + gib cr aus; + execute (type, "", d font, 0); + IF NOT is error + THEN schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + x move + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + + . gib cr aus : + IF d xpos <> 0 + THEN execute (carriage return, "", d xpos, 0); + d xpos := 0; + FI; + +END PROC font wechsel; + + +PROC gib text token aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + INT CONST token laenge := LENGTH d token. text; + INT VAR token pos := 1, alte token pos, summe := 0; + IF token laenge > 0 + THEN REP alte token pos := token pos; + stranalyze (replacement tabelle, summe, 0, + d token. text, token pos, token laenge, + ausgang); + IF ausgang = 0 + THEN gib token rest aus; + ELSE gib token teil aus; + gib ersatzdarstellung aus; + FI; + PER; + FI; + + . gib token rest aus : + IF token laenge >= alte token pos + THEN execute (write text, d token. text, alte token pos, token laenge) FI; + d xpos INCR d token. breite; + LEAVE gib text token aus; + + . gib token teil aus : + IF token pos >= alte token pos + THEN execute (write text, d token. text, alte token pos, token pos) FI; + + . gib ersatzdarstellung aus : + IF ausgang = maxint + THEN ersatzdarstellung := extended replacement (d token. font, + d token. text SUB token pos + 1, d token. text SUB token pos + 2); + execute (write text, ersatzdarstellung, 1, LENGTH ersatzdarstellung); + tokenpos INCR 3; + ELSE IF ausgang < 0 + THEN ausgang := ausgang XOR minint; + token pos INCR 1; + FI; + execute (write text, replacements, ausgang + 1, ausgang + code (replacements SUB ausgang)); + token pos INCR 2; + FI; + + . ersatzdarstellung : par1 + +END PROC gib text token aus; + + +PROC schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +enable stop; +gebe restliche token aus; +gib cr aus; +seiten ende kommando; + +. gebe restliche token aus : + IF erster ypos index d <> 0 + THEN drucke tokenspeicher (maxint, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + rest := papier laenge - d ypos; + aktuelle zeilentiefe der letzten zeile := 0; + +. gib cr aus : + IF d xpos <> 0 + THEN execute (carriage return, "", d xpos, 0); + d xpos := 0; + FI; + +. seiten ende kommando : + seite ist offen := FALSE; + a ypos := top margin; + aktuelle spalte := 1; + close (page, rest); + +END PROC schliesse seite ab; + + +PROC eroeffne seite (INT CONST x wanted l, y wanted l, + PROC (INT CONST, INT VAR, INT VAR) open ) : + +IF vor erster seite THEN eroeffne druck FI; +seiten anfang kommando; +initialisiere neue seite; + +. eroeffne druck : + open (document, x size, y size); + vor erster seite := FALSE; + d font := -1; + d modifikationen := 0; + +. seiten anfang kommando : + x start := x wanted l; + y start := y wanted l; + open (page, x start, y start); + gedruckte seiten INCR 1; + seite ist offen := TRUE; + +. initialisiere neue seite : + INT CONST dif left margin := x wanted l - x start - left margin + indentation, + dif top margin := y wanted l - y start - top margin; + IF dif left margin <> 0 + THEN erstes tab token := 1; + verschiebe token xpos (dif left margin); + a xpos INCR dif left margin; + left margin INCR dif left margin; + FI; + IF dif top margin <> 0 + THEN verschiebe token ypos (dif top margin); + a ypos INCR dif top margin; + top margin INCR dif top margin; + FI; + d xpos := 0; + d ypos := 0; + IF seitenlaenge <= papierlaenge + THEN seitenlaenge := top margin + pagelength; + ELSE seitenlaenge DECR papierlaenge; + FI; + papierlaenge := y size - y start; + papierbreite := x size - x start; + +END PROC eroeffne seite; + +(****************************************************************) + +PROC elan fuss und kopf (INT CONST fuss oder kopf, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +IF fuss oder kopf <= 0 THEN elan fuss FI; +IF fuss oder kopf >= 0 THEN elan kopf FI; + +. + elan fuss : + y move zur fusszeile; + drucke elan fuss; + close page cmd; + +. y move zur fusszeile : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + verschiebung := rest auf seite - font hoehe; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +. drucke elan fuss : + IF bottom label = "" + THEN seiten nr := "" + ELSE seiten nr := bottom label; + seiten nr CAT "/"; + FI; + seiten nr CAT text (gedruckte seiten); + elan text := seiten nr; + elan text CAT " "; + elan text cat blanks ((max zeichen fuss - LENGTH dateiname) DIV 2 - LENGTH elan text); + elan text CAT dateiname; + elan text cat blanks (max zeichen fuss - LENGTH seiten nr - LENGTH elan text - 3); + elan text CAT " "; + elan text CAT seiten nr; + IF LENGTH elan text > max zeichen zeile + THEN elan text := subtext (elan text, 1, max zeichen zeile) FI; + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + + . seiten nr : par1 + +. close page cmd : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + close (page, papierlaenge - d ypos); + seite ist offen := FALSE; + +. + elan kopf : + open page cmd ; + y move zur kopfzeile; + drucke elan kopf; + +. open page cmd : + x start := x wanted; + y start := y wanted; + open (page, x start, y start); + IF fuss oder kopf = 1 THEN execute (type, "", d font, 0) FI; + gedruckte seiten INCR 1; + seite ist offen := TRUE; + top margin := y wanted - y start; + left margin := x wanted - x start; + rest auf seite := pagelength; + papierlaenge := y size - y start; + d ypos := 0; + d xpos := 0; + +. y move zur kopf zeile : + verschiebung := top margin; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + IF verschiebung = 0 THEN rest auf seite INCR top margin FI; + +. drucke elan kopf : + elan text := headline pre; + elan text CAT date; + elan text CAT headline post; + elan text CAT datei name; + IF LENGTH elan text > max zeichen zeile + THEN elan text := subtext (elan text, 1, max zeichen zeile) FI; + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC elan fuss und kopf; + + +PROC gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +cr plus lf (1, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); +linker rand wenn noetig; +d token. breite := LENGTH elan text * einrueckbreite; +gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +. linker rand wenn noetig : + IF left margin > 0 + THEN disable stop; + d xpos := left margin; + execute (move, "", left margin, 0); + IF is error + THEN clear error; + d xpos := 0; + FI; + enable stop; + FI; + +END PROC gib elan text aus; + + +PROC cr plus lf (INT CONST anzahl, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +gib cr aus; +gib lf aus; +rest auf seite DECR verschiebung; + +. gib cr aus : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + +. gib lf aus : + verschiebung := anzahl * font hoehe; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +END PROC cr plus lf ; + + +END PACKET eumel printer; + diff --git a/system/std.zusatz/1.8.7/src/eumelmeter b/system/std.zusatz/1.8.7/src/eumelmeter new file mode 100644 index 0000000..ba92476 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/eumelmeter @@ -0,0 +1,131 @@ + (* Author: J.Liedtke*) +PACKET eumelmeter DEFINES (* Stand: 11.10.83 *) + + init log , + log : + + +LET snapshot interval = 590.0 ; + +REAL VAR next snapshot time , + time , timex , + paging wait , paging wait x , + paging busy , paging busy x , + fore cpu , fore cpu x , + back cpu , back cpu x , + system cpu , system cpu x , + delta t ; +INT VAR storage max, used ; +TEXT VAR record ; + +PROC init log : + + time := clock (1) ; + paging wait := clock (2) ; + paging busy := clock (3) ; + fore cpu := clock (4) ; + back cpu := clock (5) ; + system cpu := clock (6) ; + next snapshot time := time + snapshot interval + +ENDPROC init log ; + +PROC log (INT CONST active terminals, active background) : + + new snapshot time if was clock reset ; + IF clock (1) >= next snapshot time + THEN save values ; + get new values ; + create stat record ; + put log (record) ; + define next snapshot time + FI . + +new snapshot time if was clock reset : + IF clock (1) < next snapshot time - snapshot interval + THEN next snapshot time := clock (1) + FI . + +save values : + time x := time ; + paging wait x := paging wait ; + paging busy x := paging busy ; + fore cpu x := fore cpu ; + back cpu x := back cpu ; + system cpu x := system cpu . + +get new values : + time := clock (1) ; + paging wait := clock (2) ; + paging busy := clock (3) ; + fore cpu := clock (4) ; + back cpu := clock (5) ; + system cpu := clock (6) ; + storage (storage max, used) . + +create stat record : + record := text (used, 5) ; + record CAT text (active terminals,3) ; + record CAT text (active background,3) ; + delta t := (time - time x) ; + percent (paging wait, paging wait x) ; + percent (paging busy, paging busy x) ; + percent (fore cpu, fore cpu x) ; + percent (back cpu, back cpu x) ; + percent (system cpu, system cpu x) ; + percent (last, 0.0) ; + percent (nutz, 0.0) . + +last : paging wait + paging busy + fore cpu + back cpu + system cpu + - paging waitx - paging busyx - fore cpux - back cpux - system cpux . + +nutz : time - paging wait - system cpu + - timex + paging waitx + system cpux . + +define next snapshot time : + next snapshot time := time + snapshot interval . + +ENDPROC log ; + +PROC percent (REAL CONST neu, alt ) : + + record CAT text ( (neu-alt) / delta t * 100.0, 6,1) + "%" + +ENDPROC percent ; + +ENDPACKET eumelmeter ; + +INT VAR active terminals , active background ; + +task password ("-") ; +break ; +command dialogue (FALSE) ; +forget ("eumelmeter") ; +init log ; +REP + pause (6000) ; + count active processes (active terminals, active background) ; + log (active terminals, active background) +PER ; + +PROC count active processes (INT VAR active terminals, active background) : + + active terminals := 0 ; + active background := 0 ; + TASK VAR process := myself ; + REP + next active (process) ; + IF user process + THEN IF process at terminal + THEN active terminals INCR 1 + ELSE active background INCR 1 + FI + FI + UNTIL process = myself PER . + +user process : NOT (process < supervisor) . + +process at terminal : channel (process) >= 0 . + +ENDPROC count active processes ; + diff --git a/system/std.zusatz/1.8.7/src/font convertor 9 b/system/std.zusatz/1.8.7/src/font convertor 9 new file mode 100644 index 0000000..a5d0ea7 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/font convertor 9 @@ -0,0 +1,1095 @@ +PACKET font convertor (* Autor : Rudolf Ruland *) + (* Stand : 29.03.88 *) + DEFINES create font table , + add fonts, + create font file : + +(* >>> ***************************************************************** <<< *) + +INT CONST int length := length of one int, + highest bit := int length * 8 - 1; + +. length of one int : + INT VAR int counter := 0, int value := max int; + REP int counter INCR 1; + int value := int value DIV 256; + UNTIL int value = 0 PER; + int counter +.; + +(* >>> ***************************************************************** <<< *) + +LET t tag = 1, + t bold = 2, + t number = 3, + t text = 4, + t operator = 5, + t delimiter = 6, + t end of file = 7, + + nil modus = 0, + font table modus = 1, + font modus = 2, + extension modus = 3, + + x unit = 1, + y unit = 2, + on string = 3, + off string = 4, + indentation pitch = 5, + font lead = 6, + font height = 7, + font depth = 8, + larger font = 9, + smaller font = 10, + font string = 11, + y off sets = 12, + bold off set = 13; + +THESAURUS VAR names, english identification := empty thesaurus, + german identification := empty thesaurus; + +insert (english identification, "xunit"); +insert (english identification, "yunit"); +insert (english identification, "onstring"); +insert (english identification, "offstring"); +insert (english identification, "indentationpitch"); +insert (english identification, "fontlead"); +insert (english identification, "fontheight"); +insert (english identification, "fontdepth"); +insert (english identification, "nextlargerfont"); +insert (english identification, "nextsmallerfont"); +insert (english identification, "fontstring"); +insert (english identification, "yoffsets"); +insert (english identification, "boldoffset"); + +insert (german identification, "xeinheit"); +insert (german identification, "yeinheit"); +insert (german identification, "onsequenz"); +insert (german identification, "offsequenz"); +insert (german identification, "einrueckbreite"); +insert (german identification, "durchschuss"); +insert (german identification, "fonthoehe"); +insert (german identification, "fonttiefe"); +insert (german identification, "groessererfont"); +insert (german identification, "kleinererfont"); +insert (german identification, "fontsequenz"); +insert (german identification, "yverschiebungen"); +insert (german identification, "boldverschiebung"); + +INT VAR modus, last modus, symbol type, int symbol, pitch, + identification nr, link nr, extension code 1, + char code 1, char code, char pos, vorzeichen, + replacements length, index; +TEXT VAR symbol, font table name, replacement, char, buffer, z; +BOOL VAR english; +FILE VAR file, font file; + +(*****************************************************************) + +LET max fonts = 50, + max extensions = 120, + font table type = 3009, + + FONTTABLE = STRUCT ( + + THESAURUS font names, + + TEXT replacements, font name links, + extension chars, extension indexes, + + ROW 4 TEXT on strings, off strings, + + REAL x unit, y unit, + + ROW 256 INT replacements table, + + INT last font, last extension, + + ROW max fonts STRUCT ( + TEXT font string, font name indexes, replacements, + extension chars, extension indexes, y offsets, + ROW 256 INT pitch table, replacements table, + INT indentation pitch, font lead, font height, font depth, + next larger font, next smaller font, bold offset ) fonts , + + ROW max extensions STRUCT ( + TEXT replacements, + ROW 256 INT pitch table, replacements table, + INT std pitch ) extensions , + + ); + +BOUND FONTTABLE VAR font table; + +DATASPACE VAR ds; + +INT VAR font nr, extension nr; + +. font : font table. fonts (font nr) +. extension : font table. extensions (extension nr) +. line nr : line no (file) - 1 +.; + +(*****************************************************************) + + +PROC create font table : + + create font table (last param) + +END PROC create font table; + + +PROC create font table (TEXT CONST font file name) : + +file := sequential file (input, font file name); +disable stop; +ds := nilspace; +modus := nil modus; +load; +IF is error THEN error (errormessage) FI; +forget (ds); + +END PROC create font table; + + +PROC add fonts (TEXT CONST font tab name, font file name) : + +file := sequential file (input, font file name); +font table name := font tab name; +change all (font table name, " ", ""); +IF NOT exists (font table name) COR type (old (font table name)) <> font table type + THEN errorstop ("Fonttabelle """ + font table name + """ gibt es nicht") +FI; +disable stop; +ds := old (font table name); +fonttable := ds; +modus := font modus; +font nr := fonttable. last font; +extension nr := fonttable. last extension; +load; +IF is error THEN error (errormessage) FI; +forget (ds); + +END PROC add fonts; + + +PROC load : + +enable stop; +initialize loading; +REP get kennung; + get identification; + get char specifications; +UNTIL symbol type >= t end of file PER; +font table found; + +. initialize loading : + scan (file); + get next symbol; + +. font table found : + IF font nr = 0 + THEN errorstop ("Fonts zur Fonttabelle """ + + font table name + """ fehlen"); + ELSE font table. last font := font nr; + font table. last extension := extension nr; + forget (font table name, quiet); + copy (ds, font table name); + type (old (font table name), font table type); + forget (ds); ds := nilspace; + FI; + +. get next symbol : + next symbol (file, symbol, symbol type); + +. get semicolon : + get next symbol; + IF symbol <> ";" OR symbol type <> t delimiter + THEN errorstop ("';' erwartet") FI; + +. + get kennung : + cout (line nr); + IF symbol type <> t bold + THEN errorstop ("Kennung erwartet") FI; + IF symbol = "FONTTABLE" OR symbol = "FONTTABELLE" + THEN initialize font table; + get font table name; + ELIF symbol = "FONT" + THEN initialize font; + get font names; + ELIF symbol = "EXTENSION" OR symbol = "ERWEITERUNG" + THEN get extension char; + initialize extension; + ELIF modus = nil modus + THEN errorstop ("Kennung 'FONTTABLE' oder 'FONTTABELLE' zu Beginn der Datei erwartet") + ELSE errorstop ("unzulaessige Kennung") + FI; + + . initialize font table : + IF modus <> nil modus THEN font table found FI; + modus := font table modus; + font nr := 0; + extension nr := 0; + font table := ds; + font table. font names := empty thesaurus; + font table. replacements := ""; + font table. font name links := ""; + font table. extension chars := ""; + font table. extension indexes := ""; + font table. x unit := 10.0/2.54; + font table. y unit := 6.0/2.54; + font table. replacements table := 0; + FOR index FROM 1 UPTO 4 + REP font table. on strings (index) := ""; + font table. off strings (index) := ""; + PER; + + . get font table name : + get name list; + symbol type := t text; + symbol := name (names, 1); + IF exists (symbol) + THEN forget (symbol); + IF exists (symbol) + THEN errorstop ("Fonttabelle existiert schon") FI; + FI; + font table name := symbol; + + . initialize font : + IF font nr = max fonts + THEN errorstop ("zu viele Fonts") FI; + font nr INCR 1; + modus := font modus; + replacements length := LENGTH font table. replacements; + font. font string := ""; + font. font name indexes := ""; + font. replacements := ""; + font. extension chars := ""; + font. extension indexes := ""; + font. y offsets := int length * ""0""; + font. indentation pitch := int (font table. x unit * 2.54 / 10.0); + font. font lead := 0; + font. font height := int (font table. y unit * 2.54 / 6.0); + font. font depth := 0; + font. next larger font := 0; + font. next smaller font := 0; + font. bold offset := 0; + font. pitch table := font. indentation pitch; + font. replacements table := font table. replacements table; + FOR index FROM 1 UPTO LENGTH font table. extension chars + REP font. replacements table + ( code (font table. extension chars SUB index) + 1 ) := maxint; + PER; + + . get font names : + get name list; + index := 0; + symbol type := t text; + WHILE next font name + REP link nr := link (font table. font names, symbol); + IF link nr = 0 + THEN insert (font table. font names, symbol, link nr); + font table. font name links CAT font nr; + ELIF (font table. font name links ISUB link nr) = 0 + THEN replace (font table. font name links, link nr, font nr); + ELSE errorstop ("Font existiert in Fonttabelle """ + + font table name + """ schon") + FI; + font. font name indexes CAT link nr; + PER; + + . next font name : + get (names, symbol, index); + symbol <> "" + + . get extension char : + IF NOT two bytes + THEN errorstop ("Erweiterungen nur im zwei-Byte-Modus erlaubt") FI; + get name list; + symbol type := t text; + symbol := name (names, 1); + IF LENGTH symbol <> 1 + THEN errorstop ("nur ein Zeichen bei Erweiterung erlaubt") FI; + extension code 1 := code (symbol) + 1; + IF NOT is kanji esc (symbol) + THEN errorstop ("Kanji-ESC-Zeichen erwartet") FI; + + . initialize extension : + IF extension nr = max extensions + THEN errorstop ("zu viele Erweiterungen") FI; + extension nr INCR 1; + IF modus <> extension modus THEN last modus := modus FI; + modus := extension modus; + IF last modus = font table modus + THEN initalize font table extension + ELSE initalize font extension + FI; + + . initalize font table extension : + IF pos (font table. extension chars, symbol) <> 0 + THEN errorstop ("Erweiterung wurde schon definiert") FI; + extension. replacements := ""; + extension. std pitch := 0; + extension. pitch table := 0; + extension. replacements table := 0; + font table. extension chars CAT symbol; + font table. extension indexes CAT extension nr; + font table. replacements table (extension code 1) := max int; + replacements length := 0; + + . initalize font extension : + IF pos (font. extension chars, symbol) <> 0 + THEN errorstop ("Erweiterung wurde schon definiert") FI; + extension. replacements := ""; + extension. std pitch := font. pitch table (extension code 1) XOR (-maxint-1); + extension. pitch table := extension. std pitch; + font. extension chars CAT symbol; + font. extension indexes CAT extension nr; + char pos := pos (font table. extension chars, symbol); + IF char pos <> 0 + THEN index := font table. extension indexes ISUB char pos; + extension. replacements table := + font table. extensions (index). replacements table; + replacements length := + LENGTH font table. extensions (index). replacements; + font. replacements table (extension code 1) := max int; + ELSE extension. replacements table := 0; + replacements length := 0; + FI; + +. + get identification : + WHILE identification found + REP cout (line nr); + determine identification link nr; + select identification; + PER; + + . identification found : + get next symbol; + symbol type = t tag + + . determine identification link nr : + identification nr := link (english identification, symbol); + english := TRUE; + IF identification nr = 0 + THEN identification nr := link (german identification, symbol); + english := FALSE; + IF identification nr = 0 + THEN errorstop ("unzulaesige Identifikation") FI; + FI; + + . select identification : + get next symbol; + IF symbol <> "=" OR symbol type <> t operator + THEN errorstop ("'=' nach Identifikation fehlt") FI; + get next symbol; + SELECT identification nr OF + CASE x unit : x unit found + CASE y unit : y unit found + CASE on string : on string found + CASE off string : off string found + CASE indentation pitch : indentation pitch found + CASE font lead : font lead found + CASE font height : font height found + CASE font depth : font depth found + CASE larger font : larger font found + CASE smaller font : smaller font found + CASE font string : font string found + CASE y offsets : y offsets found + CASE bold offset : bold offset found + END SELECT; + + . x unit found : + check modus (font table modus); + font table. x unit := real (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("REAL-Denoter nach 'x unit' erwartet") + ELSE errorstop ("REAL-Denoter nach 'x einheit' erwartet") + FI; + FI; + get semicolon; + + . y unit found : + check modus (font table modus); + font table. y unit := real (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("REAL-Denoter nach 'y unit' erwartet") + ELSE errorstop ("REAL-Denoter nach 'y einheit' erwartet") + FI; + FI; + get semicolon; + + . on string found : + check modus (font table modus); + FOR index FROM 1 UPTO 4 + REP IF symbol type <> t text + THEN IF english + THEN errorstop ("TEXT-Denoter nach 'on string' erwartet") + ELSE errorstop ("TEXT-Denoter nach 'on sequenz' erwartet") + FI; + FI; + font table. on strings (index) := symbol; + get next symbol; + IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter + THEN errorstop ("',' oder ';' in Liste erwartet") FI; + IF symbol = ";" THEN LEAVE on string found FI; + IF index = 4 THEN errorstop ("';' erwartet") FI; + get next symbol; + PER; + + . off string found : + check modus (font table modus); + FOR index FROM 1 UPTO 4 + REP IF symbol type <> t text + THEN IF english + THEN errorstop ("TEXT-Denoter nach 'off string' erwartet") + ELSE errorstop ("TEXT-Denoter nach 'off sequenz' erwartet") + FI; + FI; + font table. off strings (index) := symbol; + get next symbol; + IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter + THEN errorstop ("',' oder ';' in Liste erwartet") FI; + IF symbol = ";" THEN LEAVE off string found FI; + IF index = 4 THEN errorstop ("';' erwartet") FI; + get next symbol; + PER; + + . indentation pitch found : + check modus (font modus); + font. indentation pitch := int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'indentation pitch' erwartet") + ELSE errorstop ("INT-Denoter nach 'einrueckbreite' erwartet") + FI; + FI; + font. pitch table := font. indentation pitch; + get semicolon; + + . font lead found : + check modus (font modus); + font. font lead := int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'font lead' erwartet") + ELSE errorstop ("INT-Denoter nach 'durchschuss' erwartet") + FI; + FI; + get semicolon; + + . font height found : + check modus (font modus); + font. font height := int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'font height' erwartet") + ELSE errorstop ("INT-Denoter nach 'fonthoehe' erwartet") + FI; + FI; + get semicolon; + + . font depth found : + check modus (font modus); + font. font depth := int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'font depth' erwartet") + ELSE errorstop ("INT-Denoter nach 'fonttiefe' erwartet") + FI; + FI; + get semicolon; + + . larger font found : + check modus (font modus); + IF symbol type <> t text + THEN IF english + THEN errorstop ("TEXT-Denoter nach 'next larger font' erwartet") + ELSE errorstop ("TEXT-Denoter nach 'groesserer font' erwartet") + FI; + FI; + determine link nr; + font. next larger font := link nr; + get semicolon; + + . smaller font found : + check modus (font modus); + IF symbol type <> t text + THEN IF english + THEN errorstop ("TEXT-Denoter nach 'next smaller font' erwartet") + ELSE errorstop ("TEXT-Denoter nach 'kleinerer font' erwartet") + FI; + FI; + determine link nr; + font. next smaller font := link nr; + get semicolon; + + . determine link nr : + change all (symbol, " ", ""); + IF symbol = "" + THEN link nr := 0 + ELSE link nr := link (font table. font names, symbol); + IF link nr = 0 + THEN insert (font table. font names, symbol, link nr); + font table. font name links CAT 0; + FI; + FI; + + . font string found : + check modus (font modus); + IF symbol type <> t text + THEN IF english + THEN errorstop ("TEXT-Denoter nach 'font string' erwartet") + ELSE errorstop ("TEXT-Denoter nach 'fontsequenz' erwartet") + FI; + FI; + font. font string := symbol; + get semicolon; + + . y offsets found : + check modus (font modus); + font. y offsets := ""; + REP IF symbol = "-" AND symbol type = t operator + THEN vorzeichen := -1; + get next symbol; + ELSE vorzeichen := 1; + FI; + int symbol := vorzeichen * int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'y offsets' erwartet") + ELSE errorstop ("INT-Denoter nach 'y verschiebungen' erwartet") + FI; + FI; + font. y offsets CAT int symbol; + get next symbol; + IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter + THEN errorstop ("',' oder ';' in Liste erwartet") FI; + IF symbol = ";" THEN LEAVE y offsets found FI; + get next symbol; + PER; + + . bold offset found : + check modus (font modus); + IF symbol = "-" AND symbol type = t operator + THEN vorzeichen := -1; + get next symbol; + ELSE vorzeichen := 1; + FI; + font. bold offset := vorzeichen * int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'bold offset' erwartet") + ELSE errorstop ("INT-Denoter nach 'bold verschiebungen' erwartet") + FI; + FI; + get semicolon; + +. + get char specifications : + WHILE char found + REP cout (line nr); + char specification; + get next symbol; + PER; + + . char found : + symbol type = t text + + . char specification : + IF LENGTH symbol <> 1 + THEN errorstop ("nur ein Zeichen bei Zeichenangabe erlaubt") FI; + char := symbol; + char code 1 := code (char) + 1; + look for specification; + look for specification; + get semicolon; + + . look for specification : + get next symbol; + IF symbol = ";" AND symbol type = t delimiter + THEN LEAVE char specification + ELIF symbol = "," AND symbol type = t delimiter + THEN get specification + ELSE errorstop ("',' oder ';' bei Zeichenspezifikation erwartet") + FI; + + . get specification : + get next symbol; + IF symbol type = t number + THEN pitch specification; + ELIF symbol type = t text + THEN replacement specification + ELSE errorstop ("unzulaessiger Wert bei Zeichenspezifikation") + FI; + + . pitch specification : + int symbol := int (symbol); + IF NOT last conversion ok + THEN errorstop ("INT-Denoter bei Breitenangabe erwartet") FI; + IF modus = font modus + THEN font. pitch table (char code 1) := int symbol; + IF is kanji esc (char) + THEN set bit (font. pitch table (char code 1), highest bit) FI; + ELIF modus = extension modus + THEN IF last modus = font modus AND + font. pitch table (extension code 1) <> max int + THEN font. pitch table (extension code 1) := max int FI; + extension. pitch table (char code 1) := int symbol; + FI; + + . replacement specification : + IF LENGTH symbol > 255 + THEN errorstop ("Ersatzdarstellungen duerfen nur 255 Zeichen haben") FI; + IF modus = font table modus + THEN font table. replacements table (char code 1) := + (LENGTH font table. replacements + 1); + font table. replacements CAT code (LENGTH symbol); + font table. replacements CAT symbol; + IF is kanji esc (char) + THEN set bit (font table. replacements table (char code 1), highest bit) FI; + ELIF modus = font modus + THEN font. replacements table (char code 1) := + (replacements length + LENGTH font. replacements + 1); + font. replacements CAT code (LENGTH symbol); + font. replacements CAT symbol; + IF is kanji esc (char) + THEN set bit (font. replacements table (char code 1), highest bit) FI; + ELIF modus = extension modus + THEN IF last modus = font modus AND + font. replacements table (extension code 1) <> max int + THEN font. replacements table (extension code 1) := max int FI; + extension. replacements table (char code 1) := + (replacements length + LENGTH extension. replacements + 1); + extension. replacements CAT code (LENGTH symbol); + extension. replacements CAT symbol; + FI; + +END PROC load; + + +PROC get name list : + + names := empty thesaurus; + get next symbol; + IF symbol <> ":" OR symbol type <> t delimiter + THEN errorstop ("':' nach Kennung erwartet") FI; + REP get next symbol; + change all (symbol, " ", ""); + IF symbol type <> t text + THEN errorstop ("TEXT-Denoter in Namesliste erwartet") FI; + IF symbol = "" + THEN errorstop ("'niltext' als Name nicht erlaubt") FI; + insert (names, symbol); + get next symbol; + IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter + THEN errorstop ("',' oder ';' in Liste erwartet") FI; + UNTIL symbol = ";" PER; + + . get next symbol : + next symbol (file, symbol, symbol type); + +END PROC get name list; + + +OP := (ROW 256 INT VAR l, INT CONST r) : + +INT VAR i; +IF modus = extension modus OR NOT two bytes + THEN FOR i FROM 1 UPTO 256 REP l (i) := r PER; + ELSE FOR i FROM 1 UPTO 129 REP l (i) := r PER; + FOR i FROM 130 UPTO 160 REP l (i) := r - maxint - 1 PER; + FOR i FROM 161 UPTO 224 REP l (i) := r PER; + FOR i FROM 225 UPTO 240 REP l (i) := r - maxint - 1 PER; + FOR i FROM 241 UPTO 256 REP l (i) := r PER; +FI; + +END OP :=; + + +PROC check modus (INT CONST mod) : + + IF mod <> modus THEN errorstop ("unzulaessige Identifikation") FI; + +END PROC check modus; + + +PROC error (TEXT CONST message) : + +(*INT CONST l := error line;*) + clear error; + errorstop ("Zeile " + text (line nr) + " bei " + letztes symbol + + " : " + message (* + errorline if neccessary *) ); + + . letztes symbol : + IF symbol type = t text + THEN decode (symbol); + """" + symbol + """" + ELIF symbol type >= t end of file + THEN "EOF" + ELSE symbol + FI +(* + . errorline if neccessary : + IF l = 0 + THEN "" + ELSE " -> " + text (l) + FI +*) +END PROC error; + + +(*******************************************************************) + + +PROC create font file (TEXT CONST font tab name, font file name) : + +enable stop; +connect font table; +put font table in font file; + +. + connect font table : + buffer := font tab name; + change all (buffer, " ", ""); + IF NOT exists (buffer) COR type (old (buffer)) <> font table type + THEN errorstop ("Fonttabelle """ + buffer + """ gibt es nicht") + FI; + font table := old (buffer); + +. + put font table in font file : + INT VAR font file nr := 0; + enable stop; + font file := sequential file (output, font file name); + max line length (font file, 16000); + check file overflow; + z := " "; + put font table; + FOR font nr FROM 1 UPTO font table. last font REP put font PER; + + . check file overflow : + WHILE lines (font file) > 3600 + REP font file nr INCR 1; + font file := sequential file (output, font file name + "." + text (font file nr)); + max line length (font file, 16000); + PER; + +. put font table : + put z; + z CAT "FONTTABLE : """; z CAT buffer; z CAT """;"; put z; + z CAT " x unit = "; z CAT text (font table. x unit); z CAT ";"; put z; + z CAT " y unit = "; z CAT text (font table. y unit); z CAT ";"; put z; + z CAT " on string = """; z cat on strings; z CAT """;"; put z; + z CAT " off string = """; z cat off strings; z CAT """;"; put z; + put font table replacements; + put font table extensions; + put z; + + . z cat on strings : + FOR index FROM 1 UPTO 4 + REP buffer := font table. on strings (index); + decode (buffer); + z CAT buffer; + IF index <> 4 THEN z CAT """, """ FI; + PER; + + . z cat off strings : + FOR index FROM 1 UPTO 4 + REP buffer := font table. off strings (index); + decode (buffer); + z CAT buffer; + IF index <> 4 THEN z CAT """, """ FI; + PER; + + . put font table replacements : + put z; + FOR char code FROM 0 UPTO 255 + REP char code 1 := char code + 1; + link nr := font table. replacements table (char code 1); + reset bit (link nr, highest bit); + IF link nr > 0 AND link nr <> maxint + THEN z CAT " "; + put char code; + put font table replacement; + put z; + FI; + PER; + + . put font table replacement : + replacement := subtext (font table. replacements, link nr + 1, + link nr + code (font table. replacements SUB link nr) ); + put replacement; + + . put font table extensions : + IF font table. extension chars <> "" + THEN FOR index FROM 1 UPTO LENGTH font table. extension chars + REP put font table extension PER; + FI; + + . put font table extension : + check file overflow; + put z; + z CAT " EXTENSION : """""; + z CAT text 3 (code (font table. extension chars SUB index)); + z CAT """"";"; + put z; put z; + replacements length := 0; + extension nr := font table. extension indexes ISUB index; + FOR char code FROM 0 UPTO 255 + REP char code 1 := char code + 1; + link nr := extension. replacements table (char code 1); + IF link nr > 0 + THEN z CAT " "; + put char code; + put extension replacement; + put z; + FI; + PER; + +. put font : + check file overflow; + put z; + z CAT " FONT : "; z cat font names; z CAT ";"; put z; + z CAT " indentation pitch = "; + z CAT text(font. indentation pitch); + z CAT ";"; put z; + IF font. font lead <> 0 + THEN z CAT " font lead = "; + z CAT text(font. font lead); + z CAT ";"; put z; + FI; + z CAT " font height = "; + z CAT text(font. font height); + z CAT ";"; put z; + IF font. font depth <> 0 + THEN z CAT " font depth = "; + z CAT text(font. font depth); + z CAT ";"; put z; + FI; + IF next larger <> "" + THEN z CAT " next larger font = """; + z CAT next larger; + z CAT """;"; put z; + FI; + IF next smaller <> "" + THEN z CAT " next smaller font = """; + z CAT next smaller; + z CAT """;"; put z; + FI; + IF font. font string <> "" + THEN z CAT " font string = """; + z CAT font string; + z CAT """;"; put z; + FI; + IF (font. y offsets ISUB 1) <> 0 OR LENGTH font. y offsets > int length + THEN z CAT " y offsets = "; + z cat y offsets; + z CAT ";"; put z; + FI; + IF font. bold offset <> 0 + THEN z CAT " bold offset = "; + z CAT text(font. bold offset); + z CAT ";"; put z; + FI; + put font pitches and replacements; + put font extensions; + + . next larger : name (font table. font names, font. next larger font) + . next smaller : name (font table. font names, font. next smaller font) + . font string : buffer := font. font string; decode (buffer); buffer + + . z cat font names : + z CAT """"; + z CAT name (font table. font names, font. font name indexes ISUB 1); + z CAT """"; + FOR index FROM 2 UPTO LENGTH font. font name indexes DIV int length + REP z CAT ", """; + z CAT name (font table. font names, font. font name indexes ISUB index); + z CAT """"; + PER; + + . z cat y offsets : + z CAT text (font. y offsets ISUB 1); + FOR index FROM 2 UPTO LENGTH font. y offsets DIV int length + REP z CAT ", "; + z CAT text (font. y offsets ISUB index); + PER; + + . put font pitches and replacements : + BOOL VAR ausgabe := FALSE; + replacements length := LENGTH font table. replacements; + put z; + z CAT " "; + FOR char code FROM 0 UPTO 255 + REP char code 1 := char code + 1; + pitch := font. pitch table (char code 1); + reset bit (pitch, highest bit); + link nr := font. replacements table (char code 1); + reset bit (link nr, highest bit); + IF (pitch <> font. indentation pitch) OR + (link nr > replacements length AND link nr <> maxint) + THEN put font char pitch and replacement; + IF ausgabe + THEN put z; + ausgabe := FALSE; + ELSE ausgabe := TRUE; + FI; + z CAT " "; + FI; + PER; + IF ausgabe THEN put z ELSE z := " " FI; + + . put font char pitch and replacement : + put char code; + put font char pitch; + IF link nr > replacements length AND link nr <> maxint + THEN put font replacement; + IF NOT ausgabe THEN z CAT (6 - LENGTH replacement) * " " FI; + ELIF ausgabe + THEN z CAT ";" + ELSE z CAT "; "; + FI; + + . put font char pitch : + IF pitch = max int + THEN char pos := pos (font. extension chars, code (char code)); + IF char pos <> 0 + THEN pitch := font table. extensions + (font. extension indexes ISUB char pos). std pitch + FI; + FI; + put char pitch; + + . put font replacement : + link nr DECR replacements length; + replacement := subtext (font. replacements, link nr + 1, + link nr + code (font. replacements SUB link nr) ); + put replacement; + + . put font extensions : + IF font. extension chars <> "" + THEN FOR index FROM 1 UPTO LENGTH font. extension chars + REP put font extension PER; + FI; + + . put font extension : + check file overflow; + put z; + z CAT " EXTENSION : """""; + z CAT text 3 (code (font. extension chars SUB index)); + z CAT """"";"; + put z; put z; z CAT " "; + detemine replacements length; + extension nr := font. extension indexes ISUB index; + ausgabe := FALSE; + FOR char code FROM 0 UPTO 255 + REP char code 1 := char code + 1; + pitch := extension. pitch table (char code 1); + link nr := extension. replacements table (char code 1); + IF pitch <> extension. std pitch OR link nr > replacements length + THEN put extension char pitch and replacement; + IF ausgabe + THEN put z; + ausgabe := FALSE; + ELSE ausgabe := TRUE; + FI; + z CAT " "; + FI; + PER; + IF ausgabe THEN put z ELSE z := " " FI; + + . detemine replacements length : + char pos := pos (font table. extension chars, + font. extension chars SUB index); + IF char pos <> 0 + THEN replacements length := LENGTH font table. extensions + (font table. extension indexes ISUB char pos). replacements; + ELSE replacements length := 0; + FI; + + . put extension char pitch and replacement : + put char code; + put char pitch; + IF link nr > replacements length + THEN put extension replacement; + IF NOT ausgabe THEN z CAT (6 - LENGTH replacement) * " " FI; + ELIF ausgabe + THEN z CAT ";" + ELSE z CAT "; "; + FI; + +. put extension replacement : + link nr DECR replacements length; + replacement := subtext (extension. replacements, link nr + 1, + link nr + code (extension. replacements SUB link nr) ); + put replacement; + +. put char code : + IF (char code >= 32 AND char code <= 122) OR + (char code >= 214 AND char code <= 223) OR + char code = 124 OR char code = 126 OR char code = 251 + THEN z CAT "(* "; + z CAT code (char code); + z CAT " *) """""; + ELSE z CAT " """""; + FI; + z CAT text 3 (char code); + z CAT """"""; + +. put char pitch : + z CAT ","; + z CAT text (pitch, 5); + +. put replacement : + decode (replacement); + z CAT ", """; + z CAT replacement; + z CAT """;" + +END PROC create font file; + + +PROC put z : + + putline (font file, z); + cout (lines (font file)); + z := " "; + +END PROC put z; + + +PROC decode (TEXT VAR string) : + + INT VAR p; + change all (string, """", """"""); + p := pos (string, ""0"", ""31"", 1); + WHILE p <> 0 + REP change (string, p, p, """" + text (code(string SUB p)) + """"); + p := pos (string, ""0"", ""31"", p); + PER; + p := pos (string, ""127"", ""255"", 1); + WHILE p <> 0 + REP change (string, p, p, """" + text (code(string SUB p)) + """"); + p := pos (string, ""127"", ""255"", p); + PER; + +END PROC decode; + + +TEXT PROC text 3 (INT CONST value) : + + buffer := text (value, 3); + change all (buffer, " ", "0"); + buffer + +END PROC text 3; + +END PACKET font convertor; + diff --git a/system/std.zusatz/1.8.7/src/free channel b/system/std.zusatz/1.8.7/src/free channel new file mode 100644 index 0000000..3814f9d --- /dev/null +++ b/system/std.zusatz/1.8.7/src/free channel @@ -0,0 +1,430 @@ +PACKET free channel DEFINES (* Autor: J.Liedtke *) + (* Stand: 10.06.86 *) + FCHANNEL , + := , + free channel , + open , + close , + out , + in , + dialogue , + save , + fetch : + + + +LET ack = 0 , + nak = 1 , + error nak = 2 , + empty message code = 256 , + long message code = 257 , + file send code = 1024 , + file receive code = 2048 , + open code = 1000 , + close code = 1001 , + + file type = 1003 ; + +INT CONST task not existing := - 1 ; + + +TYPE FCHANNEL = STRUCT (TASK server, TEXT input buffer, server name) ; + +INT VAR message code , response code ; +TASK VAR partner ; +DATASPACE VAR ds ; + +BOUND TEXT VAR msg ; +TEXT VAR response, char, esc char , record ; + +FILE VAR file ; + + +OP := (FCHANNEL VAR dest, FCHANNEL CONST source) : + + dest.server := source.server ; + dest.input buffer := "" ; + dest.server name := source.server name ; + open (dest) + +ENDOP := ; + +FCHANNEL PROC free channel (TEXT CONST channel name) : + + FCHANNEL:(niltask,"", channel name) + +ENDPROC free channel ; + +PROC open (FCHANNEL VAR channel) : + + INT VAR receipt ; + + initialize message dataspace ; + send open code ; + IF receipt <> ack + THEN errorstop ("channel not free") + FI . + +initialize message dataspace : + forget (ds) ; + ds := nilspace . + +send open code : + ping pong (channel.server, open code, ds, receipt) ; + IF receipt = task not existing + THEN channel.server := task (channel.server name) ; + ping pong (channel.server, open code, ds, receipt) + FI . + +ENDPROC open ; + +PROC close (FCHANNEL VAR channel) : + + forget (ds) ; + ds := nilspace ; + call (channel.server, close code, ds, response code) + +ENDPROC close ; + +PROC close (TEXT CONST channel server) : + + forget (ds) ; + ds := nilspace ; + call (task (channel server), close code, ds, response code) + +ENDPROC close ; + + +PROC out (FCHANNEL VAR channel, TEXT CONST message) : + + send message ; + get response . + +send message : + IF message = "" + THEN call (channel.server, empty message code, ds, response code) + ELSE msg := ds ; + CONCR (msg) := message ; + call (channel.server, long message code, ds, response code) + FI . + +get response : + IF response code < 0 + THEN errorstop ("channel not ready") + ELIF response code < 256 + THEN channel.input buffer CAT code (response code) + ELIF response code = long message code + THEN msg := ds ; + channel.input buffer CAT CONCR (msg) + FI . + +ENDPROC out ; + +PROC in (FCHANNEL VAR channel, TEXT VAR response) : + + out (channel, "") ; + response := channel.input buffer ; + channel.input buffer := "" + +ENDPROC in ; + +PROC save (FCHANNEL VAR channel, TEXT CONST file name, control chars) : + + prepare ds ; + call (channel.server, file send code, ds, response code) ; + IF response code = error nak + THEN BOUND TEXT VAR error msg := ds ; + errorstop (error msg) + FI . + +prepare ds : + forget (ds) ; + ds := old (file name, file type) ; + FILE VAR f := sequential file (modify, ds) ; + headline (f, control chars) . + +ENDPROC save ; + +PROC fetch (FCHANNEL VAR channel, TEXT CONST file name, control chars) : + + IF NOT exists (file name) COR yes ("""" + file name + """ loeschen") + THEN fetch first part ; + WHILE more to fetch REP + fetch next part + PER + FI . + +fetch first part : + INT VAR part := 0 ; + receive file (channel, file name, control chars) . + +fetch next part : + part INCR 1 ; + receive file (channel, file name + "." + text (part), control chars) . + +more to fetch : response code = file receive code . + +ENDPROC fetch ; + +PROC receive file (FCHANNEL VAR channel,TEXT CONST file name, control chars): + + prepare ds ; + call (channel.server, file receive code, ds, response code); + IF response code = error nak + THEN BOUND TEXT VAR error msg := ds ; + errorstop (error msg) + ELSE forget (file name, quiet) ; + copy (ds, file name) ; + forget (ds) ; + ds := nilspace ; + FI . + +prepare ds : + forget (ds) ; + ds := nilspace ; + BOUND TEXT VAR ctl := ds ; + ctl := control chars . + +ENDPROC receive file ; + + +PROC dialogue (FCHANNEL CONST channel, TEXT CONST esc) : + + forget (ds) ; + ds := nilspace ; + partner := channel.server ; + esc char := esc ; + enable stop ; + + response code := empty message code ; + REP + get and send message charety ; + out response option + PER . + +get and send message charety : + IF response code = empty message code + THEN char := incharety (10) + ELSE char := incharety + FI ; + IF char = "" + THEN call (partner, empty message code, ds, response code) + ELIF char = esc char + THEN LEAVE dialogue + ELSE call (partner, code (char), ds, response code) + FI . + +out response option : + IF response code < 256 + THEN out (code (response code)) + ELIF response code = long message code + THEN msg := ds ; + out (CONCR (msg)) + FI . + +ENDPROC dialogue ; + +PROC free channel (INT CONST nr) : + + INT CONST my channel := nr ; + break ; + disable stop ; + REP + wait (ds, message code, partner) ; + IF message code = open code + THEN connect to my channel ; + use channel ; + break (quiet) + ELIF message code >= 0 + THEN send (partner, nak, ds) + FI + PER . + +use channel : + ping pong (partner, ack, ds, message code) ; + WHILE message code <> close code AND message code >= 0 REP + IF message code <= long message code THEN dialogue + ELIF message code = file receive code THEN receive file + ELIF message code = file send code THEN send file + ELIF message code = open code THEN ignore open + ELSE errorstop ("falsche Sendung") + FI + UNTIL is error PER ; + IF is error + THEN send error message + ELSE send handshake ack + FI . + +dialogue : + IF message code < 256 + THEN out (code (message code)) + ELIF message code = long message code + THEN msg := ds ; + out (CONCR (msg)) + FI ; + response := incharety (1) ; + IF response = "" + THEN ping pong (partner, empty message code, ds, message code) + ELSE short or long response + FI . + +short or long response : + char := incharety ; + IF char = "" + THEN short response + ELSE long response + FI . + +short response : + ping pong (partner, code (response), ds, message code) . + +long response : + msg := ds ; + response CAT char ; + msg := response ; + REP + cat input (msg, char) ; + msg CAT char + UNTIL char = "" OR LENGTH msg > 500 PER ; + ping pong (partner, long message code, ds, message code) . + +connect to my channel : + continue (my channel) ; + WHILE is error REP + clear error ; + pause (100) ; + continue (my channel) + PER . + +send handshake ack : + send (partner, ack, ds) . + +send error message : + forget (ds) ; + ds := nilspace ; + BOUND TEXT VAR error msg := ds ; + error msg := error message ; + clear error ; + send (partner, error nak, ds) . + +ignore open : + ping pong (partner, ack, ds, message code) . + +ENDPROC free channel ; + +PROC send file : + + enable stop ; + file := sequential file (input,ds) ; + get control chars ; + skip chars ; + REP + getline (file, record) ; + out (record) ; + end of line + UNTIL eof (file) PER ; + end of transmission ; + send ack reply . + +get control chars : + TEXT CONST + control chars := headline (file) , + end of file char := control chars SUB 1 , + end of line char := control chars SUB 2 , + handshake char := control chars SUB 3 . + +end of line : + out (end of line char) ; + IF handshake char <> "" + THEN wait for handshake + FI . + +wait for handshake : + REP + char := incharety (300) ; + IF char = "" + THEN errorstop ("timeout") + FI + UNTIL char = handshake char PER . + +end of transmission : + skip chars ; + out (end of file char) . + +skip chars : + WHILE incharety (3) <> "" REP PER . + +send ack reply : + forget (ds) ; + ds := nilspace ; + ping pong (partner, ack, ds, message code) . + +ENDPROC send file ; + +PROC receive file : + + enable stop ; + get control chars ; + open file ; + INT VAR line no := 0 ; + REP + receive line ; + IF eof received + THEN ping pong (partner, ack, ds, message code) ; + LEAVE receive file + FI ; + putline (file, record) ; + line no INCR 1 + UNTIL near file overflow PER ; + ping pong (partner, file receive code, ds, message code) . + +get control chars : + BOUND TEXT VAR control chars := ds ; + TEXT CONST + end of file char := control chars SUB 1 , + end of line char := control chars SUB 2 , + handshake char := control chars SUB 3 , + handshake prompt := control chars SUB 4 . + +open file : + forget (ds) ; + ds := nilspace ; + file := sequential file (output, ds) . + +receive line : + record := "" ; + REP + cat input (record, char) ; + IF char = "" + THEN wait for char + FI ; + IF char = handshake prompt THEN out (handshake char) + ELIF char = ""9"" THEN expand tabs + ELIF char = ""12"" THEN page + FI + UNTIL char = end of line char OR char = end of file char PER . + +wait for char : + char := incharety (300) ; + IF char = "" + THEN errorstop ("timeout") + ELIF char >= ""32"" + THEN record CAT char + FI . + +expand tabs: + record CAT (8-(LENGTH record MOD 8)) * " " . + +page: + record := "#page# " . + +eof received : + char = end of file char OR (record SUB LENGTH record ) = end of file char . + +near file overflow : + line no > 3999 OR (line no > 3800 AND record = "#page# ") . + +ENDPROC receive file ; + +ENDPACKET free channel ; + diff --git a/system/std.zusatz/1.8.7/src/longint b/system/std.zusatz/1.8.7/src/longint new file mode 100644 index 0000000..e78bb52 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/longint @@ -0,0 +1,423 @@ +PACKET longint DEFINES LONGINT, (* Autoren: S.Baumann,A.Bentrup *) + :=, (* T.Sillke *) + <, (* Stand: 17.03.81 *) + >, + <=, + >=, + <>, + =, + -, + +, + *, + **, + ABS, + abs, + DECR, + DIV, + get, + INCR, + int, + (*last rest,*) + longint, + max, + max longint, + min, + MOD, + put, + random, + SIGN, + sign, + text, + zero: + +TYPE LONGINT = TEXT; + +LONGINT VAR result,aleft,aright; +TEXT VAR ergebnis,x,y,z,h; +INT VAR v byte,slr,sll; +INT CONST snull :: code("0"), mtl :: 300 ; +TEXT CONST negativ :: code(127),max digit :: code(99),null :: code(0), + overflow :: "LONGINT overflow",eins :: code(1); +BOOL VAR vorl,vorr,vleft,vright; + +OP := (LONGINT VAR left, LONGINT CONST right) : + CONCR(left) := CONCR(right) +END OP :=; + +BOOL OP < (LONGINT CONST left,right) : + slr := sign(right)*length(right); + sll := sign(left )*length(left ); + IF slr <> sll THEN + IF slr > sll THEN TRUE ELSE FALSE FI + ELSE IF slr>0 + THEN CONCR(left) < CONCR(right) + ELSE CONCR(left) > CONCR(right) FI + FI +END OP < ; + +BOOL OP > (LONGINT CONST left,right) : + slr := sign(right)*length(right); + sll := sign(left )*length(left ); + IF slr <> sll THEN + IF slr < sll THEN TRUE ELSE FALSE FI + ELSE IF slr>0 + THEN CONCR(left) > CONCR(right) + ELSE CONCR(left) < CONCR(right) FI + FI +END OP > ; + +BOOL OP <= (LONGINT CONST left,right) : + NOT (left > right) +END OP <=; + +BOOL OP >= (LONGINT CONST left,right) : + NOT (left < right) +END OP >=; + +BOOL OP <> (LONGINT CONST left,right) : + CONCR (left) <> CONCR (right) +END OP <>; + +BOOL OP = (LONGINT CONST left,right) : + CONCR (left) = CONCR (right) +END OP = ; + +LONGINT OP - (LONGINT CONST arg) : + SELECT code(CONCR(arg)SUB1) OF + CASE 0 : zero + CASE 127: LONGINT : (subtext(CONCR(arg),2)) + OTHERWISE LONGINT : (negativ + CONCR(arg)) + END SELECT +END OP -; + +LONGINT OP + (LONGINT CONST arg) : arg END OP +; + +LONGINT OP - (LONGINT CONST left,right) : + IF CONCR(left ) = null THEN LEAVE - WITH -right + ELIF CONCR(right) = null THEN LEAVE - WITH left + ELIF sign(left) <> sign(right) THEN LEAVE - WITH left + (-right) FI; + betrag(left,right); + BOOL CONST betrag max :: aleft > aright; + IF betrag max + THEN result := LONGINT : (CONCR(aleft ) SUB CONCR(aright)) + ELSE result := LONGINT : (CONCR(aright) SUB CONCR(aleft )) FI; + kuerze fuehrende nullen(CONCR(result),null); + IF vleft XOR betrag max THEN -result ELSE result FI +END OP -; + +LONGINT OP + (LONGINT CONST left,right) : + IF sign(left) <> sign(right) THEN LEAVE + WITH left - (-right) FI; + betrag(left,right); + IF aleft > aright + THEN result := LONGINT : (CONCR(aleft ) ADD CONCR(aright)) + ELSE result := LONGINT : (CONCR(aright) ADD CONCR(aleft )) FI; + IF vleft THEN result ELSE -result FI +END OP +; + +LONGINT OP * (LONGINT CONST left,right) : + IF CONCR(left) = null OR CONCR(right) = null THEN LEAVE * WITH zero + ELIF length(left) + length(right) > mtl THEN errorstop (overflow) FI; + betrag(left,right); + IF aleft < aright + THEN result := LONGINT : (CONCR(aright) MUL CONCR(aleft )) + ELSE result := LONGINT : (CONCR(aleft ) MUL CONCR(aright)) FI; + IF length(CONCR(result)) = mtl THEN errorstop(overflow) FI; + IF vleft XOR vright THEN -result ELSE result FI +END OP *; + +LONGINT OP ** (LONGINT CONST arg,exp) : + IF exp > longint(max int) THEN errorstop (overflow) FI; + arg ** int(exp) +END OP **; + +LONGINT OP ** (LONGINT CONST arg,INT CONST exp) : + IF exp < 0 THEN errorstop ("LONGINT OP ** : negativ exp") + ELIF CONCR(arg)=null AND exp=0 THEN errorstop(text(0 ** 0)) FI; + IF exp = 0 THEN one + ELIF exp = 1 THEN arg + ELIF sign(arg) = -1 AND exp MOD 2 <> 0 + THEN -LONGINT:(CONCR(abs(arg))EXPexp) + ELSE LONGINT:(CONCR(abs(arg))EXPexp) FI +END OP **; + +LONGINT OP ABS (LONGINT CONST arg) : abs(arg) END OP ABS; + +LONGINT PROC abs (LONGINT CONST a) : + IF (CONCR(a)SUB1)=negativ THEN LONGINT:(subtext(CONCR(a),2)) ELSE a FI +END PROC abs; + +OP DECR (LONGINT VAR result,LONGINT CONST ab) : + result := result - ab; +END OP DECR; + +LONGINT OP DIV (LONGINT CONST left,right) : + IF CONCR(right) = null THEN error stop("LONGINT OP DIV by zero") FI; + betrag(left,right); h := CONCR(aright); + y := null + CONCR(aleft ); vorl := vleft; + z := null + CONCR(aright); vorr := vright; + IF aleft < aright THEN y:=CONCR(aleft); LEAVE DIV WITH zero FI; + INT VAR try,i,cr1 :: code(z SUB 2),cr2,cr3,zw; + BOOL VAR sh :: length(z) <> 2; + IF sh THEN cr3:=code(zSUB3); cr2:=10*cr1+cr3DIV10; cr3:=100*cr1+cr3 FI; + CONCR(result) := ""; + FOR i FROM 0 UPTO length(y)-length(z) REP + laufe eine abschaetzung durch; + CONCR (result) CAT code(try) + PER; kuerze fuehrende nullen(y,null); + IF(CONCR(result)SUB1)=nullTHEN CONCR(result):=subtext(CONCR(result),2)FI; + IF vleft XOR vright THEN -result ELSE result FI. + + laufe eine abschaetzung durch : + zw := 100*code(y SUB i+1) + code(y SUB i+2); + IF zw < 3276 AND sh THEN IF zw < 327 + THEN try := min((100*zw + code(ySUBi+3)) DIV cr3, 99) + ELSE try := min(( 10*zw + code(ySUBi+3)DIV10)DIV cr2, 99) FI + ELSE try := min( zw DIV cr1, 99) FI; + x := z MUL code(try); + WHILE x > subtext(y,i+1,i+length(x)) REP + try DECR 1; x := x SUB z PER; + replace(y,i + 1,subtext(y,i + 1,i + length(x)) SUB x) +END OP DIV; + +PROC get (LONGINT VAR result) : + get (ergebnis); + result := longint(ergebnis); +END PROC get; + +PROC get (FILE VAR file,LONGINT VAR result) : + get(file,ergebnis); + result := longint(ergebnis); +END PROC get; + +OP INCR (LONGINT VAR result,LONGINT CONST dazu) : + result := result + dazu; +END OP INCR; + +INT PROC int (LONGINT CONST longint) : + IF length(longint) > 3 + THEN max int + 1 + ELSE ergebnis := (3-length(longint))*null + CONCR(abs(longint)); + (code(ergebnis SUB 1) * 10000 + + code(ergebnis SUB 2) * 100 + + code(ergebnis SUB 3)) * sign(longint) + FI +END PROC int; + +LONGINT PROC longint (INT CONST int) : + CONCR(result) := code( abs(int) DIV 10000) + + code((abs(int) MOD 10000) DIV 100) + + code( abs(int) MOD 100); + kuerze fuehrende nullen (CONCR(result),null); + IF int < 1 THEN -result ELSE result FI +END PROC longint; + +LONGINT PROC longint (TEXT CONST text) : + INT VAR i; + ergebnis := compress(text); + BOOL VAR minus :: (ergebnisSUB1) = "-"; + IF (ergebnisSUB1)="+" OR minus THEN ergebnis:=subtext(ergebnis,2) FI; + kuerze fuehrende nullen(ergebnis,"0"); + kuerze die unzulaessigen zeichen aus ergebnis; + schreibe ergebnis im hundertersystem in result; + result mit vorzeichen. + + kuerze die unzulaessigen zeichen aus ergebnis : + ergebnis := subtext(ergebnis,1,letztes zulaessiges zeichen). + letztes zulaessiges zeichen : + FOR i FROM 1 UPTO length(ergebnis) REP + UNTIL pos("0123456789", ergebnis SUB i) = 0 PER; + i - 1. + schreibe ergebnis im hundertersystem in result : + sll := length(ergebnis); + IF sll MOD 2 <> 0 THEN ergebnis := "0"+ergebnis; sll INCR 1 FI; + i := 1; CONCR(result) := ""; + REP schreibe ein zeichen im hundertersystem in result; + i INCR 2 + UNTIL i >= sll PER. + schreibe ein zeichen im hundertersystem in result : + CONCR(result) CAT code((code(ergebnis SUB i ) - snull) * 10 + + code(ergebnis SUB i + 1) - snull). + result mit vorzeichen : + IF ergebnis="" THEN zero ELIF minus THEN -result ELSE result FI +END PROC longint; + +LONGINT PROC max (LONGINT CONST left,right) : + IF left > right THEN left ELSE right FI +END PROC max; + +LONGINT PROC max longint : + LONGINT : ((mtl - 1) * max digit) +END PROC max longint; + +LONGINT PROC min (LONGINT CONST left,right) : + IF left < right THEN left ELSE right FI +END PROC min; + +LONGINT OP MOD (LONGINT CONST left,right) : + IF CONCR(right) = null THEN errorstop("LONGINT OP MOD by zero") FI; + result := left DIV right; last rest +END OP MOD; + +PROC put (LONGINT CONST longint) : + INT VAR i :: 1,zwei ziffern; + IF sign(longint) = -1 THEN out("-"); i:=2 FI; + out(text(code(CONCR(longint) SUB i))); + FOR i FROM i + 1 UPTO length(CONCR(longint)) REP + zwei ziffern := code(CONCR(longint) SUB i); + out(code(zwei ziffern DIV 10 + snull)); + out(code(zwei ziffern MOD 10 + snull)); + PER;out(" ") +END PROC put; + +PROC put (FILE VAR file,LONGINT CONST longint) : + put(file,text(longint)); +END PROC put; + +LONGINT PROC random (LONGINT CONST lower bound,upper bound) : + INT VAR i; x := CONCR(upper bound - lower bound - one); y := ""; + FOR i FROM 1 UPTO length(x) REP y CAT code(random(0,99)) PER; + upper bound - (LONGINT : (y) MOD LONGINT : (x)) +END PROC random; + +INT OP SIGN (LONGINT CONST arg) : sign(arg) END OP SIGN; + +INT PROC sign (LONGINT CONST arg) : + SELECT code(CONCR(arg) SUB 1) OF + CASE 0 : 0 + CASE 127 : -1 + OTHERWISE 1 + END SELECT +END PROC sign; + +TEXT PROC text (LONGINT CONST longint) : + INT VAR i::1,zwei ziffern; ergebnis := ""; + IF sign(longint) = -1 THEN ergebnis := "-"; i:=2 FI; + ergebnis CAT text (code (CONCR (longint) SUB i ) ) ; + FOR i FROM i+1 UPTO length(CONCR(longint)) REP + zwei ziffern := code(CONCR(longint) SUB i); + ergebnis CAT code(zwei ziffern DIV 10 + snull); + ergebnis CAT code(zwei ziffern MOD 10 + snull) + PER; ergebnis +END PROC text; + +TEXT PROC text (LONGINT CONST longint,INT CONST length) : + x := text(longint); sll := LENGTH x; + IF sll > length THEN length * "*" ELSE (length - sll)*" " + x FI +END PROC text; + +LONGINT PROC last rest : + IF y=null THEN LEAVE last rest WITH zero FI; + IF vorl XOR vorr THEN y := h SUB y; kuerze fuehrende nullen(y,null); + vorl := TRUE FI; + IF NOTvorr THEN y:=negativ+y; vorr := TRUE FI; LONGINT:(y) +END PROC last rest; + +LONGINT PROC zero : LONGINT : (null) END PROC zero; +LONGINT PROC one : LONGINT : (""1"") END PROC one; + + +(* ----------------------- INTERNE HILFSPROZEDUREN ----------------------- *) + +TEXT OP ADD (TEXT CONST left,right) : + INT VAR carrybit :: 0,i,dif :: length(left) - length(right); + ergebnis := left; + FOR i FROM length(left) DOWNTO dif + 1 REP + replace(ergebnis,i,das result der addition) + PER; + IF carrybit = 1 THEN addiere den uebertrag FI; + ergebnis. + + das result der addition : + v byte := (code(left SUB i) + code(right SUB i - dif) + carrybit); + IF v byte > 99 + THEN carrybit := 1; code(v byte - 100) + ELSE carrybit := 0; code(v byte) + FI. + addiere den uebertrag : + FOR i FROM i DOWNTO 1 + WHILE (ergebnis SUB i) >= max digit REP + replace(ergebnis,i,null) + PER; + IF (ergebnis SUB 1) = null OR dif = 0 + THEN pruefe auf longint overflow + ELSE replace(ergebnis,i,code(code(ergebnis SUB i) + 1)) + FI. + pruefe auf longint overflow : + IF length(ergebnis) = mtl - 1 THEN errorstop(overflow) FI; + ergebnis := eins + ergebnis +END OP ADD; + +PROC betrag (LONGINT CONST a, b) : + vleft := (CONCR(a)SUB1)<>negativ; vright := (CONCR(b)SUB1)<>negativ; + IF vleft THEN aleft :=a ELSE CONCR(aleft ):=subtext(CONCR(a),2) FI; + IF vright THEN aright:=b ELSE CONCR(aright):=subtext(CONCR(b),2) FI +END PROC betrag; + +TEXT OP EXP (TEXT CONST arg,INT CONST exp) : + INT VAR zaehler :: exp; + x := arg; z := eins; + REP IF zaehler MOD 2 = 1 THEN z := z MUL x FI; + zaehler := zaehler DIV 2; x := x MUL x + UNTIL zaehler = 1 PER; + x MUL z +END OP EXP; + +PROC kuerze fuehrende nullen ( TEXT VAR text,TEXT CONST snull) : + INT VAR i; + text := subtext(text,erste nicht snull). + + erste nicht snull : + FOR i FROM 1 UPTO length (text) - 1 REP + UNTIL (text SUB i) <> snull PER; + i +END PROC kuerze fuehrende nullen; + +INT PROC length (LONGINT CONST a) : + IF (CONCR(a)SUB1)=negativ THEN length(CONCR(a))-1 ELSE length(CONCR(a)) FI +END PROC length; + +TEXT OP MUL (TEXT CONST left,right) : + INT VAR i,j,carrybit,v,w; + ergebnis := (length(left) + length(right) - 1) * null; + FOR i FROM length(ergebnis) DOWNTO length(left) REP + v := i - length(left); w := length(right) - length(ergebnis) + i; + carrybit := 0; + FOR j FROM length(left) DOWNTO 1 REP + replace(ergebnis,v + j,result der addition) + PER; + replace(ergebnis,v,code(code(ergebnis SUB v) + carrybit)); + PER; + IF carrybit = 0 THEN ergebnis ELSE code(carrybit) + ergebnis FI. + + result der addition : + v byte := code(right SUB w) * code(left SUB j) + carrybit + + code(ergebnis SUB v + j); + carrybit := v byte DIV 100; + code(v byte MOD 100) +END OP MUL; + +TEXT OP SUB (TEXT CONST left,right) : + INT VAR carrybit :: 0,i,dif :: length(left) - length(right); + ergebnis := left; + FOR i FROM length(left) DOWNTO dif + 1 REP + replace(ergebnis,i,das result der subtraktion); + PER; + IF carrybit = 1 THEN subtrahiere den uebertrag FI; + ergebnis. + + das result der subtraktion : + v byte := (code(left SUB i) - code(right SUB i - dif) - carrybit); + IF v byte < 0 + THEN carrybit := 1;code(v byte + 100) + ELSE carrybit := 0;code(v byte) + FI. + subtrahiere den uebertrag : + FOR i FROM i DOWNTO 2 + WHILE (ergebnis SUB i) = null REP + replace(ergebnis,i,max digit) + PER; + replace(ergebnis,i,code(code(ergebnis SUB i) - 1)) +END OP SUB; + +END PACKET longint; + diff --git a/system/std.zusatz/1.8.7/src/matrix b/system/std.zusatz/1.8.7/src/matrix new file mode 100644 index 0000000..d9de9fb --- /dev/null +++ b/system/std.zusatz/1.8.7/src/matrix @@ -0,0 +1,482 @@ +PACKET matrix DEFINES MATRIX, matrix, idn, (* Stand : 16.06.86 wk *) + :=, sub, (* Autor : H.Indenbirken *) + row, column, + COLUMNS, + ROWS, + DET, + INV, + TRANSP, + transp, + replace row, replace column, + replace element, + get, put, + =, <>, + +, -, * : + +TYPE MATRIX = STRUCT (INT rows, columns, VECTOR elems); +TYPE INITMATRIX = STRUCT (INT rows, columns, REAL value, BOOL idn); + +MATRIX VAR a :: idn (1); +INT VAR i; + +(**************************************************************************** +PROC dump (MATRIX CONST m) : + put line (text (m.rows) + " Reihen, " + text (m.columns) + " Spalten."); + dump (m.elems) . + +END PROC dump; +****************************************************************************) + +OP := (MATRIX VAR l, MATRIX CONST r) : + CONCR (l) := CONCR (r); +END OP :=; + +OP := (MATRIX VAR l, INITMATRIX CONST r) : + l.rows := r.rows; + l.columns := r.columns; + l.elems := vector (r.rows*r.columns, r.value); + IF r.idn + THEN idn FI . + +idn : + INT VAR i; + FOR i FROM 1 UPTO r.rows + REP replace (l.elems, calc pos (l.columns, i, i), 1.0) PER + +END OP :=; + +INITMATRIX PROC matrix (INT CONST rows, columns, REAL CONST value) : + IF rows <= 0 + THEN errorstop ("PROC matrix : rows <= 0") + ELIF columns <= 0 + THEN errorstop ("PROC matrix : columns <= 0") FI; + + INITMATRIX : (rows, columns, value, FALSE) + +END PROC matrix; + +INITMATRIX PROC matrix (INT CONST rows, columns) : + matrix (rows, columns, 0.0) + +END PROC matrix; + +INITMATRIX PROC idn (INT CONST size) : + IF size <= 0 + THEN errorstop ("MATRIX PROC idn : size <= 0") FI; + + INITMATRIX : (size, size, 0.0, TRUE) + +END PROC idn; + +VECTOR PROC row (MATRIX CONST m, INT CONST i) : + VECTOR VAR v :: vector (m.columns); + INT VAR j, k :: 1, pos :: (i-1) * m.columns; + FOR j FROM pos+1 UPTO pos + m.columns + REP replace (v, k, m.elems SUB j); + k INCR 1 + PER; + v + +END PROC row; + +VECTOR PROC column (MATRIX CONST m, INT CONST j) : + VECTOR VAR v :: vector (m.rows); + INT VAR i, k :: j; + FOR i FROM 1 UPTO m.rows + REP replace (v, i, m.elems SUB k); + k INCR m.columns + PER; + v + +END PROC column; + +INT OP COLUMNS (MATRIX CONST m) : + m.columns + +END OP COLUMNS; + +INT OP ROWS (MATRIX CONST m) : + m.rows + +END OP ROWS; + +REAL PROC sub (MATRIX CONST a, INT CONST row, column) : + a.elems SUB calc pos (a.columns, row, column) + +END PROC sub; + +PROC replace row (MATRIX VAR m, INT CONST rowindex, VECTOR CONST rowvalue) : + test ("PROC replace row : ", "LENGTH rowvalue", "COLUMNS m", + LENGTH rowvalue, m.columns); + test ("PROC replace row : row ", rowindex, m.rows); + + INT VAR i, pos :: (rowindex-1) * m.columns; + FOR i FROM 1 UPTO m.columns + REP replace (m.elems, pos+i, rowvalue SUB i) PER + +END PROC replace row; + +PROC replace column (MATRIX VAR m, INT CONST columnindex, + VECTOR CONST columnvalue) : + test ("PROC replace column : ", "LENGTH columnvalue", "ROWS m", + LENGTH columnvalue, m.rows); + test ("PROC replace column : column ", columnindex, m.columns); + + INT VAR i; + FOR i FROM 1 UPTO m.rows + REP replace (m.elems, calc pos (m.columns, i, columnindex), + columnvalue SUB i) PER + +END PROC replace column; + +PROC replace element (MATRIX VAR a, INT CONST row, column, REAL CONST x) : + test ("PROC replace element : row ", row, a.rows); + test ("PROC replace element : column ", column, a.columns); + replace (a.elems, calc pos (a.columns, row, column), x) + +END PROC replace element; + +BOOL OP = (MATRIX CONST l, r) : + IF l.rows <> r.rows + THEN FALSE + ELIF l.columns <> r.columns + THEN FALSE + ELSE l.elems = r.elems FI + +END OP =; + +BOOL OP <> (MATRIX CONST l, r) : + IF l.rows <> r.rows + THEN TRUE + ELIF l.columns <> r.columns + THEN TRUE + ELSE l.elems <> r.elems FI + +END OP <>; + +INT PROC calc pos (INT CONST columns, z, s) : + (z-1) * columns + s +END PROC calc pos; + +MATRIX OP + (MATRIX CONST m) : + m + +END OP +; + +MATRIX OP + (MATRIX CONST l, r) : + test ("MATRIX OP + : ", "ROWS l", "ROWS r", l.rows, r.rows); + test ("MATRIX OP + : ", "COLUMNS l", "COLUMNS r", l.columns, r.columns); + + a := l; + INT VAR i; + FOR i FROM 1 UPTO l.rows * l.columns + REP replace (a.elems, i, (l.elems SUB i) + (r.elems SUB i)) + PER; + a + +END OP +; + +MATRIX OP - (MATRIX CONST m) : + a := m; + INT VAR i; + FOR i FROM 1 UPTO m.rows * m.columns + REP replace (a.elems, i, -a.elems SUB i) + PER; + a + +END OP -; + +MATRIX OP - (MATRIX CONST l, r) : + test ("MATRIX OP - : ", "ROWS l", "ROWS r", l.rows, r.rows); + test ("MATRIX OP - : ", "COLUMNS l", "COLUMNS r", l.columns, r.columns); + + a := l; + INT VAR i; + FOR i FROM 1 UPTO l.rows * l.columns + REP replace (a.elems, i, (l.elems SUB i) - (r.elems SUB i)) + PER; + a + +END OP -; + +MATRIX OP * (REAL CONST x, MATRIX CONST m) : + m*x + +END OP *; + +MATRIX OP * (MATRIX CONST m, REAL CONST x) : + a := m; + INT VAR i; + FOR i FROM 1 UPTO m.rows * m.columns + REP replace (a.elems, i, x*m.elems SUB i) PER; + a + +END OP *; + +VECTOR OP * (VECTOR CONST v, MATRIX CONST m) : + test ("VECTOR OP * : ", "LENGTH v", "ROWS m", LENGTH v, m.rows); + VECTOR VAR result :: vector (m.columns); (*wk*) + INT VAR i; + FOR i FROM 1 UPTO m.columns + REP replace (result, i, v * column (m, i)) PER; + result . + +END OP *; + +VECTOR OP * (MATRIX CONST m, VECTOR CONST v) : + test ("VECTOR OP * : ", "COLUMNS m", "LENGTH v", COLUMNS m, LENGTH v); + VECTOR VAR result :: vector (m.rows); (*wk*) + INT VAR i; + FOR i FROM 1 UPTO m.rows + REP replace (result, i, row (m, i) * v) PER; + result . + +END OP *; + +MATRIX OP * (MATRIX CONST l, r) : + test ("MATRIX OP * : ","COLUMNS l","ROWS r", l.columns, r.rows); + + a.rows := l.rows; + a.columns := r.columns; + a.elems := vector (a.rows*a.columns) + INT VAR i, j; + FOR i FROM 1 UPTO a.rows + REP FOR j FROM 1 UPTO a.columns + REP VECTOR VAR rl :: row (l, i), cr :: column (r, j); + replace (a.elems, calc pos (a.columns, i, j), rl * cr) + PER + PER; + a . + +END OP *; + +PROC get (MATRIX VAR a, INT CONST rows, columns) : + + a := matrix (rows,columns); + INT VAR i, j; + VECTOR VAR v; + FOR i FROM 1 UPTO rows + REP get (v, columns); + store row + PER . + +store row : + FOR j FROM 1 UPTO a.columns + REP replace (a.elems, calc pos (a.columns, i, j), v SUB j) + PER . + +END PROC get; + +PROC put (MATRIX CONST a, INT CONST length, fracs) : + INT VAR i, j; + FOR i FROM 1 UPTO a.rows + REP FOR j FROM 1 UPTO a.columns + REP put (text (sub (a, i, j), length, fracs)) PER; + line (2); + PER + +END PROC put; + +PROC put (MATRIX CONST a) : + INT VAR i, j; + FOR i FROM 1 UPTO a.rows + REP FOR j FROM 1 UPTO a.columns + REP TEXT CONST number :: " " + text (sub (a, i, j)); + put (subtext (number, LENGTH number - 15)) + PER; + line (2); + PER + +END PROC put; + +TEXT VAR error :: ""; +PROC test (TEXT CONST proc, l text, r text, INT CONST left, right) : + IF left <> right + THEN error := proc; + error CAT l text; + error CAT " ("; + error CAT text (left); + error CAT ") <> "; + error CAT r text; + error CAT " ("; + error CAT text (right); + error CAT ")"; + errorstop (error) + FI . + +END PROC test; + +PROC test (TEXT CONST proc, INT CONST i, n) : + IF i < 1 + THEN error := proc; + error CAT "subscript underflow ("; + error CAT text (i); + error CAT ")"; + errorstop (error) + ELIF i > n + THEN error := proc; + error CAT "subscript overflow (i="; + error CAT text (i); + error CAT ", max="; + IF n <= 0 + THEN error CAT "undefined" + ELSE error CAT text (n) FI; + error CAT ")"; + errorstop (error) + FI + +END PROC test; + + +MATRIX OP TRANSP (MATRIX CONST m) : + MATRIX VAR a :: m; + transp (a); + a + +END OP TRANSP; + +PROC transp (MATRIX VAR m) : + INT VAR k :: 1, n :: m.rows*m.columns; + a := m; + FOR i FROM 2 UPTO n + REP replace (m.elems, i, a.elems SUB position) PER; + a := idn (1); + i := m.rows; + m.rows := m.columns; + m.columns := i . + +position : + k INCR m.columns; + IF k > n + THEN k DECR (n-1) FI; + k . +END PROC transp; + +MATRIX OP INV (MATRIX CONST m) : + a := m; + ROW 32 INT VAR pivots; + INT VAR i, j, k :: ROWS a, n :: COLUMNS a, pos; + + IF n <> k + THEN errorstop ("MATRIX OP INV : no square matrix") FI; + + initialisiere die pivotpositionen; + + FOR j FROM 1 UPTO n + REP pivotsuche (a, j, pos); + IF sub (a, pos, pos) = 0.0 + THEN errorstop ("MATRIX OP INV : singular matrix") FI; + zeilentausch (a, j, pos); + merke dir die vertauschung; + transformiere die matrix + PER; + + spaltentausch; + a . + +initialisiere die pivotpositionen : + FOR i FROM 1 UPTO n + REP pivots [i] := i PER . + +merke dir die vertauschung : + IF pos > j + THEN INT VAR hi :: pivots [j]; + pivots [j] := pivots [pos]; + pivots [pos] := hi + FI . + +transformiere die matrix : + REAL VAR h := 1.0/sub (a, j, j); + + FOR k FROM 1 UPTO n + REP IF k <> j + THEN FOR i FROM 1 UPTO n + REP IF i <> j + THEN replace element (a, i, k, sub (a, i, k) - + sub (a, i, j)*sub (a, j, k)*h); + FI + PER; + FI + PER; + + FOR k FROM 1 UPTO n + REP replace element (a, j, k, -h*sub (a, j, k)); + replace element (a, k, j, h*sub (a, k, j)) + PER; + replace element (a, j, j, h) . + +spaltentausch : + VECTOR VAR v :: vector (n); + FOR i FROM 1 UPTO n + REP FOR k FROM 1 UPTO n + REP replace (v, pivots [k], sub(a, i, k)) PER; + replace row (a, i, v) + PER . + +END OP INV; + +REAL OP DET (MATRIX CONST m) : + IF COLUMNS m <> ROWS m + THEN errorstop ("REAL OP DET : no square matrix") FI; + + a := m; + INT VAR i, j, k, n :: COLUMNS m, pos; + REAL VAR merker := 1.0; + FOR j FROM 1 UPTO n + REP pivotsuche (a, j, pos); + IF j<> pos + THEN zeilentausch (a, j, pos); + zeilen tausch merken + FI; + transformiere die matrix + PER; + produkt der pivotelemente . + +transformiere die matrix : + REAL VAR hp := sub(a,j,j); + IF hp = 0.0 + THEN LEAVE DET WITH 0.0 + ELSE REAL VAR h := 1.0/hp; + FI; + FOR i FROM j+1 UPTO n + REP FOR k FROM j+1 UPTO n + REP replace element (a, i, k, sub (a, i, k) - + sub (a, i, j)*h*sub (a, j, k)) + PER + PER . + +produkt der pivotelemente : + REAL VAR produkt :: sub (a, 1, 1); + FOR j FROM 2 UPTO n + REP produkt := produkt * sub (a, j, j) PER; + a := idn (1); + produkt * merker. + +zeilen tausch merken: + merker := merker * (-1.0). + +END OP DET; + +PROC pivotsuche (MATRIX CONST a, INT CONST start pos, INT VAR pos) : + REAL VAR max :: abs (sub (a, start pos, start pos)); + INT VAR i; + pos := start pos; + + FOR i FROM start pos+1 UPTO COLUMNS a + REP IF abs (sub (a, i, start pos)) > max + THEN max := abs (sub (a, i, start pos)); + pos := i + FI + PER . + +END PROC pivotsuche; + +PROC zeilentausch (MATRIX VAR a, INT CONST old pos, pos) : + VECTOR VAR v := row (a, pos); + replace row (a, pos, row (a, old pos)); + replace row (a, old pos, v) . + +END PROC zeilentausch; + +END PACKET matrix; + diff --git a/system/std.zusatz/1.8.7/src/port server b/system/std.zusatz/1.8.7/src/port server new file mode 100644 index 0000000..46c647f --- /dev/null +++ b/system/std.zusatz/1.8.7/src/port server @@ -0,0 +1,164 @@ +PACKET port server: (* Autor : R. Ruland *) + (* Stand : 21.03.86 *) + +INT VAR port station; +TEXT VAR port := "PRINTER"; + +put ("gib Name des Zielspools : "); editget (port); line; +put ("gib Stationsnummer des Zielspools : "); get (port station); + +server channel (15); +spool duty ("Verwalter fuer Task """ + port + + """ auf Station " + text (port station)); + +LET max counter = 10 , + time slice = 300 , + + ack = 0 , + fetch code = 11 , + param fetch code = 21 , + file save code = 22 , + file type = 1003 , + + begin char = ""0"", + end char = ""1""; + + +INT VAR reply, old heap size; +TEXT VAR file name, write pass, read pass, sendername, buffer; +FILE VAR file; + +DATASPACE VAR ds, file ds, send ds; + +BOUND STRUCT (TEXT file name, write pass, read pass, sendername, INT station) VAR msg; +BOUND TEXT VAR error msg ; + +spool manager (PROC save file); + +PROC save file : + + disable stop ; + command dialogue (FALSE); + ds := nilspace; file ds := nilspace; send ds := nil space; + old heap size := heap size; + + REP + execute save file; + + IF is error THEN save error (error message) FI; + + IF heap size > old heap size + 4 + THEN collect heap garbage ; + old heap size := heap size + FI; + + PER + +ENDPROC save file; + + +PROC execute save file : + +enable stop; +forget (file ds) ; file ds := nilspace; +call (father, fetch code, file ds, reply); +IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE save file ds +FI; + +. save file ds : + IF type (file ds) = file type + THEN get file params; + insert file params; + call station (port station, port, file save code, file ds); + ELSE errorstop ("Datenraum hat falschen Typ") + FI; + +. get file params : + forget (ds); ds := nilspace; + call (father, param fetch code, ds, reply); + IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE msg := ds; + file name := msg. file name; + write pass := msg. write pass; + read pass := msg. read pass; + sendername := msg. sender name; + FI; + +. insert file params : + buffer := ""; + in headline (filename); + in headline (write pass); + in headline (read pass); + in headline (sendername); + file := sequential file (input, file ds) ; + headline (file, buffer); + +END PROC execute save file; + + +PROC call station (INT CONST order task station, TEXT CONST order task name, + INT CONST order code, DATASPACE VAR order ds) : + + INT VAR counter := 0; + TASK VAR order task; + disable stop; + REP order task := order task station // order task name; + IF is error CAND pos (error message, "antwortet nicht") > 0 + THEN clear error; + counter := min (max counter, counter + 1); + pause (counter * time slice); + ELSE enable stop; + forget (send ds); send ds := order ds; + call (order task, order code, send ds, reply); + disable stop; + IF reply = ack + THEN forget (order ds); order ds := send ds; + forget (send ds); + LEAVE call station + ELSE error msg := send ds; + errorstop (error msg); + FI; + FI; + PER; + +END PROC call station; + + +TASK OP // (INT CONST station, TEXT CONST name) : + + enable stop; + station / name + +END OP //; + + +PROC in headline (TEXT CONST information) : + IF pos (information, begin char) <> 0 + OR pos (information, end char) <> 0 + THEN errorstop ("Name darf nicht Code 0 oder Code 1 enthalten") FI; + buffer CAT begin char; + buffer CAT information; + buffer CAT end char; +END PROC in headline; + + +PROC save error (TEXT CONST message) : + clear error; + file name CAT "."; + file name CAT sender name; + file name CAT ".ERROR"; + file := sequential file (output, file name); + putline (file, " "); + putline (file, "Uebertragung nicht korrekt beendet "); + putline (file, " "); + put (file, "ERROR :"); put (file, message); + save (file name, public); + clear error; + forget(file name, quiet); +END PROC save error; + +ENDPACKET port server; + diff --git a/system/std.zusatz/1.8.7/src/printer server b/system/std.zusatz/1.8.7/src/printer server new file mode 100644 index 0000000..b1a30bc --- /dev/null +++ b/system/std.zusatz/1.8.7/src/printer server @@ -0,0 +1,99 @@ +PACKET multi user printer : (* Autor : Rudolf Ruland *) + (* Stand : 24.03.86 *) + +INT VAR c; +put ("gib Druckerkanal : "); get (c); + + server channel (c); + station only (FALSE) ; + spool duty ("Ausgabe mit dem Drucker"); + spool control task (myself); + +LET ack = 0 , + + fetch code = 11 , + param fetch code = 21 , + file type = 1003 ; + +INT VAR reply, old heap size, sender station; +TEXT VAR file name, userid, password, sendername; +FILE VAR file ; + +DATASPACE VAR ds, file ds; + +BOUND STRUCT (TEXT file name, userid, password, sendername, INT station) VAR msg; +BOUND TEXT VAR error msg ; + +spool manager (PROC printer); + +PROC printer : + + disable stop ; + command dialogue (FALSE); + ds := nilspace; file ds := nilspace; + continue (server channel) ; + check error ("Kanal belegt"); + + old heap size := heap size ; + REP + execute print ; + + IF is error + THEN put error; + clear error; + FI ; + + IF heap size > old heap size + 4 + THEN collect heap garbage ; + old heap size := heap size + FI + PER + +ENDPROC printer ; + + +PROC execute print : + + enable stop ; + forget (file ds) ; file ds := nilspace ; + call (father, fetch code, file ds, reply) ; + IF reply = ack CAND type (file ds) = file type + THEN get file params; + print file + FI ; + +. get file params : + forget (ds); ds := nilspace; + call (father, param fetch code, ds, reply); + IF reply <> ack + THEN error msg := ds; errorstop (error msg); + ELSE msg := ds; + file name := msg. file name; + userid := msg. userid; + password := msg. password; + sendername := msg. sender name; + sender station := msg. station; + FI; + +. print file : + file := sequential file (input, file ds); + print (file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC execute print ; + + +PROC check error (TEXT CONST message) : + IF is error + THEN clear error; + rename myself (message); + IF is error THEN clear error; end (myself) FI; + pause (18000); + end (myself); + FI; +END PROC check error; + +ENDPACKET multi user printer ; + diff --git a/system/std.zusatz/1.8.7/src/purge b/system/std.zusatz/1.8.7/src/purge new file mode 100644 index 0000000..55230ff --- /dev/null +++ b/system/std.zusatz/1.8.7/src/purge @@ -0,0 +1,85 @@ +PACKET purge DEFINES purge : + + +TEXT VAR task name, record, file name, dummy ; + +FILE VAR permit ; + + +PROC purge : + + IF exists ("permitted tasks") + THEN access catalogue ; + permit := sequential file (input, "permitted tasks") ; + say (""10""13"TASKS :"10""10""13"") ; + IF myself < supervisor + THEN purge son tasks (brother (supervisor)) + ELSE purge son tasks (myself) + FI + FI ; + IF exists ("permitted files") + THEN permit := sequential file (input, "permitted files") ; + say (""10""13"DATEIEN :"10""10""13"") ; + purge files + FI + +ENDPROC purge ; + +PROC purge son tasks (TASK CONST father task) : + + TASK VAR actual task := son (father task) ; + WHILE NOT is niltask (actual task) REP + purge son tasks (actual task) ; + IF NOT actual task permitted + THEN erase actual task + FI ; + actual task := brother (actual task) + END REP . + +erase actual task : + say ("""") ; say (task name) ; say ("""") ; + IF yes (" loeschen") + THEN end (actual task) + FI . + +actual task permitted : + task name := name (actual task) ; + reset (permit) ; + WHILE NOT eof (permit) REP + getline (permit, record) ; + IF task name = record + THEN LEAVE actual task permitted WITH TRUE + FI + END REP ; + FALSE . + +ENDPROC purge son tasks ; + +PROC purge files : + + begin list ; + get list entry (file name, dummy) ; + WHILE file name <> "" REP + IF NOT file permitted + THEN forget (file name) + FI ; + get list entry (file name, dummy) + END REP . + +file permitted : + IF file name = "permitted tasks" OR file name = "permitted files" + THEN LEAVE file permitted WITH TRUE + FI ; + reset (permit) ; + WHILE NOT eof (permit) REP + getline (permit, record) ; + IF file name = record + THEN LEAVE file permitted WITH TRUE + FI + END REP ; + FALSE . + +ENDPROC purge files ; + +ENDPACKET purge ; + diff --git a/system/std.zusatz/1.8.7/src/referencer b/system/std.zusatz/1.8.7/src/referencer new file mode 100644 index 0000000..2ee65e4 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/referencer @@ -0,0 +1,1077 @@ +(* ------------------- VERSION 10 vom 01.08.86 -------------------- *) +PACKET referencer errors DEFINES report referencer error: + +(* Programm zur Fehlerbehandlung des referencers. + Autor: Rainer Hahn *) + +TEXT VAR fehlerdummy, + message; + +PROC report referencer error (INT CONST error nr, + INT CONST line nr, + TEXT CONST addition): + + einfache fehlermeldung aufbauen; + diese auf terminal ausgeben; + fehlermeldung in fehlerdatei ausgeben. + +einfache fehlermeldung aufbauen: + message := "WARNUNG in Zeile "; + message CAT text (line nr); + message CAT " : "; + message CAT simple message. + +diese auf terminal ausgeben: + line ; + putline (message). + +fehlermeldung in fehlerdatei ausgeben: + note (message); + note line ; + fehlerdummy := " >>> "; + fehlerdummy CAT zusatz; + note (fehlerdummy); + note line. + +simple message: + SELECT error nr OF + CASE 1: "Text Denoter ueber mehr als eine Zeile" + CASE 2: "Nicht beendeter Text Denoter bei Programmende" + CASE 3: "Kommentar ueber mehr als eine Zeile" + CASE 4: "Nicht beendeter Kommentar bei Programmende" + CASE 5: "Ueberdeckung" + CASE 6, 9: "Refinement mehrmals eingesetzt" + CASE 7, 10: "Refinement wird nicht aufgerufen" + CASE 8: "Objekt wird nicht angesprochen" + OTHERWISE "" + ENDSELECT. + +zusatz: + SELECT error nr OF + CASE 1, 2, 3, 4: "Ueber " + addition + " Zeilen" + CASE 5: addition + CASE 6, 7, 8: addition + CASE 9, 10: addition + " in mindestens einer Prozedur" + OTHERWISE "interner Fehler: HRZ Bielefeld benachrichtigen!" + END SELECT. +END PROC report referencer error +END PACKET referencer errors; +(************************************************************************) + +PACKET name table handling + DEFINES NAMETABLE, + empty name table, + put name, + get name, + dump table: + +(* Programm zur Speicherung von Namen. + Autor: Rainer Hahn *) + +LET hash table length = 1024, + hash table length minus one = 1023, + start of name table = 255, + name table length = 2000; + +TYPE NAMETABLE = STRUCT (INT number of entries, + ROW hash table length INT hash table, + ROW name table length INT next, + ROW name table length TEXT name table); + +TEXT VAR dummy, f; + +PROC put name (NAMETABLE VAR n, TEXT CONST name, INT VAR pointer): + INT VAR errechneter index; + hash (name, errechneter index); + IF noch kein eintrag + THEN gaenzlich neuer eintrag + ELSE name in vorhandener kette + FI. + +noch kein eintrag: + n . hash table [errechneter index] = 0. + +gaenzlich neuer eintrag: + n . hash table [errechneter index] := n . number of entries; + neuer eintrag (n, name, pointer). + +name in vorhandener kette: + INT VAR dieser eintrag :: n. hash table [errechneter index]; + REP + IF name ist vorhanden + THEN pointer := dieser eintrag; + LEAVE put name + ELIF kette zu ende + THEN neuer eintrag an vorhandene kette anketten; + neuer eintrag (n, name, pointer); + LEAVE put name + ELSE naechster eintrag in der kette + FI + END REP. + +name ist vorhanden: + n . name table [dieser eintrag] = name. + +kette zu ende: + n . next [dieser eintrag] = 0. + +neuer eintrag an vorhandene kette anketten: + n . next [dieser eintrag] := n . number of entries. + +naechster eintrag in der kette: + dieser eintrag := n . next [dieser eintrag]. +END PROC put name; + +PROC neuer eintrag (NAMETABLE VAR n, TEXT CONST name, INT VAR pointer): + n . name table [n . number of entries] := name; + n . next [n . number of entries] := 0; + pointer := n . number of entries; + n . number of entries INCR 1; + IF n . number of entries > name table length + THEN errorstop ("volle Namenstabelle") + FI +END PROC neuer eintrag; + +PROC hash (TEXT CONST name, INT VAR index) : + INT VAR i; + index := code (name SUB 1); + FOR i FROM 2 UPTO length (name) REP + addmult cyclic + ENDREP. + +addmult cyclic : + index INCR index ; + IF index > hash table length minus one + THEN wrap around + FI; + index := (index + code (name SUB i)) MOD hash table length. + +wrap around : + index DECR hash table length minus one +ENDPROC hash ; + +PROC get name (NAMETABLE CONST n, INT CONST index, TEXT VAR t): + IF index < n . number of entries AND index >= start of name table + THEN t := n . name table [index] + ELSE errorstop ("Interner Fehler 1") + FI +END PROC get name; + +PROC empty name table (NAMETABLE VAR n): +INT VAR i; + n . number of entries := start of name table; + FOR i FROM 1 UPTO hash table length REP + n . hash table [i] := 0 + END REP +END PROC empty name table; + +PROC dump table (NAMETABLE CONST n): + line ; + put ("Bitte Name der Datei, in die die Namenstabelle gehen soll:"); + getline (f); + line ; + file assoziieren; + dump namens ketten; + zusammenfassung. + +file assoziieren: + FILE VAR file :: sequential file (output, f). + +dump namens ketten: + INT VAR i, + anz hash eintraege :: 0, + kette 3 eintraege :: 0; + FOR i FROM 1 UPTO hash table length REP + IF n . hash table [i] <> 0 + THEN anz hash eintraege INCR 1; + INT VAR naechster eintrag :: n . hash table [i]; + dump hash eintrag; + ketten eintraege + FI + END REP. + +dump hash eintrag: + dummy := text (i); + WHILE length (dummy) < 4 REP dummy CAT " " END REP; + dummy CAT ": ". + +ketten eintraege: + INT VAR anz eintraege pro kette :: 0; + WHILE naechster eintrag > 0 REP + anz eintraege pro kette INCR 1; + dummy CAT " "; + dummy CAT text (naechster eintrag); + dummy CAT " -> "; + dummy CAT n . name table [naechster eintrag]; + naechster eintrag := n . next [naechster eintrag]; + END REP; + IF anz eintraege pro kette > 2 + THEN kette 3 eintraege INCR 1 + FI; + putline (file, dummy). + +zusammenfassung: + statistik ueberschrift; + anzahl hash eintraege; + anzahl namens eintraege; + verkettungsfaktor; + anzahl laengerer ketten. + +statistik ueberschrift: + line (file, 2); + dummy := " ---------- "; + dummy CAT "S T A T I S T I K:"; + dummy CAT " ---------- "; + putline (file, dummy); + line (file, 2). + +anzahl hash eintraege: + dummy := "Anzahl Hash-Eintraege (max. "; + dummy CAT text (hash table length); + dummy CAT "): "; + dummy CAT text (anz hash eintraege); + putline (file, dummy). + +anzahl namens eintraege: + dummy := "Anzahl Namen (max. "; + dummy CAT text (name table length - start of name table + 1); + dummy CAT "): "; + dummy CAT text (n . number of entries - start of name table); + putline (file, dummy). + +verkettungsfaktor: + dummy := "Verkettungsfaktor (Anzahl Namen / Anzahl Ketten): "; + dummy CAT text (real (n . number of entries - start of name table) / + real (anz hash eintraege)); + putline (file, dummy). + +anzahl laengerer ketten: + dummy := "Anzahl Ketten > 2 Eintraege: "; + dummy CAT text (kette 3 eintraege); + putline (file, dummy). +END PROC dump table; +END PACKET name table handling; +(***************************************************************************) + +PACKET scanner DEFINES init scanning, + init name table with, + dump name table, + get name, + end scanning, + line number, + symbol: + +(* Programm zum scannen von ELAN-Programmen. + Autor: Rainer Hahn *) + +FILE VAR eingabe; + +DATASPACE VAR ds alt := nilspace, + ds neu := nilspace; + +BOUND NAMETABLE VAR tabelle; + +TEXT VAR zeile, + zeichen, + dummy; + +LET end of program = ""30"", + eop = 1, + identifier = 2, + keyword = 3, + delimiter = 4, + punkt = 46, + doppelpunkt = 58, + init symbol = 30, + assign symbol = 31; + +INT VAR zeilen nr, + zeichen pos; + +PROC init name table with (TEXT CONST worte): +INT VAR index; + forget (ds alt); + ds alt := nilspace; + tabelle := dsalt; + empty name table (CONCR (tabelle)); + INT VAR anf :: 1, + ende :: pos (worte, ",", 1); + WHILE ende > 0 REP + dummy := subtext (worte, anf, ende - 1); + put name (CONCR (tabelle), dummy, index); + anf := ende + 1; + ende := pos (worte, ",", ende + 1) + END REP; + dummy := subtext (worte, anf); + put name (CONCR (tabelle), dummy, index) +END PROC init name table with; + +PROC init scanning (TEXT CONST f): + IF exists (f) + THEN namenstabelle holen; + erste zeile lesen + ELSE errorstop ("Datei existiert nicht") + FI. + +namenstabelle holen: + forget (ds neu); + ds neu := ds alt; + tabelle := ds neu. + +erste zeile lesen: + eingabe := sequential file (input, f); + IF eof (eingabe) + THEN errorstop ("Datei ist leer") + ELSE zeile := ""; + zeilen nr := 0; + zeile lesen; + naechstes non blank zeichen + FI +END PROC init scanning; + +PROC dump name table: + dump table (CONCR (tabelle)) +END PROC dump name table; + +PROC end scanning (TEXT CONST f): + IF anything noted + THEN eingabe := sequential file (modify, f); + note edit (eingabe) + FI +END PROC end scanning; + +PROC get name (INT CONST index, TEXT VAR t): + get name (CONCR (tabelle), index, t) +END PROC get name; + +PROC zeile lesen: + getline (eingabe, zeile); + zeilen nr INCR 1; + cout (zeilen nr); + zeichen pos := 0 +END PROC zeile lesen; + +PROC naechstes non blank zeichen: + REP + zeichen pos := pos (zeile, ""33"", ""254"", zeichen pos + 1); + IF zeichen pos <> 0 + THEN zeichen := (zeile SUB zeichen pos); + LEAVE naechstes non blank zeichen + ELIF eof (eingabe) + THEN zeichen := end of program; + LEAVE naechstes non blank zeichen + ELSE zeile lesen + FI + END REP. +END PROC naechstes non blank zeichen; + +PROC naechstes zeichen: + IF zeichen pos > length (zeile) + THEN IF eof (eingabe) + THEN zeichen := end of program; + LEAVE naechstes zeichen + ELSE zeile lesen + FI + FI; + zeichenpos INCR 1; + zeichen := zeile SUB zeichenpos +END PROC naechstes zeichen; + +INT PROC line number: + IF zeichenpos = pos (zeile, ""33"", ""254"", 1) + THEN zeilen nr - 1 + ELSE zeilen nr + FI +END PROC line number; + +PROC symbol (INT VAR symb, type): + REP + suche naechstes checker symbol + END REP. + +suche naechstes checker symbol: + SELECT code (zeichen) OF + CASE 30: (* end of programn *) + symb := eop; + type := eop; + LEAVE symbol + CASE 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122: + (* small letters *) + identifier aufsammeln; + put name (CONCR (tabelle), dummy, symb); + type := identifier; + LEAVE symbol + CASE 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, + 82, 83, 84, 85, 86, 87, 88, 89, 90: (* large letters *) + schluesselwort aufsammeln; + put name (CONCR (tabelle), dummy, symb); + type := keyword; + LEAVE symbol + CASE 34: (* " *) + skip text denoter + CASE 40: (* ( *) + IF (zeile SUB zeichen pos + 1) = "*" + THEN skip comment + ELSE symb := code (zeichen); + type := delimiter; + naechstes non blank zeichen; + LEAVE symbol; + FI + CASE 58: (* : *) + IF (zeile SUB zeichenpos + 1) = "=" + THEN symb := assign symbol; + zeichenpos INCR 1 + ELIF (zeile SUB zeichenpos + 1) = ":" + THEN symb := init symbol; + zeichenpos INCR 1 + ELSE symb := doppelpunkt + FI; + type := delimiter; + naechstes non blank zeichen; + LEAVE symbol + CASE 48, 49, 50, 51, 52, 53, 54, 55, 56, 57: (* 0 - 9 *) + int denoter skippen; + IF zeichen = "." + THEN naechstes non blank zeichen; + IF digit + THEN real denoter skippen + ELSE symb := punkt; + type := delimiter; + LEAVE symbol + FI + FI + CASE 41, 44, 46, 59, 61: (* ) , . ; = *) + symb := code (zeichen); + type := delimiter; + naechstes non blank zeichen; + LEAVE symbol + OTHERWISE naechstes non blank zeichen + END SELECT. +END PROC symbol; + +PROC real denoter skippen: + int denoter skippen; + IF zeichen = "e" + THEN naechstes non blank zeichen; + int denoter skippen + FI +END PROC real denoter skippen; + +PROC int denoter skippen: + naechstes non blank zeichen; + WHILE zeichen >= "0" AND zeichen <= "9" REP + naechstes non blank zeichen + ENDREP; + zeichenpos DECR 1; + naechstes non blank zeichen +END PROC int denoter skippen; + +PROC identifier aufsammeln: + dummy := zeichen; + REP + naechstes non blank zeichen; + IF small letter or digit + THEN dummy CAT zeichen + ELSE LEAVE identifier aufsammeln + FI + END REP +END PROC identifier aufsammeln; + +PROC schluesselwort aufsammeln: + dummy := ""; + sammle schluesselwort; + IF dummy = "END" + THEN noch einmal + FI. + +sammle schluesselwort: + WHILE large letter REP + dummy CAT zeichen; + naechstes zeichen + END REP; + IF zeichen = " " + THEN naechstes non blank zeichen + FI. + +noch einmal: + sammle schluesselwort +END PROC schluesselwort aufsammeln; + +PROC skip text denoter: + INT VAR anz zeilen :: 0; + zeichen pos := pos (zeile, """", zeichenpos + 1); + WHILE zeichen pos = 0 REP + naechste zeile einlesen; + zeichen pos := pos (zeile, """"); + END REP; + ende text denoter. + +ende text denoter: + IF anz zeilen > 1 + THEN report referencer error (1, zeilen nr, text (anz zeilen)) + FI; + naechstes non blank zeichen. + +naechste zeile einlesen: + IF eof (eingabe) + THEN report referencer error (2, zeilen nr, text (anz zeilen)); + zeichen := end of program; + LEAVE skip text denoter + ELSE zeile lesen; + anz zeilen INCR 1 + FI. +END PROC skip text denoter; + +PROC skip comment: + INT VAR anz zeilen :: 0; + zeichen pos := pos (zeile, "*)", zeichenpos + 2); + WHILE zeichen pos = 0 REP + naechste zeile einlesen; + zeichen pos := pos (zeile, "*)"); + END REP; + ende comment. + +ende comment: + IF anz zeilen > 1 + THEN report referencer error (3, zeilen nr, text (anz zeilen)) + FI; + zeichen pos INCR 2; + naechstes non blank zeichen. + +naechste zeile einlesen: + IF eof (eingabe) + THEN report referencer error (4, zeilen nr, text (anz zeilen)); + zeichen := end of program; + LEAVE skip comment + ELSE zeile lesen; + anz zeilen INCR 1 + FI. +END PROC skip comment; + +BOOL PROC small letter or digit: + (zeichen >= "0" AND zeichen <= "9") OR (zeichen >= "a" AND zeichen <= "z") +END PROC small letter or digit; + +BOOL PROC small letter: + zeichen >= "a" AND zeichen <= "z" +END PROC small letter; + +BOOL PROC large letter: + zeichen >= "A" AND zeichen <= "Z" +END PROC large letter; + +BOOL PROC digit: + zeichen >= "0" AND zeichen <= "9" +END PROC digit; +END PACKET scanner; +(*************************************************************************) +PACKET referencer2 DEFINES referencer: + +(* Programm fuer den 'referencer' + Autor: Rainer Hahn *) + +INT VAR symb, + typ, + max index; + +TEXT VAR dummy, + dummy2, + name; + +DATASPACE VAR ds; + +BOUND ROW max TEXT VAR liste; + +FILE VAR f; + +BOOL VAR initialisiert :: FALSE, + symbol bereits geholt, + globale deklarationen; + +LET max = 1751, + global text = "<--G", + local text = "<--L", + refinement text = "<--R", + procedure text = "<--P", + eop = 1, + identifier = 2, + keyword = 3, + init symbol = 30, + assign symbol = 31, + klammer auf = 40, + klammer zu = 41, + komma = 44, + punkt = 46, + doppelpunkt = 58, + semikolon = 59, + proc symbol = 255, + end proc symbol = 256, + packet symbol = 257, + end packet symbol = 258, + type symbol = 259, + var symbol = 260, + const symbol = 261, + let symbol = 262, + leave symbol = 263, + op symbol = 264, + endop symbol = 265, + endif symbol = 266, + fi symbol = 266; + +PROC referencer: + referencer (last param) +END PROC referencer; + +PROC referencer (TEXT CONST check file): + referencer (check file, check file + ".r") +END PROC referencer; + +PROC referencer (TEXT CONST check file, dump file): + IF exists (check file) + THEN dump file ggf loeschen + ELSE errorstop ("Eingabe-Datei nicht vorhanden") + FI; + disable stop; + start referencing (check file, dump file); + forget (ds); + enable stop. + +dump file ggf loeschen: + IF exists (dump file) + THEN forget (dump file, quiet) + FI. +END PROC referencer; + +PROC start referencing (TEXT CONST check file, dump file): + enable stop; + ueberschrift; + initialisierung; + verkuerzte syntax analyse; + line ; + in dump file kopieren (dump file); + line ; + end scanning (check file). + +ueberschrift: + page; + put ("REFERENCER:"); + put (check file); + put ("->"); + putline (dump file). + +initialisierung: + IF NOT initialisiert + THEN init name table with +("PROC,ENDPROC,PACKET,ENDPACKET,TYPE,VAR,CONST,LET,LEAVE,OP,ENDOP,ENDIF,FI"); + initialisiert := TRUE + FI; + ds := nilspace; + liste := ds; + max index := end op symbol; + dummy := checkfile. + +verkuerzte syntax analyse: + globale deklarationen := TRUE; + line ; + init scanning (dummy); + symbol bereits geholt := FALSE; + REP + IF symbol bereits geholt + THEN symbol bereits geholt := FALSE + ELSE symbol (symb, typ) + FI; + IF typ = keyword + THEN nach schluesselwort verarbeiten + ELIF symb = punkt + THEN ggf refinement aufnehmen + ELIF typ = identifier + THEN identifier aufnehmen und ggf aktuelle parameter liste + FI + UNTIL typ = eop ENDREP. + +identifier aufnehmen und ggf aktuelle parameter liste: + in die liste (symb, ""); + symbol (symb, typ); + IF symb = klammer auf + THEN aktuelle parameter aufnehmen + ELSE symbol bereits geholt := TRUE + FI. + +nach schluesselwort verarbeiten: + SELECT symb OF + CASE let symbol: + let deklarationen aufsammeln + CASE packet symbol: + namen des interface aufsammeln + CASE end packet symbol: + skip naechstes symbol + CASE var symbol, const symbol: + datenobjekt deklaration aufnehmen + CASE proc symbol: + globale deklarationen := FALSE; + prozedur name und ggf parameter aufsammeln + CASE end proc symbol: + globale deklarationen := TRUE; + skip naechstes symbol + CASE op symbol: + globale deklarationen := FALSE; + operatornamen skippen und ggf parameter aufsammeln + CASE end op symbol: + globale deklarationen := TRUE; + skip until (semikolon) + CASE type symbol: + namen der typ definition aufsammeln + CASE leave symbol: + skip naechstes symbol + OTHERWISE: + ENDSELECT. + +skip naechstes symbol: + symbol (symb, typ). +END PROC start referencing; + +PROC aktuelle parameter aufnehmen: + REP + symbol (symb, typ); + IF typ = identifier + THEN in die liste (symb, "") + FI + UNTIL symb = klammer zu END REP. +END PROC aktuelle parameter aufnehmen; + +PROC ggf refinement aufnehmen: + symbol (symb, typ); + symbol bereits geholt := TRUE; + WHILE typ = identifier REP + doppelpunkt oder selektor + END REP. + +doppelpunkt oder selektor: + INT CONST letzter id :: symb; + symbol (symb, typ); + IF symb = doppelpunkt + THEN in die liste (letzter id, refinement text); + LEAVE ggf refinement aufnehmen + ELSE in die liste (letzter id, ""); + IF symb = punkt + THEN symbol (symb, typ) + ELSE LEAVE ggf refinement aufnehmen + FI + FI +END PROC ggf refinement aufnehmen; + +PROC namen des interface aufsammeln: + packet name ueberspringen; + namen der schnittstelle aufsammeln. + +packet name ueberspringen: + symbol (symb, typ). + +namen der schnittstelle aufsammeln: + REP + symbol (symb, typ); + IF typ = identifier + THEN in die liste (symb, "") + FI + UNTIL symb = doppelpunkt END REP. +END PROC namen des interface aufsammeln; + +PROC let deklarationen aufsammeln: + REP + symbol (symb, typ); + IF typ = identifier + THEN let name aufnehmen + ELIF typ = keyword + THEN bis zum komma oder semikolon + FI; + UNTIL symb = semikolon END REP. + +let name aufnehmen: + IF globale deklarationen + THEN in die liste (symb, global text) + ELSE in die liste (symb, "") + FI; + REP + symbol (symb, typ); + IF typ = identifier + THEN in die liste (symb, "") + FI + UNTIL symb = komma OR symb = semikolon END REP. +END PROC let deklarationen aufsammeln; + +PROC namen der typ definition aufsammeln: + REP + symbol (symb, typ); + bis zum komma oder semikolon + UNTIL symb = semikolon END REP +END PROC namen der typ definition aufsammeln; + +PROC bis zum komma oder semikolon: + INT VAR anz klammern :: 0; + REP + symbol (symb, typ); (* fields aufnehmen weggelassen *) + IF symb = klammer auf + THEN anz klammern INCR 1 + ELIF symb = klammer zu + THEN anz klammern DECR 1 + FI + UNTIL (symb = komma AND anz klammern = 0) OR symb = semikolon ENDREP. +END PROC bis zum komma oder semikolon; + +PROC datenobjekt deklaration aufnehmen: + symbol (symb, typ); + REP + IF globale deklarationen + THEN in die liste (symb, global text) + ELSE in die liste (symb, local text) + FI; + skip ggf initialisierung; + IF symb = komma + THEN symbol (symb, typ) + FI + UNTIL symb = semikolon OR symb = punkt END REP. + +skip ggf initialisierung: + symbol (symb, typ); + IF symb = init symbol OR symb = assign symbol + THEN initialisierung skippen + FI. + +initialisierung skippen: + INT VAR anz klammern :: 0; + REP + INT CONST vorheriges symbol :: symb, + vorheriger typ :: typ; + symbol (symb, typ); + IF symb = klammer auf + THEN anz klammern INCR 1; + IF vorheriger typ = identifier + THEN in die liste (vorheriges symbol, "") + FI + ELIF symb = klammer zu + THEN anz klammern DECR 1; + IF vorheriger typ = identifier + THEN in die liste (vorheriges symbol, "") + FI + ELIF vorheriger typ = identifier AND symb = doppelpunkt + THEN in die liste (vorheriges symbol, refinement text); + LEAVE datenobjekt deklaration aufnehmen + ELIF vorheriger typ = identifier + THEN in die liste (vorheriges symbol, "") + FI + UNTIL (symb = komma AND anz klammern = 0) + OR symb = semikolon OR symb = end proc symbol OR + symb = end op symbol OR symb = endif symbol OR symb = fi symbol + END REP. +END PROC datenobjekt deklaration aufnehmen; + +PROC prozedur name und ggf parameter aufsammeln: + prozedurname aufsammeln; + symbol (symb, typ); + IF symb <> doppelpunkt + THEN formale parameter aufsammeln + FI. + +prozedurname aufsammeln: + symbol (symb, typ); + in die liste (symb, procedure text). +END PROC prozedurname und ggf parameter aufsammeln; + +PROC operatornamen skippen und ggf parameter aufsammeln: + symbol (symb, typ); + IF symb <> doppelpunkt + THEN formale parameter aufsammeln + FI +END PROC operatornamen skippen und ggf parameter aufsammeln; + +PROC formale parameter aufsammeln: + REP + symbol (symb, typ); + IF typ = identifier + THEN in die liste (symb, local text); + FI + UNTIL symb = doppelpunkt END REP +END PROC formale parameter aufsammeln; + +PROC skip until (INT CONST zeichencode): + skip until (zeichencode, 0) +END PROC skip until; + +PROC skip until (INT CONST z1, z2): + REP + symbol (symb, typ) + UNTIL symb = z1 OR symb = z2 END REP +END PROC skip until; + +PROC in die liste (INT CONST index, TEXT CONST zusatz): + IF index > max index + THEN listenelemente initialisieren; + FI; + IF aktueller eintrag = "" + THEN namens eintrag + FI; + aktueller eintrag CAT " "; + aktueller eintrag CAT text (line number); + aktueller eintrag CAT zusatz. + +aktueller eintrag: + liste [index]. + +listenelemente initialisieren: + INT VAR i; + FOR i FROM max index + 1 UPTO index REP + liste [i] := "" + END REP; + max index := index. + +namens eintrag: + get name (index, aktueller eintrag); + WHILE length (aktueller eintrag) < 15 REP + aktueller eintrag CAT " " + END REP; + aktueller eintrag CAT ":". +END PROC in die liste; + +TEXT VAR zeile; + +PROC in dump file kopieren (TEXT CONST dump file): + putline ("Ausgabedatei erstellen"); + f := sequential file (output, dump file); + INT VAR i; + kopieren und ggf fehlermeldung; + modify (f); + ggf sortieren; + zeile ggf aufspalten; + modify (f); + to line (f, 1). + +kopieren und ggf fehlermeldung: + FOR i FROM fi symbol UPTO max index REP + cout (i); + zeile := liste [i]; + IF zeile <> "" + THEN ausgabe der referenz und ggf fehlermeldung + FI + ENDREP. + +ausgabe der referenz und ggf fehlermeldung: + putline (f, zeile); + ggf referencer fehlermeldung. + +ggf sortieren: + IF yes (dump file + " sortieren") + THEN sort (dump file); + FI. + +zeile ggf aufspalten: + i := 0; + to line (f, 1); + WHILE NOT eof (f) REP + i INCR 1; + cout (i); + read record (f, zeile); + ggf aufspalten + END REP. + +ggf aufspalten: +INT VAR anf :: 1, ende :: pos (zeile, " ", 72); + IF ende > 0 + THEN dummy := subtext (zeile, 1, ende - 1); + write record (f, dummy); + spalte bis restzeile auf; + dummy CAT subtext (zeile, anf); + write record (f, dummy); + FI; + down (f). + +spalte bis restzeile auf: + REP + dummy := " "; + anf := ende + 1; + ende := pos (zeile, " ", ende + 55); + down (f); + insert record (f); + IF ende <= 0 + THEN LEAVE spalte bis restzeile auf + FI; + dummy CAT subtext (zeile, anf, ende - 1); + write record (f, dummy); + END REP. +END PROC in dump file kopieren; + +PROC ggf referencer fehlermeldung: + name := subtext (zeile, 1, min( pos(zeile, " "), pos(zeile, ":")) - 1); + dummy := subtext (zeile, pos (zeile, ": ") + 2); + ueberdeckungs ueberpruefung; + not used ueberpruefung; + IF pos (dummy, "R") > 0 + THEN refinement mehr als zweimal verwendet + FI. + +ueberdeckungs ueberpruefung: + IF pos (dummy, global text) > 0 AND pos (dummy, local text) > 0 + THEN dummy2 := "und Zeile "; + dummy2 CAT text (nr (pos (dummy, local text))); + dummy2 CAT ": "; + dummy2 CAT name; + report referencer error + (5, nr (pos (dummy, global text)), dummy2) + FI. + +not used ueberpruefung: + IF pos (dummy, " ") = 0 AND + (pos (dummy, global text) > 0 OR pos (dummy, local text) > 0 OR + pos (dummy, refinement text) > 0) + THEN not used fehlermeldung + FI. + +not used fehlermeldung: + report referencer error + (8, nr (length (dummy) - length (local text) + 1), name). + +refinement mehr als zweimal verwendet: + INT VAR refinement deklarationen :: 0, + refinement aufrufe :: 0, + anf :: 1; + WHILE pos (dummy,"R", anf) > 0 REP + refinement deklarationen INCR 1; + anf := pos (dummy, "R", anf) + 1 + END REP; + anf := 1; + WHILE pos (dummy, " ", anf) > 0 REP + refinement aufrufe INCR 1; + anf := pos (dummy, " ", anf) + 1 + END REP; + IF refinement deklarationen = 1 + THEN IF refinement aufrufe > 1 + THEN report referencer error + (6, nr (pos (dummy, refinement text)), name) + ELIF refinement aufrufe = 0 + THEN report referencer error + (7, nr (pos (dummy, refinement text)), name) + FI + ELIF refinement deklarationen > 1 + THEN IF 2 * refinement deklarationen - 1 > refinement aufrufe + THEN report referencer error (9, 0, name) + ELIF 2 * refinement deklarationen - 1 < refinement aufrufe + THEN report referencer error (10, 0, name) + FI + FI. +END PROC ggf referencer fehlermeldung; + +INT PROC nr (INT CONST ende): + INT VAR von :: ende - 1; + WHILE von > 0 AND ((dummy SUB von) >= "0" AND (dummy SUB von) <= "9") REP + von DECR 1 + END REP; + int (subtext (dummy, von + 1, ende - 1)) +END PROC nr; +END PACKET referencer2; + +(* +REP + referencer ("ref fehler"); + edit ("ref fehler.r"); +UNTIL no ("nochmal") END REP*) + diff --git a/system/std.zusatz/1.8.7/src/reporter b/system/std.zusatz/1.8.7/src/reporter new file mode 100644 index 0000000..4febc32 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/reporter @@ -0,0 +1,531 @@ +(* ------------------- VERSION 12 vom 06.08.86 -------------------- *) +PACKET reporter routines DEFINES generate counts, + count on, + count off, + generate reports, + eliminate reports, + assert, + report on, + report off, + report: + +(* Programm zur Ablaufverfolgung von ELAN Programmen. Das Programm + verfolgt Prozedur- und Refinementaufrufe ('trace') und erstellt + eine Haeufigkeitszaehlung ('count') und beachtet 'assertions'. + Autor: Rainer Hahn *) + +FILE VAR input file; + +INT VAR zeilen nr, + type; + +TEXT VAR zeile, + dummy, + dummy1, + symbol; + +LET quadro fis = "####", + triple fis = "###", + double fis = "##", + tag = 1, + bold = 2; + +DATASPACE VAR ds := nilspace; +BOUND ROW max STRUCT (INT anzahl, BOOL proc) VAR zaehlwerk; + +LET max = 3000; + +(******************* gen report-Routinen ******************************) + +PROC generate reports: + generate reports (last param) +END PROC generate reports; + +PROC generate reports (TEXT CONST name): + disable stop; + gen trace statements (name); + IF is error AND error message = "ende" + THEN clear error; + last param (name) + FI; + to line (input file, 1); + enable stop. +END PROC generate reports; + +PROC gen trace statements (TEXT CONST name): + enable stop; + IF exists (name) + THEN input file := sequential file (modify, name) + ELSE errorstop ("input file does not exist") + FI; + input file modifizieren +END PROC gen trace statements; + +(*************************** Test file modifizieren *****************) + +PROC input file modifizieren: + zeilen nr := 1; + to line (input file, 1); + col (input file, 1); + REP + lese zeile; + IF triple fis symbol + THEN wandele in quadro fis + FI; + IF proc oder op symbol + THEN verarbeite operator oder prozedurkopf + ELIF refinement symbol + THEN verarbeite ggf refinements + FI; + vorwaerts + END REP. + +triple fis symbol: + pos (zeile, triple fis) > 0 AND + (pos (zeile, triple fis) <> pos (zeile, quadro fis)). + +wandele in quadro fis: + change all (zeile, triple fis, quadro fis); + write record (input file, zeile). + +proc oder op symbol: + pos (zeile, "PROC") > 0 OR pos (zeile, "OP") > 0. + +verarbeite operator oder prozedurkopf: + scan (zeile); + symbol lesen; + IF symbol = "PROC" OR symbol = "OP" + THEN + ELIF symbol = "END" + THEN LEAVE verarbeite operator oder prozedurkopf + ELIF type = bold + THEN next symbol (symbol, type); + IF NOT (symbol = "PROC" OR symbol = "OP") + THEN LEAVE verarbeite operator oder prozedurkopf + FI + ELSE LEAVE verarbeite operator oder prozedurkopf + FI; + scanne kopf; + insertiere trace anweisung. + +scanne kopf: + dummy := double fis; + dummy CAT "report("""; + dummy CAT text (line no (input file) + 1); + dummy CAT ": "; + dummy CAT symbol; (* PROC oder OP *) + dummy CAT " "; + symbol lesen; + dummy CAT symbol; + fuege bis namens ende an; + dummy CAT " "; + ueberlese ggf parameterliste. + +fuege bis namens ende an: + REP + symbol lesen; + IF symbol = "(" OR symbol = ":" + THEN LEAVE fuege bis namensende an + FI; + dummy CAT symbol + END REP. + +ueberlese ggf parameterliste: + WHILE symbol <> ":" REP + symbol lesen + END REP. + +insertiere trace anweisung: + WHILE pos (zeile, ":") = 0 REP + vorwaerts; + lese zeile + END REP; + schreibe zeile mit report statement. + +refinement symbol: + INT CONST point pos := pos (zeile, ".") ; + point pos > 0 AND point pos >= length (zeile) - 1. + +verarbeite ggf refinements: + ueberlies leere zeilen ; + IF ist wirklich refinement + THEN insertiere report fuer refinement + FI . + +ueberlies leere zeilen : + REP + vorwaerts; + lese zeile + UNTIL pos (zeile, ""33"", ""254"", 1) > 0 PER . + +ist wirklich refinement : + scan (zeile) ; + next symbol (symbol, type) ; + next symbol (symbol) ; + symbol = ":" AND type = tag . + +insertiere report fuer refinement: + dummy := double fis; + dummy CAT "report("" "; + dummy CAT text (line no (input file) + 1); + dummy CAT ": "; + dummy1 := subtext (zeile, 1, pos (zeile, ":") - 1); + dummy CAT dummy1; + schreibe zeile mit report statement +END PROC input file modifizieren; + +PROC schreibe zeile mit report statement: + dummy CAT """);"; + dummy CAT double fis; + IF doppelpunkt steht am ende der zeile + THEN vorwaerts; + insert record (input file); + write record (input file, dummy) + ELSE insert char (dummy, ":", 1); + change (zeile, ":", dummy); + write record (input file, zeile) + FI. + +doppelpunkt steht am ende der zeile: + (zeile SUB length (zeile)) = ":" OR (zeile SUB length (zeile) - 1) = ":". +END PROC schreibe zeile mit report statement; + +PROC symbol lesen: + next symbol (symbol, type); + IF ende der zeile gescannt + THEN vorwaerts; + lese zeile; + continue scan (zeile); + next symbol (symbol, type) + FI. + +ende der zeile gescannt: + type >= 7. +END PROC symbol lesen; + +PROC vorwaerts: + IF eof (input file) + THEN errorstop ("ende") + FI; + down (input file); + IF eof (input file) + THEN errorstop ("ende") + FI +END PROC vorwaerts; + +PROC lese zeile: + read record (input file, zeile); + cout (zeilen nr); + zeilen nr INCR 1 +END PROC lese zeile; + +(************************ eliminate reports-Routinen ******************) + +PROC eliminate reports: + eliminate reports (last param) +END PROC eliminate reports; + +PROC eliminate reports (TEXT CONST name): + disable stop; + eliminate statements (name); + IF is error AND error message = "ende" + THEN clear error; + last param (name) + FI; + to line (input file, 1); + enable stop. +END PROC eliminate reports; + +PROC eliminate statements (TEXT CONST name): + enable stop; + IF exists (name) + THEN input file := sequential file (modify, name) + ELSE errorstop ("input file does not exist") + FI; + statements entfernen. + +statements entfernen: + to line (input file, 1); + col (input file, 1); + zeilen nr := 1; + WHILE NOT eof (input file) REP + lese zeile; + IF pos (zeile, double fis) > 0 + THEN eliminiere zeichenketten in dieser zeile + ELSE vorwaerts + FI + END REP. + +eliminiere zeichenketten in dieser zeile: + INT VAR anfang := pos (zeile, double fis); + WHILE es ist noch etwas zu eliminieren REP + IF es ist ein quadro fis + THEN wandele es in ein triple fis + ELIF es ist ein triple fis + THEN lass diese sequenz stehen + ELSE entferne zeichenkette + FI + END REP; + IF zeile ist jetzt leer + THEN delete record (input file) + ELSE write record (input file, zeile); + vorwaerts + FI. + +es ist noch etwas zu eliminieren: + anfang > 0. + +es ist ein quadro fis: + pos (zeile, quadro fis, anfang) = anfang. + +wandele es in ein triple fis: + delete char (zeile, anfang); + anfang := pos (zeile, double fis, anfang + 3). + +es ist ein triple fis: + pos (zeile, triple fis, anfang) = anfang. + +lass diese sequenz stehen: + anfang := pos (zeile, triple fis, anfang + 1) + 3. + +entferne zeichenkette: + INT VAR end := pos (zeile, double fis, anfang+2) ; + IF end > 0 + THEN change (zeile, anfang, end + 1, ""); + anfang := pos (zeile, double fis, anfang) + ELSE anfang := pos (zeile, double fis, anfang+2) + FI . + +zeile ist jetzt leer: + pos (zeile, ""33"", ""254"", 1) = 0. +END PROC eliminate statements; + +(********************** Trace-Routinen *******************************) + +FILE VAR trace file; + +BOOL VAR zaehlwerk initialisiert :: FALSE, + trace on, + haeufigkeit on; + +PROC report (TEXT CONST message): + IF exists ("TRACE") + THEN + ELSE trace on := TRUE; + haeufigkeit on := FALSE; + FI; + BOOL CONST ist prozedur :: + pos (message, "PROC") > 0 OR pos (message, "OP") > 0; + trace file := sequential file (modify, "TRACE"); + IF lines (trace file) <= 0 + THEN insert record (trace file); + write record (trace file, "") + ELSE to line (trace file, lines (trace file)); + read record (trace file, dummy); + IF dummy <> "" + THEN down (trace file); + insert record (trace file); + write record (trace file, "") + FI + FI; + IF trace on + THEN write record (trace file, message); + down (trace file); + insert record (trace file); + write record (trace file, "") + FI; + IF haeufigkeit on + THEN haeufigkeits zaehlung + FI. + +haeufigkeits zaehlung: + hole zeilen nr; + zaehle mit. + +hole zeilen nr: + INT CONST von pos :: pos (message, ""33"", ""254"", 1); + zeilen nr := + int (subtext (message, von pos, pos (message, ":", von pos + 1) - 1)). + +zaehle mit: + IF last conversion ok AND zeilen nr > 0 AND zeilen nr <= max + THEN zaehlwerk [zeilen nr] . anzahl INCR 1; + zaehlwerk [zeilen nr] . proc := ist prozedur + FI +END PROC report; + +PROC report (TEXT CONST message, INT CONST value): + report (message, text (value)) +END PROC report; + +PROC report (TEXT CONST message, REAL CONST value): + report (message, text (value)) +END PROC report; + +PROC report (TEXT CONST message, TEXT CONST value): + dummy1 := message; + dummy1 CAT ": "; + dummy1 CAT value; + report (dummy1) +END PROC report; + +PROC report (TEXT CONST message, BOOL CONST value): + dummy1 := message; + dummy1 CAT ": "; + IF value + THEN dummy1 CAT "TRUE" + ELSE dummy1 CAT "FALSE" + FI; + report (dummy1) +END PROC report; + +PROC report on: + trace on := TRUE; + dummy1 := "REPORT ---> ON"; + report (dummy1) +END PROC report on; + +PROC report off: + dummy1 := "REPORT ---> OFF"; + report (dummy1); + trace on := FALSE; +END PROC report off; + +PROC assert (BOOL CONST value): + assert ("", value) +END PROC assert; + +PROC assert (TEXT CONST message, BOOL CONST value): + dummy1 := "ASSERTION:"; + dummy1 CAT message; + dummy1 CAT " ---> "; + IF value + THEN dummy1 CAT "TRUE" + ELSE line; + put ("ASSERTION:"); + put (message); + put ("---> FALSE"); + line; + IF yes ("weiter") + THEN dummy1 CAT "FALSE" + ELSE errorstop ("assertion failed") + FI + FI; + report (dummy1) +END PROC assert; + +(************************** haeufigkeits-zaehlung ****************) + +PROC count on: + report ("COUNT ---> ON"); + haeufigkeit on := TRUE; + initialisiere haeufigkeit. + +initialisiere haeufigkeit: + INT VAR i; + forget (ds); + ds := nilspace; + zaehlwerk initialisiert := TRUE; + zaehlwerk := ds; + FOR i FROM 1 UPTO max REP + zaehlwerk [i] . anzahl := 0 + END REP +END PROC count on; + +PROC count off: + report ("COUNT ---> OFF"); + haeufigkeit on := FALSE +END PROC count off; + +PROC generate counts: + generate counts (last param) +END PROC generate counts; + +PROC generate counts (TEXT CONST name): + disable stop; + insert counts (name); + last param (name); + to line (input file, 1); + enable stop. +END PROC generate counts; + +PROC insert counts (TEXT CONST name): + enable stop; + IF exists (name) + THEN input file := sequential file (modify, name); + col (input file, 1) + ELSE errorstop ("input file does not exist") + FI; + IF NOT zaehlwerk initialisiert + THEN errorstop ("count nicht eingeschaltet") + FI; + counts insertieren; + dataspace loeschen; + statistik ausgeben. + +counts insertieren: + REAL VAR gesamt aufrufe :: 0.0, + proc aufrufe :: 0.0, + andere aufrufe :: 0.0; + zeilen nr := 1; + WHILE zeilen nr <= lines (input file) REP + cout (zeilen nr); + IF zaehlwerk [zeilen nr] . anzahl > 0 + THEN anzahl aufrufe in die eingabe zeile einfuegen; + aufrufe mitzaehlen + FI; + zeilen nr INCR 1 + END REP. + +anzahl aufrufe in die eingabe zeile einfuegen: + to line (input file, zeilen nr); + read record (input file, zeile); + dummy := double fis; + dummy CAT text (zaehlwerk [zeilen nr] . anzahl); + dummy CAT double fis; + change (zeile, 1, 0, dummy); + write record (input file, zeile). + +aufrufe mitzaehlen: + gesamt aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl); + IF zaehlwerk [zeilen nr] . proc + THEN proc aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl) + ELSE andere aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl) + FI. + +dataspace loeschen: + zaehlwerk initialisiert := FALSE; + forget (ds). + +statistik ausgeben: + line (2); + put ("Anzahl der Gesamtaufrufe:"); + ggf int put (gesamt aufrufe); + line; + put ("davon:"); + line; + ggf int put (proc aufrufe); put ("Prozeduren oder Operatoren"); + line; + ggf int put (andere aufrufe); put ("Refinements und andere"); + line. +END PROC insert counts; + +PROC ggf int put (REAL CONST wert): + IF wert >= real (maxint) + THEN put (wert) + ELSE put (int (wert)) + FI +END PROC ggf int put; +END PACKET reporter routines; +(* +REP + IF exists ("rep fehler") + THEN copy ("rep fehler", "zzz") + ELSE errorstop ("rep fehler exisitiert nicht") + FI; + generate reports ("zzz"); + edit("zzz"); + forget ("zzz") +UNTIL no ("nochmal") END REP; +edit("reporter")*) + diff --git a/system/std.zusatz/1.8.7/src/scheduler b/system/std.zusatz/1.8.7/src/scheduler new file mode 100644 index 0000000..cba48e0 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/scheduler @@ -0,0 +1,420 @@ + +PACKET std schedule strategy DEFINES (* Autor: J.Liedtke *) + (* Stand: 15.10.82 *) + strategic decision : + + +PROC strategic decision + (INT CONST foreground workers, background workers, + REAL CONST fore cpu load, back cpu load, paging load, + INT VAR lowest activation prio, max background tasks) : + + IF no background permitted + THEN lowest activation prio := 0 ; + max background tasks := 0 + ELSE lowest activation prio := 10 ; + select max background tasks + FI . + +no background permitted : + foreground workers > 0 AND fore cpu load > 0.03 . + +select max background tasks : + IF fore cpu load > 0.01 + THEN max background tasks := 1 + ELIF paging load < 0.07 + THEN max background tasks := 3 + ELIF paging load < 0.15 + THEN max background tasks := 2 + ELSE max background tasks := 1 + FI . + +ENDPROC strategic decision ; + +ENDPACKET std schedule strategy ; + + + (* Autor: J.Liedtke*) +PACKET eumelmeter DEFINES (* Stand: 11.10.83 *) + + init log , + log : + + +LET snapshot interval = 590.0 ; + +REAL VAR next snapshot time , + time , timex , + paging wait , paging wait x , + paging busy , paging busy x , + fore cpu , fore cpu x , + back cpu , back cpu x , + system cpu , system cpu x , + delta t ; +INT VAR storage max, used ; +TEXT VAR record ; + +PROC init log : + + time := clock (1) ; + paging wait := clock (2) ; + paging busy := clock (3) ; + fore cpu := clock (4) ; + back cpu := clock (5) ; + system cpu := clock (6) ; + next snapshot time := time + snapshot interval + +ENDPROC init log ; + +PROC log (INT CONST active terminals, active background) : + + new snapshot time if was clock reset ; + IF clock (1) >= next snapshot time + THEN save values ; + get new values ; + create stat record ; + put log (record) ; + define next snapshot time + FI . + +new snapshot time if was clock reset : + IF clock (1) < next snapshot time - snapshot interval + THEN next snapshot time := clock (1) + FI . + +save values : + time x := time ; + paging wait x := paging wait ; + paging busy x := paging busy ; + fore cpu x := fore cpu ; + back cpu x := back cpu ; + system cpu x := system cpu . + +get new values : + time := clock (1) ; + paging wait := clock (2) ; + paging busy := clock (3) ; + fore cpu := clock (4) ; + back cpu := clock (5) ; + system cpu := clock (6) ; + storage (storage max, used) . + +create stat record : + record := text (used, 5) ; + record CAT text (active terminals,3) ; + record CAT text (active background,3) ; + delta t := (time - time x) ; + percent (paging wait, paging wait x) ; + percent (paging busy, paging busy x) ; + percent (fore cpu, fore cpu x) ; + percent (back cpu, back cpu x) ; + percent (system cpu, system cpu x) ; + percent (last, 0.0) ; + percent (nutz, 0.0) . + +last : paging wait + paging busy + fore cpu + back cpu + system cpu + - paging waitx - paging busyx - fore cpux - back cpux - system cpux . + +nutz : time - paging wait - system cpu + - timex + paging waitx + system cpux . + +define next snapshot time : + next snapshot time := time + snapshot interval . + +ENDPROC log ; + +PROC percent (REAL CONST neu, alt ) : + + record CAT text ( (neu-alt) / delta t * 100.0, 6,1) + "%" + +ENDPROC percent ; + +ENDPACKET eumelmeter ; + + + +PACKET background que manager DEFINES (* Autor: J.Liedtke *) + (* Stand: 15.10.82 *) + into background que , + delete from background que , + get first from background que , + get next from background que : + +LET que size = 100 , + ENTRY = STRUCT (TASK task, INT class) ; + +INT VAR end of que := 0 , + actual entry pos ; + +ROW que size ENTRY VAR que ; + + +PROC into background que (TASK CONST task) : + + INT VAR class := prio (task) ; + IF end of que = que size + THEN delete all not existing tasks + FI ; + check whether already in que ; + IF already in que + THEN IF in same class + THEN LEAVE into background que + ELSE delete from background que (task) ; + into background que (task) + FI + ELSE insert new entry + FI . + +check whether already in que : + INT VAR entry pos := 1 ; + WHILE entry pos <= end of que REP + IF que (entry pos).task = task + THEN LEAVE check whether already in que + FI ; + entry pos INCR 1 + PER . + +already in que : entry pos <= end of que . + +in same class : que (entry pos).class = class . + +insert new entry : + end of que INCR 1 ; + que (end of que) := ENTRY:( task, class ) . + +delete all not existing tasks : + INT VAR j ; + FOR j FROM 1 UPTO end of que REP + TASK VAR examined := que (j).task ; + IF NOT exists (examined) + THEN delete from background que (examined) + FI + PER . + +ENDPROC into background que ; + +PROC delete from background que (TASK CONST task) : + + search for entry ; + IF entry found + THEN delete entry ; + update actual entry pos + FI . + +search for entry : + INT VAR entry pos := 1 ; + WHILE entry pos <= end of que REP + IF que (entry pos).task = task + THEN LEAVE search for entry + FI ; + entry pos INCR 1 + PER . + +entry found : entry pos <= end of que . + +delete entry : + INT VAR i ; + FOR i FROM entry pos UPTO end of que - 1 REP + que (i) := que (i+1) + PER ; + end of que DECR 1 . + +update actual entry pos : + IF actual entry or following one deleted + THEN actual entry pos DECR 1 + FI . + +actual entry or following one deleted : + entry pos >= actual entry pos . + +ENDPROC delete from background que ; + +PROC get first from background que (TASK VAR task, INT CONST lowest class) : + + actual entry pos := 0 ; + get next from background que (task, lowest class) + +ENDPROC get first from background que ; + +PROC get next from background que (TASK VAR task, INT CONST lowest class) : + + search next entry of permitted class ; + IF actual entry pos <= end of que + THEN task := que (actual entry pos).task + ELSE task := niltask + FI . + +search next entry of permitted class : + REP + actual entry pos INCR 1 + UNTIL actual entry pos > end of que + COR que (actual entry pos).class <= lowest class PER. + +ENDPROC get next from background que ; + +ENDPACKET background que manager ; + + + +PACKET scheduler DEFINES (* Autor: J.Liedtke *) + (* Stand: 09.12.82 *) + scheduler : + + +LET std background prio = 7 , + highest background prio = 5 , + long slice = 6000 , + short slice = 600 , + blocked busy = 4 ; + +INT VAR slice , + foreground workers , + background workers ; + +BOOL VAR is logging ; + +REAL VAR fore cpu load , back cpu load , paging load ; + + +access catalogue ; +TASK CONST ur task := brother (supervisor) ; + +TASK VAR actual task ; + + +PROC scheduler : + IF yes ("mit eumelmeter") + THEN is logging := TRUE + ELSE is logging := FALSE + FI ; + task password ("-") ; + break ; + set autonom ; + command dialogue (FALSE) ; + forget ("scheduler", quiet) ; + disable stop; + REP scheduler operation; + clear error + PER; + +END PROC scheduler; + +PROC scheduler operation: + enable stop; + IF is logging + THEN init log + FI; + slice := short slice ; + init system load moniting ; + REP + pause (slice) ; + monit system load ; + look at all active user tasks and block background workers ; + activate next background workers if possible ; + IF is logging + THEN log (foreground workers, background workers) + FI + PER . + +init system load moniting : + REAL VAR + time x := clock (1) , + fore cpu x := clock (4) , + back cpu x := clock (5) , + paging x := clock (2) + clock (3) . + +monit system load : + REAL VAR interval := clock (1) - time x ; + fore cpu load := (clock (4) - fore cpu x) / interval ; + back cpu load := (clock (5) - back cpu x) / interval ; + paging load := (clock (2) + clock (3) - paging x) / interval ; + time x := clock (1) ; + fore cpu x := clock (4) ; + back cpu x := clock (5) ; + paging x := clock (2) + clock (3) . + +ENDPROC scheduler operation; + +PROC look at all active user tasks and block background workers : + + foreground workers := 0 ; + background workers := 0 ; + actual task := myself ; + next active (actual task) ; + WHILE NOT (actual task = myself) REP + IF actual task < ur task + THEN look at this task + FI ; + next active (actual task) + END REP . + +look at this task : + IF channel (actual task) >= 0 + THEN foreground workers INCR 1 + ELSE background workers INCR 1 ; + block actual task if simple worker + FI . + +block actual task if simple worker : + IF son (actual task) = niltask + THEN pause (5) ; + block (actual task) ; + IF status (actual task) = blocked busy + THEN set background prio ; + into background que (actual task) + ELIF prio (actual task) < highest background prio + THEN unblock (actual task) + FI + FI . + +set background prio : + IF prio (actual task) < highest background prio + THEN prio (actual task, std background prio) + FI . + +ENDPROC look at all active user tasks and block background workers ; + +PROC activate next background workers if possible : + + INT VAR lowest activation prio , + max background workers , + active background workers := 0 ; + + strategic decision (foreground workers, background workers, + fore cpu load, back cpu load, paging load, + lowest activation prio, max background workers) ; + + IF background permitted + THEN try to activate background workers + FI ; + IF active background workers > 0 + THEN slice := short slice + ELSE slice := long slice + FI . + +background permitted : max background workers > 0 . + +try to activate background workers : + get first from background que (actual task, lowest activation prio) ; + IF NOT is niltask (actual task) + THEN delete from background que (actual task) + FI ; + + WHILE active background workers < max background workers REP + IF is niltask (actual task) + THEN LEAVE try to activate background workers + ELIF status (actual task) <> blocked busy + THEN delete from background que (actual task) + ELSE + unblock (actual task) ; + active background workers INCR 1 + FI ; + get next from background que (actual task, lowest activation prio) + PER . + +ENDPROC activate next background workers if possible ; + +ENDPACKET scheduler ; + +scheduler; + diff --git a/system/std.zusatz/1.8.7/src/spool cmd b/system/std.zusatz/1.8.7/src/spool cmd new file mode 100644 index 0000000..9b43d36 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/spool cmd @@ -0,0 +1,178 @@ +PACKET spool cmd (* Autor : R. Ruland *) + (* Stand : 13.08.87 *) + DEFINES + spool control password, + + kill spool, + first spool, + start spool, + stop spool, + halt spool, + 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, TEXT actual entries, password) VAR control msg; +BOUND TEXT VAR error msg; +INT VAR reply; + +INITFLAG VAR in this task := FALSE; +BOOL VAR dialogue; +TEXT VAR control password, password; + +control password := ""; + +PROC spool control password (TEXT CONST new password): + + IF on line THEN say (""3""13""5"") FI; + disable stop; + do ("enter spool control password (""" + new password + """)"); + clear error; + no do again; + cover tracks; + cover tracks (control password); + control password := new password; + +END PROC spool control password; + + +PROC call spool (INT CONST op code, TEXT CONST name, TASK CONST spool) : + + dialogue := command dialogue; + password := write password; + password CAT "/"; + password CAT read password; + disable stop; + command dialogue (FALSE); + enter password (control password); + command dialogue (dialogue); + call (op code, name, spool); + command dialogue (FALSE); + enter password (password); + command dialogue (dialogue); + +END PROC call spool; + + +PROC start spool (TASK CONST spool) : + + enable stop; + call spool (halt code, "", spool); + call spool (start code, "", spool); + +END PROC start spool; + + +PROC start spool (TASK CONST spool, INT CONST new channel) : + + enable stop; + call spool (halt code, "", spool); + call spool (start code, text (new channel), spool); + +END PROC start spool; + + +PROC stop spool (TASK CONST spool) : + + call spool (stop code, "", spool); + +END PROC stop spool; + +PROC stop spool (TASK CONST spool, TEXT CONST deactive msg) : + + call spool (stop code, deactive msg, spool); + +END PROC stop spool; + + +PROC halt spool (TASK CONST spool) : + + call spool (halt code, "", spool); + +END PROC halt spool; + +PROC halt spool (TASK CONST spool, TEXT CONST deactive msg) : + + call spool (halt code, deactive msg, spool); + +END PROC halt spool; + + +PROC wait for halt (TASK CONST spool) : + + call spool (wait for halt code, "", spool); + +END PROC wait for halt; + +PROC wait for halt (TASK CONST spool, TEXT CONST deactive msg) : + + call spool (wait for halt code, deactive msg, spool); + +END PROC wait for halt; + + +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. password := control password; + 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) + + . 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 kill spool (TASK CONST spool) : + + control spool (spool, killer code, " loeschen", FALSE) + +END PROC kill spool; + + +PROC first spool (TASK CONST spool) : + + control spool (spool, first code, " als erstes", TRUE) + +END PROC first spool; + + +END PACKET spool cmd; + diff --git a/system/std.zusatz/1.8.7/src/spool manager b/system/std.zusatz/1.8.7/src/spool manager new file mode 100644 index 0000000..6b4fe55 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/spool manager @@ -0,0 +1,1058 @@ +PACKET spool manager DEFINES (* Autor : R. Ruland *) + (* Stand : 23.02.88 *) + + spool manager , + + server channel , + spool duty, + station only, + auto stop, + enter spool control password, + spool control password, + + start spool, + stop spool, + halt spool, + kill spool, + first spool, + spool entry line, + number spool entries, + spool status, + server task, + clear spool, + list spool, + : + +LET que size = 200 , + + ack = 0 , + nak = 1 , + error nak = 2 , + second phase ack = 5 , + false code = 6 , + + fetch code = 11 , + save code = 12 , + exists code = 13 , + erase code = 14 , + list code = 15 , + all code = 17 , + param fetch code = 21 , + file save code = 22 , + entry line code = 23 , + killer code = 24 , + first code = 25 , + start code = 26 , + stop code = 27 , + halt code = 28 , + wait for halt code = 29 , + help code = 49 , + continue code = 100 , + + control codes = ""23""24""25""26""27""28""29"" , + + file type = 1003 , + help file name = "help"; + +LET begin char = ""0"", + end char = ""1""; + +LET PARAMS = STRUCT (TEXT name, userid, password, sendername, INT station); + +BOUND ROW que size STRUCT (PARAMS ds params, TEXT entry line) VAR que; + + ROW que size DATASPACE VAR que space; + +PARAMS VAR save params; + +DATASPACE VAR que ds, global ds; + +FILE VAR file; + +INT VAR last order, reply, old heap size, que index, fetch index, + station by start, begin pos, end pos, order task station, sp channel; + +TEXT VAR que entries, free entries, order task name, buffer, deactive message, + error message buffer, sp duty, start time, control password; + +BOOL VAR server is waiting, stop cmd pending, start cmd pending, + auto stop pending, stat only; + +TASK VAR last order task, server, calling parent, task in control; + +INITFLAG VAR in this task := FALSE, init que space := FALSE; + +BOUND STRUCT (TEXT name, userid, password) VAR msg; +BOUND STRUCT (TEXT entry line, INT index, TEXT actual entries, password) VAR control msg; +BOUND PARAMS VAR fetch msg; +BOUND THESAURUS VAR all msg; +BOUND TEXT VAR error msg; + + +. que is empty : que entries = "" +. que is full : free entries = "" +. number entries : LENGTH que entries + +. first index : code (que entries SUB 1) +. list index : code (que entries SUB que index) +. last index : code (que entries SUB number entries) + +. fetch entry : que (fetch index) +. list entry : que (list index) +. last entry : que (last index) + +. was define station : station by start <> station (myself) +. is valid fetch entry : fetch index > 0 +.; + +INT VAR command index , params ; +TEXT VAR param 1, param 2 ; +LET spool command list = "start:1.01stop:3.0halt:4.0first:5.0killer:6.0"; + +sp channel := 0; +sp duty := ""; +deactive message := ""; +stat only := FALSE; +auto stop pending := FALSE; +task in control := supervisor; +control password := "-"; + + +PROC server channel (INT CONST channel nr) : + IF channel nr <= 0 OR channel nr >= 33 + THEN errorstop ("falsche Kanalangabe") FI; + sp channel := channel nr; +END PROC server channel; + +INT PROC server channel : sp channel END PROC server channel; + + +PROC station only (BOOL CONST flag) : + stat only := flag +END PROC station only; + +BOOL PROC station only : stat only END PROC station only; + + +PROC auto stop (BOOL CONST flag) : + auto stop pending := flag +END PROC auto stop; + +BOOL PROC auto stop : auto stop pending END PROC auto stop; + + +PROC spool duty (TEXT CONST duty) : + sp duty := duty; +END PROC spool duty; + +TEXT PROC spool duty : sp duty END PROC spool duty; + + +PROC enter spool control password (TEXT CONST new password): + disable stop; + cover tracks; + cover tracks (control password); + control password := new password; +END PROC enter spool control password; + +PROC spool control password (TEXT CONST new password): + IF on line THEN say (""3""13""5"") FI; + enter spool control password (new password); +END PROC spool control password; + + +PROC spool manager (PROC server start) : + spool manager (PROC (DATASPACE VAR, INT CONST, + INT CONST, TASK CONST) spool manager, + PROC server start, TRUE) +END PROC spool manager; + + +PROC spool manager (PROC server start, BOOL CONST initial start) : + spool manager (PROC (DATASPACE VAR, INT CONST, + INT CONST, TASK CONST) spool manager, + PROC server start, initial start) +END PROC spool manager; + + +PROC spool manager (PROC (DATASPACE VAR, INT CONST, + INT CONST, TASK CONST) spool, + PROC server start, + BOOL CONST initial start) : + + set autonom; + break; + disable stop; + command dialogue (FALSE); + initialize spool manager; + REP start spool if necessary; + wait for next order; + IF order not allowed THEN reject order + ELIF is first phase THEN first phase + ELIF is second phase THEN second phase + ELSE send nak + FI; + send error if necessary; + collect heap garbage if necessary; + PER + + . initialize spool manager : + initialize if necessary; + stop server; + erase fetch entry; + start cmd pending := initial start; + stop cmd pending := FALSE; + last order task := niltask; + + . initialize if necessary : + IF NOT initialized (in this task) + THEN clear spool; + global ds := nilspace; + que ds := nilspace; + que := que ds; + server := niltask; + calling parent := niltask; + server is waiting := FALSE; + station by start := station (myself); + old heap size := 0; + error message buffer := ""; + FI; + + . start spool if necessary : + IF start cmd pending AND NOT stop cmd pending + THEN start server (PROC server start) FI; + + . wait for next order : + INT VAR order, phase; + TASK VAR order task; + forget (global ds); + wait (global ds, order, order task); + + . order not allowed : + station only CAND station (ordertask) <> station (myself) CAND + ( order > 255 COR pos (control codes, code (order)) = 0 ) + + . reject order : + errorstop ("kein Zugriffsrecht auf Task " + text (station(myself)) + + "/""" + name(myself) + """") + + . is first phase : + order <> second phase ack + + . first phase : + phase := 1; + last order := order; + last order task := order task; + spool (global ds, order, phase, order task); + + . is second phase : + order task = last order task + + . second phase : + phase INCR 1 ; + order := last order; + spool (global ds, order, phase, order task); + + . send nak : + forget (global ds); + global ds := nilspace; + send (order task, nak, global ds); + + . send error if necessary : + IF is error + THEN forget (global ds); + global ds := nilspace; + error msg := global ds; + CONCR (error msg) := error message; + clear error; + send (order task, error nak, global ds); + FI; + + . collect heap garbage if necessary : + IF heap size > old heap size + 2 + THEN collect heap garbage; + old heap size := heap size; + FI; + +END PROC spool manager; + + +PROC spool manager (DATASPACE VAR order ds, + INT CONST order, phase, + TASK CONST order task ): + + enable stop; + SELECT order OF + CASE fetch code, help code : out of que or help + CASE param fetch code : send fetch params + CASE save code : new que entry + CASE file save code : new file que entry + CASE exists code : exists que entry + CASE erase code : erase que entry + CASE list code : send spool list + CASE all code : send owners ds names + + CASE entry line code : send next entry line + CASE killer code : kill entry + CASE first code : make to first + CASE start code : start server task + CASE stop code : stop server task + CASE halt code, wait for halt code + : halt server task + + OTHERWISE : + + IF order >= continue code AND order task = supervisor + THEN spool monitor + ELSE wrong operation + FI; + + END SELECT; + +. wrong operation : + IF order > error nak + THEN errorstop ("falscher Auftrag fuer Task " + text (station(myself)) + + "/""" + name(myself) + """") + FI; + +. + out of que or help : + IF order task = server + THEN out of que + ELSE send help file + FI; + + . out of que : + erase fetch entry; + IF stop cmd pending + THEN stop server + ELIF que is empty + THEN IF auto stop pending + THEN stop server + ELSE server is waiting := TRUE + FI; + ELSE send first entry; + FI; + + . send help file : + check server (TRUE); + IF order = fetch code + THEN msg := order ds; + IF msg. name <> help file name + THEN errorstop ("keine Servertask") FI; + FI; + forget (order ds); + order ds := old (help file name); + send (order task, ack, order ds); + +. + send fetch params : + IF order task = server + THEN send params + ELSE errorstop ("keine Servertask") + FI; + + . send params : + forget(order ds); order ds := nilspace; + fetch msg := order ds; + fetch msg := fetch entry. ds params; + send (order task, ack, order ds); + +. + new que entry : + IF phase = 1 + THEN prepare into que + ELSE into que (order ds, order task) + FI; + +. + prepare into que : + msg := order ds ; + save params. name := msg.name; + save params. userid := msg.userid; + save params. password := msg.password; + save params. sendername := name (order task); + save params. station := station (order task); + forget (order ds); order ds := nilspace; + send (order task, second phase ack, order ds); + +. + new file que entry : + IF type (order ds) <> file type + THEN errorstop ("Datenraum hat falschen Typ"); + ELSE get file params; + into que (order ds, order task); + FI; + + . get file params : + file := sequential file (input, order ds); + end pos := 0; + next headline information (save params. name); + next headline information (save params. userid); + next headline information (save params. password); + next headline information (save params. sendername); + next headline information (buffer); + save params. station := int (buffer); + IF NOT last conversion ok + THEN save params. station := station (order task) FI; + IF save params. sendername = "" + THEN save params. sendername := name (order task) FI; + IF save params. name = "" + THEN IF headline (file) <> "" + THEN save params. name := headline (file); + ELSE errorstop ("Name unzulaessig") + FI; + ELSE headline (file, save params. name); + FI; + +. + exists que entry : + msg := order ds ; + order task name := name (order task); + order task station := station (order task); + FOR que index FROM 1 UPTO number entries + REP IF is entry from order task (msg. name) + THEN send ack; + LEAVE exists que entry + FI; + PER ; + forget (order ds); order ds := nilspace; + send (order task, false code, order ds) + +. + erase que entry : + msg := order ds ; + order task name := name (order task); + order task station := station (order task); + IF phase = 1 + THEN ask for erase + ELSE erase entry from order task + FI; + + . ask for erase : + FOR que index FROM 1 UPTO number entries + REP IF is entry from order task (msg. name) + THEN manager question ("""" + msg.name + """ loeschen", order task); + LEAVE erase que entry + FI; + PER ; + manager message ("""" + msg.name + """ existiert nicht", order task); + + . erase entry from order task : + IF is valid que index (que index) CAND is entry from order task (msg. name) + THEN delete que entry; + LEAVE erase que entry + ELSE FOR que index FROM 1 UPTO number entries + REP IF is entry from order task (msg. name) + THEN delete que entry; + LEAVE erase que entry + FI; + PER; + manager message ("""" + msg.name + """ existiert nicht", order task); + FI; + + . delete que entry : + kill spool (que index); + send ack; + +. + send owners ds names: + order task name := name (order task); + order task station := station (order task); + forget (order ds); order ds := nilspace; all msg := order ds; + all msg := empty thesaurus; + FOR que index FROM 1 UPTO number entries + REP IF is entry from order task ("") + THEN insert (all msg, list entry. ds params. name) + FI; + PER; + send (order task, ack, order ds) + +. + send spool list : + forget (global ds); global ds := nilspace; + file := sequential file (output, global ds); + list spool (file); + send (order task, ack, global ds); + +. + send next entry line : + control msg := order ds; check control password (control msg. password); + IF control msg. index = 0 THEN control msg. actual entries := que entries FI; + get next entry line; + send (order task, ack, order ds); + + . get next entry line : + REP control msg. index INCR 1; + IF control msg. index > LENGTH control msg. actual entries + THEN control msg. index := 0; + control msg. entry line := ""; + LEAVE get next entry line; + FI; + que index := control que index; + UNTIL is valid que index (que index) PER; + control msg. entry line := list entry. entry line; + + . control que index : + pos (que entries, control msg. actual entries SUB control msg. index) + +. + kill entry : + control msg := order ds; check control password (control msg. password); + kill spool (control que index); + send (order task, ack, order ds); + +. + make to first : + control msg := order ds; check control password (control msg. password); + first spool (control que index); + send (order task, ack, order ds); + +. + start server task : + msg := order ds; check control password (msg. password); + IF exists (server) AND NOT stop cmd pending + THEN errorstop ("Spool muß zuerst gestoppt werden") FI; + new server channel is necessary; + start cmd pending := TRUE; + IF server channel <= 0 OR server channel >= 33 + THEN manager message ("WARNUNG : Serverkanal nicht eingestellt", order task); + ELSE send ack + FI; + + . new server channel is necessary : + INT CONST new channel := int (msg. name); + IF last conversion ok THEN server channel (new channel) FI; + +. + stop server task : + msg := order ds; check control password (msg. password); + IF phase = 1 + THEN start cmd pending := FALSE; + deactive message := msg. name; + stop server; + check fetch entry; + ELSE reinsert fetch entry; + send ack; + FI; + +. + halt server task : + msg := order ds; check control password (msg. password); + IF phase = 1 + THEN stop cmd pending := TRUE; + start cmd pending := FALSE; + deactive message := msg. name; + IF NOT exists (server) OR server is waiting + THEN stop server; + check fetch entry; + ELIF order = wait for halt code + THEN calling parent := order task; + ELSE send ack; + FI; + ELSE reinsert fetch entry; + send ack; + FI; + + . check fetch entry : + IF is valid fetch entry + THEN manager question (""13""10"" + + fetch entry. entry line + " neu eintragen", order task); + fetch index := -fetch index; + ELSE send ack; + FI; + +. + send ack : + forget (order ds); order ds := nilspace; + send (order task, ack, order ds) + +. + spool monitor : + continue (order - continue code); + disable stop; + put error message if there is one; + WHILE online + REP command dialogue (TRUE); + sysout (""); + sysin (""); + get command ("gib Spool-Kommando:"); + analyze command (spool command list, 3, command index, params, param1, param2); + reset editor; + SELECT command index OF + CASE 1 : start spool + CASE 2 : start spool (int (param1)) + CASE 3 : stop spool + CASE 4 : halt spool + CASE 5 : first spool + CASE 6 : kill spool + OTHERWISE : do command + END SELECT; + PER; + save error message if there is one; + command dialogue (FALSE); + break (quiet); + set autonom; + + . put error message if there is one : + IF error message buffer <> "" + THEN errorstop (error message buffer); FI; + + . save error message if there is one : + IF is error + THEN error message buffer := error message; + clear error; + ELSE error message buffer := ""; + FI; + + . reset editor : + WHILE aktueller editor > 0 REP quit PER; + clear error; + +END PROC spool manager; + + +PROC send first entry : + + forget (global ds); + global ds := que space (first index); + send (server, ack, global ds, reply) ; + IF reply = ack + THEN fetch index := first index; + que entries := subtext (que entries, 2); + server is waiting := FALSE; + start time := time of day; + start time CAT " am "; + start time CAT date; + FI; + +END PROC send first entry; + + +PROC into que (DATASPACE VAR order ds, TASK CONST order task) : + + IF que is full + THEN errorstop ("Spool ist voll") + ELSE make new entry; + send ack; + awake server if necessary + FI; + + . make new entry : + que entries CAT (free entries SUB 1); + free entries := subtext (free entries, 2); + que space (last index) := order ds; + last entry. ds params := save params; + build entry line; + + . build entry line : + IF LENGTH last entry. ds params. sender name > 16 + THEN buffer := subtext (last entry. ds params. sender name, 1, 13); + buffer CAT "..."""; + ELSE buffer := last entry. ds params. sender name; + buffer CAT """"; + buffer := text (buffer, 17); + FI; + last entry. entry line := entry station text; + last entry. entry line CAT "/"""; + last entry. entry line CAT buffer; + last entry. entry line CAT " : """ ; + last entry. entry line CAT last entry. ds params. name; + last entry. entry line CAT """ (" ; + last entry. entry line CAT text (storage (order ds)); + last entry. entry line CAT " K)"; + + . entry station text : + IF last entry. ds params. station = 0 + THEN " " + ELSE text (last entry. ds params. station, 3) + FI + + . send ack : + forget (order ds); order ds := nilspace; + send (order task, ack, order ds) + + . awake server if necessary : + IF server is waiting THEN send first entry FI; + +END PROC into que; + + +(*********************************************************************) +(* Hilfsprozeduren zum Spoolmanager *) +(*********************************************************************) + + +PROC reinsert fetch entry : + + IF fetch index <> 0 + THEN insert char (que entries, code (abs (fetch index)), 1); + fetch index := 0; + FI; + +END PROC reinsert fetch entry; + + +PROC erase fetch entry : + + IF fetch index <> 0 + THEN free entries CAT code (abs (fetch index)); + forget (que space (abs (fetch index))); + fetch index := 0; + FI; + +END PROC erase fetch entry; + + +PROC start server (PROC server start): + + stop server; + begin (PROC server start, server); + station by start := station (myself); + start cmd pending := FALSE; + deactive message := ""; + +END PROC start server; + + +PROC stop server : + + IF exists (server) THEN end (server) ELSE check server (FALSE) FI; + server := niltask; + server is waiting := FALSE; + stop cmd pending := FALSE; + send calling parent reply if necessary; + + . send calling parent reply if necessary : + IF exists (calling parent) + THEN forget (global ds); global ds := nilspace; + send (calling parent, ack, global ds); + calling parent := niltask; + FI; + +END PROC stop server; + + +PROC check server (BOOL CONST with stop) : + + IF was define station CAND NOT is niltask (server) + THEN stop old server if necessary FI; + + . stop old server if necessary : + access catalogue; + TASK VAR old server := son (myself); + WHILE NOT is niltask (old server) + REP IF index (old server) = index (server) THEN old server found FI; + old server := brother (old server); + PER; + + . old server found : + IF name (old server) = "-" THEN end (old server) FI; + IF with stop THEN stop server FI; + LEAVE stop old server if necessary; + +END PROC check server; + + +BOOL PROC is valid que index (INT CONST index) : + + 1 <= index AND index <= number entries + +END PROC is valid que index; + + +BOOL PROC is entry from order task (TEXT CONST file name) : + + correct order task CAND correct filename + + . correct order task : + order task name = list entry. ds params. sendername + AND order task station = list entry. ds params. station + + . correct file name : + file name = "" OR file name = list entry. ds params. name + +END PROC is entry from order task; + + +PROC check control password (TEXT CONST password) : + + IF control password = "-" + THEN errorstop ("Kontrolle des Spools nicht erlaubt") + ELIF control password <> "" CAND control password <> password + THEN errorstop ("Passwort falsch") + FI; + +END PROC check control password; + + +PROC next headline information (TEXT VAR t): + + begin pos := pos (headline (file), begin char, end pos + 1); + IF begin pos = 0 + THEN begin pos := LENGTH headline (file) + 1; + t := ""; + ELSE end pos := pos (headline (file), end char, begin pos + 1); + IF end pos = 0 + THEN end pos := LENGTH headline (file) + 1; + t := ""; + ELSE t := subtext (headline (file), begin pos+1, end pos-1) + FI + FI + +END PROC next headline information; + +(*********************************************************************) +(* Prozeduren zur Verwaltung der Warteschlange *) +(*********************************************************************) + +PROC start spool : + + enable stop; + IF server channel <= 0 OR server channel >= 33 + THEN display (""13""10"WARNUNG : Serverkanal nicht eingestellt"13""10"") + FI; + halt spool; + start cmd pending := TRUE; + +END PROC start spool; + +PROC start spool (INT CONST new channel) : + + enable stop; + server channel (new channel); + start spool; + +END PROC start spool; + +PROC stop spool (TEXT CONST deactive msg) : + + disable stop; + deactive message := deactive msg; + start cmd pending := FALSE; + stop server; + IF is valid fetch entry CAND on line CAND + yes (""13""10"" + fetch entry. entry line + " neu eintragen") + THEN reinsert fetch entry + ELSE erase fetch entry; + FI; + +END PROC stop spool; + +PROC stop spool : stop spool ("") END PROC stop spool; + +PROC halt spool (TEXT CONST deactive msg) : + + enable stop; + deactive message := deactive msg; + stop cmd pending := TRUE; + start cmd pending := FALSE; + IF NOT exists (server) OR server is waiting THEN stop spool FI; + +END PROC halt spool; + +PROC halt spool : halt spool ("") END PROC halt spool; + + +PROC kill spool : + + enable stop; + say (""13""10""); + que index := 1; + WHILE que index <= number entries + REP IF yes (list entry. entry line + " loeschen") + THEN kill spool (que index) + ELSE que index INCR 1 + FI; + PER; + +END PROC kill spool; + +PROC kill spool (INT CONST index) : + + IF is valid que index (index) + THEN forget (que space (code (que entries SUB index))); + free entries CAT (que entries SUB index); + delete char (que entries, index); + FI; + +END PROC kill spool; + + +PROC first spool : + + enable stop; + say (""13""10""); + FOR que index FROM 1 UPTO number entries + REP IF yes (list entry. entry line + " als erstes") + THEN first spool (que index); + LEAVE first spool + FI; + PER; + +END PROC first spool; + +PROC first spool (INT CONST index) : + + IF is valid que index (index) + THEN insert char (que entries, que entries SUB index, 1); + delete char (que entries, index + 1); + FI; + +END PROC first spool; + + +TEXT PROC spool entry line (INT CONST index) : + + IF index = 0 CAND is valid fetch entry + THEN fetch entry. entry line + ELIF is valid que index (index) + THEN entry. entry line + ELSE "" + FI + + . entry : que (code (que entries SUB index)) + +END PROC spool entry line; + + +INT PROC number spool entries : number entries END PROC number spool entries; + +INT PROC spool status : + + IF exists (server) + THEN IF stop cmd pending + THEN IF start cmd pending + THEN 3 (* aktiviert (neu start) *) + ELSE 2 (* aktiviert (warten auf halt) *) + FI + ELSE IF server is waiting + THEN 0 (* kein Auftrag in Bearbeitung *) + ELSE 1 (* aktiviert *) + FI + FI + ELIF start cmd pending + THEN 0 (* wird aktiviert *) + ELIF is valid fetch entry + THEN IF was define station + THEN -3 (* deaktiviert (define station) *) + ELSE -2 (* deaktiviert (server gelöcht) *) + FI + ELSE -1 (* deaktiviert *) + FI + +END PROC spool status; + +TASK PROC server task : server END PROC server task; + + +PROC clear spool : + + disable stop; + IF NOT initialized (init que space) + THEN FOR que index FROM 1 UPTO que size + REP que space (que index) := nilspace PER; + FI; + que entries := ""; + free entries := ""; + fetch index := 0; + stop server; + FOR que index FROM 1 UPTO que size + REP forget (que space (que index)); + free entries CAT code (que index); + PER; + +END PROC clear spool; + + +PROC list spool : + + disable stop; + DATASPACE VAR list ds := nilspace; + FILE VAR list file := sequential file (output, list ds); + list spool (list file); + show (list file); + forget (list ds); + +END PROC list spool; + + +PROC list spool (FILE VAR f) : + + enable stop; + output (f); + max line length (f, 1000); + headline (f, station text + name (myself) + """"); + put spool duty; + put current job; + put spool que; + + . station text : + IF station(myself) = 0 + THEN "/""" + ELSE text (station(myself)) + "/""" + FI + + . put spool duty : + IF spool duty <> "" + THEN write (f, "Aufgabe: "); + write (f, spool duty ); + line (f, 2); + FI; + + . put current job : + IF is valid fetch entry + THEN write (f, "In Bearbeitung seit "); + write (f, start time); + write (f, ":"); + line (f, 2); + putline (f, fetch entry. entry line); + IF NOT exists (server) + THEN IF was define station + THEN putline (f, "Spool ist deaktiviert, da Stationsnummer geaendert wurde") + ELSE putline (f, "Spool ist deaktiviert, da der Server gelöscht wurde") + FI; + ELIF stop cmd pending + THEN IF start cmd pending + THEN putline (f, "Spool wird nach diesem Auftrag neu aktiviert"); + ELSE putline (f, "Spool wird nach diesem Auftrag deaktiviert"); + FI; + FI; + line (f); + ELSE write (f, "kein Auftrag in Bearbeitung"); + IF NOT exists (server) + THEN write (f, ", da Spool deaktiviert"); + IF start cmd pending + THEN line (f); + write (f, "Spool wird nach Verlassen der Task aktiviert"); + FI; + IF deactive message <> "" + THEN line (f); + write (f, deactive message); + FI; + ELIF que is empty + THEN write (f, ", da Warteschlange leer"); + LEAVE list spool; + FI; + line (f, 2); + FI; + + . put spool que : + IF que is empty + THEN putline (f, "Warteschlange ist leer"); + ELSE write (f, "Warteschlange ("); + write (f, text (number entries)); + IF number entries = 1 + THEN write (f, " Auftrag):"); + ELSE write (f, " Auftraege):"); + FI; + line (f, 2); + FOR que index FROM 1 UPTO number entries + REP putline (f, list entry. entry line) PER; + FI; + +END PROC list spool; + + +ENDPACKET spool manager; + diff --git a/system/std.zusatz/1.8.7/src/std analysator b/system/std.zusatz/1.8.7/src/std analysator new file mode 100644 index 0000000..7e14722 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/std analysator @@ -0,0 +1,68 @@ +PACKET std analysator (* Autor : Rudolf Ruland *) + (* Stand : 06.11.86 *) + DEFINES std analysator : + + +LET text code = 1, + error code = 2, + token code = 3; + +INT VAR instruction begin; +TEXT VAR unknown instruction := ""; + +PROC std analysator (INT CONST op code, TEXT VAR string, + INT VAR par1, par2, par3, par4, par5, par6, par7) : + + SELECT op code OF + + CASE text code : analyse text + CASE error code : report errors + CASE token code : report tokens + + END SELECT ; + + . record : string + . record pos : par1 + . width : par4 + . height : par5 + . depth : par6 + + . analyse text : + instruction begin := record pos + 1; + record pos := pos (record, "#", instruction begin) + 1; + width := 0; + height := 0; + depth := 0; + unknown instruction := subtext (record, instruction begin, instruction end); + + . instruction end : record pos - 2 + + +. error msg : string +. error nr : par1 +. + report errors : + IF error nr = 0 + THEN error msg := "unbekannte Anweisung (ignoriert): "; + error msg CAT unknown instruction; + error nr := 1; + ELSE error msg := ""; + error nr := 0; + FI; + + +. token text : string +. token nr : par1 +. token font nr : par2 +. token modifications : par3 +. token width : par4 +. token x pos : par5 +. token y pos : par6 +. token type : par7 +. + report tokens : + +END PROC std analysator; + +END PACKET std analysator; + diff --git a/system/std.zusatz/1.8.7/src/vector b/system/std.zusatz/1.8.7/src/vector new file mode 100644 index 0000000..5c9e896 --- /dev/null +++ b/system/std.zusatz/1.8.7/src/vector @@ -0,0 +1,213 @@ +PACKET vector DEFINES VECTOR, :=, vector, (* Autor : H.Indenbirken *) + SUB, LENGTH, length, norm, (* Stand : 21.10.83 *) + nilvector, replace, =, <>, + +, -, *, /, + get, put : + + +TYPE VECTOR = STRUCT (INT lng, TEXT elem); +TYPE INITVECTOR = STRUCT (INT lng, REAL value); + +INT VAR i; +TEXT VAR t :: "12345678"; +VECTOR VAR v :: nilvector; + +(**************************************************************************** +PROC dump (VECTOR CONST v) : + put line (text (v.lng) + " Elemente :"); + FOR i FROM 1 UPTO v.lng + REP put line (text (i) + ": " + text (element i)) PER . + +element i : + v.elem RSUB i . + +END PROC dump; +****************************************************************************) + +OP := (VECTOR VAR l, VECTOR CONST r) : + l.lng := r.lng; + l.elem := r.elem + +END OP :=; + +OP := (VECTOR VAR l, INITVECTOR CONST r) : + l.lng := r.lng; + replace (t, 1, r.value); + l.elem := r.lng * t + +END OP :=; + +INITVECTOR PROC nilvector : + vector (1, 0.0) + +END PROC nilvector; + +INITVECTOR PROC vector (INT CONST lng, REAL CONST value) : + IF lng <= 0 + THEN errorstop ("PROC vector : lng <= 0") FI; + INITVECTOR : (lng, value) + +END PROC vector; + +INITVECTOR PROC vector (INT CONST lng) : + vector (lng, 0.0) + +END PROC vector; + +REAL OP SUB (VECTOR CONST v, INT CONST i) : + test ("REAL OP SUB : ", v, i); + v.elem RSUB i + +END OP SUB; + +INT OP LENGTH (VECTOR CONST v) : + v.lng + +END OP LENGTH; + +INT PROC length (VECTOR CONST v) : + v.lng + +END PROC length; + +REAL PROC norm (VECTOR CONST v) : + REAL VAR result :: 0.0; + FOR i FROM 1 UPTO v.lng + REP result INCR ((v.elem RSUB i)**2) PER; + sqrt (result) . + +END PROC norm; + +PROC replace (VECTOR VAR v, INT CONST i, REAL CONST r) : + test ("PROC replace : ", v, i); + replace (v.elem, i, r) + +END PROC replace; + +BOOL OP = (VECTOR CONST l, r) : + l.elem = r.elem +END OP =; + +BOOL OP <> (VECTOR CONST l, r) : + l.elem <> r.elem +END OP <>; + +VECTOR OP + (VECTOR CONST v) : + v +END OP +; + +VECTOR OP + (VECTOR CONST l, r) : + test ("VECTOR OP + : ", l, r); + v := l; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (l.elem RSUB i) + (r.elem RSUB i)) PER; + v + +END OP +; + +VECTOR OP - (VECTOR CONST a) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, - (a.elem RSUB i)) PER; + v + +END OP -; + +VECTOR OP - (VECTOR CONST l, r) : + test ("VECTOR OP - : ", l, r); + v := l; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (l.elem RSUB i) - (r.elem RSUB i)) PER; + v +END OP -; + +REAL OP * (VECTOR CONST l, r) : + test ("REAL OP * : ", l, r); + REAL VAR x :: 0.0; + FOR i FROM 1 UPTO l.lng + REP x INCR ((l.elem RSUB i) * (r.elem RSUB i)) PER; + x + +END OP *; + +VECTOR OP * (VECTOR CONST v, REAL CONST r) : + r*v + +END OP *; + +VECTOR OP * (REAL CONST r, VECTOR CONST a) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, r*(a.elem RSUB i)) PER; + v + +END OP *; + +VECTOR OP / (VECTOR CONST a, REAL CONST r) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (a.elem RSUB i)/r) PER; + v + +END OP /; + +TEXT VAR error :: ""; +PROC test (TEXT CONST proc, VECTOR CONST v, INT CONST i) : + IF i > v.lng + THEN error := proc; + error CAT "subscript overflow (LENGTH v="; + error CAT text (v.lng); + error CAT ", i="; + error CAT text (i); + error CAT ")"; + errorstop (error) + ELIF i < 1 + THEN error := proc; + error CAT "subscript underflow (i = "; + error CAT text (i); + error CAT ")"; + errorstop (error) + FI . + +END PROC test; + +PROC test (TEXT CONST proc, VECTOR CONST a, b) : + IF a.lng <> b.lng + THEN error := proc; + error CAT "LENGTH a ("; + IF a.lng <= 0 + THEN error CAT "undefined" + ELSE error CAT text (a.lng) FI; + error CAT ") <> LENGTH b ("; + error CAT text (b.lng); + error CAT ")"; + errorstop (error) + FI + +END PROC test; + +PROC get (VECTOR VAR v, INT CONST lng) : + v.lng := lng; + v.elem := lng * "12345678"; + REAL VAR x; + FOR i FROM 1 UPTO lng + REP get (x); + replace (v.elem, i, x) + PER . + +END PROC get; + +PROC put (VECTOR CONST v, INT CONST length, fracs) : + FOR i FROM 1 UPTO v.lng + REP put (text (v.elem RSUB i, length, fracs)) PER + +END PROC put; + +PROC put (VECTOR CONST v) : + FOR i FROM 1 UPTO v.lng + REP put (text (v.elem RSUB i)) PER + +END PROC put; + +END PACKET vector; + diff --git a/tools/highlight.py b/tools/highlight.py new file mode 100755 index 0000000..ecdb49e --- /dev/null +++ b/tools/highlight.py @@ -0,0 +1,55 @@ +#!/usr/bin/env python3 +# vim: set fileencoding=utf8 : + +""" +Highlight elan source file +""" + +if __name__ == '__main__': + import sys, os, shutil + from pygments import highlight + from pygments.lexers import get_lexer_by_name + from pygments.formatters import HtmlFormatter + from jinja2 import Template + + tpl = Template(""" + + + + + + {{ path }} + + + +

{{ path }}

+ + {{ code|safe }} + """) + + destdir = '_build' + f = sys.argv[1] + print (f) + + basedir = os.path.dirname (f) + basedestdir = os.path.join (destdir, basedir) + os.makedirs (basedestdir, exist_ok=True) + shutil.copy (f, os.path.join (destdir, f)) + destf = os.path.join (destdir, f + '.html') + + try: + with open (f, 'r') as srcfd: + code = srcfd.read () + except UnicodeDecodeError: + # that’s fine + sys.exit (0) + + lexer = get_lexer_by_name("elan", stripall=True) + formatter = HtmlFormatter (linenos=True, lineanchors='line', anchorlinenos=True) + with open (destf, 'w') as destfd: + tpl.stream(code=highlight(code, lexer, formatter), path=f, rawfile=os.path.basename (f), index=os.path.relpath ('.', os.path.dirname (f))).dump (destfd) + diff --git a/tools/makeindex.py b/tools/makeindex.py new file mode 100755 index 0000000..76816b2 --- /dev/null +++ b/tools/makeindex.py @@ -0,0 +1,53 @@ +#!/usr/bin/env python3 +# vim: set fileencoding=utf8 : + +""" +Create package index +""" + +if __name__ == '__main__': + import os + from operator import itemgetter + from itertools import groupby + from yarl import URL + + pkgs = {} + + for dirpath, dirnames, filenames in os.walk ('.'): + dirs = dirpath.split (os.sep) + if len (dirs) < 4: + continue + + cat = dirs[1] + if cat not in {'app', 'devel', 'doc', 'lang', 'system'}: + continue + pkg = dirs[2] + ver = dirs[3] + + i = (cat, pkg, ver) + pkgs.setdefault (i, []) + + for f in filenames: + # not highlighting anything else currently (doc for example) + if dirs[-1] == 'src': + pkgs[i].append (os.path.join (*dirs[4:], f)) + + for cat, pkgs in groupby (sorted (pkgs.items(), key=itemgetter(0)), key=lambda x: x[0][0]): + print (f'{cat}\n{"^"*len(cat)}\n') + for (cat, pkg, ver), files in pkgs: + heading = f'{pkg}-{ver}' + print (f'\n{heading}\n{"*"*len(heading)}\n') + disklist = os.path.join (cat, pkg, ver, 'source-disk') + if os.path.exists (disklist): + with open (disklist) as fd: + diskfiles = [x.strip() for x in fd.readlines ()] + assert all (map (lambda x: os.path.isfile (os.path.join ('..', 'disks', x)), diskfiles)), diskfiles + disks = map (lambda x: URL('../disks/' + x.split('/')[0] + '.zip'), diskfiles) + print ('Source disk: ') + print (',\n'.join (map (lambda x: f'`{x[0]} <{x[1].raw_path}>`__', enumerate (disks, 1)))) + print ('') + for f in sorted (files, key=lambda x: x.lower()): + u = URL (f'{cat}/{pkg}/{ver}/{f}.html') + print (f'- `{f} <{u.raw_path}>`__') + print ('') + -- cgit v1.2.3

Raw file
Back to index