unit tc_edit;

{$I options.inc}

interface

uses crt,graph,tc_glob,tc_draw,tc_io,mouse;

procedure edit;

implementation

{$ifopt N+}
 type real=extended;
{$endif}

var pick_x,pick_y,pick_dist:real; {Pickstelle und Mindestabstand}
    pick_anz:integer; {Anzahl gepickter Elemente}

function test_text(var text_ptr:ptr_obj_type):boolean;
{GH}
begin
with text_ptr^ do
   test_text:=sqrt(sqr(pick_x-x_pos)+sqr(pick_y-y_pos))<=pick_dist;
end; {test_text}

function test_box(var box_ptr:ptr_obj_type):boolean;
{GH}
begin
with box_ptr^ do
   test_box:=(pick_x>=x_pos-pick_dist) and (pick_x<=x_pos+width+pick_dist) and
             (pick_y>=y_pos-pick_dist) and (pick_y<=y_pos+height+pick_dist);
end; {test_box}

function test_line(var line_ptr:ptr_obj_type):boolean;
{GH}

function min(a,b:real):real;
begin if a<=b then min:=a else min:=b;
end;

function max(a,b:real):real;
begin if a>=b then max:=a else max:=b;
end;

var slope,h,px,py,x1,y1,x2,y2,dx,dy:real;
begin
with line_ptr^ do begin
   if em then begin
      h_slope:=round(width-x_pos); v_slope:=round(height-y_pos);
   end;
   if h_slope=0 then
      test_line:=(abs(pick_x-x_pos)<=pick_dist) and
                 (pick_y>min(y_pos,height)) and (pick_y<max(y_pos,height))
   else begin
      test_line:=false; slope:=v_slope/h_slope;
      x1:=x_pos; y1:=y_pos; x2:=width; y2:=height;
      px:=pick_x; py:=pick_y;
      if abs(slope)>1 then begin
         h:=x1; x1:=y1; y1:=h;
         h:=x2; x2:=y2; y2:=h;
         h:=px; px:=py; py:=h;
         slope:=1/slope;
      end;
      if (px>min(x1,x2)) and (px<max(x1,x2)) then begin
         dx:=px-x1; dy:=dx*slope;
         test_line:=abs(py-y1-dy)<=pick_dist;
      end;
   end;
end;
end; {test_line}

function test_circ(var circ_ptr:ptr_obj_type):boolean;
{GH}
begin
with circ_ptr^ do
   test_circ:=abs(sqrt(sqr(pick_x-x_pos)+sqr(pick_y-y_pos)))<=rad;
end; {test_circ}

function test_oval(var oval_ptr:ptr_obj_type):boolean;
{GH}
begin
with oval_ptr^ do
   test_oval:=(pick_x>=lux-pick_dist) and (pick_x<=lux+width+pick_dist) and
              (pick_y>=luy-pick_dist) and (pick_y<=luy+height+pick_dist);
end; {test_oval}

function test_bezier(var bez_ptr:ptr_obj_type):boolean;
{GH}
begin
with bez_ptr^ do
   test_bezier:=(sqrt(sqr(pick_x-x_pos)+sqr(pick_y-y_pos))<=pick_dist) or
                (sqrt(sqr(pick_x-xx_pos)+sqr(pick_y-yy_pos))<=pick_dist);
end; {test_bezier}

procedure mark_obj(obj_ptr:ptr_obj_type);
{JW,GH}
var sx1,sx2,sy1,sy2:integer;
begin
 if max_color>=15
 then
  with obj_ptr^ do begin
   if picked
   then begin
    setcolor(lightred);
    setfillstyle(solidfill,lightred);
   end;
   redraw_one(obj_ptr);
  end
 else
  with obj_ptr^ do begin
   if (art=txt) or (art=circ) or (art = putaux)
   then begin
    if not picked
    then
     setcolor(0);
    trans(x_pos,y_pos,sx1,sy1);
    if (art=txt) or (art = putaux)
    then
     circle(sx1,sy1-1,7)
    else
     circle(sx1,sy1,round(h_mag*rad)+2);
   end
   else
    if (art=bezier) or (art=bezvec)
    then begin
     if not picked
     then
      setcolor(0);
     trans(x_pos,y_pos,sx1,sy1); circle(sx1,sy1,3);
     trans(xx_pos,yy_pos,sx1,sy1); circle(sx1,sy1,3);
    end
    else begin
     if picked
     then begin
      setlinestyle(dottedln,0,normwidth);
      setcolor(0);
     end;
     case art of
      box: if picked
           then begin
            trans(x_pos,y_pos,sx1,sy1);
            trans(x_pos+width,y_pos+height,sx2,sy2);
            if solid
            then begin
             setfillstyle(interleavefill,color);
             bar(sx1,sy1,sx2,sy2);
             setfillstyle(solidfill,color);
            end
            else
             rectangle(sx1,sy2,sx2,sy1);
           end
           else
            draw_box(obj_ptr);
      lin,vec: draw_line(obj_ptr);
      oval: draw_oval(obj_ptr);
     end; {case}
    end;
  end; {with}
 setcolor(color);
 setfillstyle(solidfill,color);
 setlinestyle(solidln,0,normwidth);
end; {mark_obj}

procedure draw_all_picked_obj(new_pick:boolean);
{JW,GH}
var
 obj_ptr:ptr_obj_type;
begin
 obj_ptr:=root;
 while obj_ptr<>nil do begin
  with obj_ptr^do
   if picked
   then begin
    picked:=new_pick;
    mark_obj(obj_ptr);
   end;
  obj_ptr:=obj_ptr^.next;
 end;
end;

procedure pick_objects;
{JW,GH}
var sx,sy:integer;
    ende,found:boolean;
    obj_ptr:ptr_obj_type;
begin
ende:=false;
while not ende do begin
   message('Pick object:'); pict_port;
   get_point(sx,sy,pick_x,pick_y,ende);
   if not ende then begin
      obj_ptr:=root; found:=false;
      while (obj_ptr<>nil) and (not found) do with obj_ptr^ do begin
         case art of
            txt,
            putaux: found:=test_text(obj_ptr);
            box   : found:=test_box(obj_ptr);
            lin,
            vec   : found:=test_line(obj_ptr);
            circ  : found:=test_circ(obj_ptr);
            oval  : found:=test_oval(obj_ptr);
            bezier,
            bezvec: found:=test_bezier(obj_ptr);
            aux   : found:=false;
         end; {case}
         found:=found and (not picked);
         if found then begin
            picked:=true; mark_obj(obj_ptr);
            message('Pick [y/n]?'); pict_port;
            if yes_no('y','n') then pick_anz:=pick_anz+1
            else begin
               found:=false; picked:=false; mark_obj(obj_ptr);
            end;
         end; {if found}
         obj_ptr:=obj_ptr^.next;
      end; {while}
      if not found then begin
         message('Not found, ENTER!');
         repeat until yes_no(#13,#0);
      end;
   end;
message('');
end; {while}
end; {pick_objects}

procedure pick_area;
{JW,GH}
var x1,x2,y1,y2:real;
    stat,sx1,sy1,sx2,sy2:integer;
    stop,ende,found:boolean;
    obj_ptr:ptr_obj_type;
begin
message('Pick area:'); get_area(sx1,sy1,sx2,sy2,ende);
if not ende then begin
   x1:=x0+sx1/h_mag; y1:=y0+(m_y-sy1)/v_mag;
   x2:=x0+sx2/h_mag; y2:=y0+(m_y-sy2)/v_mag;
   obj_ptr:=root;
   while obj_ptr<>nil do with obj_ptr^ do begin
      case art of
      txt,
      putaux: found:=(x_pos>=x1) and (x_pos<=x2) and
                  (y_pos>=y1) and (y_pos<=y2);
      box: found:=(x_pos>=x1) and (x_pos+width<=x2) and
                  (y_pos>=y1) and (y_pos+height<=y2);
      lin,vec: found:=(x_pos>=x1) and (x_pos<=x2) and
                       (y_pos>=y1) and (y_pos<=y2) and
                       (width>=x1) and (width<=x2) and
                       (height>=y1) and (height<=y2);
      circ: found:=(x_pos-rad>=x1) and (x_pos+rad<=x2) and
                    (y_pos-rad>=y1) and (y_pos+rad<=y2);
      oval: found:=(lux>=x1) and (lux+width<=x2) and
                    (luy>=y1) and (luy+height<=y2);
      bezier,
      bezvec:
             found:=(x_pos>=x1) and {(width>=x1) and} (xx_pos>=x1) and
                     (x_pos<=x2) and {(width<=x2) and} (xx_pos<=x2) and
                     (y_pos>=y1) and {(height>=y1) and} (yy_pos>=y1) and
                     (y_pos<=y2) and {(height<=y2) and} (yy_pos<=y2);
      aux: found:=false;         {width,height kann auáerhalb Screen liegen}
      end; {case}
      if found then begin
         pick_anz:=pick_anz+1; picked:=true; mark_obj(obj_ptr);
      end;
      obj_ptr:=obj_ptr^.next;
   end;
end;
setwritemode(xorput); rectangle (sx1,sy1,sx2,sy2); setwritemode(normalput);
message('');
end; {pick_area}

procedure unpick;
{JW,GH}
var obj_ptr:ptr_obj_type;
begin
if pick_anz>0 then begin
   pick_anz:=0; obj_ptr:=root; pict_port;
   draw_all_picked_obj(false);
end;
end; {unpick}

procedure pick(what:string);
{GH}
var ende:boolean;
    wahl:integer;
begin
ende:=false; wahl:=1; pick_anz:=0;
while not ende do begin
   funk[0]:=what;
   funk[1]:='Pick objects';
   funk[2]:='Pick area';
   funk[3]:='Unpick';
   menu(3,wahl);
   case wahl of
      0: ende:=true;
      1: pick_objects;
      2: pick_area;
      3: unpick;
   end; {case}
end; {while}
end; {pick}

procedure text_edit;
{GH}
var sx,sy:integer;
    ende,found:boolean;
    obj_ptr:ptr_obj_type;
begin
message('Pick Box/Text:'); pict_port;
get_point(sx,sy,pick_x,pick_y,ende);
if not ende then begin
   obj_ptr:=root; found:=false;
   while (obj_ptr<>nil) and (not found) do with obj_ptr^ do begin
      found:=false;
      case art of
         txt,
         putaux : begin
            found:=test_text(obj_ptr);
            if found then begin
               picked:=true; mark_obj(obj_ptr);
               message('Edit [y/n]?'); pict_port;
               if yes_no('y','n') then get_text(obj_ptr,ende)
                  else found:=false;
               picked:=false; mark_obj(obj_ptr);
            end;
         end;
         box: if not solid then begin
            found:=test_box(obj_ptr);
            if found then begin
               picked:=true; mark_obj(obj_ptr);
               message('Edit [y/n]?'); pict_port;
               if yes_no('y','n') then begin
                  setcolor(0); draw_box_text(obj_ptr); setcolor(color);
                  get_text(obj_ptr,ende);
               end else found:=false;
               draw_box(obj_ptr); picked:=false;
            end;
         end;
      end; {case}
      obj_ptr:=obj_ptr^.next;
   end; {with}
   if not found then begin
      message('Not found, ENTER!');
      repeat until yes_no(#13,#0);
   end;
end;
message('');
end; {text_edit}

procedure move(obj_ptr:ptr_obj_type; x,y:real);
{JW,GH}
begin
with obj_ptr^ do begin
   x_pos:=x_pos+x; y_pos:=y_pos+y;
   if art=oval then begin
      lux:=lux+x; luy:=luy+y;
   end else if (art=lin) or (art=vec) then begin
      width:=width+x; height:=height+y;
   end else if (art=bezier) or (art=bezvec) then begin
      xx_pos:=xx_pos+x; yy_pos:=yy_pos+y;
      width:=width+x; height:=height+y;
   end;
end;
end; {move}

procedure copy_picked(x1,y1:real;cop:boolean;nc:integer);
{JW,GH}
var
 new_ptr,
 obj_ptr,
 cop_ptr:ptr_obj_type;
 i:integer;
begin
 obj_ptr:=root;
 new_ptr:=cur_obj;
 while (obj_ptr<>nil) and (new_ptr^.next <> obj_ptr) do begin
  with obj_ptr^ do begin
   if picked
   then begin
    if cop
    then begin
     cop_ptr:=obj_ptr;
     for i:=1 to nc do begin
      new(cur_obj^.next); cur_obj:=cur_obj^.next;
      cur_obj^:=cop_ptr^; cur_obj^.next:=nil;
      with cur_obj^ do
       if ((art=txt) or (art=box) or (art=putaux)) and (inhalt<>nil)
       then begin
        new(inhalt);
        inhalt^:=cop_ptr^.inhalt^;
       end;
      move(cur_obj,x1,y1);
      cop_ptr:=cur_obj;
     end;
     picked:=false;
    end
    else
     move(obj_ptr,x1,y1);
   end;
  end;
  obj_ptr:=obj_ptr^.next;
 end;
end;

procedure copy_move(cop:boolean);
{JW,GH}
var x1,x2,y1,y2:real;
    sx,sy,nc,code,i:integer;
    nc_str:string[10];
    ende:boolean;
begin
if cop then pick('COPY')
       else pick('MOVE');
ende:=pick_anz=0;
if not ende then begin
   message('Moving-vector,');
   message('First point:'); pict_port;
   get_point(sx,sy,x1,y1,ende);
end;
if not ende then begin
   message('Second point:'); pict_port;
   get_point(sx,sy,x2,y2,ende);
   x1:=x2-x1; y1:=y2-y1;
end;
if (not ende) and cop then begin
   message('Number of Copies:'); nc:=1; str(nc,nc_str);
   get_str(msg_line,nc_str,ende);
   if (not ende) and (nc_str<>'') then begin
      val(nc_str,nc,code);
      if (code<>0) or (nc<1) then begin
         msg_line:=msg_line+18; message('Error, ENTER !');
         repeat until yes_no(#13,#0);
      end;
   end;
end;
if ende and (pick_anz>0) then unpick;
if not ende then begin
   copy_picked(x1,y1,cop,nc);
   unpick;
   redraw(true);
end;
message('');
end; {copy_move}

procedure mirror;
{JW,GH}
var x,y,dx,dy,mu,hr:real;
    sx,sy,wahl,hi:integer;
    ende:boolean;
    obj_ptr:ptr_obj_type;
begin
pick('MIRROR');
ende:=pick_anz=0;
if not ende then begin
   message('Point on Mirror:'); pict_port;
   get_point(sx,sy,x,y,ende);
end;
if not ende then begin
   funk[0]:='MIRROR';
   funk[1]:='  0ø (-)';
   funk[2]:=' 45ø (/)';
   funk[3]:=' 90ø (|)';
   funk[4]:='135ø (\)';
   wahl:=1; menu(4,wahl); ende:=wahl=0;
end;
if ende and (pick_anz>0) then unpick;
if not ende then begin
   obj_ptr:=root;
   while obj_ptr<>nil do with obj_ptr^ do begin
      if picked then begin
         picked:=false;
         new(cur_obj^.next); cur_obj:=cur_obj^.next;
         cur_obj^:=obj_ptr^; cur_obj^.next:=nil;
         with cur_obj^ do
         if ((art=txt) or (art=box) or (art=putaux)) and (inhalt<>nil)
         then begin
            new(inhalt); inhalt^:=obj_ptr^.inhalt^;
         end;
         case wahl of
         1: with cur_obj^ do begin
            case art of
               txt,circ,
               putaux   : y_pos:=2*y-y_pos;
               box      : y_pos:=2*y-y_pos-height;
               lin,vec  : begin
                           y_pos:=2*y-y_pos; height:=2*y-height;
                           if not em then v_slope:=-v_slope;
                          end;
               oval     : begin
                           y_pos:=2*y-y_pos; luy:=2*y-luy-height;
                           case part[1] of
                              't': part[1]:='b';
                              'b': part[1]:='t';
                           end;
                           case part[2] of
                              't': part[2]:='b';
                              'b': part[2]:='t';
                           end;
                        end;
               bezier,
               bezvec   : begin
                           y_pos:=2*y-y_pos;
                           yy_pos:=2*y-yy_pos;
                           height:=2*y-height;
                          end;
            end; {case}
         end;
         2: with cur_obj^ do begin
            mu:=(-x+y+x_pos-y_pos);
            case art of
               txt,circ,
               putaux: begin
                  x_pos:=x_pos-mu; y_pos:=y_pos+mu;
               end;
               box: begin
                  x_pos:=x_pos-mu; y_pos:=y_pos+mu;
                  hr:=width; width:=height; height:=hr;
               end;
               lin,vec: begin
                  x_pos:=x_pos-mu; y_pos:=y_pos+mu;
                  mu:=(-x+y+width-height);
                  width:=width-mu; height:=height+mu;
                  if not em then begin
                     hi:=v_slope; v_slope:=h_slope; h_slope:=hi;
                     len:=abs(width-x_pos); if len=0 then len:=abs(height-y_pos);
                  end;
               end;
               oval: begin
                  x_pos:=x_pos-mu; y_pos:=y_pos+mu;
                  mu:=(-x+y+lux-luy);
                  lux:=lux-mu; luy:=luy+mu;
                  hr:=width; width:=height; height:=hr;
                  case part[1] of
                     'l': part[1]:='b';
                     'r': part[1]:='t';
                     't': part[1]:='r';
                     'b': part[1]:='l';
                  end;
                  case part[2] of
                     't': begin
                        part[2]:=part[1]; part[1]:='r';
                     end;
                     'b': begin
                        part[2]:=part[1]; part[1]:='l';
                     end;
                  end;
               end;
               bezier,
               bezvec: begin
                  x_pos:=x_pos-mu; y_pos:=y_pos+mu;
                  mu:=(-x+y+xx_pos-yy_pos);
                  xx_pos:=xx_pos-mu; yy_pos:=yy_pos+mu;
                  mu:=(-x+y+width-height);
                  width:=width-mu; height:=height+mu;
               end;
            end; {case}
         end;
         3: with cur_obj^ do begin
            case art of
               txt,circ,putaux: x_pos:=2*x-x_pos;
               box: x_pos:=2*x-x_pos-width;
               lin,vec: begin
                  x_pos:=2*x-x_pos; width:=2*x-width;
                  if not em then h_slope:=-h_slope;
               end;
               oval: begin
                  x_pos:=2*x-x_pos; lux:=2*x-lux-width;
                  case part[1] of
                     'l': part[1]:='r';
                     'r': part[1]:='l';
                  end;
               end;
               bezier,
               bezvec: begin
                  x_pos:=2*x-x_pos; xx_pos:=2*x-xx_pos; width:=2*x-width;
               end;
            end; {case}
         end;
         4: with cur_obj^ do begin
            mu:=(x+y-x_pos-y_pos);
            case art of
               txt,circ,putaux: begin
                  x_pos:=x_pos+mu; y_pos:=y_pos+mu;
               end;
               box: begin
                  hr:=x_pos+width;
                  x_pos:=x+y-y_pos-height; y_pos:=x+y-hr;
                  hr:=width; width:=height; height:=hr;
               end;
               lin,vec: begin
                  x_pos:=x_pos+mu; y_pos:=y_pos+mu;
                  mu:=x+y-width-height;
                  width:=width+mu; height:=height+mu;
                  if not em then begin
                     hi:=v_slope; v_slope:=-h_slope; h_slope:=-hi;
                     len:=abs(width-x_pos); if len=0 then len:=abs(height-y_pos);
                  end;
               end;
               oval: begin
                  x_pos:=x_pos+mu; y_pos:=y_pos+mu;
                  hr:=lux+width;
                  lux:=x+y-luy-height; luy:=x+y-hr;
                  hr:=width; width:=height; height:=hr;
                  case part[1] of
                     'l': part[1]:='t';
                     'r': part[1]:='b';
                     't': part[1]:='l';
                     'b': part[1]:='r';
                  end;
                  case part[2] of
                     't': begin
                        part[2]:=part[1]; part[1]:='l';
                     end;
                     'b': begin
                        part[2]:=part[1]; part[1]:='r';
                     end;
                  end;
               end;
               bezier,
               bezvec: begin
                  x_pos:=x_pos+mu; y_pos:=y_pos+mu;
                  mu:=(x+y-xx_pos-yy_pos);
                  xx_pos:=xx_pos+mu; yy_pos:=yy_pos+mu;
                  mu:=x+y-width-height;
                  width:=width+mu; height:=height+mu;
               end;
            end; {case}
         end;
         end; {case}
      end;
      obj_ptr:=obj_ptr^.next;
   end;
   redraw(true);
end;
message('');
end; {mirror}

procedure rotate;
{JW,GH}
var x,y,dx,dy,mu,hr:real;
    sx,sy,wahl,hi:integer;
    ende:boolean;
    obj_ptr:ptr_obj_type;
begin
pick('ROTATE');
ende:=pick_anz=0;
if not ende then begin
   message('Rotation center:'); pict_port;
   get_point(sx,sy,x,y,ende);
end;
if not ende then begin
   funk[0]:='ROTATE';
   funk[1]:='Left 90ø';
   funk[2]:='180ø';
   funk[3]:='Right 90ø';
   wahl:=1; menu(3,wahl); ende:=wahl=0;
end;
if ende and (pick_anz>0) then unpick;
if not ende then begin
   obj_ptr:=root;
   while obj_ptr<>nil do with obj_ptr^ do begin
      if picked then begin
         picked:=false;
         new(cur_obj^.next); cur_obj:=cur_obj^.next;
         cur_obj^:=obj_ptr^; cur_obj^.next:=nil;
         with cur_obj^ do
         if ((art=txt) or (art=box) or (art=putaux)) and (inhalt<>nil)
         then begin
            new(inhalt); inhalt^:=obj_ptr^.inhalt^;
         end;
         case wahl of
         1: with cur_obj^ do begin
            case art of
               txt,circ,putaux: begin
                  hr:=x_pos;
                  x_pos:=x+(y-y_pos); y_pos:=y+(hr-x);
               end;
               box: begin
                  y_pos:=y_pos+height; hr:=x_pos;
                  x_pos:=x+(y-y_pos); y_pos:=y+(hr-x);
                  hr:=width; width:=height; height:=hr;
               end;
               lin,vec: begin
                  hr:=x_pos;
                  x_pos:=x+(y-y_pos); y_pos:=y+(hr-x);
                  hr:=width;
                  width:=x+(y-height); height:=y+(hr-x);
                  if not em then begin
                     hi:=h_slope; h_slope:=-v_slope; v_slope:=hi;
                     len:=abs(width-x_pos); if len=0 then len:=abs(height-y_pos);
                  end;
               end;
               oval: begin
                  hr:=x_pos;
                  x_pos:=x+(y-y_pos); y_pos:=y+(hr-x);
                  luy:=luy+height; hr:=lux;
                  lux:=x+(y-luy); luy:=y+(hr-x);
                  hr:=width; width:=height; height:=hr;
                  case part[1] of
                     't': part[1]:='l';
                     'b': part[1]:='r';
                     'l': part[1]:='b';
                     'r': part[1]:='t';
                  end;
                  case part[2] of
                     't': begin
                        part[2]:=part[1]; part[1]:='l';
                     end;
                     'b': begin
                        part[2]:=part[1]; part[1]:='r';
                     end;
                  end;
               end;
               bezier,
               bezvec: begin
                  hr:=x_pos;
                  x_pos:=x+(y-y_pos); y_pos:=y+(hr-x);
                  hr:=xx_pos;
                  xx_pos:=x+(y-yy_pos); yy_pos:=y+(hr-x);
                  hr:=width;
                  width:=x+(y-height); height:=y+(hr-x);
               end;
            end; {case}
         end;
         2: with cur_obj^ do begin
            case art of
               txt,circ,putaux: begin
                  x_pos:=2*x-x_pos; y_pos:=2*y-y_pos;
               end;
               box: begin
                  x_pos:=2*x-x_pos-width; y_pos:=2*y-y_pos-height;
               end;
               lin,vec: begin
                  x_pos:=2*x-x_pos; y_pos:=2*y-y_pos;
                  width:=2*x-width; height:=2*y-height;
                  if not em then begin
                     h_slope:=-h_slope; v_slope:=-v_slope;
                  end;
               end;
               oval: begin
                  x_pos:=2*x-x_pos; y_pos:=2*y-y_pos;
                  lux:=2*x-lux-width; luy:=2*y-luy-height;
                  case part[1] of
                     'l': part[1]:='r';
                     'r': part[1]:='l';
                     't': part[1]:='b';
                     'b': part[1]:='t';
                  end;
                  case part[2] of
                     't': part[2]:='b';
                     'b': part[2]:='t';
                  end;
               end;
               bezier,
               bezvec: begin
                  x_pos:=2*x-x_pos; y_pos:=2*y-y_pos;
                  xx_pos:=2*x-xx_pos; yy_pos:=2*y-yy_pos;
                  width:=2*x-width; height:=2*y-height;
               end;
            end; {case}
         end;
         3: with cur_obj^ do begin
            case art of
               txt,circ,putaux: begin
                  hr:=x_pos;
                  x_pos:=x+(y_pos-y); y_pos:=y-(hr-x);
               end;
               box: begin
                  x_pos:=x_pos+width; hr:=x_pos;
                  x_pos:=x+(y_pos-y); y_pos:=y-(hr-x);
                  hr:=width; width:=height; height:=hr;
               end;
               lin,vec: begin
                  hr:=x_pos;
                  x_pos:=x+(y_pos-y); y_pos:=y-(hr-x);
                  hr:=width;
                  width:=x+(height-y); height:=y-(hr-x);
                  if not em then begin
                     hi:=h_slope; h_slope:=v_slope; v_slope:=-hi;
                     len:=abs(width-x_pos); if len=0 then len:=abs(height-y_pos);
                  end;
               end;
               oval: begin
                  hr:=x_pos;
                  x_pos:=x+(y_pos-y); y_pos:=y-(hr-x);
                  lux:=lux+width; hr:=lux;
                  lux:=x+(luy-y); luy:=y-(hr-x);
                  hr:=width; width:=height; height:=hr;
                  case part[1] of
                     't': part[1]:='r';
                     'b': part[1]:='l';
                     'l': part[1]:='t';
                     'r': part[1]:='b';
                  end;
                  case part[2] of
                     't': begin
                        part[2]:=part[1]; part[1]:='r';
                     end;
                     'b': begin
                        part[2]:=part[1]; part[1]:='l';
                     end;
                  end;
               end;
               bezier,
               bezvec: begin
                  hr:=x_pos;
                  x_pos:=x+(y_pos-y); y_pos:=y-(hr-x);
                  hr:=xx_pos;
                  xx_pos:=x+(yy_pos-y); yy_pos:=y-(hr-x);
                  hr:=width;
                  width:=x+(height-y); height:=y-(hr-x);
               end;
            end; {case}
         end;
         end; {case}
      end;
      obj_ptr:=obj_ptr^.next;
   end;
   redraw(true);
end;
message('');
end; {rotate}

procedure del_picked;
{JW,GH}
var p1,p2:ptr_obj_type;
begin
 while (root<>nil) and (root^.picked) do begin
    p1:=root; root:=root^.next;
    with p1^ do
     if ((art=txt) or (art=box) or (art=putaux)) and (inhalt<>nil)
     then dispose(inhalt);
    dispose(p1);
 end;
 if root<>nil then begin
    p2:=root; p1:=root^.next;
    while p1<>nil do begin
       if p1^.picked then begin
          p2^.next:=p1^.next;
          with p1^ do
           if ((art=txt) or (art=box) or (art=putaux)) and (inhalt<>nil)
           then dispose(inhalt);
          dispose(p1);
          p1:=p2^.next;
       end else begin
          p2:=p1; p1:=p1^.next;
       end;
    end;
    cur_obj:=p2;
 end else cur_obj:=nil;
end;

procedure del;
{JW,GH}
begin
pick('DELETE');
if pick_anz>0 then begin
   message('Delete picked'); message('objects [y/n]?');
   if yes_no('y','n') then begin
    del_picked;
    redraw(true);
   end
   else unpick;
   message('');
end;
end; {del}

procedure zap;
{JW,GH}
var
 hptr1,hptr2:ptr_obj_type;
begin
if root<>nil then begin
   message('Delete all [y/n]?');
   if yes_no('y','n') then begin
      delete_object_list;
      {release(heap_bottom);
      root:=nil; cur_obj:=nil;}
      rulers; saved:=true;
   end;
   message('');
end;
end; {zap}

procedure save_mac;
{GH}
begin
   pick('SAVE MACRO');
   if pick_anz>0 then begin
      save(true,false); unpick;
   end;
end; {save_mac}

procedure load_mac;
{GH}
var obj_ptr,h_ptr:ptr_obj_type;
    sx,sy:integer;
    x1,x2,y1,y2:real;
    ende:boolean;
begin
   h_ptr:=cur_obj; load(true,false,false); pict_port;
   if h_ptr<>nil then obj_ptr:=h_ptr^.next
      else obj_ptr:=root;
   ende:=obj_ptr=nil;
   while obj_ptr<>nil do begin
      mark_obj(obj_ptr); obj_ptr:=obj_ptr^.next;
   end;
   if not ende then begin
      message('Moving-vector,');
      message('First point:'); pict_port;
      get_point(sx,sy,x1,y1,ende);
   end;
   if not ende then begin
      message('Second point:'); pict_port;
      get_point(sx,sy,x2,y2,ende);
      x1:=x2-x1; y1:=y2-y1;
   end;
   if h_ptr<>nil then obj_ptr:=h_ptr^.next
      else obj_ptr:=root;
   while obj_ptr<>nil do begin
      obj_ptr^.picked:=false;
      if not ende then move(obj_ptr,x1,y1);
      obj_ptr:=obj_ptr^.next;
   end;
   redraw(true); message('');
end; {load_mac}

procedure metamorphose(cop:boolean);
{JW}
const
 f=1.05;
 max_skelett=10;
var
 mx,my,sx,sy,stat:integer;
 w,h,fx,fy,d,md:real;
 x,y:array[1..max_skelett] of real;
 ende:boolean;
 obj_ptr:ptr_obj_type;
 z:char;
 istr:string[2];
 i,mi,maxi:byte;

function np(xpos,ypos:real):byte;
{JW}
var
 i:byte;
begin
 md:=1000;
 for i := 1 to maxi do begin
  d:=pythagoras(xpos-x[i],ypos-y[i]);
  if d < md
  then begin
   md:=d;
   mi:=i;
  end;
 end;
 np:=mi;
end;

begin
 pick('New Size');
 ende:=pick_anz=0;
 if not ende
 then begin
  sx:=-1000;sy:=-1000;
  for i:= 1 to max_skelett do begin
   str(i,istr);
   message('MorphingPoint: '+istr);
   pict_port;
   get_point(mx,my,x[i],y[i],ende);
   if ende
   then begin
    maxi:=i-1;
    break;
   end;
  end;
  message('');
  message('Move and Morph !');
  ende:=false;
 end;
 if not ende
 then begin
  if cop
  then
   copy_picked(0,0,true,1);
  sx:=m_xpos;
  sy:=m_ypos;
  repeat
   if keypressed
   then
    z:=readkey
   else begin
    stat:=mouse_stat(true);
    case stat of
     0   : if (m_xpos<>sx) or (m_ypos<>sy)
           then begin
            for i:= 1 to maxi do begin
             x[i]:=x[i]+(m_xpos-sx);
             y[i]:=y[i]+(sy-m_ypos);
            end;
            copy_picked(m_xpos-sx,sy-m_ypos,false,0);
            redraw(false);
            draw_all_picked_obj(true);
           end;
    -1,13: ; {linke Taste, ENTER}
    -2,27: begin {rechte Taste, ESC}
            ende:=true;
            if cop
            then
             del_picked;
            redraw(true);
           end;
    ord('P'): toggle_snap;
    end; {case}
    z:=chr(1);
   end;
   case z of
    '+'    : begin
              fx:=f;
              fy:=fx;
             end;
    '-'    : begin
              fx:=1/f;
              fy:=fx;
             end;
    chr(0) : begin
              z:=readkey;
              case z of
               #72:begin {up}
                    fx:=1;
                    fy:=f;
                   end;
               #80:begin {down}
                    fx:=1;
                    fy:=1/f;
                   end;
               #75:begin {left}
                    fx:=1/f;
                    fy:=1;
                   end;
               #77:begin {right}
                    fx:=f;
                    fy:=1;
                   end;
              end;
             end;
    chr(27): begin
              ende:=true;
              if cop
              then
               del_picked;
{              redraw(true);}
             end;
    chr(13): ende:=true;
   else z:=chr(1)
   end;
   if z <> chr(1)
   then begin
    z:=chr(1);
    obj_ptr:=root;
    while not ende and (obj_ptr <> nil) do begin
     with obj_ptr^ do begin
      if picked
      then begin
       mi:=np(x_pos,y_pos);
       x_pos  :=x[mi]+(x_pos-x[mi])*fx;
       y_pos  :=y[mi]+(y_pos-y[mi])*fy;
       case art of
          box    : begin
                    width  :=width*fx;
                    height :=height*fy;
                   end;
          circ   : rad     :=rad*(fx+fy)/2;
          lin,vec: begin
                    mi:=np(width,height);
                    width  :=x[mi]+(width-x[mi])*fx;
                    height :=y[mi]+(height-y[mi])*fy;
                    if not em then
                     if (h_slope=0) and (abs(v_slope)=1)
                     then
                      len := abs(y_pos-height)
                     else
                      if (v_slope=0) and (abs(h_slope)=1)
                      then
                       len := abs(x_pos-width)
                      else
                       if fx=fy
                       then
{                        len := pythagoras(x_pos-width,y_pos-height)}
                        len := len*fx
                       else
                        em := true;
                   end;
          oval   : begin
                    mi:=np(lux,luy);
                    lux    :=x[mi]+(lux-x[mi])*fx;
                    luy    :=y[mi]+(luy-y[mi])*fy;
                    width  :=width*fx;
                    height :=height*fy;
                   end;
          bezier,
          bezvec : begin
                    mi:=np(xx_pos,yy_pos);
{                    mi:=np(width,height);}
                    width  :=x[mi]+(width-x[mi])*fx;
                    height :=y[mi]+(height-y[mi])*fy;
                    xx_pos :=x[mi]+(xx_pos-x[mi])*fx;
                    yy_pos :=y[mi]+(yy_pos-y[mi])*fy;
                   end;
       end; {case}
      end;
     end;
     obj_ptr:=obj_ptr^.next;
    end;
    redraw(false);
    draw_all_picked_obj(true);
   end;
  until ende or (stat=-1) or (stat=13);
  redraw(false);
  draw_all_picked_obj(false);
 end;
 message('');
end;

procedure edit;
{GH}
var ende:boolean;
    wahl:integer;
begin
ende:=false; wahl:=1;
while not ende do begin
   funk[0]:='EDIT';
   funk[1]:='Text-Edit';
   funk[2]:='Copy';
   funk[3]:='Move';
   funk[4]:='Mirror';
   funk[5]:='Rotate';
   funk[6]:='Morphing Copy';
   funk[7]:='Morphing Original';
   funk[8]:='Delete';
   funk[9]:='Delete all';
   funk[10]:='Save Macro';
   funk[11]:='Load Macro';
   menu(11,wahl);
   if wahl>0 then saved:=false;
   case wahl of
      0: ende:=true;
      1: text_edit;
      2: copy_move(true);
      3: copy_move(false);
      4: mirror;
      5: rotate;
      6: metamorphose(true);
      7: metamorphose(false);
      8: del;
      9: zap;
     10: save_mac;
     11: load_mac;
   end; {case}
end; {while}
end; {edit}

begin
   pick_dist:=2;
end. {unit tc_edit}
