home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / fortran / library / forsubl1 / demo.for < prev    next >
Encoding:
Text File  |  1992-07-06  |  68.4 KB  |  2,067 lines
  1.       PROGRAM DEMO
  2.  
  3. C ╔════════════════════════════════════════════════════════════════════╗
  4. C ║Programmbeschreibung                                                ║
  5. C ║Das Programm demonstriert den Gebrauch der Subroutinen aus der      ║
  6. C ║FORTRAN-77-Library FORSUB.FOR.                                      ║
  7. C ╟────────────────────────────────────────────────────────────────────╢
  8. C ║ Autor:          Dipl.-Ing. Friedhelm Killet                        ║
  9. C ║                 Escheln 28a                                        ║
  10. C ║                 4152 Kempen                                        ║
  11. C ║                 Tel. 02151/8674                                    ║
  12. C ╟────────────────────────────────────────────────────────────────────╢
  13. C ║Fertigstellung:  10. Januar 1990                                    ║
  14. C ║Freigabe:        10. Januar 1990                                    ║
  15. C ║letzte Änderung: 24. Februar 1990                                   ║
  16. C ╟────────────────────────────────────────────────────────────────────╢
  17. C ║Zur Erstellung benützte Hardware                                    ║
  18. C ║Computer:        Hewlett Packard Vectra ES/12                       ║
  19. C ║Bildschirm:      Hewlett Packard Video Graphics Color Display       ║
  20. C ║Videokarte:      Hewlett Packard Video Graphics Adapter HP D1180A   ║
  21. C ╟────────────────────────────────────────────────────────────────────╢
  22. C ║Zur Erstellung benützte Software                                    ║
  23. C ║Texteditor:      IBM Professional Editor 1.0                        ║
  24. C ║Compiler:        Microsoft Fortran Optimizing Compiler 4.00A        ║
  25. C ║Linker:          Microsoft Overlay Linker 3.0                       ║
  26. C ║Code Compressor: Microsoft EXE File Compression Utility 4.04        ║
  27. C ║Debugger:        Microsoft Code Viev symbolic debugger 1.10         ║
  28. C ╟────────────────────────────────────────────────────────────────────╢
  29. C ║Zur Erstellung benützte Libraries                                   ║
  30. C ║LLIBFORE.LIB:    Microsoft Fortran Standard Library                 ║
  31. C ║                 Large model, emulator                              ║
  32. C ║FORSUB.LIB:      Alle nicht in LLIBFORE.LIB enthaltenen Funktionen  ║
  33. C ║                 Version Januar 1990, Autor: Killet                 ║
  34. C ╟────────────────────────────────────────────────────────────────────╢
  35. C ║Compilieren, Binden und Comprimieren                                ║
  36. C ║Compilieren:     FL /c /O /Al /Fpi DEMO.FOR                         ║
  37. C ║Linken:          LINK DEMO, DEMO, NUL, LLIBFORE FORSUB /NOD /SE:256 ║
  38. C ║Comprimieren:    EXEPACK DEMO.EXE DEMO.XXX                          ║
  39. C ║                 DEL DEMO.EXE                                       ║
  40. C ║                 REN DEMO.XXX DEMO.EXE                              ║
  41. C ╟────────────────────────────────────────────────────────────────────╢
  42. C ║Vom Programm benötigte Dateien                                      ║
  43. C ║DEMO.HLP:        Die Datei enthält Texteintragungen, die vom        ║
  44. C ║                 Programm benötigt werden. Sie darf nicht mit einem ║
  45. C ║                 Editor oder einer Textverarbeitung bearbeitet      ║
  46. C ║                 werden, da sie mit einer Recordlänge von 72        ║
  47. C ║                 Characters direct organisiert ist! Die Datei wird  ║
  48. C ║                 vom Programm selbstständig im aktuellen Laufwerk   ║
  49. C ║                 oder auf der Festplatte des Systems gefunden.      ║
  50. C ╟────────────────────────────────────────────────────────────────────╢
  51. C ║Hardwareanforderungen zum Betrieb des Programms und der Unter-      ║
  52. C ║programme:                                                          ║
  53. C ║Computer:        IBM-compartibler XT oder AT Personal-Computer. Der ║
  54. C ║                 Arbeitsspeicher sollte mindestens 560 kByte groß   ║
  55. C ║                 sein.                                              ║
  56. C ║Video:           Monochrome- oder Farbmonitor. Der Monitor muß nicht║
  57. C ║                 graphikfähig sein. Die Demonstratinon der          ║
  58. C ║                 Subroutine SCRIPT ist jedoch nur mit einer EGA-    ║
  59. C ║                 oder VGA-Karte möglich.                            ║
  60. C ╚════════════════════════════════════════════════════════════════════╝
  61.  
  62. C VARIABLEN
  63.       INTEGER ALTMOD,COL,HM(16),IOS,VSEG
  64. C ALTMOD: ALTER VIDEOMODUS
  65. C COL:    FARBATTRIBUT NORMAL
  66. C HM:     FELD FÜR AUSWAHLEN AUS DEM HAUPTMENÜ
  67. C IOS:    EIN/AUSGABE-STATUS
  68. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  69.       CHARACTER FNAME*50
  70. C FNAME:  NAME DER DATEI MIT VOM PROGRAMM BENÖTIGTEN TEXTEN
  71.  
  72. C PARAMETER FÜR DATEIUNITS
  73.       INTEGER HI
  74.       PARAMETER (HI=1)
  75. C HI = 1: HILFEDATEI DEMO.HLP
  76.  
  77. C VARIABLEN MIT DATEN VORBELEGEN
  78.       DATA VSEG /0/, COL /23/
  79.  
  80. C AKTUELLEN VIDEOMODUS SEICHERN UND NEUEN MODUS SETZEN
  81.       I=1
  82.       CALL VIDMOD (3,ALTMOD,I)
  83.       IF (I .EQ. 0) CALL VIDMOD (2,ALTMOD,0)
  84.  
  85. C VERZEICHNIS DER DIRECT ORGANISIERTEN TEXTDATEI "DEMO.HLP" FINDEN
  86.       CALL DFIND ('DEMO.HLP'//CHAR(0),1,FNAME)
  87.  
  88. C TEXTDATEI "DEMO.HLP" MIT DEM UNIT "HI" ERÖFFNEN
  89.       OPEN (HI,FILE=FNAME,STATUS='OLD',ACCESS='DIRECT',RECL=72,
  90.      -FORM='FORMATTED',IOSTAT=IOS)
  91.       IF (IOS .NE. 0) CALL ERRLEV (2)
  92.  
  93. C CURSOR AUSSCHALTEN
  94.       CALL CTYP (0,0)
  95.  
  96. C BILDSCHIRM-DISPLAY ERSTELLEN
  97.       CALL LOES (25,80,1,1,32,COL,0)
  98.       CALL SCBL ('DEMO DER',8,2,100,0,COL,0)
  99.       CALL SCBL ('BIBLIOTHEK',10,10,100,0,COL,0)
  100.       CALL SCBL ('FORSUB.LIB',10,18,100,0,COL,0)
  101.       CALL PAUS (3)
  102.  
  103. C BILDSCHIRMFENSTER ERZEUGEN
  104.       CALL BILDFE (VSEG,COL,HI)
  105.  
  106. C HAUPTMENÜ GENERIEREN (BILDSCHIRMFENSTER NR. 2)
  107.     1 CALL GETFEN (2,5,5,VSEG,IOS)
  108.       CALL ME1FEN (2,16,1,HM,VSEG,71,IOS)
  109.  
  110. C ZEILENWEISE BILDSCHIRM-I/O DEMONSTRIEREN
  111.       IF (HM(1) .GT. 0) THEN
  112.          CALL IOZW (VSEG,COL)
  113.  
  114. C ZEILENWEISE BILDSCHIRM-I/O DEMONSTRIEREN
  115.       ELSEIF (HM(2) .GT. 0) THEN
  116.          CALL IOBW (VSEG,COL)
  117.  
  118. C MENÜSTEUERUNG DEMONSTRIEREN
  119.       ELSEIF (HM(3) .GT. 0) THEN
  120.          CALL MENU (VSEG,COL)
  121.  
  122. C BILDSCHIRMMASKEN DEMONSTRIEREN
  123.       ELSEIF (HM(4) .GT. 0) THEN
  124.          CALL MASKE (VSEG,COL)
  125.  
  126. C BILDSCHIRMMASKEN DEMONSTRIEREN
  127.       ELSEIF (HM(5) .GT. 0) THEN
  128.          CALL FENST (VSEG,COL)
  129.  
  130. C SCHRIFTEN DEMONSTRIEREN
  131.       ELSEIF (HM(6) .GT. 0) THEN
  132.          CALL SCHRI (VSEG,COL)
  133.  
  134. C SCHRIFTEN DEMONSTRIEREN
  135.       ELSEIF (HM(7) .GT. 0) THEN
  136.          CALL ZEIT (VSEG,COL)
  137.  
  138. C TRANSFORMATIONEN DEMONSTRIEREN
  139.       ELSEIF (HM(8) .GT. 0) THEN
  140.          CALL TRANS (VSEG,COL)
  141.  
  142. C ZUFALLZAHLEN UND SORTIERUNGEN DEMONSTRIEREN
  143.       ELSEIF (HM(9) .GT. 0) THEN
  144.          CALL ZUSOR (VSEG,COL)
  145.  
  146. C STRINGMANIPULATIONEN DEMONSTRIEREN
  147.       ELSEIF (HM(10) .GT. 0) THEN
  148.          CALL STRIMA (VSEG,COL)
  149.  
  150. C DATEI- VERZEICHNIS- UND LAUFWERKSZUGRIFFE DEMONSTRIEREN
  151.       ELSEIF (HM(11) .GT. 0) THEN
  152.          CALL DATVER (VSEG,COL)
  153.  
  154. C INFORMATION ÜBER DAS LESEN UND SCHREIBEN VON SPEICHERINHALTEN
  155.       ELSEIF (HM(12) .GT. 0) THEN
  156.          CALL PEKPOK (VSEG)
  157.  
  158. C INFORMATION ÜBER DIE VIRITUELLE SPEICHERVERWALTUNG
  159.       ELSEIF (HM(13) .GT. 0) THEN
  160.          CALL VIRSPE (VSEG)
  161.  
  162. C DEMONSTRATION DES CHILDPROZESSES UND DES INTERRUPT-AUFRUFS
  163.       ELSEIF (HM(14) .GT. 0) THEN
  164.          CALL CHIINT (VSEG,COL)
  165.  
  166. C DEMONSTRATION VERSCHIEDENER SUBROUTINEN
  167.       ELSEIF (HM(15) .GT. 0) THEN
  168.          CALL VERSCH (VSEG,COL)
  169.  
  170. C ALLE FENSTER WIEDER SCHLIEßEN
  171.       ELSEIF (HM(16) .GT. 0) THEN
  172.          DO 2 I=30,1,-1
  173.             CALL CLOFEN (I,VSEG,COL,IOS)
  174.     2    CONTINUE
  175.  
  176. C ALTEN VIDEOMODUS SETZEN, CURSOR EINSCHALTEN UND PROGRAMM BEENDEN
  177.          CALL VIDMOD (ALTMOD,0,1)
  178.          CALL CTYP (1,1)
  179.          CALL ERRLEV (0)
  180.       ENDIF
  181.       GOTO 1
  182.       END
  183.  
  184.  
  185.       SUBROUTINE BILDFE (VSEG,COL,HI)
  186. C DIE SUBROUTINE ERZEUGT DIE VOM PROGRAMM BENÖTIGTEN BILDSCHIRMFENSTER
  187. ************************************************************************
  188.  
  189. C VARIABLEN
  190.       INTEGER COL,HI,IOS,VSEG
  191. C COL:    FARBATTRIBUT
  192. C HI:     UNIT FÜR DATEI MIT HILFSTEXTEN
  193. C IOS:    ERRORFLAG
  194. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  195.  
  196. C BILDSCHIRMFENSTER FÜR DEN HINTERGRUND ERSTELLEN
  197.       CALL LOES (25,80,1,1,32,COL,0)
  198.       CALL AWRI ('DEMONSTRATION DER FORTRAN-BIBLIOTHEK FORSUB.LIB',47,
  199.      -3,17,COL)
  200.       CALL PUTFEN (1,25,80,1,1,VSEG,IOS)
  201.       IF (IOS .NE. 0) GOTO 1
  202.  
  203. C BILDSCHIRMFENSTER FÜR AKTIONEN ERSTELLEN
  204.       CALL PUTFEN (30,15,60,6,11,VSEG,IOS)
  205.       IF (IOS .NE. 0) GOTO 1
  206.       CALL CLOFEN (30,VSEG,0,IOS)
  207.       CALL RAMFEN (30,2,COL,'Aktionsfenster','Demonstration der '//
  208.      -'Library FORSUB.LIB',VSEG,IOS)
  209.  
  210. C BILDSCHIRMFENSTER FÜR DAS HAUPTMENÜ ERZEUGEN UND IN DER MEMORY ABLEGEN
  211.       CALL TEXFEN (2,16,1,70,HI,5,71,VSEG,IOS)
  212.       IF (IOS .NE. 0) GOTO 1
  213.       CALL RAMFEN (2,2,78,'Hauptmenü','Bewegen: <Cursor> '//
  214.      -'Wählen: <Return>',VSEG,IOS)
  215.  
  216. C BILDSCHIRMFENSTER FÜR ZEILENWEISE I/O ERZEUGEN
  217.       CALL TEXFEN (3,17,1,41,HI,24,33,VSEG,IOS)
  218.       IF (IOS .NE. 0) GOTO 1
  219.       CALL RAMFEN (3,1,32,'Zeilenweise I/O','Bewegen: <Cursor> '//
  220.      -'Wählen: <Return>',VSEG,IOS)
  221.  
  222. C BILDSCHIRMFENSTER FÜR BLOCKWEISE I/O ERZEUGEN
  223.       CALL TEXFEN (4,7,1,41,HI,44,52,VSEG,IOS)
  224.       IF (IOS .NE. 0) GOTO 1
  225.       CALL RAMFEN (4,1,49,'Blockweise I/O','Bewegen: <Cursor> '//
  226.      -'Wählen: <Return>',VSEG,IOS)
  227.  
  228. C BILDSCHIRMFENSTER ZUR DEMONSTRATION DER MENÜSTEUERUNG ERZEUGEN
  229.       CALL TEXFEN (5,7,1,49,HI,54,83,VSEG,IOS)
  230.       IF (IOS .NE. 0) GOTO 1
  231.       CALL RAMFEN (5,1,94,'Menüsteuerung','Bewegen: <Cursor> '//
  232.      -'Wählen: <Return>',VSEG,IOS)
  233.  
  234. C BILDSCHIRMFENSTER ZUR DEMONSTRATION DER MASKEN ERZEUGEN
  235.       CALL TEXFEN (6,4,1,51,HI,79,98,VSEG,IOS)
  236.       IF (IOS .NE. 0) GOTO 1
  237.       CALL RAMFEN (6,1,107,'Bildschirmmasken','Bewegen: <Cursor> '//
  238.      -'Wählen: <Return>',VSEG,IOS)
  239.  
  240. C BILDSCHIRMFENSTER ZUR DEMONSTRATION DER FENSTERTECHNIK ERZEUGEN
  241.       CALL TEXFEN (7,3,1,61,HI,108,112,VSEG,IOS)
  242.       IF (IOS .NE. 0) GOTO 1
  243.       CALL RAMFEN (7,1,118,'Fenstertechnik','Demonstrationsprogramm',
  244.      -VSEG,IOS)
  245.  
  246. C BILDSCHIRMFENSTER ZUR DEMONSTRATION DER SCHRIFTENGENERIERUNG
  247.       CALL TEXFEN (8,5,1,45,HI,162,3,VSEG,IOS)
  248.       IF (IOS .NE. 0) GOTO 1
  249.       CALL RAMFEN (8,1,3,'Schriftengenerator','Bewegen: <Cursor> '//
  250.      -'Wählen: <Return>',VSEG,IOS)
  251.  
  252. C BILDSCHIRMFENSTER ZUR DEMONSTRATION ZEIT- UND AKUSTIKSTEUERUNG
  253.       CALL TEXFEN (9,2,1,59,HI,170,33,VSEG,IOS)
  254.       IF (IOS .NE. 0) GOTO 1
  255.       CALL RAMFEN (9,1,33,'Zeitsteuerung, Akustik',
  256.      -'Demonstrationsprogramm',VSEG,IOS)
  257.  
  258. C BILDSCHIRMFENSTER ZUR DEMONSTRATION VON TRANSFORMATIONEN
  259.       CALL TEXFEN (10,2,1,50,HI,175,53,VSEG,IOS)
  260.       IF (IOS .NE. 0) GOTO 1
  261.       CALL RAMFEN (10,1,53,'Transformationen',
  262.      -'Demonstrationsprogramm',VSEG,IOS)
  263.  
  264. C BILDSCHIRMFENSTER FÜR ZUFALLZAHLEN UND SORTIERUNGEN
  265.       CALL TEXFEN (11,5,1,27,HI,180,82,VSEG,IOS)
  266.       IF (IOS .NE. 0) GOTO 1
  267.       CALL RAMFEN (11,1,82,'Zufallzahlen + Sortierungen',
  268.      -'Bewegen:<Cur>  Wählen:<Ret>',VSEG,IOS)
  269.  
  270. C BILDSCHIRMFENSTER FÜR STRINGMANIPULATIONEN HERSTELLEN
  271.       CALL TEXFEN (12,2,1,36,HI,188,103,VSEG,IOS)
  272.       IF (IOS .NE. 0) GOTO 1
  273.       CALL RAMFEN (12,1,103,'Stringmanipulationen',
  274.      -'Demonstrationsprogramm',VSEG,IOS)
  275.  
  276. C BILDSCHIRMFENSTER FÜR DATEI- VERZ.- UND LAUFW.-FUNKTIONEN
  277.       CALL TEXFEN (13,2,1,37,HI,193,120,VSEG,IOS)
  278.       IF (IOS .NE. 0) GOTO 1
  279.       CALL RAMFEN (13,1,120,'Datei--Verz.--Laufw.',
  280.      -'Demonstrationsprogramm',VSEG,IOS)
  281.  
  282. C BILDSCHIRMFENSTER FÜR SPEICHER-LESE- UND SCHREIB-OPERATIONEN
  283.       CALL TEXFEN (14,14,1,40,HI,198,4,VSEG,IOS)
  284.       IF (IOS .NE. 0) GOTO 1
  285.       CALL RAMFEN (14,1,4,'Speicherinhalte lesen/schreiben',
  286.      -'Information',VSEG,IOS)
  287.  
  288. C BILDSCHIRMFENSTER FÜR VIRITUELLE SPEICHERVERWALTUNG
  289.       CALL TEXFEN (15,16,1,62,HI,215,33,VSEG,IOS)
  290.       IF (IOS .NE. 0) GOTO 1
  291.       CALL RAMFEN (15,1,33,'Virituelle Speicherverwaltung',
  292.      -'Information',VSEG,IOS)
  293.  
  294. C BILDSCHIRMFENSTER FÜR CHILD-PROZESS UND INTERRUPT-AUFRUF
  295.       CALL TEXFEN (16,2,1,35,HI,234,52,VSEG,IOS)
  296.       IF (IOS .NE. 0) GOTO 1
  297.       CALL RAMFEN (16,1,52,'Child-Prozess, Interrupt-Aufruf',
  298.      -'Demonstrationsprogramm',VSEG,IOS)
  299.  
  300. C BILDSCHIRMFENSTER FÜR VERSCHIEDENE SUBROUTINEN
  301.       CALL TEXFEN (17,3,1,72,HI,239,63,VSEG,IOS)
  302.       IF (IOS .NE. 0) GOTO 1
  303.       CALL RAMFEN (17,1,63,'Verschiedene Subroutinen',
  304.      -'Demonstrationsprogramm',VSEG,IOS)
  305.       RETURN
  306.  
  307. C FEHLER AUFGETRETEN
  308.     1 CALL ERRLEV (2)
  309.       END
  310.  
  311.  
  312.       SUBROUTINE IOZW (VSEG,COL)
  313. C DIE SUBROUTINE DEMONSTRIERT DIE ZEILENWEISE BILDSCHIRM-I/O
  314. ************************************************************************
  315.  
  316. C VARIABLEN
  317.       INTEGER COL,IOS,ME(17),VSEG
  318. C COL:    FARBATTRIBUT
  319. C IOS:    ERRORFLAG
  320. C ME:     FELD FÜR MENÜAUSWAHLEN
  321. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  322.       REAL A
  323. C A:      HILFSVARIABLE
  324.       CHARACTER TEXT*30,ZEICH*28
  325. C TEXT:   TESTVARIABLE
  326. C ZEICH:  STRING MIT FILTERZEICHEN
  327.  
  328. C DATEN
  329.       DATA ZEICH /'ABCDEFGHIJKLMNOPQRSTUVWXYZ '/
  330.  
  331. C MENÜ GENERIEREN (BILDSCHIRMFENSTER NR. 3)
  332.       CALL GETFEN (3,2,2,VSEG,IOS)
  333.     1 CALL ME1FEN (3,17,1,ME,VSEG,33,IOS)
  334.  
  335. C UNTERPROGRAMM VERLASSEN
  336.       IF (ME(17) .GT. 0) RETURN
  337.  
  338. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  339.       CALL GETFEN (30,6,11,VSEG,IOS)
  340.  
  341. C CURSOR EINSCHALTEN
  342.       CALL CTYP (1,1)
  343.  
  344. C STRING POSITIONIERT EINLESEN
  345.       IF (ME(1) .GT. 0) THEN
  346.          CALL AWRI ('Geben Sie mit Hilfe von AREAD einen Text ein!',
  347.      -   45,9,18,COL)
  348.          CALL AREAD (TEXT,30,13,26,71,632,0)
  349.          CALL AWRI (TEXT,30,17,26,COL)
  350.          CALL PAUS (3)
  351.  
  352. C STRING POSITIONIERT KORRIGIEREN
  353.       ELSEIF (ME(2) .GT. 0) THEN
  354.          CALL AWRI ('Korrigieren Sie mit Hilfe von AREAD einen Text!',
  355.      -   47,9,17,COL)
  356.          TEXT='Dieses ist ein Korrekturtext!'
  357.          CALL AREAD (TEXT,30,13,26,71,632,1)
  358.          CALL AWRI (TEXT,30,17,26,COL)
  359.          CALL PAUS (3)
  360.  
  361. C STRING GEFILTERT POSITIONIERT EINLESEN
  362.       ELSEIF (ME(3) .GT. 0) THEN
  363.          CALL AWRI ('Geben Sie mit Hilfe von AREADZ einen Text ein!',
  364.      -   46,9,18,COL)
  365.          CALL AWRI ('Es sind nur die Zeichen A bis Z zugelassen!',
  366.      -   43,10,19,COL)
  367.          CALL AREADZ (TEXT,30,ZEICH,28,13,26,71,632,0)
  368.          CALL AWRI (TEXT,30,17,26,COL)
  369.          CALL PAUS (3)
  370.  
  371. C STRING GEFILTERT POSITIONIERT KORRIGIEREN
  372.       ELSEIF (ME(4) .GT. 0) THEN
  373.          CALL AWRI ('Korrigieren Sie mit Hilfe von AREADZ einen Text!',
  374.      -   48,9,17,COL)
  375.          CALL AWRI ('Es sind nur die Zeichen A bis Z zugelassen!',
  376.      -   43,10,19,COL)
  377.          TEXT='Dieses ist ein Korrekturtext!'
  378.          CALL AREADZ (TEXT,30,ZEICH,28,13,26,71,632,1)
  379.          CALL AWRI (TEXT,30,17,26,COL)
  380.          CALL PAUS (3)
  381.  
  382. C STRING POSITIONIERT SCHREIBEN
  383.       ELSEIF (ME(5) .GT. 0) THEN
  384.          CALL AWRI ('Mit Hilfe von AWRI werden Strings geschrieben!',
  385.      -   46,9,17,COL)
  386.          TEXT='Zu schreibender Text!'
  387.          CALL AWRI (TEXT,21,11,21,71)
  388.          CALL AWRI (TEXT,21,13,40,142)
  389.          CALL AWRI (TEXT,21,15,18,117)
  390.          CALL AWRI (TEXT,21,17,26,57)
  391.          CALL AWRI (TEXT,21,16,38,224)
  392.          CALL AWRI ('<RETURN>',8,19,62,COL)
  393.          CALL TAST (1,1)
  394.  
  395. C INTEGER POSITIONIERT LESEN
  396.       ELSEIF (ME(6) .GT. 0) THEN
  397.          CALL AWRI ('Geben Sie mit Hilfe von IREAD ein Integer ein!',
  398.      -   46,9,18,COL)
  399.          CALL IREAD (I,8,13,37,71,632,0)
  400.          CALL IWRI (I,8,17,37,COL)
  401.          CALL PAUS (3)
  402.  
  403. C INTEGER POSITIONIERT KORRIGIEREN
  404.       ELSEIF (ME(7) .GT. 0) THEN
  405.          CALL AWRI ('Korrigieren Sie mit Hilfe von IREAD ein Integer!',
  406.      -   47,9,17,COL)
  407.          I=12345678
  408.          CALL IREAD (I,8,13,37,71,632,1)
  409.          CALL IWRI (I,8,17,37,COL)
  410.          CALL PAUS (3)
  411.  
  412. C INTEGERS POSITIONIERT SCHREIBEN
  413.       ELSEIF (ME(8) .GT. 0) THEN
  414.          CALL AWRI ('Mit Hilfe von IWRI werden Integers geschrieben!',
  415.      -   47,9,17,COL)
  416.          CALL IWRI (11,2,11,21,71)
  417.          CALL IWRI (24561,9,13,44,142)
  418.          CALL IWRI (1248,4,15,19,117)
  419.          CALL IWRI (-12847362,10,17,29,57)
  420.          CALL IWRI (-111,4,16,56,224)
  421.          CALL AWRI ('<RETURN>',8,19,62,COL)
  422.          CALL TAST (1,1)
  423.  
  424. C REAL POSITIONIERT LESEN
  425.       ELSEIF (ME(9) .GT. 0) THEN
  426.          CALL AWRI ('Geben Sie mit Hilfe von RREAD ein Real ein!',
  427.      -   43,9,19,COL)
  428.          CALL RREAD (A,10.3,13,36,71,632,0)
  429.          CALL RWRI (A,10.3,17,36,COL)
  430.          CALL PAUS (3)
  431.  
  432. C REAL POSITIONIERT KORRIGIEREN
  433.       ELSEIF (ME(10) .GT. 0) THEN
  434.          CALL AWRI ('Korrigieren Sie mit Hilfe von RREAD ein Real!',
  435.      -   44,9,19,COL)
  436.          A=123456.789
  437.          CALL RREAD (A,10.3,13,36,71,632,1)
  438.          CALL RWRI (A,10.3,17,36,COL)
  439.          CALL PAUS (3)
  440.  
  441. C REALS POSITIONIERT SCHREIBEN
  442.       ELSEIF (ME(11) .GT. 0) THEN
  443.          CALL AWRI ('Mit Hilfe von RWRI werden Reals geschrieben!',
  444.      -   44,9,19,COL)
  445.          CALL RWRI (11.22,5.2,11,21,71)
  446.          CALL RWRI (24561.1456,10.4,13,44,142)
  447.          CALL RWRI (1248.0,8.1,15,19,117)
  448.          CALL RWRI (-12847362.12456,15.5,17,29,57)
  449.          CALL RWRI (-111.33,7.2,16,56,224)
  450.          CALL AWRI ('<RETURN>',8,19,62,COL)
  451.          CALL TAST (1,1)
  452.  
  453. C DATUM POSITIONIERT LESEN
  454.       ELSEIF (ME(12) .GT. 0) THEN
  455.          CALL AWRI ('Geben Sie mit Hilfe von DREAD ein Datum ein!',
  456.      -   44,9,19,COL)
  457.          CALL DREAD (I,13,36,71,632,0)
  458.          CALL DWRI (I,17,36,COL)
  459.          CALL PAUS (3)
  460.  
  461. C DATUM POSITIONIERT KORRIGIEREN
  462.       ELSEIF (ME(13) .GT. 0) THEN
  463.          CALL AWRI ('Korrigieren Sie mit Hilfe von DREAD ein Datum!',
  464.      -   45,9,18,COL)
  465.          I=19900115
  466.          CALL DREAD (I,13,36,71,632,1)
  467.          CALL DWRI (I,17,36,COL)
  468.          CALL PAUS (3)
  469.  
  470. C DATUM POSITIONIERT SCHREIBEN
  471.       ELSEIF (ME(14) .GT. 0) THEN
  472.          CALL AWRI ('Mit Hilfe von DWRI werden Daten geschrieben!',
  473.      -   44,9,19,COL)
  474.          CALL DWRI (19900122,11,21,71)
  475.          CALL DWRI (18851124,13,44,142)
  476.          CALL DWRI (17150923,15,19,117)
  477.          CALL DWRI (19891224,17,29,57)
  478.          CALL DWRI (20000101,16,56,224)
  479.          CALL AWRI ('<RETURN>',8,19,62,COL)
  480.          CALL TAST (1,1)
  481.  
  482. C FEHLERMELDUNG AUSGEBEN
  483.       ELSEIF (ME(15) .GT. 0) THEN
  484.          CALL AWRI ('Mit FMEL wird eine Fehlermeldung ausgegeben!',
  485.      -   43,9,19,COL)
  486.          CALL AWRI ('Hier sind Zahlen zwischen 10 und 20 zugelassen!',
  487.      -   46,10,18,COL)
  488.          CALL IREAD (I,4,13,25,71,632,0)
  489.          IF (I .LT. 10) THEN
  490.             CALL FMEL ('zu klein!',9,1,13,48,71)
  491.          ELSEIF (I .GT. 20) THEN
  492.             CALL FMEL ('zu groß!',8,1,13,49,71)
  493.          ELSE
  494.             CALL FMEL ('richtig!',8,1,13,49,71)
  495.          ENDIF
  496.          CALL PAUS (5)
  497.  
  498. C ZEICHEN AUS DER TASTATUR LESEN
  499.       ELSEIF (ME(16) .GT. 0) THEN
  500.          CALL AWRI ('TAST gibt den Zeichencode einer Taste zurück!',
  501.      -   45,9,18,COL)
  502.          CALL AWRI ('Beenden Sie den Test mit <RETURN>!',34,10,24,COL)
  503.          CALL AWRI ('Zeichencode:    , Gruppenflag:   ',33,17,24,COL)
  504.          J=1
  505.     2    CALL TAST (I,J)
  506.          CALL IWRI (I,3,17,37,COL)
  507.          CALL IWRI (J,2,17,55,COL)
  508.          IF (J .NE. 5) GOTO 2
  509.          CALL PAUS (1)
  510.       ENDIF
  511.  
  512. C CURSOR WIEDER AUSSCHALTEN
  513.       CALL CTYP (0,0)
  514.  
  515. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  516.       CALL CLOFEN (30,VSEG,0,IOS)
  517.       GOTO 1
  518.       END
  519.  
  520.  
  521.       SUBROUTINE IOBW (VSEG,COL)
  522. C DIE SUBROUTINE DEMONSTRIERT DIE BLOCKWEISE BILDSCHIRM-I/O
  523. ************************************************************************
  524.  
  525. C VARIABLEN
  526.       INTEGER COL,IOS,ME(7),VSEG
  527. C COL:    FARBATTRIBUT
  528. C IOS:    ERRORFLAG
  529. C ME:     FELD FÜR MENÜAUSWAHLEN
  530. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  531.       CHARACTER FELD(7)*50
  532. C FELD:   HILFSFELD FÜR DIE ROUTINE SCREEN
  533.  
  534. C MENÜ GENERIEREN (BILDSCHIRMFENSTER NR. 4)
  535.       CALL GETFEN (4,4,37,VSEG,IOS)
  536.     1 CALL ME1FEN (4,7,1,ME,VSEG,52,IOS)
  537.  
  538. C UNTERPROGRAMM VERLASSEN
  539.       IF (ME(7) .GT. 0) RETURN
  540.  
  541. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  542.       CALL GETFEN (30,6,11,VSEG,IOS)
  543.  
  544. C BILDSCHIRMFENSTER LÖSCHEN
  545.       IF (ME(1) .GT. 0) THEN
  546.          CALL AWRI ('Mit LOES kann man Bildschirmblöcke überschreiben!',
  547.      -   49,9,16,COL)
  548.          CALL LOES (7,56,12,13,176,78,0)
  549.          CALL LOES (4,12,13,15,32,47,0)
  550.          CALL LOES (5,18,13,35,48,95,3)
  551.          CALL LOES (3,12,15,55,250,99,0)
  552.          CALL PAUS (6)
  553.  
  554. C RAHMEN ZEICHNEN
  555.       ELSEIF (ME(2) .GT. 0) THEN
  556.          CALL AWRI ('RAHM zeichnet einen Rahmen auf den Bildschirm!',
  557.      -   45,9,18,COL)
  558.          CALL RAHM (7,56,12,13,0,16,0)
  559.          CALL RAHM (4,12,13,15,1,18,0)
  560.          CALL RAHM (5,18,13,35,2,20,3)
  561.          CALL RAHM (3,12,15,55,0,30,0)
  562.          CALL PAUS (6)
  563.  
  564. C TEXT- UND ATTRIBUTBLOCK LESEN UND SCHREIBEN
  565.       ELSEIF (ME(3) .GT. 0 .OR. ME(4) .GT. 0) THEN
  566.          IF (ME(3) .GT. 0) THEN
  567.             CALL AWRI ('SCREEN kann Textblöcke positioniert lesen '//
  568.      -      'und schreiben!',56,9,13,COL)
  569.             I=0
  570.             J=10
  571.          ELSE
  572.             CALL AWRI ('SCREEN kann Farbblöcke positioniert lesen '//
  573.      -      'und schreiben!',56,9,13,COL)
  574.             CALL AWRI ('Mit Monochrome-Monitor ist nichts zu sehen!',
  575.      -      43,10,19,COL)
  576.             I=1
  577.             J=11
  578.          ENDIF
  579.          CALL SCREEN (I,FELD,7,50,2,16)
  580.          CALL SCREEN (J,FELD,7,50,12,16)
  581.          CALL PAUS (6)
  582.  
  583. C TEXTBLOCK AUF- UND ABWÄRTS SCROLLEN
  584.       ELSEIF (ME(5) .GT. 0 .OR. ME(6) .GT. 0) THEN
  585.          IF (ME(5) .GT. 0) THEN
  586.             CALL AWRI ('Mit WIND kann ein Text aufwärts gescrollt '//
  587.      -      'werden!',48,9,17,COL)
  588.             I=0
  589.          ELSE
  590.             CALL AWRI ('Mit WIND kann ein Text abwärts gescrollt '//
  591.      -      'werden!',47,9,17,COL)
  592.             I=1
  593.          ENDIF
  594.          CALL AWRI ('Dieses Textfenster wird',23,13,29,COL)
  595.          CALL AWRI ('mit Hilfe der',13,14,34,COL)
  596.          CALL AWRI ('Subroutine WIND',15,15,33,COL)
  597.          CALL AWRI ('aufwärts oder abwärts',21,16,30,COL)
  598.          CALL AWRI ('über den Bildschirm gescrollt!',30,17,26,COL)
  599.          CALL PAUS (1)
  600.          DO 2 J=1,9
  601.             CALL WIND (I,1,11,25,19,60,COL)
  602.             CALL PAUS (1)
  603.     2    CONTINUE
  604.       ENDIF
  605.  
  606. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  607.       CALL CLOFEN (30,VSEG,0,IOS)
  608.       GOTO 1
  609.       END
  610.  
  611.  
  612.       SUBROUTINE MENU (VSEG,COL)
  613. C DIE SUBROUTINE DEMONSTRIERT DIE VERWENDUNG VON MENUABFRAGEN
  614. ************************************************************************
  615.  
  616. C VARIABLEN
  617.       INTEGER COL,FELD(12),IOS,ME(7),VSEG
  618. C COL:    FARBATTRIBUT
  619. C FELD:   FELD ZUR DEMONSTRATION DER MENÜAUSWAHLEN
  620. C IOS:    ERRORFLAG
  621. C ME:     FELD FÜR MENÜAUSWAHLEN
  622. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  623.       CHARACTER A*1,STRING*6
  624. C A:      ANTWORTVARIABLE FÜR DIE SUBROUTINE FRAG
  625. C STRING: STRING FÜR DIE ROUTINE OPTION
  626.  
  627. C MENÜ GENERIEREN (BILDSCHIRMFENSTER NR. 3)
  628.       CALL GETFEN (5,15,12,VSEG,IOS)
  629.     1 CALL ME1FEN (5,7,1,ME,VSEG,83,IOS)
  630.  
  631. C UNTERPROGRAMM VERLASSEN
  632.       IF (ME(7) .GT. 0) RETURN
  633.  
  634. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  635.       CALL GETFEN (30,6,11,VSEG,IOS)
  636.  
  637. C FÜR EINIGE FUNKTIONEN CURSOR EINSCHALTEN
  638.       IF (ME(1) .EQ. 0 .AND. ME(2) .EQ. 0) CALL CTYP (1,1)
  639.  
  640. C MENÜTEXT AUF DEN BILDSCHIRM BRINGEN
  641.       IF (ME(1) .GT. 0) THEN
  642.          CALL AWRI ('MENTXT schreibt Text aus einer Datei in Menüform!',
  643.      -   49,9,16,COL)
  644.          CALL MENTXT (12,12,3,12,100,1,64,COL)
  645.          CALL PAUS (6)
  646.  
  647. C EINFACHE AUSWAHL UND MEHRFACHE AUSWAHL
  648.       ELSEIF (ME(2) .GT. 0 .OR. ME(3) .GT. 0) THEN
  649.          IF (ME(2) .GT. 0) THEN
  650.             I=1
  651.             J=28
  652.             CALL AWRI ('MENAKT ermöglicht eine einfache Auswahl!',
  653.      -      40,9,21,COL)
  654.          ELSE
  655.             I=0
  656.             J=16
  657.             CALL AWRI ('MENAKT ermöglicht eine mehrfache Auswahl!',
  658.      -      41,9,20,COL)
  659.          ENDIF
  660.          CALL MENTXT (12,12,3,13,100,1,64,COL)
  661.          CALL MENAKT (12,12,3,13,100,I,FELD,10,J,COL)
  662.          CALL PAUS (2)
  663.  
  664. C MEHRFACHE MENÜAUSWAHL MIT KENNBUCHSTABEN
  665.       ELSEIF (ME(4) .GT. 0) THEN
  666.          CALL AWRI ('OPTION ermöglicht die Auswahl mit Kennbuchstaben!',
  667.      -   49,8,16,COL)
  668.          CALL MENTXT (6,22,1,10,100,1,64,COL)
  669.          CALL OPTION (STRING,6,18,25,51,COL)
  670.          CALL PAUS (2)
  671.  
  672. C FRAGE MIT J/N
  673.       ELSEIF (ME(5) .GT. 0) THEN
  674.          CALL AWRI ('FRAG lässt nur die Antworten Ja oder Nein zu!',
  675.      -   45,9,18,COL)
  676.          CALL FRAG (A,'Gefällt Ihnen FORSUB.LIB?',25,14,23,56,COL)
  677.          IF (A .EQ. 'J') THEN
  678.             CALL AWRI ('Das habe ich erwartet!',22,16,30,COL)
  679.          ELSE
  680.             CALL AWRI ('Das wundert mich aber!',22,16,30,COL)
  681.          ENDIF
  682.          CALL PAUS (4)
  683.  
  684. C FRAGE MIT ZIFFER ALS ANTWORT
  685.       ELSEIF (ME(6) .GT. 0) THEN
  686.          CALL AWRI ('ZIFRAG lässt als Antworten nur Ziffern zu!',
  687.      -   42,9,20,COL)
  688.          CALL ZIFRAG (I,'Wie würden Sie FORSUB.LIB benoten?',34,14,22,
  689.      -   58,COL)
  690.          IF (I .LT. 3) THEN
  691.             CALL AWRI ('Das habe ich erwartet!',22,16,30,COL)
  692.          ELSE
  693.             CALL AWRI ('Das wundert mich aber!',22,16,30,COL)
  694.          ENDIF
  695.          CALL PAUS (4)
  696.       ENDIF
  697.  
  698. C CURSOR WIEDER AUSSCHALTEN
  699.       IF (ME(1) .EQ. 0 .AND. ME(2) .EQ. 0) CALL CTYP (0,0)
  700.  
  701. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  702.       CALL CLOFEN (30,VSEG,0,IOS)
  703.       GOTO 1
  704.       END
  705.  
  706.  
  707.       SUBROUTINE MASKE (VSEG,COL)
  708. C DIE SUBROUTINE DEMONSTRIERT DIE VERWENDUNG VON BILDSCHIRMMASKEN
  709. ************************************************************************
  710.  
  711. C VARIABLEN
  712.       INTEGER AB(8),ADDR(8),ART(8),AUF(8),COL,FORM(8),IOS,KON(8),
  713.      -LAN(8),ME(4),SP(8),SPM(8),TLAN(8),VSEG,ZEI(8),I/0/,J/0/,K/0/,L/0/
  714. C I, J, K, L MÜSSEN NICHT UNBEEDINGT MIT EINEN WERT VORBELEGT WERDEN;
  715. C JEDOCH BRINGEN EINIGE COMPILERVERSIONEN OHNE VORBELEGUNG EINE WARNUNG,
  716. C OBWOHL DAS PROGRAMM EINWANDFREI FUNKTIONIERT! DAS HAT MIT DER FUNCTION
  717. C LOC() ZU TUN!
  718. C AB:     VARIABLENFELD FÜR MASK UND TYMASK
  719. C ADDR    VARIABLENFELD FÜR MASK
  720. C ART:    VARIABLENFELD FÜR MASK UND TXMASK
  721. C AUF:    VARIABLENFELD FÜR MASK UND TXMASK
  722. C COL:    FARBATTRIBUT
  723. C FORM:   VARIABLENFELD FÜR MASK
  724. C IOS:    ERRORFLAG
  725. C KON:    VARIABLENFELD FÜR MASK UND TXMASK
  726. C LAN:    VARIABLENFELD FÜR MASTXT
  727. C ME:     FELD FÜR MENÜAUSWAHLEN
  728. C SP:     VARIABLENFELD FÜR MASTXT
  729. C SPM:    VARIABLENFELD FÜR MASK UND TXMASK
  730. C TLAN:   VARIABLENFELD FÜR TXMASK
  731. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  732. C ZEI:    VARIABLENFELD FÜR MASTXT, MASK UND TXMASK
  733.       REAL A/0.0/,B/0.0/
  734. C A, B MÜSSEN NICHT UNBEEDINGT MIT EINEN WERT VORBELEGT WERDEN;
  735. C JEDOCH BRINGEN EINIGE COMPILERVERSIONEN OHNE VORBELEGUNG EINE WARNUNG,
  736. C OBWOHL DAS PROGRAMM EINWANDFREI FUNKTIONIERT! DAS HAT MIT DER FUNCTION
  737. C LOC() ZU TUN!
  738. C A:      HILFSVARIABLE
  739. C B:      HILFSVARIABLE
  740.       CHARACTER TEXT(8)*20
  741. C TEXT:   TEXTVARIABLENFELD FÜR MASK UND TXMASK
  742.  
  743. C DATEN
  744.       DATA LAN /12,17,9,14,9,12,10,15/, ZEI /12,12,13,14,15,15,16,16/,
  745.      -     SP /15,43,22,45,20,42,18,41/, ART /1,1,2,2,3,3,4,4/,
  746.      -     FORM /4,6,62,41,10,1,0,0/, SPM /28,61,32,60,30,55,29,57/,
  747.      -     AUF /0,0,1,3,4,4,5,6/, AB /3,3,4,5,7,8,0,0/,
  748.      -     TLAN /13,6,20,7,10,1,11,10/
  749.  
  750. C MENÜ GENERIEREN (BILDSCHIRMFENSTER NR. 3)
  751.       CALL GETFEN (6,19,24,VSEG,IOS)
  752.     1 CALL ME1FEN (6,4,1,ME,VSEG,98,IOS)
  753.  
  754. C UNTERPROGRAMM VERLASSEN
  755.       IF (ME(4) .GT. 0) RETURN
  756.  
  757. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  758.       CALL GETFEN (30,6,11,VSEG,IOS)
  759.  
  760. C FÜR EINIGE FUNKTIONEN CURSOR EINSCHALTEN UND KENNFELD NULL SETZEN
  761.       IF (ME(2) .GT. 0 .OR. ME(3) .GT. 0) THEN
  762.          CALL CTYP (1,1)
  763.          DO 2 I=1,8
  764.             KON(I)=0
  765.     2    CONTINUE
  766.       ENDIF
  767.  
  768. C MASKENTEXT AUF DEN BILDSCHIRM BRINGEN
  769.       IF (ME(1) .GT. 0) THEN
  770.          CALL AWRI ('MASTXT positioniert Dateitext auf dem Bildschirm!',
  771.      -   49,9,16,COL)
  772.          CALL MASTXT (8,LAN,ZEI,SP,1,86,COL)
  773.          CALL RAHM (7,54,11,14,1,COL,0)
  774.          CALL PAUS (6)
  775.  
  776. C MASKE FÜR ALLE DATENTYPEN GENERIEREN
  777.       ELSEIF (ME(2) .GT. 0) THEN
  778.          CALL AWRI ('MASK generiert eine Maske für alle Datentypen!',
  779.      -   46,9,18,COL)
  780.          CALL MASTXT (8,LAN,ZEI,SP,1,86,COL)
  781.          CALL RAHM (8,54,11,14,1,COL,0)
  782.          ADDR(1)=LOC(I)
  783.          ADDR(2)=LOC(J)
  784.          ADDR(3)=LOC(A)
  785.          ADDR(4)=LOC(B)
  786.          ADDR(5)=LOC(TEXT(1))
  787.          ADDR(6)=LOC(TEXT(2))
  788.          ADDR(7)=LOC(K)
  789.          ADDR(8)=LOC(L)
  790.          CALL MASK (ART,ADDR,FORM,ZEI,SPM,AUF,AB,KON,8,17,16,COL,512)
  791.          CALL PAUS (4)
  792.  
  793. C MASKE NUR FÜR TEXTE GENERIEREN
  794.       ELSEIF (ME(3) .GT. 0) THEN
  795.          CALL AWRI ('TXMASK generiert eine Maske für Textvariablen!',
  796.      -   46,9,18,COL)
  797.          CALL MASTXT (8,LAN,ZEI,SP,1,97,COL)
  798.          CALL RAHM (8,54,11,14,1,COL,0)
  799.          CALL TXMASK (TEXT,TLAN,ZEI,SPM,AUF,AB,KON,8,17,16,COL,512)
  800.          CALL PAUS (4)
  801.       ENDIF
  802.  
  803. C CURSOR WIEDER AUSSCHALTEN
  804.       IF (ME(2) .GT. 0 .OR. ME(3) .GT. 0) CALL CTYP (0,0)
  805.  
  806. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  807.       CALL CLOFEN (30,VSEG,0,IOS)
  808.       GOTO 1
  809.       END
  810.  
  811.  
  812.       SUBROUTINE FENST (VSEG,COL)
  813. C DIE SUBROUTINE DEMONSTRIERT DIE VERWENDUNG DER FENSTERTECHNIK
  814. ************************************************************************
  815.  
  816. C VARIABLEN
  817.       INTEGER COL,COLD(28),FELD(12),IOS,RART(28),VSEG,VSEGD
  818. C COL:    FARBATTRIBUT
  819. C COLD    FARBATTRIBUTE FÜR DEMONSTRATIONEN
  820. C IOS:    ERRORFLAG
  821. C FELD:   VARIABLENFELD FÜR ME1FEN UND MENFEN
  822. C RART:   RAHMENART
  823. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  824. C VSEGD:  ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG FÜR DEMONSTRATION
  825.  
  826. C FENSTER MIT HINWEIS ZUR DEMONSTRATION DER FENSTERTECHNIK
  827.       CALL PRIFEN (7,30,VSEG,0,IOS)
  828.       CALL GETFEN (30,20,2,VSEG,IOS)
  829.  
  830. C HINTERGRUND IN FENSTER NUMMER 29 ABLEGEN
  831.       CALL PUTFEN (29,25,80,1,1,VSEG,IOS)
  832.       IF (IOS .NE. 0) CALL ERRLEV (2)
  833.       CALL PAUS (8)
  834.       CALL PRIFEN (7,30,VSEG,0,IOS)
  835.  
  836. C BILDSCHIRM LÖSCHEN
  837.       CALL LOES (25,80,1,1,32,COL,0)
  838.  
  839. C BILDSCHIRMFENSTER FÜR DEN HINTERGRUND ERZEUGEN (FENSTER 1, VSEGD)
  840.       CALL PUTFEN (1,25,80,1,1,VSEGD,IOS)
  841.       IF (IOS .NE. 0) CALL ERRLEV (2)
  842.  
  843. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  844.       CALL TEXFEN (29,2,1,50,1,114,78,VSEGD,IOS)
  845.       IF (IOS .NE. 0) CALL ERRLEV (2)
  846.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  847.       CALL GETFEN (29,12,15,VSEGD,IOS)
  848.       CALL PAUS (4)
  849.  
  850. C ZUFÄLLIGE FENSTER ERZEUGEN
  851.       DO 1 I=2,28
  852.          CALL ZUFALL (COLD(I),1,126)
  853.          CALL ZUFALL (IH,3,13)
  854.          CALL ZUFALL (IB,6,40)
  855.          CALL ZUFALL (IZEI,1,26-IH)
  856.          CALL ZUFALL (ISP,1,81-IB)
  857.          IF (COLD(I) .LT. 16) COLD(I)=COLD(I)+15+IB
  858.          IF (I .EQ. 6) COLD(I)=71
  859.          IF (I .EQ. 25) COLD(I)=2
  860.          IF (I .EQ. 28) COLD(I)=4
  861.          CALL LOES (IH,IB,IZEI,ISP,32,COLD(I),0)
  862.          CALL PUTFEN (I,IH,IB,IZEI,ISP,VSEGD,IOS)
  863.          IF (IOS .NE. 0) CALL ERRLEV (2)
  864.          CALL GETFEN (29,12,15,VSEGD,IOS)
  865.     1 CONTINUE
  866.       CALL PAUS (1)
  867.  
  868. C MELDUNGSFENSTER FREIGEBEN
  869.       CALL CLOFEN (29,VSEGD,COL,IOS)
  870.       CALL FREFEN (29,VSEGD,IOS)
  871.       CALL PAUS (6)
  872.  
  873. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  874.       CALL TEXFEN (29,1,1,50,1,116,78,VSEGD,IOS)
  875.       IF (IOS .NE. 0) CALL ERRLEV (2)
  876.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  877.       CALL GETFEN (29,12,15,VSEGD,IOS)
  878.       CALL PAUS (4)
  879.  
  880. C FENSTER UMRAHMEN
  881.       DO 2 I=2,28
  882.          CALL ZUFALL (RART(I),1,2)
  883.          CALL RAMFEN (I,RART(I),COLD(I),'Test','NUM',VSEGD,IOS)
  884.     2 CONTINUE
  885.       CALL PAUS (1)
  886.  
  887. C MELDUNGSFENSTER FREIGEBEN
  888.       CALL CLOFEN (29,VSEGD,COL,IOS)
  889.       CALL FREFEN (29,VSEGD,IOS)
  890.       CALL PAUS (6)
  891.  
  892. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  893.       CALL TEXFEN (29,1,1,50,1,117,78,VSEGD,IOS)
  894.       IF (IOS .NE. 0) CALL ERRLEV (2)
  895.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  896.       CALL GETFEN (29,12,15,VSEGD,IOS)
  897.       CALL PAUS (4)
  898.  
  899. C PRIORITÄT ZWEIER FENSTER TAUSCHEN
  900.       CALL PRIFEN (25,28,VSEGD,COL,IOS)
  901.       CALL PAUS (4)
  902.       CALL PRIFEN (25,28,VSEGD,COL,IOS)
  903.       CALL PAUS (1)
  904.  
  905. C MELDUNGSFENSTER FREIGEBEN
  906.       CALL CLOFEN (29,VSEGD,COL,IOS)
  907.       CALL FREFEN (29,VSEGD,IOS)
  908.       CALL PAUS (6)
  909.  
  910. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  911.       CALL TEXFEN (29,1,1,50,1,118,78,VSEGD,IOS)
  912.       IF (IOS .NE. 0) CALL ERRLEV (2)
  913.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  914.       CALL GETFEN (29,12,15,VSEGD,IOS)
  915.       CALL PAUS (4)
  916.  
  917. C POSITION EINES FENSTERS VERÄNDERN
  918.       CALL MOPFEN (25,2,2,VSEGD,COL,IOS)
  919.       CALL PAUS (4)
  920.       CALL MOPFEN (25,5,10,VSEGD,COL,IOS)
  921.       CALL PAUS (1)
  922.  
  923. C MELDUNGSFENSTER FREIGEBEN
  924.       CALL CLOFEN (29,VSEGD,COL,IOS)
  925.       CALL FREFEN (29,VSEGD,IOS)
  926.       CALL PAUS (6)
  927.  
  928. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  929.       CALL TEXFEN (29,1,1,50,1,119,78,VSEGD,IOS)
  930.       IF (IOS .NE. 0) CALL ERRLEV (2)
  931.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  932.       CALL GETFEN (29,12,15,VSEGD,IOS)
  933.       CALL PAUS (4)
  934.  
  935. C GRÖßE EINES FENSTERS VERÄNDERN
  936.       CALL GRPFEN (25,13,40,VSEGD,COLD(25),IOS)
  937.       IF (IOS .NE. 0) CALL ERRLEV (2)
  938.       CALL LOSFEN (25,32,COLD(25),VSEGD,IOS)
  939.       CALL RAMFEN (25,RART(25),COLD(25),'Test','NUM',VSEGD,IOS)
  940.       CALL PAUS (4)
  941.       CALL GRPFEN (25,3,6,VSEGD,COLD(25),IOS)
  942.       IF (IOS .NE. 0) CALL ERRLEV (2)
  943.       CALL LOSFEN (25,32,COLD(25),VSEGD,IOS)
  944.       CALL RAMFEN (25,RART(25),COLD(25),'Test','NUM',VSEGD,IOS)
  945.       CALL PAUS (1)
  946.  
  947. C MELDUNGSFENSTER FREIGEBEN
  948.       CALL CLOFEN (29,VSEGD,COL,IOS)
  949.       CALL FREFEN (29,VSEGD,IOS)
  950.       CALL PAUS (6)
  951.  
  952. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  953.       CALL TEXFEN (29,1,1,50,1,120,78,VSEGD,IOS)
  954.       IF (IOS .NE. 0) CALL ERRLEV (2)
  955.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  956.       CALL GETFEN (29,12,15,VSEGD,IOS)
  957.       CALL PAUS (4)
  958.  
  959. C FENSTERINHALTE ÜBERSCHREIBEN
  960.       DO 3 I=2,28
  961.          CALL LOSFEN (I,62+I,COLD(I),VSEGD,IOS)
  962.     3 CONTINUE
  963.       CALL PAUS (1)
  964.  
  965. C MELDUNGSFENSTER FREIGEBEN
  966.       CALL CLOFEN (29,VSEGD,COL,IOS)
  967.       CALL FREFEN (29,VSEGD,IOS)
  968.       CALL PAUS (6)
  969.  
  970. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  971.       CALL TEXFEN (29,1,1,50,1,121,78,VSEGD,IOS)
  972.       IF (IOS .NE. 0) CALL ERRLEV (2)
  973.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  974.       CALL GETFEN (29,12,15,VSEGD,IOS)
  975.       CALL PAUS (4)
  976.  
  977. C FENSTERINHALTE LÖSCHEN
  978.       DO 4 I=2,28
  979.          CALL LOSFEN (I,32,COLD(I),VSEGD,IOS)
  980.     4 CONTINUE
  981.       CALL PAUS (1)
  982.  
  983. C MELDUNGSFENSTER FREIGEBEN
  984.       CALL CLOFEN (29,VSEGD,COL,IOS)
  985.       CALL FREFEN (29,VSEGD,IOS)
  986.       CALL PAUS (6)
  987.  
  988. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  989.       CALL TEXFEN (29,1,1,50,1,122,78,VSEGD,IOS)
  990.       IF (IOS .NE. 0) CALL ERRLEV (2)
  991.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  992.       CALL GETFEN (29,12,15,VSEGD,IOS)
  993.       CALL PAUS (4)
  994.  
  995. C FENSTER SCHLIEßEN
  996.       DO 5 I=2,28
  997.          CALL CLOFEN (I,VSEGD,0,IOS)
  998.     5 CONTINUE
  999.       CALL PAUS (1)
  1000.  
  1001. C MELDUNGSFENSTER FREIGEBEN
  1002.       CALL CLOFEN (29,VSEGD,COL,IOS)
  1003.       CALL FREFEN (29,VSEGD,IOS)
  1004.       CALL PAUS (2)
  1005.  
  1006. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  1007.       CALL TEXFEN (29,4,1,50,1,125,78,VSEGD,IOS)
  1008.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1009.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  1010.       CALL GETFEN (29,11,15,VSEGD,IOS)
  1011.       CALL PAUS (4)
  1012.  
  1013. C FENSTER UMRAHMEN UND ÖFFNEN
  1014.       DO 6 I=2,11
  1015.          CALL RAMFEN (I,1,COLD(I),'Demo','NUM',VSEGD,IOS)
  1016.          CALL INFFEN (I,0,0,IZEI,ISP,0,0,VSEGD,IOS)
  1017.          CALL GETFEN (I,IZEI,ISP,VSEGD,IOS)
  1018.     6 CONTINUE
  1019.  
  1020. C FENSTER MANUELL BEWEGEN
  1021.       CALL MOVFEN (6,VSEGD,0,IOS)
  1022.       CALL PAUS (1)
  1023.  
  1024. C MELDUNGSFENSTER FREIGEBEN
  1025.       CALL CLOFEN (29,VSEGD,COL,IOS)
  1026.       CALL FREFEN (29,VSEGD,IOS)
  1027.       CALL PAUS (6)
  1028.  
  1029. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  1030.       CALL TEXFEN (29,3,1,50,1,132,78,VSEGD,IOS)
  1031.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1032.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  1033.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1034.       CALL GETFEN (29,12,15,VSEGD,IOS)
  1035.       CALL PAUS (4)
  1036.  
  1037. C FENSTER MANUELL VERGRÖßERN ODER VERKLEINERN
  1038.       CALL GROFEN (6,VSEGD,COLD(6),IOS)
  1039.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1040.       CALL LOSFEN (6,32,COLD(6),VSEGD,IOS)
  1041.       CALL RAMFEN (6,RART(6),COLD(6),'Test','NUM',VSEGD,IOS)
  1042.       CALL PAUS (1)
  1043.  
  1044. C MELDUNGSFENSTER FREIGEBEN
  1045.       CALL CLOFEN (29,VSEGD,COL,IOS)
  1046.       CALL FREFEN (29,VSEGD,IOS)
  1047.       CALL PAUS (6)
  1048.  
  1049. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  1050.       CALL TEXFEN (29,3,1,50,1,138,78,VSEGD,IOS)
  1051.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1052.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  1053.       CALL GETFEN (29,12,15,VSEGD,IOS)
  1054.       CALL PAUS (4)
  1055.  
  1056. C FENSTER MANUELL BESCHREIBEN
  1057.       CALL CTYP (1,1)
  1058.       CALL WRIFEN (6,VSEGD,IOS)
  1059.       CALL CTYP (0,0)
  1060.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1061.       CALL PAUS (1)
  1062.  
  1063. C MELDUNGSFENSTER FREIGEBEN
  1064.       CALL CLOFEN (29,VSEGD,COL,IOS)
  1065.       CALL FREFEN (29,VSEGD,IOS)
  1066.       CALL PAUS (6)
  1067.  
  1068. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  1069.       CALL TEXFEN (29,3,1,50,1,144,78,VSEGD,IOS)
  1070.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1071.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  1072.       CALL GETFEN (29,12,15,VSEGD,IOS)
  1073.       CALL PAUS (4)
  1074.  
  1075. C EINFACHE AUSWAHL AUS EINEM FENSTER REALISIEREN
  1076.       CALL FREFEN (15,VSEGD,IOS)
  1077.       CALL TEXFEN (15,12,3,12,1,64,2,VSEGD,IOS)
  1078.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1079.       CALL RAMFEN (15,1,3,'┤einfache Auswahl├','<Cursor>─<Return>',
  1080.      -VSEGD,IOS)
  1081.       CALL GETFEN (15,4,21,VSEGD,IOS)
  1082.       CALL ME1FEN (15,12,3,FELD,VSEGD,0,IOS)
  1083.       CALL PAUS (1)
  1084.  
  1085. C MELDUNGSFENSTER FREIGEBEN
  1086.       CALL CLOFEN (29,VSEGD,COL,IOS)
  1087.       CALL FREFEN (29,VSEGD,IOS)
  1088.       CALL PAUS (6)
  1089.  
  1090. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  1091.       CALL TEXFEN (29,3,1,50,1,150,78,VSEGD,IOS)
  1092.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1093.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  1094.       CALL GETFEN (29,12,15,VSEGD,IOS)
  1095.       CALL PAUS (4)
  1096.  
  1097. C MEHRFACHE AUSWAHL AUS EINEM FENSTER REALISIEREN
  1098.       CALL FREFEN (16,VSEGD,IOS)
  1099.       CALL TEXFEN (16,12,3,12,1,64,2,VSEGD,IOS)
  1100.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1101.       CALL RAMFEN (16,1,3,'┤mehrfache Auswahl├',
  1102.      -'<Cursor>─<Return>─<F1>─<F2>',VSEGD,IOS)
  1103.       CALL GETFEN (16,18,5,VSEGD,IOS)
  1104.       CALL MENFEN (16,12,3,FELD,VSEGD,0,IOS)
  1105.       CALL PAUS (1)
  1106.  
  1107. C MELDUNGSFENSTER FREIGEBEN
  1108.       CALL CLOFEN (29,VSEGD,COL,IOS)
  1109.       CALL FREFEN (29,VSEGD,IOS)
  1110.       CALL PAUS (6)
  1111.  
  1112. C BILDSCHIRMFENSTER FÜR DIE MELDUNG ERZEUGEN (FENSTER 29, VSEGD)
  1113.       CALL TEXFEN (29,3,1,50,1,156,78,VSEGD,IOS)
  1114.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1115.       CALL RAMFEN (29,1,78,CHAR(0),CHAR(0),VSEGD,IOS)
  1116.       CALL GETFEN (29,12,15,VSEGD,IOS)
  1117.       CALL PAUS (4)
  1118.  
  1119. C FENSTER MANUELL VERWALTEN
  1120.       DO 7 I=2,29
  1121.          CALL CLOFEN (I,VSEGD,0,IOS)
  1122.     7 CONTINUE
  1123.       CALL FREFEN (1,VSEGD,IOS)
  1124.       CALL CTYP (1,1)
  1125.       CALL VERFEN (VSEGD,COL,IOS)
  1126.       CALL CTYP (0,0)
  1127.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1128.       CALL PAUS (1)
  1129.  
  1130. C FENSTER SCHLIEßEN UND AUS DER MEMORY ENTFERNEN
  1131.       DO 8 I=1,30
  1132.          CALL CLOFEN (I,VSEGD,COL,IOS)
  1133.          CALL FREFEN (I,VSEGD,IOS)
  1134.     8 CONTINUE
  1135.  
  1136. C HINTERGRUND WIEDERHERSTELLEN UND VERWALTUNGSFELD AUS MEMORY ENTFERNEN
  1137.       CALL GETFEN (29,1,1,VSEG,IOS)
  1138.       CALL FREFEN (29,VSEG,IOS)
  1139.       CALL FREMEM (VSEGD,IOS)
  1140.       END
  1141.  
  1142.  
  1143.       SUBROUTINE SCHRI (VSEG,COL)
  1144. C DIE SUBROUTINE DEMONSTRIERT DIE VERWENDUNG VERSCHIEDENER SCHRIFTEN
  1145. ************************************************************************
  1146.  
  1147. C VARIABLEN
  1148.       INTEGER COL,IOS,ME(5),VSEG
  1149. C COL:    FARBATTRIBUT
  1150. C IOS:    ERRORFLAG
  1151. C ME:     FELD FÜR MENÜAUSWAHLEN
  1152. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  1153.  
  1154. C MENÜ GENERIEREN (BILDSCHIRMFENSTER NR. 6)
  1155.       CALL GETFEN (8,5,17,VSEG,IOS)
  1156.     1 CALL ME1FEN (8,5,1,ME,VSEG,3,IOS)
  1157.  
  1158. C UNTERPROGRAMM VERLASSEN
  1159.       IF (ME(5) .GT. 0) RETURN
  1160.  
  1161. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  1162.       CALL GETFEN (30,6,11,VSEG,IOS)
  1163.  
  1164. C FÜR EINIGE FUNKTIONEN CURSOR EINSCHALTEN
  1165.       IF (ME(3) .GT. 0 .OR. ME(4) .GT. 0) CALL CTYP (1,1)
  1166.  
  1167. C ROM-ÄQUIVALENTEN BLOCKTEXT SCHREIBEN
  1168.       IF (ME(1) .GT. 0) THEN
  1169.          CALL AWRI ('SCBL schreibt ROM-äquivalenten Blocktext!',
  1170.      -   41,9,20,COL)
  1171.          CALL SCBL ('TEST',4,12,100,0,COL,5)
  1172.          CALL PAUS (6)
  1173.  
  1174. C FILIGRANEN BLOCKTEXT SCHREIBEN
  1175.       ELSEIF (ME(2) .GT. 0) THEN
  1176.          CALL AWRI ('SCBL schreibt filigranen Blocktext zum Bildschirm!'
  1177.      -   ,50,9,16,COL)
  1178.          CALL SCBL ('TEST',4,12,100,0,COL,0)
  1179.          CALL PAUS (6)
  1180.  
  1181. C TEXTZEICHENSÄTZE LADEN UND VORFÜHREN
  1182.       ELSEIF (ME(3) .GT. 0) THEN
  1183.  
  1184. C HINWEISTEXT AUF DEN BILDSCHIRM BRINGEN
  1185.          CALL AWRI ('SCRIPT benutzt alternative Zeichensätze!)'
  1186.      -   ,40,9,21,COL)
  1187.          CALL AWRI ('EGA- oder VGA-Videokonfiguration wird benötigt!)',
  1188.      -   47,11,17,COL)
  1189.  
  1190. C ERSTE SCHRIFT AUF DEN BILDSCHIRM BRINGEN
  1191.          I=0
  1192.          CALL SCRIPT ('ELITE14'//CHAR(0),I)
  1193.          IF (I .NE. 0) THEN
  1194.             CALL AWRI ('Keine EGA- oder VGA- Videokonfiguration,',
  1195.      -      39,15,21,COL)
  1196.             CALL AWRI ('oder Scriptdateien nicht im Verzeichnis!',
  1197.      -      39,16,21,COL)
  1198.             CALL PAUS (6)
  1199.             GOTO 3
  1200.          ENDIF
  1201.          CALL AWRI ('Dieser Text ist in ELITE14 geschrieben!',
  1202.      -   39,15,21,COL)
  1203.          CALL PAUS (6)
  1204.  
  1205. C DREI ANDERE SCHRIFTEN AUF DEN BILDSCHIRM BRINGEN
  1206.          CALL SCRIPT ('BOLD6'//CHAR(0),0)
  1207.          CALL AWRI (' Dieser Text ist in BOLD6 geschrieben! ',
  1208.      -   39,15,21,COL)
  1209.          CALL PAUS (6)
  1210.          CALL SCRIPT ('PICA10'//CHAR(0),0)
  1211.          CALL AWRI (' Dieser Text ist in PICA10 geschrieben!',
  1212.      -   39,15,21,COL)
  1213.          CALL PAUS (6)
  1214.          CALL SCRIPT ('SCR24'//CHAR(0),0)
  1215.          CALL AWRI (' Dieser Text ist in SCR24 geschrieben! ',
  1216.      -   39,15,21,COL)
  1217.          CALL PAUS (6)
  1218.  
  1219. C ALTEN VIDEOMODUS WIEDERHERSTELLEN
  1220.          CALL VIDMOD (2,0,2)
  1221.          CALL VIDMOD (3,0,2)
  1222.  
  1223. C TEXTZEICHENSATZ IM 40-ZEILEN-MODUS LADEN UND VORFÜHREN
  1224.       ELSEIF (ME(4) .GT. 0) THEN
  1225.  
  1226. C HINTERGRUND IN FENSTER 29 ABLEGEN
  1227.          CALL PUTFEN (29,25,80,1,1,VSEG,IOS)
  1228.          IF (IOS .NE. 0) CALL ERRLEV (2)
  1229.          CALL LOES (25,80,1,1,32,COL,0)
  1230.  
  1231. C VIDEOMODUS 40 ZEICHEN SETZEN
  1232.          I=2
  1233.          CALL VIDMOD (1,IALT,I)
  1234.          IF (I .EQ. 0) CALL VIDMOD (0,IALT,2)
  1235.  
  1236. C NEUEN ZEICHENSATZ GENERIEREN UND RAHMEN ZEICHNEN
  1237.          I=0
  1238.          CALL SCRIPT ('SCR24'//CHAR(0),I)
  1239.          IF (I .NE. 0) THEN
  1240.             CALL AWRI ('Keine EGA- oder VGA-Videokonfig.!',
  1241.      -      33,9,5,COL)
  1242.             GOTO 2
  1243.          ENDIF
  1244.          CALL RAHM (16,40,1,1,0,COL,5)
  1245.  
  1246. C SCHRIFT AUSGEBEN
  1247.          CALL AWRI ('SCRIPT benutzt alternat. Zeichensätze',
  1248.      -   37,6,2,COL)
  1249.          CALL AWRI ('mit EGA- oder VGA-Videokonfiguration!',
  1250.      -   37,8,2,COL)
  1251.          CALL AWRI ('Dieser Text ist in SCR24 geschrieben!',
  1252.      -   37,10,2,COL)
  1253.  
  1254. C ALTE VIDEOKONFIGURATION SETZEN UND BILDSCHIRM WIEDERHERSTELLEN
  1255.     2    CALL PAUS (6)
  1256.          CALL VIDMOD (IALT,0,1)
  1257.          CALL GETFEN (29,1,1,VSEG,IOS)
  1258.          CALL FREFEN (29,VSEG,IOS)
  1259.       ENDIF
  1260.  
  1261. C CURSOR WIEDER AUSSCHALTEN
  1262.     3 IF (ME(3) .GT. 0 .OR. ME(4) .GT. 0) CALL CTYP (0,0)
  1263.  
  1264. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  1265.       CALL CLOFEN (30,VSEG,0,IOS)
  1266.       GOTO 1
  1267.       END
  1268.  
  1269.  
  1270.       SUBROUTINE ZEIT (VSEG,COL)
  1271. C DIE SUBROUTINE DEMONSTRIERT ZEIT- UND AKUSTIKSTEUERUNG
  1272. ************************************************************************
  1273.  
  1274. C VARIABLEN
  1275.       INTEGER COL,IOS,VSEG
  1276. C COL:    FARBATTRIBUT
  1277. C IOS:    ERRORFLAG
  1278. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  1279.  
  1280. C HINWEISFENSTER GENERIEREN (BILDSCHIRMFENSTER NR. 9)
  1281.       CALL PRIFEN (9,30,VSEG,0,IOS)
  1282.       CALL GETFEN (30,21,19,VSEG,IOS)
  1283.       CALL PAUS (8)
  1284.       CALL PRIFEN (9,30,VSEG,0,IOS)
  1285.  
  1286. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  1287.       CALL GETFEN (30,6,11,VSEG,IOS)
  1288.  
  1289. C HINWEISTEXT SCHREIBEN
  1290.       CALL AWRI ('Mit den Subroutinen PAUS, LAUT und PIEPS',
  1291.      -40,9,21,COL)
  1292.       CALL AWRI ('können Pausen beliebiger Zeitdauer und Töne',
  1293.      -43,11,19,COL)
  1294.       CALL AWRI ('beliebiger Frequenz und Dauer erzeugt werden!',
  1295.      -45,13,18,COL)
  1296.  
  1297. C PAUSEN ERZEUGEN UND DABEI FELD FARBLICH KENNZEICHNEN
  1298.       DO 1 I=1,20
  1299.          IF (J .EQ. 176) THEN
  1300.             J=177
  1301.          ELSEIF (J .EQ. 177) THEN
  1302.             J=178
  1303.          ELSEIF (J .EQ. 178) THEN
  1304.             J=176
  1305.          ELSE
  1306.             J=176
  1307.          ENDIF
  1308.          CALL LOES (4,50,15,16,J,(MOD(I-1,8)*16)+15,0)
  1309.          CALL RWRI (I*0.1,4.1,17,34,COL)
  1310.          CALL AWRI (' SEKUNDEN!',10,17,38,COL)
  1311.          CALL LAUT (100,INT(I*0.1/0.055),1)
  1312.     1 CONTINUE
  1313.       CALL LOES (4,50,15,16,32,COL,0)
  1314.       CALL PAUS (3)
  1315.  
  1316. C TÖNE ERZEUGEN
  1317.       DO 2 I=1,16
  1318.          CALL LAUT (100,INT(I*0.05/0.055),1)
  1319.          CALL IWRI (100+I*200,4,17,35,COL)
  1320.          CALL AWRI ('HERTZ!',6,17,40,COL)
  1321.          CALL LAUT (INT(1193180/(300+I*200)),INT(I*0.05/0.055),0)
  1322.     2 CONTINUE
  1323.       CALL AWRI ('PAUS wartet bis Sie eine Taste drücken!',39,17,21,COL)
  1324.       CALL PAUS (-1)
  1325.       CALL LOES (1,40,17,21,32,COL,0)
  1326.       DO 3 I=16,1,-1
  1327.          CALL LAUT (100,INT((17-I)*0.05/0.055),1)
  1328.          CALL IWRI (100+I*200,4,17,35,COL)
  1329.          CALL AWRI ('HERTZ!',6,17,40,COL)
  1330.          CALL LAUT (INT(1193180/(300+I*200)),INT((17-I)*0.05/0.055),0)
  1331.     3 CONTINUE
  1332.       CALL PAUS (3)
  1333.  
  1334. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  1335.       CALL CLOFEN (30,VSEG,0,IOS)
  1336.       END
  1337.  
  1338.  
  1339.       SUBROUTINE TRANS (VSEG,COL)
  1340. C DIE SUBROUTINE DEMONSTRIERT TRANSFORMATIONEN
  1341. ************************************************************************
  1342.  
  1343. C VARIABLEN
  1344.       INTEGER COL,IOS,VSEG
  1345. C COL:    FARBATTRIBUT
  1346. C IOS:    ERRORFLAG
  1347. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  1348.  
  1349. C HINWEISFENSTER GENERIEREN (BILDSCHIRMFENSTER NR. 10)
  1350.       CALL PRIFEN (10,30,VSEG,0,IOS)
  1351.       CALL GETFEN (30,2,28,VSEG,IOS)
  1352.       CALL PAUS (8)
  1353.       CALL PRIFEN (10,30,VSEG,0,IOS)
  1354.  
  1355. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  1356.       CALL GETFEN (30,6,11,VSEG,IOS)
  1357.  
  1358. C HINWEISTEXT FÜR FARBTRANSFORMATION SCHREIBEN
  1359.       CALL AWRI ('ATTRIB erzeugt aus einem normalen Farbattribut',
  1360.      -46,11,18,COL)
  1361.       CALL AWRI ('je ein inverses, intensives, blinkendes und',
  1362.      -43,12,19,COL)
  1363.       CALL AWRI ('intensivinverses Farbattribut!',30,13,26,COL)
  1364.  
  1365. C ATTRIBUTE ERZEUGEN UND DEMONSTRIEREN
  1366.       IN=71
  1367.       CALL ATTRIB (IN,IV,IT,IB,II)
  1368.       CALL AWRI (' normal ',8,16,17,IN)
  1369.       CALL AWRI ('inverse ',8,16,27,IV)
  1370.       CALL AWRI ('intensiv',8,16,37,IT)
  1371.       CALL AWRI ('blinkend',8,16,47,IB)
  1372.       CALL AWRI ('int/inv.',8,16,57,II)
  1373.       CALL PAUS (6)
  1374.  
  1375. C HINWEISTEXT FÜR ADRESSTRANSFORMATION SCHREIBEN
  1376.       CALL LOES (6,55,11,14,32,COL,0)
  1377.       CALL AWRI ('ADRESS wandelt eine Maschinenadresse aus der',
  1378.      -44,11,19,COL)
  1379.       CALL AWRI ('LOC()-Funktion in Segment und Offset um:',
  1380.      -40,12,21,COL)
  1381.  
  1382. C ADRESSE TRANSFORMIEREN UND ERGEBNISSE SCHREIBEN
  1383.       CALL ADRESS (LOC(COL),IS,IO)
  1384.       CALL AWRI ('Adresse:             Segment:          Offset:',
  1385.      -46,16,14,COL)
  1386.       CALL IWRI (LOC(COL),10,16,23,COL)
  1387.       CALL IWRI (IS,7,16,44,COL)
  1388.       CALL IWRI (IO,7,16,61,COL)
  1389.       CALL PAUS (6)
  1390.  
  1391. C HINWEISTEXT FÜR DATUMSTRANSFORMATION SCHREIBEN
  1392.       CALL LOES (6,55,11,14,32,COL,0)
  1393.       CALL AWRI ('DTRAN kann ein Datum vom Stringformat in ein Integer',
  1394.      -52,11,15,COL)
  1395.       CALL AWRI ('wandeln und umgekehrt!',
  1396.      -22,12,30,COL)
  1397.  
  1398. C DATUM TRANSFORMIEREN UND ERGEBNISSE SCHREIBEN
  1399.       CALL DTRAN (I,'20.01.1990',1)
  1400.       CALL AWRI ('Datum: 20.01.1990  Integeräquivalent:',
  1401.      -37,16,19,COL)
  1402.       CALL IWRI (I,8,16,57,COL)
  1403.       CALL PAUS (6)
  1404.  
  1405. C HINWEISTEXT FÜR ZEITTRANSFORMATION SCHREIBEN
  1406.       CALL LOES (6,55,11,14,32,COL,0)
  1407.       CALL AWRI ('ZTRAN kann eine Zeit vom Stringformat in ein Integer',
  1408.      -52,11,15,COL)
  1409.       CALL AWRI ('wandeln und umgekehrt!',
  1410.      -22,12,30,COL)
  1411.  
  1412. C ZEIT TRANSFORMIEREN UND ERGEBNISSE SCHREIBEN
  1413.       CALL ZTRAN (I,'14.25.00',1)
  1414.       CALL AWRI ('Zeit: 14.25.00  Integeräquivalent:',
  1415.      -34,16,20,COL)
  1416.       CALL IWRI (I,6,16,55,COL)
  1417.       CALL PAUS (6)
  1418.  
  1419. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  1420.       CALL CLOFEN (30,VSEG,0,IOS)
  1421.       END
  1422.  
  1423.  
  1424.       SUBROUTINE ZUSOR (VSEG,COL)
  1425. C DIE SUBROUTINE DEMONSTRIERT ZUFALLZAHLEN UND SORTIERUNGEN
  1426. ************************************************************************
  1427.  
  1428. C VARIABLEN
  1429.       INTEGER COL,IFELD(10),IOS,ME(5),VSEG
  1430. C COL:    FARBATTRIBUT
  1431. C IFELD:  FELD FÜR SORTIERUNG
  1432. C IOS:    ERRORFLAG
  1433. C ME:     FELD FÜR MENÜAUSWAHLEN
  1434. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  1435.       REAL RFELD(10)
  1436. C RFELD:  FELD FÜR SORTIERUNG
  1437.       CHARACTER AFELD(10)*10
  1438. C AFELD:  FELD FÜR SORTIERUNG
  1439.  
  1440. DATEN
  1441.       DATA IFELD /932434,124232,12,34545,98989,-1284,773271,-71232,
  1442.      -23245,-45627/
  1443.       DATA RFELD /932.34,124.32,12.0,434.54,989.9,-14.,73.71,-21.32,
  1444.      -33.5,-56.7/
  1445.       DATA AFELD /'eins','zwei','drei','vier','fünf','sechs','sieben',
  1446.      -'acht','neun','zehn'/
  1447.  
  1448. C HINWEISFENSTER GENERIEREN (BILDSCHIRMFENSTER NR. 9)
  1449.       CALL GETFEN (11,10,26,VSEG,IOS)
  1450.     1 CALL ME1FEN (11,5,1,ME,VSEG,82,IOS)
  1451.  
  1452. C UNTERPROGRAMM VERLASSEN
  1453.       IF (ME(5) .GT. 0) RETURN
  1454.  
  1455. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  1456.       CALL GETFEN (30,6,11,VSEG,IOS)
  1457.  
  1458. C ZUFALLZAHLEN ERZEUGEN
  1459.       IF (ME(1) .GT. 0) THEN
  1460.          CALL AWRI ('ZUFALL erzeugt zufällige Zahlen im Integerformat!',
  1461.      -   49,9,16,COL)
  1462.          DO 2 I=1,10
  1463.             CALL ZUFALL (J,0,100000)
  1464.             IF (I .LT. 6) THEN
  1465.                CALL IWRI (J,6,13,14+I*8,COL)
  1466.             ELSE
  1467.                CALL IWRI (J,6,15,14+(I-5)*8,COL)
  1468.             ENDIF
  1469.     2    CONTINUE
  1470.          CALL PAUS (6)
  1471.  
  1472. C INTEGER SORTIEREN
  1473.       ELSEIF (ME(2) .GT. 0) THEN
  1474.          CALL AWRI ('ISORT sortiert Integers fallend oder steigend!',
  1475.      -   46,9,18,COL)
  1476.          CALL ISORT (10,IFELD,0)
  1477.          DO 3 I=1,10
  1478.             IF (I .LT. 6) THEN
  1479.                CALL IWRI (IFELD(I),6,13,14+I*8,COL)
  1480.             ELSE
  1481.                CALL IWRI (IFELD(I),6,15,14+(I-5)*8,COL)
  1482.             ENDIF
  1483.     3    CONTINUE
  1484.          CALL PAUS (6)
  1485.  
  1486. C REALS SORTIEREN
  1487.       ELSEIF (ME(3) .GT. 0) THEN
  1488.          CALL AWRI ('RSORT sortiert Reals fallend oder steigend!',
  1489.      -   43,9,19,COL)
  1490.          CALL RSORT (10,RFELD,0)
  1491.          DO 4 I=1,10
  1492.             IF (I .LT. 6) THEN
  1493.                CALL RWRI (RFELD(I),6.2,13,14+I*8,COL)
  1494.             ELSE
  1495.                CALL RWRI (RFELD(I),6.2,15,14+(I-5)*8,COL)
  1496.             ENDIF
  1497.     4    CONTINUE
  1498.          CALL PAUS (6)
  1499.  
  1500. C STRINGS SORTIEREN
  1501.       ELSEIF (ME(4) .GT. 0) THEN
  1502.          CALL AWRI ('ASORT sortiert Teste fallend oder steigend!',
  1503.      -   43,9,19,COL)
  1504.          CALL ASORT (10,AFELD,0)
  1505.          DO 5 I=1,10
  1506.             IF (I .LT. 6) THEN
  1507.                CALL AWRI (AFELD(I),6,13,15+I*8,COL)
  1508.             ELSE
  1509.                CALL AWRI (AFELD(I),6,15,15+(I-5)*8,COL)
  1510.             ENDIF
  1511.     5    CONTINUE
  1512.          CALL PAUS (6)
  1513.       ENDIF
  1514.  
  1515. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  1516.       CALL CLOFEN (30,VSEG,0,IOS)
  1517.       GOTO 1
  1518.       END
  1519.  
  1520.  
  1521.       SUBROUTINE STRIMA (VSEG,COL)
  1522. C DIE SUBROUTINE DEMONSTRIERT STRINGMANIPULATIONEN
  1523. ************************************************************************
  1524.  
  1525. C VARIABLEN
  1526.       INTEGER COL,IOS,VSEG
  1527. C COL:    FARBATTRIBUT
  1528. C IOS:    ERRORFLAG
  1529. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  1530.       CHARACTER TEXT1*50,TEXT2*50
  1531. C TEXT1:  ORIGINALTEXT FÜR DEMONSTRATIONEN
  1532. C TEXT2:  DURCH DEMONSTRATION VERÄNDERTER TEXT
  1533.  
  1534. C DATEN
  1535.       DATA TEXT1 /'Oben steht der Originaltext, unten die Abänderung!'/
  1536.  
  1537. C HINWEISFENSTER GENERIEREN (BILDSCHIRMFENSTER NR. 12)
  1538.       CALL PRIFEN (12,30,VSEG,0,IOS)
  1539.       CALL GETFEN (30,15,13,VSEG,IOS)
  1540.       CALL PAUS (8)
  1541.       CALL PRIFEN (12,30,VSEG,0,IOS)
  1542.  
  1543. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  1544.       CALL GETFEN (30,6,11,VSEG,IOS)
  1545.  
  1546. C HINWEISTEXT FÜR "CHANGE" SCHREIBEN
  1547.       CALL AWRI ('CHANGE wechselt den String "Original" gegen den',
  1548.      -47,9,18,COL)
  1549.       CALL AWRI ('String "Ur" aus!',16,10,33,COL)
  1550.  
  1551. C ORIGINALTEXT UND GEÄNDERTEN TEXT SCHREIBEN
  1552.       CALL AWRI (TEXT1,50,15,16,71)
  1553.       CALL CHANGE (TEXT1,'Original',TEXT2,'Ur')
  1554.       CALL AWRI (TEXT2,50,17,16,71)
  1555.       CALL PAUS (6)
  1556.  
  1557. C HINWEISTEXT FÜR "CHAWAL" SCHREIBEN
  1558.       CALL LOES (9,55,9,14,32,COL,0)
  1559.       CALL AWRI ('CHAWAL wechselt das Zeichen "e" gegen',
  1560.      -37,9,23,COL)
  1561.       CALL AWRI ('das Zeichen "$" aus!',20,10,31,COL)
  1562.  
  1563. C ORIGINALTEXT UND GEÄNDERTEN TEXT SCHREIBEN
  1564.       CALL AWRI (TEXT1,50,15,16,71)
  1565.       CALL CHAWAL (TEXT1,'e',TEXT2,'$')
  1566.       CALL AWRI (TEXT2,50,17,16,71)
  1567.       CALL PAUS (6)
  1568.  
  1569. C HINWEISTEXT FÜR "CHAZEI" SCHREIBEN
  1570.       CALL LOES (9,55,9,14,32,COL,0)
  1571.       CALL AWRI ('CHAZEI wechselt alle Zeichen, die lexikaligraphisch',
  1572.      -51,9,15,COL)
  1573.       CALL AWRI ('kleiner als m und größer als d sind, gegen % aus!',
  1574.      -49,10,16,COL)
  1575.  
  1576. C ORIGINALTEXT UND GEÄNDERTEN TEXT SCHREIBEN
  1577.       CALL AWRI (TEXT1,50,15,16,71)
  1578.       CALL CHAZEI (TEXT1,'e','m',TEXT2,'%')
  1579.       CALL AWRI (TEXT2,50,17,16,71)
  1580.       CALL PAUS (6)
  1581.  
  1582. C HINWEISTEXT FÜR "DEHN" SCHREIBEN
  1583.       CALL LOES (9,55,9,14,32,COL,0)
  1584.       CALL AWRI ('DEHN vervielfacht Leerzeichen solange, bis eine',
  1585.      -47,9,17,COL)
  1586.       CALL AWRI ('Stringlänge von 50 Characters erreicht ist!',
  1587.      -43,10,19,COL)
  1588.  
  1589. C ORIGINALTEXT UND GEÄNDERTEN TEXT SCHREIBEN
  1590.       TEXT2='Das ist ein auf 50 Zeichen zu dehnender Text'
  1591.       CALL AWRI (TEXT2,50,15,16,71)
  1592.       CALL DEHN (TEXT2,TEXT2,50)
  1593.       CALL AWRI (TEXT2,50,17,16,71)
  1594.       CALL PAUS (6)
  1595.  
  1596. C HINWEISTEXT FÜR "DELETE" SCHREIBEN
  1597.       CALL LOES (9,55,9,14,32,COL,0)
  1598.       CALL AWRI ('DELETE entfernt alle Zeichenketten "er"',39,9,21,COL)
  1599.       CALL AWRI ('aus dem Originaltext!',21,10,30,COL)
  1600.  
  1601. C ORIGINALTEXT UND GEÄNDERTEN TEXT SCHREIBEN
  1602.       CALL AWRI (TEXT1,50,15,16,71)
  1603.       CALL DELETE (TEXT1,TEXT2,'er')
  1604.       CALL AWRI (TEXT2,50,17,16,71)
  1605.       CALL PAUS (6)
  1606.  
  1607. C HINWEISTEXT FÜR "FUEG" SCHREIBEN
  1608.       CALL LOES (9,55,9,14,32,COL,0)
  1609.       CALL AWRI ('FUEG fügt eine Zeichenkette an einer vorgegebenen',
  1610.      -49,9,16,COL)
  1611.       CALL AWRI ('Position im Text ein!',21,10,30,COL)
  1612.  
  1613. C ORIGINALTEXT UND GEÄNDERTEN TEXT SCHREIBEN
  1614.       TEXT2='In diesen Text wird eingefügt!'
  1615.       CALL AWRI (TEXT2,50,15,16,71)
  1616.       CALL FUEG (TEXT2,'ein String ',TEXT2,20)
  1617.       CALL AWRI (TEXT2,50,17,16,71)
  1618.       CALL PAUS (6)
  1619.  
  1620. C HINWEISTEXT FÜR "GETWOR" SCHREIBEN
  1621.       CALL LOES (9,55,9,14,32,COL,0)
  1622.       CALL AWRI ('GETWOR ermittelt das vierte Wort im Text!',
  1623.      -41,9,20,COL)
  1624.  
  1625. C ORIGINALTEXT UND GEÄNDERTEN TEXT SCHREIBEN
  1626.       CALL AWRI (TEXT1,50,15,16,71)
  1627.       CALL GETWOR (TEXT1,4,TEXT2)
  1628.       CALL AWRI (TEXT2,50,17,16,71)
  1629.       CALL PAUS (6)
  1630.  
  1631. C HINWEISTEXT FÜR "LAENGE" SCHREIBEN
  1632.       CALL LOES (9,55,9,14,32,COL,0)
  1633.       CALL AWRI ('LAENGE ermittelt die Stringlänge eines Textes!',
  1634.      -46,9,18,COL)
  1635.  
  1636. C ORIGINALTEXT UND STRINGLÄNGE SCHREIBEN
  1637.       CALL AWRI (TEXT1,50,15,16,71)
  1638.       CALL LAENGE (TEXT1,I)
  1639.       CALL AWRI ('Der Text ist    Characters lang!',32,17,25,71)
  1640.       CALL IWRI (I,2,17,38,71)
  1641.       CALL PAUS (6)
  1642.  
  1643. C HINWEISTEXT FÜR "POSIT" SCHREIBEN
  1644.       CALL LOES (9,55,9,14,32,COL,0)
  1645.       CALL AWRI ('POSIT ermittelt die Position des Strings "Ab"!',
  1646.      -45,9,18,COL)
  1647.  
  1648. C ORIGINALTEXT UND POSITION SCHREIBEN
  1649.       CALL AWRI (TEXT1,50,15,16,71)
  1650.       CALL POSIT (TEXT1,I,'Ab',0)
  1651.       CALL AWRI ('Der String beginnt in Position   !',34,17,24,71)
  1652.       CALL IWRI (I,2,17,55,71)
  1653.       CALL PAUS (6)
  1654.  
  1655. C HINWEISTEXT FÜR "UPCASE" SCHREIBEN
  1656.       CALL LOES (9,55,9,14,32,COL,0)
  1657.       CALL AWRI ('UPCASE wechselt alle Kleinbuchstaben gegen',
  1658.      -42,9,20,COL)
  1659.       CALL AWRI ('Großbuchstaben aus!',19,10,31,COL)
  1660.  
  1661. C ORIGINALTEXT UND GEÄNDERTEN TEXT SCHREIBEN
  1662.       CALL AWRI (TEXT1,50,15,16,71)
  1663.       CALL UPCASE (TEXT1,TEXT2)
  1664.       CALL AWRI (TEXT2,50,17,16,71)
  1665.       CALL PAUS (6)
  1666.  
  1667. C HINWEISTEXT ÜBER WEITERE ROUTINEN SCHREIBEN
  1668.       CALL LOES (9,55,9,14,32,COL,0)
  1669.       CALL AWRI ('Es sind weitere Subroutinen zu',30,9,26,COL)
  1670.       CALL AWRI ('diesem Thema in FORSUB.LIB vorhanden,',37,10,22,COL)
  1671.       CALL AWRI ('die am Bildschirm nicht',23,11,29,COL)
  1672.       CALL AWRI ('demonstriert werden können!',27,12,27,COL)
  1673.       CALL AWRI ('Die Möglichkeiten der hier in',29,14,26,COL)
  1674.       CALL AWRI ('Kurzform vorgestellten Routinen',31,15,25,COL)
  1675.       CALL AWRI ('sind weitaus größer!',20,16,31,COL)
  1676.       CALL PAUS (6)
  1677.  
  1678. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  1679.       CALL CLOFEN (30,VSEG,0,IOS)
  1680.       END
  1681.  
  1682.  
  1683.       SUBROUTINE DATVER (VSEG,COL)
  1684. C DIE SUBROUTINE DEMONSTRIERT DATEI- LAUFWERKS- UND VERZEICHNISROUTINEN
  1685. ************************************************************************
  1686.  
  1687. C VARIABLEN
  1688.       INTEGER COL,IOS,VSEG
  1689. C COL:    FARBATTRIBUT
  1690. C IOS:    ERRORFLAG
  1691. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  1692.       CHARACTER ATTR*6,DATEI(6)*12,DATEI1(6)*50,DATUM*10,LW,LWKE*20,
  1693.      -NAME*12,VERZ*64,ZEIT*8
  1694. C ATTR:   DATEIATTRIBUTE
  1695. C DATEI:  DATEINAMEN OHNE PFAD
  1696. C DATEI1: DATEINAMEN MIT PFAD
  1697. C DATUM:  DATEIDATUM
  1698. C LW:     AKTUELLES LAUFWERK
  1699. C LWKE:   ALLE LAUFWERKE
  1700. C NAME:   DATEINAME
  1701. C VERZ:   VERZEICHNIS
  1702. C ZEIT:   DATEIZEIT
  1703.  
  1704. C HINWEISFENSTER GENERIEREN (BILDSCHIRMFENSTER NR. 13)
  1705.       CALL PRIFEN (13,30,VSEG,0,IOS)
  1706.       CALL GETFEN (30,15,35,VSEG,IOS)
  1707.       CALL PAUS (8)
  1708.       CALL PRIFEN (13,30,VSEG,0,IOS)
  1709.  
  1710. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  1711.       CALL GETFEN (30,6,11,VSEG,IOS)
  1712.  
  1713. C HINWEISTEXT FÜR "LAUFD" SCHREIBEN
  1714.       CALL AWRI ('LAUFD ermittelt das aktuelle Laufwerk!',38,9,22,COL)
  1715.  
  1716. C AKTUELLES LAUFWERK ERMITTELN
  1717.       CALL AWRI ('Das aktuelle Laufwerk ist  :',28,15,27,COL)
  1718.       CALL LAUFD (LW)
  1719.       CALL AWRI (LW,1,15,53,71)
  1720.       CALL PAUS (6)
  1721.  
  1722. C HINWEISTEXT FÜR "LAUFW" SCHREIBEN
  1723.       CALL LOES (9,55,9,14,32,COL,0)
  1724.       CALL AWRI ('LAUFW ermittelt alle physikalischen, logischen,',
  1725.      -47,9,17,COL)
  1726.       CALL AWRI ('und substituierten Laufwerke im System!',39,10,21,COL)
  1727.  
  1728. C ALLE LAUFWERKE ERMITTELN
  1729.       CALL AWRI ('Diese Laufwerke sind im System vorhanden:',
  1730.      -41,15,20,COL)
  1731.       CALL LAUFW (LWKE,I)
  1732.       CALL AWRI (LWKE,I,16,(80-I)/2+1,71)
  1733.       CALL PAUS (6)
  1734.  
  1735. C HINWEISTEXT FÜR "LAUFK" SCHREIBEN
  1736.       CALL LOES (9,55,9,14,32,COL,0)
  1737.       CALL AWRI ('LAUFK ermittelt den Typ eines Laufwerks!',40,9,21,COL)
  1738.  
  1739. C ALLE LAUFWERKTYPEN ERMITTELN
  1740.       DO 1 J=1,MIN(I,6)
  1741.          CALL LAUFK (LWKE(J:J),K)
  1742.          IF (K .EQ. 0) THEN
  1743.             CALL AWRI ('Laufwerk '//LWKE(J:J)//': Festplatte oder '//
  1744.      -      'RAM-Disk!',37,12+J,22,COL)
  1745.          ELSEIF (K .EQ. 1) THEN
  1746.             CALL AWRI ('Laufwerk '//LWKE(J:J)//': Diskettenlaufwerk!',
  1747.      -      30,12+J,22,COL)
  1748.          ELSEIF (K .EQ. 2) THEN
  1749.             CALL AWRI ('Laufwerk '//LWKE(J:J)//': Serverlaufwerk!',
  1750.      -      27,12+J,22,COL)
  1751.          ELSE
  1752.             CALL AWRI ('Laufwerk '//LWKE(J:J)//': ungültiges Laufwerk!',
  1753.      -      32,12+J,22,COL)
  1754.          ENDIF
  1755.     1 CONTINUE
  1756.       CALL PAUS (6)
  1757.  
  1758. C HINWEISTEXT FÜR "GETVER" SCHREIBEN
  1759.       CALL LOES (9,55,9,14,32,COL,0)
  1760.       CALL AWRI ('GETVER ermittelt das aktuelle Verzeichnis!',
  1761.      -42,9,20,COL)
  1762.  
  1763. C AKTUELLES VERZEICHNIS ERMITTELN
  1764.       CALL AWRI ('Das aktuelle Verzeichnis ist:',29,15,26,COL)
  1765.       CALL GETVER (VERZ,I)
  1766.       CALL LAENGE (VERZ,I)
  1767.       IF (I .EQ. 0) THEN
  1768.          VERZ='\'
  1769.          I=1
  1770.       ENDIF
  1771.       CALL AWRI (VERZ,I,16,(80-I)/2+1,71)
  1772.       CALL PAUS (6)
  1773.  
  1774. C HINWEISTEXT FÜR "DSUCH" SCHREIBEN
  1775.       CALL LOES (9,55,9,14,32,COL,0)
  1776.       CALL AWRI ('DSUCH findet eine oder mehrere Dateien',38,9,22,COL)
  1777.       CALL AWRI ('oder Unterverzeichnisse in einem Verzeichnis!',
  1778.      -45,10,18,COL)
  1779.  
  1780. C DATEIEN *.* IM AKTUELLEN VERZEICHNIS FINDEN
  1781.       K=6
  1782.       CALL DSUCH ('*.*'//CHAR(0),127,K,DATEI)
  1783.       DO 2 J=1,K
  1784.          CALL LAENGE (DATEI(J),I)
  1785.          CALL AWRI (DATEI(J),I,12+J,35,71)
  1786.     2 CONTINUE
  1787.       CALL PAUS (8)
  1788.  
  1789. C HINWEISTEXT FÜR "DFIND" SCHREIBEN
  1790.       CALL LOES (9,55,9,14,32,COL,0)
  1791.       CALL AWRI ('DFIND findet eine oder mehrere Dateien',38,9,22,COL)
  1792.       CALL AWRI ('"*.COM" im gesamten System!',27,10,27,COL)
  1793.  
  1794. C DATEIEN *.COM IM GESAMTEN SYSTEM FINDEN
  1795.       I=6
  1796.       CALL DFIND ('*.COM'//CHAR(0),I,DATEI1)
  1797.       DO 3 J=1,I
  1798.          CALL LAENGE (DATEI1(J),K)
  1799.          CALL AWRI (DATEI1(J),K,12+J,(80-K)/2+1,71)
  1800.     3 CONTINUE
  1801.       CALL PAUS (8)
  1802.  
  1803. C HINWEISTEXT FÜR "DINFO" SCHREIBEN
  1804.       CALL LOES (9,55,9,14,32,COL,0)
  1805.       CALL AWRI ('DINFO liefert Dateiinformationen!',33,9,24,COL)
  1806.  
  1807. C DATEIINFORMATIONEN ERMITTELN
  1808.       DO 4 J=1,I
  1809.          CALL LAENGE (DATEI1(J),K)
  1810.          CALL DINFO (DATEI1(J)(1:K)//CHAR(0),NAME,ATTR,IDAT,IZEIT,IGRO)
  1811.          CALL DTRAN (IDAT,DATUM,0)
  1812.          CALL ZTRAN (IZEIT,ZEIT,0)
  1813.          CALL AWRI (ATTR//' '//DATUM//' '//ZEIT//'        '//NAME,
  1814.      -   46,12+J,18,71)
  1815.          CALL IWRI (IGRO,6,12+J,45,71)
  1816.     4 CONTINUE
  1817.       CALL PAUS (10)
  1818.  
  1819. C HINWEISTEXT ÜBER WEITERE ROUTINEN SCHREIBEN
  1820.       CALL LOES (10,55,9,14,32,COL,0)
  1821.       CALL AWRI ('Es sind weitere Subroutinen zu',30,9,26,COL)
  1822.       CALL AWRI ('diesem Thema in FORSUB.LIB vorhanden,',37,10,22,COL)
  1823.       CALL AWRI ('die am Bildschirm nicht',23,11,29,COL)
  1824.       CALL AWRI ('demonstriert werden können!',27,12,27,COL)
  1825.       CALL PAUS (6)
  1826.  
  1827. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  1828.       CALL CLOFEN (30,VSEG,0,IOS)
  1829.       END
  1830.  
  1831.  
  1832.       SUBROUTINE PEKPOK (VSEG)
  1833. C DIE SUBROUTINE SCHREIBT EINEN HINWEISTEXT ÜBER LESE- UND SCHREIB-
  1834. C OPERATIONEN VON UND ZU MASCHINENADRESSEN
  1835. ************************************************************************
  1836.  
  1837. C VARIABLEN
  1838.       INTEGER IOS,VSEG
  1839. C IOS:    ERRORFLAG
  1840. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  1841.  
  1842. C HINWEISFENSTER GENERIEREN (BILDSCHIRMFENSTER NR. 14)
  1843.       CALL PRIFEN (14,30,VSEG,0,IOS)
  1844.       CALL GETFEN (30,6,21,VSEG,IOS)
  1845.       CALL TAST (1,1)
  1846.       CALL PRIFEN (14,30,VSEG,0,IOS)
  1847.       END
  1848.  
  1849.  
  1850.       SUBROUTINE VIRSPE (VSEG)
  1851. C DIE SUBROUTINE SCHREIBT EINEN HINWEISTEXT ZUR VIRITUELLEN SPEICHER-
  1852. C VERWALTUNG
  1853. ************************************************************************
  1854.  
  1855. C VARIABLEN
  1856.       INTEGER IOS,VSEG
  1857. C IOS:    ERRORFLAG
  1858. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  1859.  
  1860. C HINWEISFENSTER GENERIEREN (BILDSCHIRMFENSTER NR. 15)
  1861.       CALL PRIFEN (15,30,VSEG,0,IOS)
  1862.       CALL GETFEN (30,7,2,VSEG,IOS)
  1863.       CALL TAST (1,1)
  1864.       CALL PRIFEN (15,30,VSEG,0,IOS)
  1865.       END
  1866.  
  1867.  
  1868.       SUBROUTINE CHIINT (VSEG,COL)
  1869. C DIE SUBROUTINE DEMONSTRIERT EINEN CHILD-PROZESS UND EINEN INTERRUPT-
  1870. C AUFRUF
  1871. ************************************************************************
  1872.  
  1873. C VARIABLEN
  1874.       INTEGER AX,COL,IOS,VSEG
  1875. C AX:     AX-REGISTER FÜR INTERRUPT-AUFRUF
  1876. C COL:    FARBATTRIBUT
  1877. C IOS:    ERRORFLAG
  1878. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  1879.  
  1880. C HINWEISFENSTER GENERIEREN (BILDSCHIRMFENSTER NR. 16)
  1881.       CALL PRIFEN (16,30,VSEG,0,IOS)
  1882.       CALL GETFEN (30,11,21,VSEG,IOS)
  1883.       CALL PAUS (6)
  1884.       CALL PRIFEN (16,30,VSEG,0,IOS)
  1885.  
  1886. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  1887.       CALL GETFEN (30,6,11,VSEG,IOS)
  1888.  
  1889. C HINWEISTEXT FÜR "SYS" SCHREIBEN
  1890.       CALL AWRI ('SYS startet einen Childprozess!',31,9,25,COL)
  1891.       CALL AWRI ('Als Beispiele wurden die DOS-Funktionen',39,11,21,COL)
  1892.       CALL AWRI ('CLS, DIR, ATTRIB und PATH gewählt!',34,13,24,COL)
  1893.       CALL AWRI ('Es können aber auch COM- und',28,15,27,COL)
  1894.       CALL AWRI ('EXE-Programme aktiviert werden!',31,17,25,COL)
  1895.       CALL PAUS (8)
  1896.  
  1897. C HINTERGRUND IN FENSTER 29 ABLEGEN
  1898.       CALL PUTFEN (29,25,80,1,1,VSEG,IOS)
  1899.       IF (IOS .NE. 0) CALL ERRLEV (2)
  1900.  
  1901. C CLS, DIR UND CHKDSK NACHEINANDER AUFRUFEN
  1902.       CALL SYS ('CLS')
  1903.       CALL SYS ('DIR')
  1904.       CALL PAUS (3)
  1905.       WRITE(*,'(///)')
  1906.       CALL SYS ('ATTRIB *.*')
  1907.       CALL PAUS (3)
  1908.       WRITE(*,'(///)')
  1909.       CALL SYS ('PATH')
  1910.       CALL PAUS (6)
  1911.  
  1912. C BILDSCHIRM WIEDERHERSTELLEN
  1913.       CALL GETFEN (29,1,1,VSEG,IOS)
  1914.       CALL FREFEN (29,VSEG,IOS)
  1915.  
  1916. C HINWEISTEXT FÜR "INTER" SCHREIBEN
  1917.       CALL LOES (9,55,9,14,32,COL,0)
  1918.       CALL AWRI ('INTER ermöglicht die Ausführung eines Software-',
  1919.      -47,9,17,COL)
  1920.       CALL AWRI ('Interrupts!',11,10,35,COL)
  1921.       CALL AWRI ('Im Beispiel wird die Funktion 30H des Interrupts 21H',
  1922.      -52,12,15,COL)
  1923.       CALL AWRI ('aufgerufen. Dadurch wird die Nummer der',39,13,21,COL)
  1924.       CALL AWRI ('aktuellen DOS-Version im AX-Register zurückgegeben.',
  1925.      -51,14,15,COL)
  1926.  
  1927. C INTERRUPT AUFRUFEN
  1928.       AX=#3000
  1929.       CALL INTER (#21,AX,0,0,0,0,0,0,0,0,0)
  1930.  
  1931. C ERGEBNIS AUF DEN BILDSCHIRM SCHREIBEN
  1932.       CALL AWRI ('Die DOS-Version hat die Nummer     !',36,16,23,COL)
  1933.       CALL IWRI (IAND(AX,2#11111111),1,16,54,71)
  1934.       CALL AWRI ('.',1,16,55,71)
  1935.       CALL IWRI (ISHFT(AX,-8),2,16,56,71)
  1936.       CALL PAUS (7)
  1937.  
  1938. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  1939.       CALL CLOFEN (30,VSEG,0,IOS)
  1940.       END
  1941.  
  1942.  
  1943.       SUBROUTINE VERSCH (VSEG,COL)
  1944. C DIE SUBROUTINE DEMONSTRIERT DATEI- LAUFWERKS- UND VERZEICHNISROUTINEN
  1945. ************************************************************************
  1946.  
  1947. C VARIABLEN UND DATEN
  1948.       INTEGER COL,IOS,VSEG
  1949. C COL:    FARBATTRIBUT
  1950. C IOS:    ERRORFLAG
  1951. C VSEG:   ADRESSE DER BILDSCHIRMFENSTERVERWALTUNG IN DER MEMORY
  1952.       CHARACTER BILDS(2)*10,TAG(7)*10
  1953. C BILDS:  FELD MIT ART DES VERW. BILDSCHIRMS
  1954. C TAG:    FELD MIT WOCHENTAGEN
  1955.       DATA BILDS /'Monochrome','Farb      '/
  1956.       DATA TAG /'Montag    ','Dienstag  ','Mittwoch  ','Donnerstag',
  1957.      -          'Freitag   ','Samstag   ','Sonntag   '/
  1958. C HINWEISFENSTER GENERIEREN (BILDSCHIRMFENSTER NR. 17)
  1959.       CALL PRIFEN (17,30,VSEG,0,IOS)
  1960.       CALL GETFEN (30,4,4,VSEG,IOS)
  1961.       CALL PAUS (8)
  1962.       CALL PRIFEN (17,30,VSEG,0,IOS)
  1963.  
  1964. C AKTIONSFENSTER ÖFFNEN (BILDSCHIRMFENSTER NR. 30)
  1965.       CALL GETFEN (30,6,11,VSEG,IOS)
  1966.  
  1967. C CURSOR EINSCHALTEN
  1968.       CALL CTYP (1,1)
  1969.  
  1970. C HINWEISTEXT FÜR "CPOS" SCHREIBEN
  1971.       CALL AWRI ('CPOS positioniert den Cursor!',29,9,26,COL)
  1972.  
  1973. C CURSOR MEHRMALS POSITIONIEREN
  1974.       DO 1 I=1,5
  1975.          CALL CPOS (10+I,10+I*10)
  1976.          CALL PAUS (2)
  1977.     1 CONTINUE
  1978.  
  1979. C HINWEISTEXT FÜR "CTYP" SCHREIBEN
  1980.       CALL LOES (1,55,9,14,32,COL,0)
  1981.       CALL AWRI ('CTYP verändert das Aussehen des Cursors!',40,9,21,COL)
  1982.  
  1983. C CURSOR MEHRMALS VERÄNDERN
  1984.       CALL CPOS (14,41)
  1985.       DO 2 I=1,5
  1986.          CALL CTYP (0,2*I-1)
  1987.          CALL PAUS (2)
  1988.     2 CONTINUE
  1989.  
  1990. C CURSOR WIEDER AUSSCHALTEN
  1991.       CALL CTYP (0,0)
  1992.  
  1993. C HINWEISTEXT FÜR "CONTCA" SCHREIBEN
  1994.       CALL LOES (1,55,9,14,32,COL,0)
  1995.       CALL AWRI ('CONTCA verhindert den Programmabbruch mit CONTROL-C!',
  1996.      -52,9,15,COL)
  1997.       CALL AWRI ('Versuchen Sie es zehn Sekunden lang!',36,11,23,COL)
  1998.  
  1999. C "CONTROL-C" ABSCHALTEN UND ERST NACH 10 SEKUNDEN WIEDER ZULASSEN
  2000.       CALL CONTCA ()
  2001.       CALL PAUS (10)
  2002.       CALL PIEPS (880,0.3)
  2003.       CALL CTBUF ()
  2004.       CALL CONTCE ()
  2005.  
  2006. C HINWEISTEXT FÜR "CONTCE" SCHREIBEN
  2007.       CALL AWRI ('CONTCE hat die CONTROL-C-Routine wieder '//
  2008.      -'eingeschaltet!',54,15,14,COL)
  2009.       CALL PAUS (6)
  2010.  
  2011. C HINWEISTEXT FÜR "DRUST" SCHREIBEN
  2012.       CALL LOES (9,55,9,14,32,COL,0)
  2013.       CALL AWRI ('DRUST kontrolliert die Betriebsbereitschaft',
  2014.      -43,9,19,COL)
  2015.       CALL AWRI ('eines Druckers an LPT1!',23,11,29,COL)
  2016.  
  2017. C DRUCKER KONTROLLIEREN UND MITTEILUNG SCHREIBEN
  2018.       I=1
  2019.       CALL DRUST (I)
  2020.       IF (I .EQ. 0) THEN
  2021.          CALL AWRI ('Drucker nicht betriebsbereit!',29,15,26,COL)
  2022.       ELSE
  2023.          CALL AWRI ('Drucker ist betriebsbereit!',27,15,27,COL)
  2024.       ENDIF
  2025.       CALL PAUS (8)
  2026.  
  2027. C HINWEISTEXT FÜR "GETDAY" SCHREIBEN
  2028.       CALL LOES (9,55,9,14,32,COL,0)
  2029.       CALL AWRI ('GETDAY ermittelt den aktuellen Wochentag!',
  2030.      -41,9,20,COL)
  2031.  
  2032. C AKTUELLEN WOCHENTAG ERMITTELN
  2033.       CALL GETDAY (ITAG)
  2034.       CALL LAENGE (TAG(ITAG),I)
  2035.       CALL AWRI ('Heute ist '//TAG(ITAG)(1:I),10+I,15,(70-I)/2+1,COL)
  2036.       CALL PAUS (8)
  2037.  
  2038. C HINWEISTEXT FÜR "SCPRF" SCHREIBEN
  2039.       CALL LOES (9,55,9,14,32,COL,0)
  2040.       CALL AWRI ('SCPRF ermittelt den verwendeten Monitortyp!',
  2041.      -43,9,19,COL)
  2042.  
  2043. C BILDSCHIRMTYP ERMITTELN
  2044.       CALL SCPRF (I)
  2045.       IF (I .EQ. #B000) THEN
  2046.          J=1
  2047.       ELSE
  2048.          J=2
  2049.       ENDIF
  2050.       CALL LAENGE (BILDS(J),I)
  2051.       CALL AWRI ('Sie verwenden einen '//BILDS(J)(1:I)//'-Bildschirm!',
  2052.      -32+I,15,(48-I)/2+1,COL)
  2053.       CALL PAUS (8)
  2054.  
  2055. C HINWEISTEXT ÜBER WEITERE ROUTINEN SCHREIBEN
  2056.       CALL LOES (10,55,9,14,32,COL,0)
  2057.       CALL AWRI ('Es sind weitere Subroutinen zu',30,9,26,COL)
  2058.       CALL AWRI ('diesem Thema in FORSUB.LIB vorhanden,',37,10,22,COL)
  2059.       CALL AWRI ('die am Bildschirm nicht',23,11,29,COL)
  2060.       CALL AWRI ('demonstriert werden können!',27,12,27,COL)
  2061.       CALL PAUS (6)
  2062.  
  2063. C AKTIONSFENSTER SCHLIEßEN (BILDSCHIRMFENSTER NR. 30)
  2064.       CALL CLOFEN (30,VSEG,0,IOS)
  2065.       END
  2066.  
  2067.