unit zoominbi;{zoominbild}

interface

procedure zoombild;

procedure zoombildlesen(var f: text);

procedure zoombildschreiben(var f: text);

implementation

uses crt, graph;

const nanz=32;
                                                   {14., 24., 30. nicht gemalt}
const feld : array[1..32, 1..2] of byte =
              ((18, 1), (0, 1), (16, 1), (0, 1), (18, 1), (0, 1), (16, 2), (2, 4),
               (18, 3), (0, 5), (16, 4), (2, 6), (18, 4), (0, 7), (16, 5), (2, 8),
               (18, 6), (0, 9), (16, 7), (2, 10), (18, 8), (0, 11), (16, 8), (2, 12),
               (18, 9), (0, 13), (16, 10), (2, 14), (18, 10), (0, 15), (16, 11), (2, 16));
   {for i:=1 to [n, 2] do if [n, 1]>=16 then y:=y+([n, 1] mod 16)-1 else x:=x+[n, 1]-1;}
      feld2 : array[0..3] of byte=(18, 0, 16, 2);
                                       {6., 13. nicht gemalt}
      {feld3 : array[1..32] of byte =                    
               (12, 17, 13, 18, 14, 19, 14, 20, 15, 21, 16, 22, 16, 23, 17, 24,
                18, 25, 19, 26, 20, 27, 20, 28, 21, 29, 22, 30, 22, 31, 23, 33);}
       feld3 : array[0..15] of shortint =
              (-4, +5, -4, +5, -4, +5, -5, +6, -5, +6, -5, +6, -6, +7, -6, +7);
       feld4 : array[0..1] of shortint = (-2, +2);

var gd, gm, len, x, y, n, i : integer;
    nmod16, nmod4 : byte;
    durch   : longint;

function punktfarbe: byte;
  begin
    punktfarbe:=random(15);
    {punktfarbe:=1;}
  end;

procedure zoombild;
  begin
    x:=321; y:=240;{Startpunkt}
    durch:=0;
    for n:=1 to nanz do
      if (n=14) or (n=24) or (n=30)
        then begin
               putpixel(x, y, punktfarbe);
               if feld[n, 1]>=16 then y:=y+((feld[n, 1] mod 16)-1)*feld[n, 2]
                                 else x:=x+(feld[n, 1] -1)*feld[n, 2];
             end{of if (n=14)... then}
        else for i:=1 to feld[n, 2] do
               begin
                 putpixel(x, y, punktfarbe);
                 if feld[n, 1]>=16 then y:=y+((feld[n, 1] mod 16)-1)
                                   else x:=x+(feld[n, 1] -1);
                 inc(durch);
               end;{of if (n=14)... else}
    len:=16;
    for n:=1 to 16*78 do  {16*78+32=640*2}
      begin
        len:=len+feld3[(n-1) mod 16]+((n-1) div 16)*feld4[(n-1) mod 2];
        nmod4:=(n-1) mod 4;
        nmod16:=n mod 16;
        if (nmod16=8) or (nmod16=14)
          then begin
                 putpixel(x, y, punktfarbe);
                 if feld2[nmod4]>=16 then y:=y+((feld2[nmod4] mod 16)-1)*len
                                     else x:=x+(feld2[nmod4] -1)*len;
               end{of if (n=8)... then}
          else for i:=1 to len do
                 begin
                   putpixel(x, y, punktfarbe);
                   if feld2[nmod4]>=16 then y:=y+((feld2[nmod4] mod 16)-1)
                                       else x:=x+(feld2[nmod4] -1);
                   inc(durch);
                 end;{of if (n=6)... else}
      end;
  end;

procedure zoombildlesen(var f: text);

  var ch: char;

  begin
    x:=321; y:=240;{Startpunkt}
    durch:=0;
    for n:=1 to nanz do
      if (n=14) or (n=24) or (n=30)
        then begin
               ch:=chr(getpixel(x, y));
               write(f, ch);
               if feld[n, 1]>=16 then y:=y+((feld[n, 1] mod 16)-1)*feld[n, 2]
                                 else x:=x+(feld[n, 1] -1)*feld[n, 2];
             end{of if (n=14)... then}
        else for i:=1 to feld[n, 2] do
               begin
                 ch:=chr(getpixel(x, y));
                 write(f, ch);
                 if feld[n, 1]>=16 then y:=y+((feld[n, 1] mod 16)-1)
                                   else x:=x+(feld[n, 1] -1);
                 inc(durch);
               end;{of if (n=14)... else}
    len:=16;
    for n:=1 to 16*78 do  {16*78+32=640*2}
      begin
        len:=len+feld3[(n-1) mod 16]+((n-1) div 16)*feld4[(n-1) mod 2];
        nmod4:=(n-1) mod 4;
        nmod16:=n mod 16;
        if (nmod16=8) or (nmod16=14)
          then begin
                 ch:=chr(getpixel(x, y));
                 write(f, ch);
                 if feld2[nmod4]>=16 then y:=y+((feld2[nmod4] mod 16)-1)*len
                                     else x:=x+(feld2[nmod4] -1)*len;
               end{of if (n=8)... then}
          else for i:=1 to len do
                 begin
                   ch:=chr(getpixel(x, y));
                   write(f, ch);
                   if feld2[nmod4]>=16 then y:=y+((feld2[nmod4] mod 16)-1)
                                       else x:=x+(feld2[nmod4] -1);
                   inc(durch);
                 end;{of if (n=6)... else}
      end;
  end;

procedure zoombildschreiben(var f: text);

  var ch: char;

  begin
    x:=321; y:=240;{Startpunkt}
    durch:=0;
    for n:=1 to nanz do
      if (n=14) or (n=24) or (n=30)
        then begin
               read(f, ch);
               putpixel(x, y, ord(ch));
               if feld[n, 1]>=16 then y:=y+((feld[n, 1] mod 16)-1)*feld[n, 2]
                                 else x:=x+(feld[n, 1] -1)*feld[n, 2];
             end{of if (n=14)... then}
        else for i:=1 to feld[n, 2] do
               begin
                 read(f, ch);
                 putpixel(x, y, ord(ch));
                 if feld[n, 1]>=16 then y:=y+((feld[n, 1] mod 16)-1)
                                   else x:=x+(feld[n, 1] -1);
                 inc(durch);
               end;{of if (n=14)... else}
    len:=16;
    for n:=1 to 16*78 do  {16*78+32=640*2}
      begin
        len:=len+feld3[(n-1) mod 16]+((n-1) div 16)*feld4[(n-1) mod 2];
        nmod4:=(n-1) mod 4;
        nmod16:=n mod 16;
        if (nmod16=8) or (nmod16=14)
          then begin
                 read(f, ch);
                 putpixel(x, y, ord(ch));
                 if feld2[nmod4]>=16 then y:=y+((feld2[nmod4] mod 16)-1)*len
                                     else x:=x+(feld2[nmod4] -1)*len;
               end{of if (n=8)... then}
          else for i:=1 to len do
                 begin
                   read(f, ch);
                   putpixel(x, y, ord(ch));
                   if feld2[nmod4]>=16 then y:=y+((feld2[nmod4] mod 16)-1)
                                       else x:=x+(feld2[nmod4] -1);
                   inc(durch);
                 end;{of if (n=6)... else}
      end;
  end;

begin
end.