unit tc_util; {$V-}

{$I options.inc}

interface

uses graph,tc_glob;

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

procedure zoom;
procedure wind;
procedure snap;
procedure options;
procedure quit;

implementation

var last_x0,last_y0,last_zoom_fac:real;

procedure do_error;
{JW}
begin
 msg_line:=msg_line+18;
 message('Error, ENTER !');
 repeat until yes_no(#13,#0);
end;

function real2str(wert:real):string;
{JW}
var
 num:string;
begin
 str(wert:1:3,num);
 real2str:=num;
end;

function int2str(wert:integer):string;
{JW}
var
 num:string;
begin
 str(wert,num);
 int2str:=num;
end;

procedure read_str(const kom:string;var default:string;var stop:boolean);
{JW}
var
 neu_str:string;
begin
 message(kom);
 neu_str:=default;
 get_str(msg_line,neu_str,stop);
 if not stop
 then
  default:=neu_str;
end;

procedure read_real(const kom:string;var default:real;var stop:boolean);
{JW}
var
 neu_str :string;
 neu_real:real;
 err_code:integer;
begin
 str(default:1:3,neu_str);
 read_str(kom,neu_str,stop);
 if not stop
 then begin
  val(neu_str,neu_real,err_code);
  if err_code <> 0
  then begin
   neu_real:=default;
   do_error;
   stop:=true;
  end;
  default:=neu_real;
 end;
 message('');
end;

procedure read_int(const kom:string;var default:integer;var stop:boolean);
{JW}
var
 neu_str:string;
 neu_int,
 err_code:integer;
begin
 str(default,neu_str);
 read_str(kom,neu_str,stop);
 if not stop
 then begin
  val(neu_str,neu_int,err_code);
  if err_code <> 0
  then begin
   neu_int:=default;
   do_error;
   stop:=true;
  end;
  default:=neu_int;
 end;
 message('');
end;

procedure zoom;
{JW,GH}
var
    ende,stop:boolean;
    wahl,err_code,sx1,sx2,sy1,sy2:integer;
    x,y,h:real;
begin
 ende:=false; wahl:=1;
 while not ende do begin
  funk[0]:='ZOOM ('+real2str(opt.zoom_fac)+')';
  funk[1]:='Factor';
  funk[2]:='Area';
  funk[3]:='All';
  funk[4]:='Last';
  menu(4,wahl);
  if (wahl>0) and (wahl<4)
  then begin
   last_zoom_fac:=opt.zoom_fac;
   last_x0:=x0; last_y0:=y0;
  end;
  case wahl of
   0: ende:=true;
   1: begin
       read_real('Zoom-factor:',opt.zoom_fac,stop);
       if not stop
       then
        if opt.zoom_fac > 0
        then begin
         h_mag:=opt.zoom_fac*3; v_mag:=h_mag*asp;
         redraw(true);
        end
        else
         do_error;
      end;
   2: begin
       message('Zoom area,'); get_area(sx1,sy1,sx2,sy2,stop);
       if not stop
       then
        if (sx1=sx2) or (sy1=sy2)
        then
         do_error
        else begin
         x0:=x0+sx1/h_mag; y0:=y0+(m_y-sy1)/v_mag;
         x:=m_x/(sx2-sx1); y:=m_y/(sy1-sy2);
         if x<y
         then
          opt.zoom_fac:=opt.zoom_fac*x
         else
          opt.zoom_fac:=opt.zoom_fac*y;
         h_mag:=opt.zoom_fac*3; v_mag:=h_mag*asp; redraw(true);
        end;
      end;
   3: begin
       x0:=0; y0:=0; opt.zoom_fac:=1;
       h_mag:=3; v_mag:=h_mag*asp; redraw(true);
      end;
   4: begin
       h:=opt.zoom_fac; opt.zoom_fac:=last_zoom_fac; last_zoom_fac:=h;
       h:=x0; x0:=last_x0; last_x0:=h;
       h:=y0; y0:=last_y0; last_y0:=h;
       h_mag:=opt.zoom_fac*3; v_mag:=h_mag*asp; redraw(true);
      end;
  end; {case}
  m_wx:=x0+m_x/h_mag; m_wy:=y0+m_y/v_mag;
  message('');
 end; {while}
end; {zoom}

procedure wind;
{GH}
var wahl,sx,sy:integer;
    x,y:real;
    ende,stop:boolean;
begin
 wahl:=1; ende:=false;
 while not ende do begin
  funk[0]:='WINDOW';
  funk[1]:='Lower left';
  funk[2]:='Upper right';
  funk[3]:='Origin';
  menu(3,wahl);
  case wahl of
   0: ende:=true;
   1: begin
       message('Lower left corner:'); pict_port;
       get_point(sx,sy,x,y,stop);
       if not stop
       then begin
        x0:=x; y0:=y; redraw(true);
        m_wx:=m_wx+x; m_wy:=m_wy+y;
       end;
       message('');
      end;
   2: begin
       message('Upper right corner:'); pict_port;
       get_point(sx,sy,x,y,stop);
       if not stop
       then begin
        x0:=x0-(m_wx-x); y0:=y0-(m_wy-y); redraw(true);
        m_wx:=x; m_wy:=y;
       end;
       message('');
      end;
   3: begin
       x0:=0; y0:=0; redraw(true);
       m_wx:=m_x/h_mag; m_wy:=m_y/v_mag;
      end;
  end; {case}
 end;
end; {wind}

procedure snap;
{JW,GH}
var wahl:integer;
    ende,stop:boolean;
begin
 wahl:=1; ende:=false;
 while not ende do begin
  if opt.snapping
  then
   funk[0]:='SNAP (On, '+int2str(opt.snap_asp)+')'
  else
   funk[0]:='SNAP (Off)';
  funk[1]:='On';
  funk[2]:='Off';
  funk[3]:='Aspect';
  menu(3,wahl);
  case wahl of
   0: ende:=true;
   1: opt.snapping:=true;
   2: opt.snapping:=false;
   3: read_int('Snap_aspect:',opt.snap_asp,stop);
  end; {case}
 end;
end; {snap}

procedure directories;
{JW,GH}
var ende,stop:boolean;
    wahl:integer;
begin
 ende:=false; wahl:=1;
 while not ende do begin
  funk[0]:='DIRECTORIES';
  funk[1]:='Picture-Directory';
  funk[2]:='Picture-Suffix';
  funk[3]:='Macro-Directory';
  funk[4]:='Macro-Suffix';
  funk[5]:='BGI-Directory';
  menu(5,wahl);
  case wahl of
   0: ende:=true;
   1: read_str('Picture-Directory:',opt.tex_path,stop);
   2: read_str('Picture-Suffix:'   ,opt.tex_suff,stop);
   3: read_str('Macro-Directory:'  ,opt.mac_path,stop);
   4: read_str('Macro-Suffix:'     ,opt.mac_suff,stop);
   5: read_str('BGI-Directory:'    ,opt.driver_path,stop);
  end; {case}
  message('');
 end;
end; {directories}

procedure lines;
{JW}
var ende,stop:boolean;
    wahl:integer;
begin
 ende:=false; wahl:=1;
 with opt do
  while not ende do begin
   funk[0]:='LINES';
   funk[1]:='Any Lines';
   funk[2]:='LaTex-Lines';
   funk[3]:='Linewidth';
   funk[4]:='Reduce';
   funk[5]:='Grade-Difference';
   if steigung
    then message('Lines     : Any')
    else message('Lines     : LaTex');
   message('Linewidth : '+linewidth);
   if reduce
   then
    message('Reduce    : ON')
   else
    message('Reduce    : OFF');
   message('Gr.- Diff : '+real2str(stdiff));
   msg_line:=msg_line+18;
   menu(5,wahl);
   case wahl of
    0: ende:=true;
    1: steigung:=true;
    2: if steigung and only_emtex
       then begin
        steigung:=false;
        only_emtex:=false;
        bezier:=true;
       end
       else
        steigung:=false;
    3: read_str('Linewidth:',linewidth,stop);
    4: reduce:=not reduce;
    5: read_real('Grade-Diff.',stdiff,stop);
   end; {case}
   message('');
  end;
end; {lines}

procedure kompatibel;
{JW}
var ende,stop:boolean;
    wahl:integer;
begin
 ende:=false; wahl:=1;
 with opt do
  while not ende do begin
   funk[0]:='COMPATIBLE';
   if only_emtex
   then
    message('Compatible: EmTex')
   else
    message('Compatible: LaTex');
   if bezier
   then
    message('Bezier.sty: ON')
   else
    message('Bezier.sty: OFF');
   message('Quality   : '+real2str(quality));
   funk[1]:='Only EmTeX ';
   funk[2]:='Any LaTeX';
   funk[3]:='Use Bezier.sty';
   funk[4]:='Quality';
   msg_line:=msg_line+18;
   menu(4,wahl);
   case wahl of
    0: ende       :=true;
    1: begin
        only_emtex:=true;
        steigung  :=true;
        bezier    :=false;
       end;
    2: only_emtex :=false;
    3: bezier:=not bezier;
    4: begin
        read_real('Quality(0.2-6.0)',quality,stop);
        if (quality < 0.2) or (quality > 6)
        then
         quality :=2;
       end;
   end; {case}
   message('');
  end;
end; {emtex}

procedure options;
{JW,GH}
var ende,stop,succ:boolean;
    wahl:integer;
    h_opt:options_type;
begin
 ende:=false; wahl:=1;
 while not ende do begin
  funk[0]:='OPTIONS';
  funk[1]:='Directories';
  funk[2]:='Snap';
  funk[3]:='Zoom';
  funk[4]:='Unitlength';
  funk[5]:='Lines';
  funk[6]:='Compatible';
  funk[7]:='Save Options';
  funk[8]:='Load Options';
  menu(8,wahl);
  case wahl of
   0: ende:=true;
   1: directories;
   2: snap;
   3: zoom;
   4: read_str('Unitlength:',opt.unitlength,stop);
   5: lines;
   6: kompatibel;
   7: begin
       read_str('Options-filename:',opt_name,stop);
       if not stop
       then begin
        assign(opt_file,opt_name);
        {$i-} rewrite(opt_file);
        if ioresult=0
        then begin
         write(opt_file,opt);
         succ:=ioresult=0;
         close(opt_file);
        end
        else
         succ:=false; {$i+}
        if not succ
        then
         do_error;
       end;
      end;
   8: begin
       read_str('Options-filename:',opt_name,stop);
       if not stop
       then begin
        load_opt(h_opt,succ);
        if succ
        then begin
         opt:=h_opt;
         h_mag:=opt.zoom_fac*3; v_mag:=h_mag*asp; redraw(true);
        end
        else
         do_error;
       end;
      end;
  end; {case}
  message('');
 end;
end; {options}

procedure quit;
{JW,GH}
begin
 if not saved
 then begin
  message('Picture not saved!');
  message('Quit anyway [y/n]?');
  if yes_no('y','n')
  then begin
   delete_object_list;
   halt
  end
  else
   message('');
 end
 else begin
  delete_object_list;
  halt;
 end;
end; {quit}

begin
   last_x0:=0; last_y0:=0; last_zoom_fac:=1;
end.
