UNIT schrift;
INTERFACE
uses crt,dos;
PROCEDURE text_links(x,y,v:INTEGER;text:STRING);
{ x=spalte und y=zeile des Textes, v=Verz”gerung, 1000= ca. 1 Sekunde }
PROCEDURE text_rechts(x,y,v:INTEGER;text:STRING);
PROCEDURE lauf_schrift(x,y,z,v:INTEGER;text:STRING);
{ x=anfangsspalte,y=zeile,z=endspalte des Textes, v=Verz”gerung;
PROCEDURE text_mitte(x,y,v:INTEGER;text:STRING);
PROCEDURE doppel_schrift(x,y,z,v:INTEGER;
text1:STRING;x1,y1,v1:INTEGER;text2:STRING);
PROCEDURE kreis_text(f:byte;text:string); { Text in Kreisform ausgeben }
{ f=Farbe }
PROCEDURE c_hide; { Cursoranzeige abschalten }
PROCEDURE c_show; { Cursor wieder anzeigen }
PROCEDURE musik;  { Ein Musikstck zum ausprobieren }
PROCEDURE beben;  { Bildschirm l”schen }

IMPLEMENTATION
CONST
     x = 39;
     y = 12;
VAR
     winkel,x_anf,y_anf,ra,i:integer;
     regs:registers;alt_a,alt_e:byte;
     laenge,halb:INTEGER;
PROCEDURE musik;
{ Ein kleines Musikstck zum ausprobieren }
TYPE nwert  = array[1..33] of integer;
     ndauer = array[1..33] of integer;
CONST
     note : nwert  = (293,349,392,440,293,349,392,440,293,349,392,
                      440,329,293,349,329,349,349,329,293,293,349,
                      440,440,392,349,329,349,
                      440,329,293,329,293);
     zeit : ndauer =  (250,250,250,1250,250,250,250,1250,250,250,250,
                       500,500,500,500,1250,250,250,250,750,250,
                       500,500,250,1000,250,250,250,500,500,500,
                       500,1250);
VAR
   hoehe,laenge : integer;
 BEGIN
   for hoehe := 1 to 33 do
     begin
       sound(note[hoehe]);
       delay(zeit[hoehe]);
     end;
     nosound;
END;

PROCEDURE beben;
VAR
 a:INTEGER;
BEGIN
 FOR a:=1 TO 25 DO
   begin
    GOTOXY(1,1);
    DELLINE;
    DELAY(20);
    INSLINE;
    DELAY(20);
    INSLINE;
    DELAY(20);
    DELLINE;
    DELAY(20);
    END;
    FOR a:=1 TO 25 DO
      INSLINE;
END;

PROCEDURE c_def;       { Cursordaten speichern }
begin
     regs.ah:=$03;regs.bh:=$0;intr($10,regs);
     alt_a:=regs.ch;alt_e:=regs.cl;
end;

PROCEDURE c_hide;      { Cursor l”schen }
begin
     regs.ah:=$01;regs.ch:=73;regs.cl:=70;intr($10,regs);
end;

PROCEDURE c_show;      { Cursor wieder setzen }
begin
     regs.ah:=$01;regs.ch:=alt_a;regs.cl:=alt_e;intr($10,regs);
end;

PROCEDURE w_inkel(w:integer);  { Zeilen und Spalten-Koordinaten berechnen }
begin
    x_anf := x + round(cos(w * pi/180)* ra * 2.5);
    y_anf := y - round(sin(w * pi/180)* ra);
end;

PROCEDURE kreis_text(f:byte;text:string); { Text in Kreisform ausgeben }
var
   laenge:integer;
   dif:integer;alt_f:integer;
begin
     winkel:=450;dif:=360 div length(text);
     ra := 10;
     laenge:=length(text);alt_f:=textattr;textcolor(f);
   FOR i:= 1 TO laenge DO
   begin
     w_inkel(winkel);
      gotoxy(x_anf,y_anf);
      write(copy(text, i,1));
      delay(30);
      winkel := winkel - dif;
    end;
    textcolor(alt_f);
end;             { Ende Procedure Kreistext }

PROCEDURE text_links(x,y,v:INTEGER;text:STRING);
{ Text von links nach rechts auf den Bildschirm schreiben }
begin
   laenge:=LENGTH(text);
   FOR i:= 1 TO laenge DO
    begin
     GOTOXY(x,y);
     WRITE(COPY(text,laenge - i + 1,i));
     DELAY(v);
    end;
end;             { Ende Procedure text_links }

PROCEDURE text_rechts(x,y,v:INTEGER;text:STRING);
{ Text von rechts nach links auf den Bildschirm schreiben }
begin
   laenge:=LENGTH(text);
   FOR i:= 1 TO laenge DO
   begin
     GOTOXY(x+laenge-i,y);
     WRITE(COPY(text, 1,i));
     DELAY(v);
    end;
end;             { Ende Procedure text_rechts }

PROCEDURE lauf_schrift(x,y,z,v:INTEGER;text:STRING);
{ Text als Laufschrift anzeigen }
VAR
    ltext:STRING;
    lauf:STRING;
    ende:BOOLEAN;
    ch:CHAR;
begin
    ende:=FALSE;
    ltext:=text;laenge:=LENGTH(text);
    WHILE LENGTH(ltext) < (z-x+laenge) DO
        ltext:=ltext+text;
    REPEAT
     i:=1;
      REPEAT
        GOTOXY(x,y);
        lauf:=COPY(ltext,i,z-x);
        WRITE(lauf);
        DELAY(v);
        INC(i);
        IF KEYPRESSED THEN ende := TRUE;
      UNTIL (i = laenge) OR ende;
    UNTIL ende;
    WHILE KEYPRESSED DO ch:=READKEY;
    ende:=FALSE;
end;

PROCEDURE text_mitte(x,y,v:INTEGER;text:STRING);
{ Text von der Mitte aus nach rechts und links schreiben }
begin
   halb:=1+LENGTH(text) div 2;
   FOR I:= 1 TO halb DO
     begin
      GOTOXY(x+halb - i,y);
      WRITE(COPY(text,1,i));
      GOTOXY(x+halb,y);
      WRITE(COPY(text,halb+halb-i+1,i));
      DELAY(v);
   end;
end;

PROCEDURE doppel_schrift(x,y,z,v:INTEGER;text1:STRING;x1,y1,v1:INTEGER;
text2:STRING);
{Texte als Laufschrift anzeigen von links nach rechts und v. rechts n.links}
VAR
   ltext1,lauf1,ltext2,lauf2:STRING;
   i,j:INTEGER;ch:CHAR;
begin
   ltext1:=text1;ltext2:=text2;
   WHILE LENGTH(ltext1) < (z-x+1+LENGTH(text1)) DO
     ltext1:=ltext1+text1;
   WHILE LENGTH(ltext2) < (v1-x1+1+LENGTH(text2)) DO
     ltext2:=ltext2+text2;
   i:=0;j:=LENGTH(text2)+1;
   REPEAT
     inc(i);
     GOTOXY(x,y);
     WRITE(COPY(ltext1,i,z-x));
     dec(j);
     GOTOXY(x1,y1);
     WRITE(COPY(ltext2,j,v1-x1));
     DELAY(v);
     IF i = LENGTH(text1) THEN i:=0;
     IF j = 0 THEN j:=LENGTH(text2)+1;
   UNTIL KEYPRESSED;
   WHILE KEYPRESSED DO CH := READKEY;
end;

BEGIN
c_def;
END.