home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / editor / paint.arc / PTFANCY.PAS < prev    next >
Pascal/Delphi Source File  |  1987-11-18  |  4KB  |  122 lines
  1. { Routines to do fancy editing, like Mirror and Fill }
  2.  
  3. procedure mirror;
  4.  
  5.     const  msg1 : prompt = ('cursor on','mirror axis?','  (Y/N)','','');
  6.            msg2 : prompt = ('keep','Top?  Bottom?','Right?  Left?','','');
  7.     var    inchar, keep, H_or_V : char;
  8.            offset, i, j, size : integer;
  9.  
  10.     begin
  11.         inchar := getchar (msg1);  (* cursor check *)
  12.         if not((inchar='y') or (inchar='Y')) then
  13.                 (* didn't set up properly. ABORT! *)
  14.         begin
  15.             ClrWin (2);
  16.             window (2, 'Aborting mirror');
  17.         end
  18.         else
  19.         begin
  20.  
  21.             keep := getchar (msg2);  (* orientation of mirror *)
  22.  
  23.             offset:=0;  (* 1 only for even symmetry, not implemented *)
  24.  
  25.             case keep of  (* MAIN WORKING CODE *)
  26.  
  27.             'L','l':   (* keep the left part *)
  28.                 begin
  29.                     if x < line-x then  size := x
  30.                                   else  size := line-x;
  31.                     for j:=0 to page do
  32.                         for i:= 0 to size do
  33.                         begin
  34.                             screen [x+offset+i, j] := screen [x-i, j];
  35.                             dab (x+offset+i, j, screen [x+offset+i, j]);
  36.                         end;
  37.                 end;
  38.  
  39.             'R','r':   (* keep the right part *)
  40.                 begin
  41.                     if x < line-x then  size := x
  42.                                   else  size := line-x;
  43.                     for j:=0 to page do
  44.                         for i:= 0 to size do
  45.                         begin
  46.                             screen [x-i, j] := screen [x+offset+i, j];
  47.                             dab (x-i, j, screen [x-i,j]);
  48.                         end;
  49.                 end;
  50.  
  51.  
  52.             'T','t':   (* keep the top part *)
  53.                 begin
  54.                     if y < page-y then  size := y
  55.                                   else  size := page-y;
  56.                     for i:=0 to line do
  57.                         for j:= 0 to size do
  58.                         begin
  59.                             screen [i, y+offset+j] := screen [i, y-j];
  60.                             dab (i, y+offset+j, screen [i, y+offset+j]);
  61.                         end;
  62.                 end;
  63.  
  64.             'B','b':   (* keep the bottom part *)
  65.                 begin
  66.                     if y < page-y then  size := y
  67.                                   else  size := page-y;
  68.                     for i:=0 to line do
  69.                         for j:= 0 to size do
  70.                         begin
  71.                             screen [i, y-j] := screen [i, y+offset+j];
  72.                             dab (i, y-j, screen [i, y-j]);
  73.                         end;
  74.                 end;
  75.  
  76.             else
  77.                 begin
  78.                     ClrWin (2);
  79.                     window (2, 'Illegal option.');
  80.                     window (2, 'Mirror aborted.');
  81.                 end;
  82.             end;
  83.         end;
  84.     end;
  85.  
  86.  
  87. function check (x,y, n : integer) : boolean;
  88.   {  this function is used by "fill" to test whether a cell is a candidate
  89.      for the next step.  N identifies whether the test is for:
  90.      0 - don't test for cell contents, just <x,y> in bounds.
  91.      1 - test for exact match.
  92.      2 - test for all but exact match.
  93.      3 - test for screen > brush.
  94.      4 - test for screen < brush.
  95.   }
  96.     begin
  97.       check := FALSE;
  98.       if (x >= 0) and (x < line) and (y >= 0) and (y < page) then
  99.           case n of
  100.           0:  check := TRUE;
  101.           1:  if screen [x,y] = brush then check := TRUE;
  102.           2:  if not (screen [x,y] = brush) then check := TRUE;
  103.           3:  if screen [x,y] > brush then check := TRUE;
  104.           4:  if screen [x,y] < brush then check := TRUE;
  105.           end;
  106.     end;
  107.  
  108.  
  109. procedure fill (x,y : integer);
  110.   { fills an area including the point <x,y>, up to a boundary of cells
  111.       >= brush if FillFlag = 3
  112.       <= brush if FillFlag = 4
  113.   }
  114.     begin
  115.         screen [x,y] := brush;
  116.         dab (x,y, brush);   (* this way, we watch it work *)
  117.                             (* For speed, drop this line, & RestorScr *)
  118.         if check (x+1,y, FillFlag)  then  fill (x+1,y);
  119.         if check (x,y+1, FillFlag)  then  fill (x,y+1);
  120.         if check (x-1,y, FillFlag)  then  fill (x-1,y);
  121.         if check (x,y-1, FillFlag)  then  fill (x,y-1);
  122.