Program egazeichen;
uses crt,dos,windows;
var
     T_alt : array[0..255,0..13] of byte absolute 49152:11776;
     T_neu : array[0..255,0..13] of byte;
     d_neu : array[0..255,0..15] of byte;
     ascii : integer;
     dateiname:string[80];
     ziel:file of byte;
     quelle:file of byte;ok:boolean;
     taste:char;reg:registers;
procedure loeschen;
begin
    While keypressed do
          taste:=readkey;
end;
Procedure initzeichen;
var
    i,ii,iii:integer;
begin
  for i:=0 to 255 do
    for ii:=0 to 13 do
      begin
      t_neu[i,ii]:=t_alt[i,ii];
      d_neu[i,ii]:=t_neu[i,ii];
      end;
  for i:=0 to 255 do
    for ii:=14 to 15 do
      d_neu[i,ii]:=0;
end;
Procedure Big_zeichen(x,y:integer; chr:char) ;
var i,
    b : integer;
    Zeile,
    c : byte;
begin
  for i := 0 to 13 do
    begin
      Zeile := T_neu[ord(chr),i];
      for b := 0 to 7 do
       begin
         c := 128 shr b;
         if (zeile and c) = c then
           winputchar(x+b,y+i,'*',gelb)
         else
           winputchar(x+b,y+i,'.',weiss);
       end;
    end;
end;
Procedure neuschreiben(ascii:integer);
var i,ii,x,y:integer;
    help: byte;
begin
  for i := 0 to 13 do
    begin
      y := 6+i;
      help := 0;
      for ii := 0 to 7 do
       begin
         x := 7 + ii;
         if wingetchar(x,y) = '*' then help := help + (128 shr ii);
       end;
       T_neu[ascii,i]:=help;
    end;
  for i := 0 to 7 do
    begin
      x := 7+i;
      help := 0;
      for ii := 0 to 7 do
       begin
         y := 6 + ii;
         if wingetchar(x,y) = '*' then help := help + (128 shr ii);
       end;
       d_neu[ascii,i]:=help;
    end;
  for i := 0 to 7 do
    begin
      x := 7+i;
      help := 0;
      for ii := 0 to 7 do
       begin
         y := 14 + ii;
         if wingetchar(x,y) = '*' then help := help + (128 shr ii);
       end;
       d_neu[ascii,i+8]:=help;
    end;
end;
procedure zwahl;
var
   ztaste:char;
   x,y:integer;
begin
winframe(31,4,66,13,dop_ra,gelb);
winprint(42,4,rot,' Zeichensatz ');
   winlinecursor;
   x:=32;y:=5;ascii:=0;
   winsetcursor(x,y);
   repeat
    ztaste:=readkey;
    if ztaste = #0 then
       ztaste:=readkey;
    case ztaste of
        #77:begin
            x := x + 1;
            if x > 63 then
              begin
               y := y+1;
               x := 32;
              end;
           end;
        #75:begin
            x := x - 1;
            if x < 32 then
             begin
              y := y-1;
              x := 63;
              end;
            end;
         #72:y := y - 1;
         #80:y := y + 1;
      end;
    if y > 12 then y := 5;
    if y <  5 then y := 12;
    winsetcursor(x,y);
   until ztaste = #13;
ascii:=ord(wingetchar(x,y));
winframe(31,4,66,13,dop_ra,weiss);
winprint(42,4,weiss,' Zeichensatz ');
winframe(5,4,16,21,dop_ra,gelb);
winprint(8,4,rot,'Zeichen');
end;
Procedure Veraendern;
var x,xalt,y,yalt,v_taste  : integer;
    z:char;
begin
  x := 7;
  y := 6;
  winframe(5,4,16,21,dop_ra,gelb);
  winprint(8,4,rot,'Zeichen');
  winlinecursor;
  winsetcursor(x,y);
  big_zeichen(7,6,chr(ascii));
    repeat
    xalt := x;
    yalt := y;
    taste:=readkey;
    if taste = #0 then
       taste:=readkey;
     v_taste := ord(taste);
    case v_taste of
        77:begin
            x := x + 1;
            if x > 14 then
              begin
               y := y+1;
               x := 7;
              end;
           end;
        75:begin
            x := x - 1;
            if x < 7 then
             begin
              y := y-1;
              x := 14;
              end;
            end;
        72:y := y - 1;
        80:y := y + 1;
        66:begin
           ok:=true;exit;
           end;
      end;
    if y > 19 then y := 6;
    if y <  6 then y := 19;
    winsetcursor(x,y);
    if v_taste = 32 then
     begin
      z:=wingetchar(x,y);
      if z = '.' then
         winputchar(x,y,'*',gelb)
       else
         winputchar(x,y,'.',weiss);
     end;
 until v_taste = 27;   { ESC }
 neuschreiben(ascii);
winframe(5,4,16,21,dop_ra,weiss);
winprint(8,4,weiss,'Zeichen');
zwahl;
end;
Procedure zeichensatz_laden;
var
i,j,fens:integer;
begin
    fens:=winopen(20,10,58,15);
    winframe(20,10,58,15,dop_ra,rot);
    winfill(21,11,57,14,' ',schwarz shl 4 + weiss);
    winprint(32,10,gelb,' Datei laden ');
    winprint(22,12,gelb,'Bitte geben Sie den Dateinamen ein:');
    winsetcursor(22,13);
    readln(dateiname);
  assign(quelle,dateiname);
  {$i-} reset(quelle); {$i+}
  if ioresult <> 0 then
    begin
    winfill(21,11,57,14,' ',hellgrau);
    winprint(22,12,gelb,'DATEI NICHT GEFUNDEN');
    delay(2000);
    winclose(true);
    exit;
    end;
  for i := 0 to 255 do
    for j := 0 to 13 do
      read(quelle,T_neu[i,j]);
  close(quelle);winclose(true);
end;
Procedure zeichensatz_speichern;
var
i,j,fens:integer;
fname:pathstr;dstr:dirstr;nstr:namestr;
estr:extstr;
zdaten:file of byte;
begin
    fens:=winopen(20,10,58,15);
    winframe(20,10,58,15,dop_ra,rot);
    winfill(21,11,57,14,' ',schwarz shl 4 + weiss);
    winprint(30,10,gelb,' Datei speichern ');
    winprint(22,12,gelb,'Bitte geben Sie den Dateinamen ein:');
    winsetcursor(22,13);
    readln(dateiname);fsplit(dateiname,dstr,nstr,estr);
   assign(ziel,dateiname);
   assign(zdaten,nstr+'.dru');
  rewrite(ziel);rewrite(zdaten);
  for i := 0 to 255 do
    for j := 0 to 13 do
      write(ziel,T_neu[i,j]);
  for i := 0 to 255 do
    for j := 0 to 15 do
      write(zdaten,d_neu[i,j]);
  close(ziel);close(zdaten);
  winclose(true);
end;
procedure zeichensatz;  { Zeichensatz anzeigen }
var
   zi:byte;
   zx,zy:byte;
begin
   zi:=0;
   for zy:=5 to 12 do
     for zx:=32 to 63 do
       begin
       winputchar(zx,zy,chr(zi),cyan);
       inc(zi);
      end;
end;
procedure bild;
begin
textbackground(blau);
textcolor(gelb);
clrscr;
winframe(0,0,79,2,dop_ra,weiss);
winframe(0,0,79,24,dop_ra,weiss);
winprint(23,1,gelb,' Z E I C H E N S A T Z E D I T O R ');
winframe(5,4,16,21,dop_ra,weiss);
winfill(6,5,15,20,' ',schwarz);
winprint(8,4,weiss,'Zeichen');
winframe(31,4,66,13,dop_ra,weiss);
winprint(42,4,weiss,' Zeichensatz ');
winfill(32,5,65,12,' ',schwarz);
winframe(29,15,69,22,dop_ra,gelb);
winfill(30,16,68,21,' ',schwarz);
winhidecursor;
winprint(44,15,rot,' Steuerung ');
winputchar(31,16,#25,weiss);winprint(32,16,weiss,'Cursor ab');
winputchar(51,16,#24,weiss);winprint(52,16,weiss,'Cursor auf');
winputchar(31,17,#27,weiss);winprint(32,17,weiss,'Cursor links');
winputchar(51,17,#26,weiss);winprint(52,17,weiss,'Cursor rechts');
winprint(31,18,weiss,'F1:Hilfe');winprint(51,18,weiss,'F2:Zs.laden');
winprint(31,19,weiss,'F3:Zs.editieren');
winprint(51,19,weiss,'F4:Zs.speichern');
winprint(31,20,weiss,'F5:neu aktivieren');
winprint(51,20,weiss,'F6:alt aktivieren');
winprint(31,21,weiss,'F7:Programmende');
winprint(51,21,weiss,'F8:Ende editieren');
end;
procedure hilfe;
var
   fens:integer;
   hch:char;
begin
   fens:=winopen(15,7,65,18);
   winframe(15,7,65,18,ein_ra,rot);
   winprint(35,7,weiss,' H I L F E ');
   winfill(16,8,64,17,' ',rot shl 4 + gelb);
   winprint(17,9,gelb,'Zeichen mit Cursor im Zeichensatzfeld ausw„hlen!');
   winprint(17,10,gelb,'Mit Returntaste best„tigen!');
   winprint(17,11,gelb,'Zeichen im Zeichenfeld editieren (Spacetaste)!');
   winprint(17,12,gelb,'Mit ESC-Taste ins Zeichensatzfeld!');
   winprint(17,13,gelb,'Neues Zeichen ausw„hlen, danach wie oben!');
   winprint(17,14,gelb,'Zur�ck zum Steuerungsmen� mit F8-Taste!');
   winprint(17,16,weiss,'Diese Anzeige mit Tastendruck beenden!');
   hch:=readkey;
   winclose(true);
end;
procedure alt_aktivieren;
var
    reg:registers;
begin
    with reg do
       begin
       ah:=$11;al:=$10;bh:=$0e;bl:=$0;
       cx:=$ff;dx:=$0;es:=seg(t_alt);bp:=ofs(t_alt);
       end;
     intr($10,reg);
     initzeichen;
end;
procedure neu_aktivieren;
var
    reg:registers;
begin
    with reg do
       begin
       ah:=$11;al:=$10;bh:=$0e;bl:=$0;
       cx:=$ff;dx:=$0;es:=seg(t_neu);bp:=ofs(t_neu);
       end;
     intr($10,reg);
end;
procedure auswahl;
var
    ch:char;
    oka:boolean;
begin
  oka:=false;
winframe(29,15,69,22,dop_ra,gelb);
winhidecursor;
winprint(44,15,rot,' Steuerung ');
  repeat
    ch:=' ';ok:=false;
    ch:=readkey;
    if ch = #0 then
       ch:=readkey;
    case ch of
        #59:begin
            hilfe;
           end;
        #60:begin
            zeichensatz_laden;
            end;
        #61:begin
            winframe(29,15,69,22,dop_ra,weiss);
            winhidecursor;
            winprint(44,15,weiss,' Steuerung ');
            repeat
            veraendern;
            winframe(5,4,16,21,dop_ra,weiss);
            winprint(8,4,weiss,'Zeichen');
            until ok;
            winframe(29,15,69,22,dop_ra,gelb);
            winhidecursor;
            winprint(44,15,rot,' Steuerung ');
            end;
        #62:begin
            zeichensatz_speichern;
            end;
        #63:begin
            neu_aktivieren;
            end;
        #64:begin
            alt_aktivieren;
            end;
        #65:begin
            oka:=true;
            end;
      end;
    until oka;
end;
begin
  reg.ah:=$10;reg.al:=$11;reg.bl:=0;intr($10,reg);
  ascii:=65;
  bild;
  zeichensatz;
  initzeichen;
  auswahl;
  textbackground(schwarz);
  textcolor(weiss);
  winsetcursor(1,1);
  clrscr;
end.