PASCAL ruft TOS: Teil 4 - Eingabe & Ausgabe

In diesem Teil werden einige Routinen besprochen, die eigentlich in jedem Programm benötigt werden. Bestimmt hat sich der eine oder andere schon geärgert, wenn ein Programm in einen Tiefschlaf fällt, weil der angesprochene Drucker nicht eingeschaltet war oder wenn das Programm ständig den gleichen Befehl ausführt, nur weil man einmal zu lange auf eine Taste gedrückt hat und jetzt der Tastaturpuffer unerbittlich arbeitet. Diese Ereignisse können jedoch einfach abgefragt und entsprechend behandelt werden. Oft möchte man in einem Programm die Funktionstasten programmieren oder bestimmte Sondertasten und -kombinationen abfragen und Datum und Uhrzeit neu einstellen. Auch hier bieten die nachfolgenden Routinen einfache Lösungen an.

TASTATUR

Der Tastaturpuffer hat eine Größe von 64 Bytes, d. h. er kann bis zu 64 Zeichen speichern. Wenn also während eines Programmablaufs eine Taste zu lange gedrückt wird, dann übernimmt der Rechner (im Extremfall) diesen Tastencode 64-mal in den Puffer. Ab diesem Zeitpunkt wird bei jeder Funktion, die eine Eingabe des Bedieners erwartet, 'eines dieser Zeichen aus dem Puffer genommen. In einem Editor konnte es somit passieren, daß dadurch wesentlich mehr Zeilen als gewünscht gelöscht wurden, ohne daß man etwas dagegen tun konnte. Diesem Zustand soll mit der folgenden Routine abgeholfen werden. Dazu wird mit der Funktion:

function Cconis: integer; GEMDOS($0B);

abgefragt, ob sich noch ein Zeichen im Tastaturpuffer befindet. Falls dies der Fall ist, wird der Wert -1 übergeben, entsprechend der Wert 0, wenn sich kein Zeichen mehr im Puffer befindet.

program PUFFER_LOESCHEN;
var ch: char;
	i: long_integer;

function cconis : boolean; gemdos ($0b); 
function crawcin: char; gemdos ($07);

procedure LOESCHE_PUFFER; 
	var dummy: char; 
	begin
		while cconis=true do dummy:=crawcin; 
	end;

begin
	loop
		{ LOESCHE_PUFFER; nach erstem Durchlauf aktivieren! }
		writeln('Bitte Taste eine Zeit gedrueckt halten!'); 
		read(ch); 
	exit if ((ch='q') or (ch='e'));
		writeln ('************************',ch);
		i:=0;
		repeat
			i:-i+1; { Programmschleife }
		until i >100000 
	end 
end.

Listing 1

program TASTATUR_REPEAT; var a: string;

procedure Bdrate ( verzoeg, wiederhol: integer ); xbios(35); 
begin
	writeln('hohe Wiederholrate:'); 
	bdrate (50,1); readln(a); 
	writeln('niedrige Wiederholrate:' ); 
	bdrate (1,10); readln(a); 
	writeln('normal'); 
	bdrate (10,3); readln(a) 
end.

Listing 2

program CURSOR; 
var ch : char;

procedure Cursor ( funktion, rate: integer); xbios(21) ;
begin

	writeln	('Cursor aus'); cursor(0,0); readln(ch);
	writeln	('Cursor ein'); cursor(1,0); readln(ch);
	writeln	('Dauercursor'); cursor(3,0); readln(ch);
	writeln	('Cursor blinkt'); cursor(2,0); readln(ch);
	writeln ('Cursor langsam'); cursor(4,70); readln(ch);
	writeln ('Cursor schnell'); cursor(4,5); readln(ch);

end.

Listing 3

Um den Puffer zu löschen, wird jeweils ein Zeichen entnommen, und ohne Echo, also nicht auf dem Bildschirm sichtbar, ausgegeben. Dies geschieht mit der Funktion:

function Crawcin: char; GEMDOS($07);

Wenn beide Funktionen in einer Prozedur loesche_puffer zusammengefaßt werden, kann man sie bequem vor jeder Eingabe aufrufen.

Zur Demonstration muß das Programm (Listing 1) zuerst ohne diese Prozedur durchlaufen werden. Dazu wird der Prozeduraufruf einfach als Kommentar geklammert. Wenn jetzt eine Taste längere Zeit gedrückt wird, rotiert das Programm und überspringt die nächsten Eingaben. Wird nun der Prozeduraufruf aktiviert, funktioniert die Eingabe einwandfrei.

Eine andere Möglichkeit, dieses Phänomen zu umgehen, ist die Tastaturwiederholrate hochzusetzen (Listing 2). Dann wird erst nach einem längeren Zeitraum ein weiterer Tastaturdruck registriert und gespeichert:

function Bdrate ( start, repeat ): integer; XBIOS(35);

Der Parameter START bestimmt, wie lange eine Taste gedrückt werden muß, bis die Wiederholung einsetzt. Als Rückgabewert erhält man die zuvor eingestellten Werte, wobei in den Bits 0-7 der Start- und in den Bits 8-15 der Wiederholwert steht. Wenn für START und REPEAT der Wert -1 angegeben wird, liefert BDRATE nur die momentanen Werte.

CURSOR

Blinkt der Cursor nicht oder zu langsam, dann kann das schnell geändert werden:

procedure Cursor( funktion, wert: integer ); XBIOS(21);

Der Parameter WERT ist i. allg. Null; nur bei der Blinkrate hat er eine Bedeutung. Die nachfolgende Tabelle und das Listing 3 zeigen die Möglichkeiten, die sich hier bieten:

program FUNKTIONSTASTEN; 
const keyboard = 2; 
var i: integer;

function bconin( dev: integer ): long_integer; bios(2);

procedure schluss ; gemdos(0);

function scan: integer; 
begin
	scan:=int( bconin( keyboard ) div 65535 ); 
end;

begin
	writeln('Funktionstastenabfrage (F1-F2)');
	writeln('( Ende mit F10 )');
	writeln;
	while true do begin 
		case scan of
			59: writeln('F1');
			60: writeln('F2');
			68: schluss;
			else : writeln( scan ) 
		end; 
	end; 
end.

Listing 4

program SONDERTASTEN; 
var i,j,k : integer;

function kbshift: integer; bios(11);

begin
	repeat
		k:=kbshift; 
		case k of
			1: write('-- SH1FT rechts --');
			2; write('-- SHIFT links --');
			4: write('-- CONTROL --');
			8: write('-- ALTERNATE --');
			16: write('-- CAPS LOCK --');
			10: write('-- CONTROL & SHIFT --'); 
			else: write(k) 
		end; 
	until k=1 
end.

Listing 5

Program OUTPUT_READY; 
const drucker = 0;

function bcostat( dev: integer ): boolean; bios(8); 

begin
	if bcostat(drucker) then begin 
		rewrite (output,'PRN:');
		writeln ('Hallo, ich bin tatsaechlich angeschaltet!'); 
		rewrite (output,'CON:');
	end
	else writeln('Drucker nicht ansprechbar') 
end.

Listing 6

Funktionsnr.	Bedeutung
0	Cursor abschalten
1	Cursor anschalten
2	Cursor blinkt
3	Cursor blinkt nicht
4	Blinkrate
5	Blinkrate wird übergeben

TASTENABFRAGE

Besonders interessant ist bei vielen Programmen die Abfrage der Funktionstasten. Eine einfache Art ist mit:

function Bconin( dev: integer ): long_integer; BIOS(2);

BCONIN wartet auf ein Zeichen von einem Eingabegerät und kehrt erst dann zurück. Der Parameter DEV hat folgende Bedeutung:

0 Centronics Schnittstelle
1 RS232 Schnittstelle
2 Tastatur
3 MIDI Schnittstelle

BCONIN gibt einen entsprechenden Wert zurück, der im Falle einer Tastatureingabe auch den SCAN-Code der gedrückten Taste im Low-Byte des oberen Wortes enthält. Nur dieser Code interessiert für die Abfrage der Funktionstasten, deshalb wird der Rest ausgeblendet. Noch ein Wort zum SCAN-Code: hier werden (fast) alle Tasten des Keyboards einfach durchnummeriert (siehe Grafik 1) und dieser Wert wird an den Rechner übergeben.

Im Beispiel Listing 4 wird beim Drücken der Taste F10 das Programm verlassen. Dies wurde erreicht mit:

procedure Pterm; GEMDOS(O);

Diese Funktion bewirkt einen Rücksprung zum Desktop bzw. zum aufrufenden Programm und stellt deshalb eine gute Abbruchbedingung bei der Funktionstastenprogrammierung dar.

Wie man der SCAN-Code-Tabelle entnehmen kann, existiert dieser nicht für die Tasten CONTROL, SHIFT, ALTERNATE und CAPS LOCK. Diese werden mit einer separaten Funktion abgefragt:

function Kbshift ( mode: integer ): long_integer; BIOS(ll);

Folgende Rückgabewerte sind möglich:

1 rechte SHIFT-Taste
2 linke SHIFT-Taste
4 CONTROL-Taste
8 ALTERNATE-Taste
16 CAPS LOCK-Taste
32 rechte Maustaste oder CLR/HOME
64 linke Maustaste oder INSERT

Die Zwischenwerte entstehen durch Drücken von Tastenkombinationen, also z. B. CONTROL & SHIFT (siehe auch Listing 5).

AUSGABEGERÄTE

Wie schon im Vorspann angesprochen, ist es empfehlenswert den Status des Druckers abzufragen, bevor man etwas ausdruckt. Gegebenenfalls kann dann der Benutzer des Programms zum Einschalten aufgefordert werden. Der Aufruf lautet:

function Bcostat( dev: integer ): integer; BIOS(8);

Dieser Aufruf dient jedoch nicht nur zur Bereitschaftsabfrage des Druckers, sondern auch die anderen Ausgabegeräte können damit überprüft werden. Dazu muß nur der Parameter DEV entsprechend geändert werden:

DEV-Nr.	Schnittstelle
0	Drucker, Centronics
1	RS232
2	Tastatur
3	MIDI
4	Tastatur-Port

Wenn als Wert eine -1 übergeben wird, dann ist das abgefragte Gerät bereit, bei einer Null ist dies nicht der Fall. Da hier nur die Werte 0 und -1 auftreten, liegt es nahe, den Funktionswert nicht als Integer oder Long_Integer zu definieren, sondern als BOOLEAN (siehe Listing 6). Die Abfrage wird dann sehr kurz und elegant.

DATUM & ZEIT

Datum und Uhrzeit können sowohl mit zwei getrennten GEMDOS-Funk-tionen als auch mit einer einzigen XBIOS-Routine gesetzt und verändert werden. Die GEMDOS-Funktionen geben jeweils einen 16-Bit-Wert zurück, die XBIOS-Routine dagegen einen 32-Bit-Wert. Dieser Wert ist wegen seiner Länge etwas unhandlich und soll deshalb hier nicht besprochen werden. Es funktioniert jedoch im Prinzip wie bei den folgenden Programmen (Listing 7 & 8).

Zeit und Datum werden mit den Funktionen:

function Tgettime: integer; GEMDOS($2C);
function Tgetdate: integer; GEMDOS($2A);

erfragt. Sie liegen in der bereits aus Teil 3 bekannten 16-Bit-Form vor, die nun interpretiert werden muß (siehe Listings).

Um Zeit und Datum ändern zu können, müssen sie nach der Eingabe wieder in die 16-Bit-Form gebracht werden. Dazu genügt allerdings ein Einzeiler. Mit dem so erhaltenen Integerwert werden die Funktionen aufgerufen:

procedure Tsettime( time : integer ); GEMDOS(A2D);
procedure Tsetdate( date : integer ); GEMDOS($2B);

Ein nochmaliges Abfragen der Funktionen oder ein Blick ins Kontrollfeld des Desktop zeigt das neu eingestellte Datum bzw. die Uhrzeit an.

Ich hoffe, daß Sie die vorgestellten Routinen in Ihren Programmen verwenden können und Ihnen somit etwas Mühe erspart wird.

mn

program UHRZEIT_Setzen;

procedure GET_ZEIT;

	var zeit,stunden.minuten,sekunden: integer;

	function Tgettime: integer; GEMDOS($2C);

	begin

		zeit:=Tgettime; 
		stunden:=shr(zeit,11);
		minuten:=shr((zeit-shl(stunden,11)),5);
		Sekunden:=(zeit-shl(stunden,11)-shl(minuten,5)); writeln(stunden:2,':',minuten:2,’:',2*sekunden:2); 
	end;

procedure SET_ZEIT;

	var zeit,stunden,minuten,sekunden: integer; 

	procedure Tsettime ( time: integer ); GEMDOS($2d); 
	begin
		writeln('STUNDEN MINUTEN SEKUNDEN getrennt durch <Return> eingeben!); 
		read(stunden,minuten,sekunden);
		zeit:=shl(stunden,11)+shl(minuten,5)+sekunden div 2;
		Tsettime( zeit ); 
	end;

begin

	GET_ZEIT;
	SET_ZEIT;
	GET_ZEIT; 
	readln

end.

program DATUM_Setzen;

procedure GET_DATUM; 
	var datum,tag,monat,jahr: integer;

	function Tgetdate: integer; GEMDOS($2a);

	begin
		datum:=Tgetdate; 
		jahr:=shr(datum,9); 
		monat:=shr((datum-shl(jahr,9)),5); 
		tag:=datum-shl(monat,5)-shl(jahr,9); 
		writeln(tag:2,'.',monat:2,'.',jahr+1980:4); 
	end;

procedure SET_DATUM; 
	var datum,tag.monat,jahr: integer;

	procedure Tsetdate ( date: integer ); GEMDOS($2b); 
	
	begin
		writeln('TAG MONAT JAHR getrennt durch <Return> eingeben! '); 
		read(tag,monat,jahr);
		datum:=shl(jahr—1980,9)+shl(monat,5)+tag;
		Tsetdate( datum ); 
	end;

begin

	GET_DATUM;
	SET_DATUM;
	GET_DATUM;
	readln

end.

---

---