unit tc_glob;
{Deklariert die von TeXcad benutzten globalen Variablen sowie die Prozeduren
 fuer das Zeichnen der Objekte und fuer die Benutzeroberflaeche.}

{$I options.inc}

interface

uses dos,crt,graph,mouse;

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

type options_type=record {JW,GH}
       driver_path,          {Pfad zum Laden des Graphiktreibers}
       tex_path,             {Pfad zum Speichern und Laden der LaTeX-Codes}
       tex_suff,             {Suffix fuer TeX-Dateien}
       mac_path,             {Pfad zum Speichern und Laden der Macros}
       mac_suff:string[80];  {Suffix fuer Macro-Dateien}
       steigung:boolean;     {Linien mit bel. Steigung?}
       only_emtex:boolean;   {EMLinien werden durch \put...\line... ersetzen?}
       bezier:boolean;       {bezier-kurven mit bezier.sty oder EMLinien}
       quality:real;         {Qualitt von bezier durch emline}
       reduce:boolean;       {Verbundene EMlinien bei gleicher Steigung
                              zusammen fassen}
       stdiff:real;          {Steigungs-Differenz fr REDUCE = TRUE}
       snapping:boolean;     {Schnapp-Funktion an oder aus}
       snap_asp:integer;     {Rasterbreite fuer Schnapp-Funktion}
       zoom_fac:real;        {Vergráerungsfaktor}
       unitlength,           {LaTeX-Einheitslaenge der Bilder}
       linewidth:string[20]; {Linienbreite}
     end;

var opt:options_type;
    opt_file:file of options_type;
    opt_name,homedir:pathstr;

type obj_art_type=(txt,box,lin,vec,circ,oval,aux,putaux,bezier,bezvec,
                   unitl,spez,beginn,ende1,ende2,point,option);
     ptr_obj_type=^obj_type;
     obj_type=record {JW,GH}
        x_pos, y_pos, width, height:real;
        next:ptr_obj_type;
        picked:boolean;
        case art:obj_art_type of
           txt,putaux,box:(inhalt:^string; adjust:string[2];
                    dash,solid:boolean; dash_dimen:real;);
           lin,vec:(em:boolean; h_slope, v_slope:integer; len:real;);
           circ:(rad:real; fill:boolean;);
           oval:(lux,luy:real; part:string[2];);
           bezier,
           bezvec:(xx_pos,yy_pos,num:real;h_sl,v_sl:integer;);

     end; {record}

type
 kom_ident=record
            art:obj_art_type;
            kom:string[15];
           end;
 kom_type =(cmakebox,cframebox,cdashbox,crule,cemline1,cemline2,cline,
            cvector1,cvector2,cbezier1,cbezier2,cbezvec,ccircle1,ccircle2,
            coval,cput,cbegin,cend1,cend2,caux,cunit,cspec,con,coff,
            cgrade,clines,cbezmac,creduce,csnap,cqual,cgdiff,
            csnapasp,czoom,cthick,cputaux);
const
 kommando : array[cmakebox..cputaux] of kom_ident =
    ((art:txt;   kom:'\makebox')   ,{cmakebox}
     (art:box;   kom:'\framebox')  ,{cframebox}
     (art:box;   kom:'\dashbox')   ,{cdashbox}
     (art:box;   kom:'\rule')      ,{crule}
     (art:lin;   kom:'\emline')    ,{cemline1}
     (art:lin;   kom:'%\emline')   ,{cemline2}
     (art:lin;   kom:'\line')      ,{cline}
     (art:vec;   kom:'\vector')    ,{cvector1}
     (art:vec;   kom:'%\vector')   ,{cvector2}
     (art:bezier;kom:'\bezier')    ,{cbezier1}
     (art:bezier;kom:'%\bezier')   ,{cbezier2}
     (art:bezvec;kom:'%\bezvec')   ,{cbezvec}
     (art:circ;  kom:'\circle')    ,{ccircle1}
     (art:circ;  kom:'%\circle')   ,{ccircle2}
     (art:oval;  kom:'\oval')      ,{coval}
     (art:point; kom:'\put')       ,{cput}
     (art:beginn;kom:'\begin')     ,{cbegin}
     (art:ende1; kom:'\end')       ,{cend1}
     (art:ende2; kom:'%\end')      ,{cend2}
     (art:aux;   kom:'')           ,{caux}
     (art:option;kom:'\unitlength'),{cunit}
     (art:option;kom:'\special')   ,{cspec}
     (art:option;kom:'\on')        ,{con}
     (art:option;kom:'\off')       ,{coff}
     (art:option;kom:'%\grade')    ,{cgrade}
     (art:option;kom:'%\emlines')  ,{clines}
     (art:option;kom:'%\beziermacro'),{cbezmac}
     (art:option;kom:'%\reduce')   ,{creduce}
     (art:option;kom:'%\snapping') ,{csnap}
     (art:option;kom:'%\quality')  ,{cqual}
     (art:option;kom:'%\graddiff') ,{cgdiff}
     (art:option;kom:'%\snapasp')  ,{csnapasp}
     (art:option;kom:'%\zoom')     ,{czoom}
     (art:option;kom:'\linethickness'),{cthick}
     (art:putaux;kom:'')            {cputaux}
     );

var root,cur_obj,work_obj:ptr_obj_type;

var old_exit_proc,heap_bottom:pointer;
    graph_driver,graph_mode, {Graphikmodus und -treiber}
    max_x,max_y, {maximale Bildschirm-Koordinaten}
    color,max_color, {normale, maximale Zeichenfarbe}
    m_x,m_y, {maximales x und y im Zeichenfenster}
    hor_splitt,ver_splitt, {Aufteilung des Bildschirms}
    curs_x,curs_y:integer; {Cursorposition in Bildschirm-Koord.}
    h_mag,v_mag,asp, {Faktoren und Aspect-ratio um
                      Welt- in Bildschirmkoordinaten umzurechnen}
    x0,y0, {linke untere Ecke des angezeigten Bildausschnittes}
    wx,wy, {Cursorposition in Weltkoordinaten}
    m_wx,m_wy:real; {maximales x und y in Weltkoordinaten}
    saved:boolean; {Bild gespeichert?}

const max_func=12;
var funk:array[0..max_func]of string[20];
    menu_pos:array[0..max_func]of integer;
    menu_curs,ver_curs,hor_curs:pointer;
    msg_line:integer;

procedure redraw_one(obj_ptr :ptr_obj_type);

procedure load_opt(var o:options_type; var succ:boolean);
{Ldt die Parameterdatei}

procedure pict_port;
{Setzt das Zeichenfenster}

procedure rulers;
{Zeichnet die Lineale im Zeichenfenster}

procedure put_cursor;
{Zeichnet den Cursor an die Position (curs_x,curs_y)}

function pythagoras(x,y:real):real;

procedure trans(x,y: real; var sx,sy: integer);
{Rechnet die Weltkoordinaten (x,y) in Bildschirmkoordinaten (sx,sy) um}

procedure draw_text(text_ptr:ptr_obj_type);
{Zeichnet eine Textmarkierung}

procedure draw_unknown_put(text_ptr:ptr_obj_type);
{Zeichnet eine Markierung fr eine unbekanntes PUT-Objekt}

procedure draw_box_text(box_ptr:ptr_obj_type);
{Zeichnet eine BoxTextmarkierung in eine Box}

procedure draw_box(box_ptr:ptr_obj_type);
{Zeichnet eine (gestrichelte) Box}

procedure draw_line(line_ptr:ptr_obj_type);
{Zeichnet eine Linie oder einen Pfeil}

procedure draw_circ(circ_ptr:ptr_obj_type);
{Zeichnet einen (gef"ullten) Kreis}

procedure draw_oval(oval_ptr:ptr_obj_type);
{Zeichnet ein(en Teil eines) Oval(s)}

procedure draw_bezier(ptr:ptr_obj_type);
{Zeichnet eine Bezierkurve als Linie oder Vector}

procedure redraw(all:boolean);
{Baut das Bild im Zeichenfenster neu auf}

procedure toggle_snap;
{Schaltet Schnappfunktion ein und aus}

function mouse_stat(mode:boolean):integer;
{<1: Mousestatus, 0=keine, -1=linke, -2=rechte Taste losgelassen,
     (m_xpos,m_ypos)=Mouseposition in Pixel,
     (wx,wy)=Mouseposition in Weltkoordinaten;
 >0: Hi-Byte=0, Lo-Byte=eingegebenes Zeichen}

procedure get_point(var sx,sy:integer; var x,y:real; var ende:boolean);
{Liefert die Koordinaten eines gewaehlten Punktes in Bildschirm-
 und in Weltkoordinaten.}

procedure get_area(var sx1,sy1,sx2,sy2:integer; var ende:boolean);
{Liefert die Pixel-Koordinaten eines anzugebenden Fensters.}

procedure message(msg:string);
{Gibt eine Nachricht im Fenster rechts oben aus, bzw. loescht das Fenster.}

function yes_no(t1,t2:char):boolean;
{Liefert TRUE, wenn Taste T1 oder linker Mouseknopf gedrueckt,
 liefert FALSE, wenn Taste T2 oder rechter Mouseknopf gedrueckt.}

procedure get_str(y:integer; var st:string; var ende:boolean);
{Gibt den String ST ab Position (0,Y) zum Editieren aus.}

procedure menu(anz:integer; var wahl:integer);
{Gibt ein Menu im Fenster rechts unten aus}

procedure delete_object_list;
{Lscht die Objekt-Liste}

implementation

uses tc_draw,timers;

var
  last_mouse_move:tclock;
  last_x,last_y:integer;

{$f+}
procedure ex;
{GH}
{Setzt den Zeiger 'exitproc' zurueck und beendet das Graphikpaket}
begin
   exitproc:=old_exit_proc; closegraph;
end; {ex}
{$f-}

procedure init;
{GH}
{Initialisiert das Graphikpaket und die globalen Variablen}
var driver,mode,err_code,i,h:integer;
    x_asp,y_asp:word;
    var opt_loaded:boolean;
    hstr:string[25];
begin
   wx:=1;wy:=1;work_obj:=nil;
   homedir:=paramstr(0); i:=length(homedir);
   while homedir[i]<>'\' do dec(i); homedir[0]:=chr(i);
   opt_name:=fexpand('texcad.opt'); load_opt(opt,opt_loaded);
   if not opt_loaded then begin
      opt_name:=homedir+'texcad.opt'; load_opt(opt,opt_loaded);
      if not opt_loaded then with opt do begin
         driver_path:=''; tex_path:=''; tex_suff:='.pic';
         mac_path:=''; mac_suff:='.mac'; unitlength:='1mm';
         steigung:=true;only_emtex:=true;bezier:=false;quality:=2;
         reduce:=true;stdiff:=0.005;
         linewidth:='0.4pt';
         snapping:=false; snap_asp:=1; zoom_fac:=1;
      end;
   end;
   root:=nil; cur_obj:=nil;
   old_exit_proc:=exitproc; exitproc:=addr(ex);
   driver:=detect; mode:=0;
   if paramcount>0 then begin
      for i:=1 to paramcount do begin
         hstr:=paramstr(i);
         if copy(hstr,1,2)='-g' then begin
            delete(hstr,1,2);
            h:=pos(',',hstr);
            if h=0 then begin
               val(hstr,driver,err_code);
               if err_code<>0 then driver:=detect;
               mode:=0;
            end else begin
               val(copy(hstr,1,h-1),driver,err_code);
               if err_code<>0 then driver:=detect
               else begin
                  val(copy(hstr,h+1,1),mode,err_code);
                  if err_code<>0 then mode:=0;
               end;
            end;
         end;
      end;
   end;
   repeat
      graph_driver:=driver; graph_mode:=mode;
      initgraph(graph_driver,graph_mode,opt.driver_path);
      err_code:=graphresult;
      if err_code<>0 then begin
        writeln('Graphics-Error ',err_code,': ',grapherrormsg(err_code));
        if err_code=grfilenotfound then begin
           write('Enter path or press RETURN to exit: ');
           readln(opt.driver_path);
           if opt.driver_path='' then halt(1);
        end else halt(1);
      end;
   until err_code=grok;
   max_x:=getmaxx; max_y:=getmaxy; color:=getcolor; max_color:=getmaxcolor;
   hor_splitt:=round((max_x+1)*0.75)+1; ver_splitt:=round((max_y+1)*0.4)+1;
   getaspectratio(x_asp,y_asp); asp:=x_asp/y_asp;
   h_mag:=opt.zoom_fac*3; v_mag:=h_mag*asp; x0:=0; y0:=0;
   m_x:=hor_splitt-3; m_y:=max_y-2; m_wx:=m_x/h_mag; m_wy:=m_y/v_mag;
   curs_x:=1; curs_y:=max_y-3; wx:=1; wy:=1; msg_line:=0;
   h:=(max_y-ver_splitt) div (max_func+1); menu_pos[0]:=0;
   for i:=1 to max_func do menu_pos[i]:=menu_pos[i-1]+h;
   saved:=true;
   setlinestyle(UserBitLn,$cccc,normwidth);
   line(0,0,m_x,0);
   line(0,0,0,m_y);
   i:=imagesize(0,0,m_x,0);
   getmem(hor_curs,i); getimage(0,0,m_x,0,hor_curs^);
   i:=imagesize(0,0,0,m_y);
   getmem(ver_curs,i); getimage(0,0,0,m_y,ver_curs^);
   setlinestyle(solidln,0,normwidth);
   rectangle(0,0,max_x,max_y);
{   setlinestyle(solidln,0,thickwidth);}
   line(hor_splitt,0,hor_splitt,max_y);
   line(hor_splitt,ver_splitt,max_x,ver_splitt);
   setlinestyle(solidln,0,normwidth);
   bar(hor_splitt+10,2,max_x-10,10);
   i:=imagesize(hor_splitt+10,2,max_x-10,10); getmem(menu_curs,i);
   getimage(hor_splitt+10,2,max_x-10,10,menu_curs^);
   putimage(hor_splitt+10,2,menu_curs^,xorput);
   rulers;
{   mark(heap_bottom);}
end; {init}

procedure load_opt(var o:options_type; var succ:boolean);
{GH}
begin
   succ:=false;
   assign(opt_file,opt_name);
   {$I-} reset(opt_file);
   if ioresult=0 then begin
      read(opt_file,o);
      succ:=ioresult=0;
      {$I+} close(opt_file);
   end;
end; {load_opt}

procedure pict_port;
{GH}
begin
   setviewport(1,1,hor_splitt-2,max_y-1,clipon);
   set_mouse_window(0,0,m_x,m_y);
   set_mouse_pos(curs_x,curs_y);
   set_mouse_speed(2,3);
end; {pict_port}

procedure rulers;
{GH}
var i:integer;
    j:string[5];
    r:real;
begin
   pict_port; clearviewport;
   settextjustify(centertext,toptext);
   if frac(x0)=0 then i:=trunc(x0)
      else i:=trunc(x0)+1;
   r:=h_mag*(i-x0);
   repeat {X-Lineal}
      if i mod 5=0 then begin
         if i mod 10=0 then begin
            str(i div 10,j); outtextxy(round(r),6,j);
         end;
         line(round(r),0,round(r),6);
      end else line(round(r),0,round(r),3);
      r:=r+h_mag; i:=i+1
   until r>=hor_splitt;
   settextjustify(righttext,centertext);
   if frac(y0)=0 then i:=trunc(y0)
      else i:=trunc(y0)+1;
   r:=m_y-v_mag*(i-y0);
   repeat {Y-Lineal}
      if i mod 5=0 then begin
         if i mod 10=0 then begin
            str(i div 10,j); outtextxy(m_x-9,round(r),j);
         end;
         line(m_x,round(r),m_x-9,round(r));
      end else line(m_x,round(r),m_x-4,round(r));
      r:=r-v_mag; i:=i+1;
   until r<=0;
   settextjustify(lefttext,toptext);
end; {rulers}

procedure put_cursor;
{GH}
begin
   putimage(curs_x,0,ver_curs^,xorput);
   putimage(0,curs_y,hor_curs^,xorput);
end; {put_cursor}

function pythagoras(x,y:real):real;
{JW}
begin
 pythagoras:=sqrt(sqr(x)+sqr(y));
end;

procedure trans(x,y: real; var sx,sy: integer);
{GH}
begin
   sx:=round(h_mag*(x-x0));
   sy:=m_y-round(v_mag*(y-y0));
end;

procedure draw_text(text_ptr:ptr_obj_type);
{GH}
var sx,sy:integer;
begin
   with text_ptr^ do trans(x_pos,y_pos,sx,sy);
   settextjustify(centertext,centertext);
   outtextxy(sx,sy,'T');
   settextjustify(lefttext,toptext);
end; {draw_text}

procedure draw_unknown_put(text_ptr:ptr_obj_type);
{JW}
var sx,sy:integer;
begin
   with text_ptr^ do trans(x_pos,y_pos,sx,sy);
   settextjustify(centertext,centertext);
   outtextxy(sx,sy,'U');
   settextjustify(lefttext,toptext);
end; {draw_unknown_put}

procedure draw_box_text(box_ptr:ptr_obj_type);
var h_just,v_just,sx,sy:integer;
    x,y:real;
begin
   with box_ptr^ do if inhalt<>nil then begin
      case adjust[1] of
         'l': begin
            h_just:=lefttext; x:=x_pos;
         end;
         'r': begin
            h_just:=righttext; x:=x_pos+width;
         end;
         'c': begin
            h_just:=centertext; x:=x_pos+width/2;
         end;
      end;
      case adjust[2] of
         't': begin
            v_just:=toptext; y:=y_pos+height;
         end;
         'b': begin
            v_just:=bottomtext; y:=y_pos;
         end;
         'c': begin
            v_just:=centertext; y:=y_pos+height/2;
         end;
      end;
      trans(x,y,sx,sy);
      settextjustify(h_just,v_just);
      outtextxy(sx,sy,'BT');
      settextjustify(lefttext,toptext);
   end;
end; {draw_box_text}

procedure draw_box(box_ptr:ptr_obj_type);
{GH}
var sx1,sx2,sy1,sy2:integer;
begin
with box_ptr^ do begin
   trans(x_pos,y_pos,sx1,sy1); trans(x_pos+width,y_pos+height,sx2,sy2);
   if solid then bar(sx1,sy1,sx2,sy2)
   else begin
      if dash then setlinestyle(dashedln,0,normwidth);
      rectangle(sx1,sy2,sx2,sy1);
      if dash then setlinestyle(solidln,0,normwidth);
      draw_box_text(box_ptr);
   end;
end;
end; {draw_box}

procedure draw_line(line_ptr:ptr_obj_type);
{GH}
var sx1,sx2,sy1,sy2:integer;
begin
with line_ptr^ do begin
   trans(x_pos,y_pos,sx1,sy1); trans(width,height,sx2,sy2);
   line(sx1,sy1,sx2,sy2);
   if art=vec then circle(sx2,sy2,3);
end;
end; {draw_line}

procedure draw_circ(circ_ptr:ptr_obj_type);
{GH}
var sx,sy:integer;
begin
with circ_ptr^ do begin
   trans(x_pos,y_pos,sx,sy);
   if fill then fillellipse(sx,sy,round(h_mag*rad),round(v_mag*rad))
   else circle(sx,sy,round(h_mag*rad));
end;
end; {draw_circ}

procedure draw_oval(oval_ptr:ptr_obj_type);
{GH}
var x1,x2,x3,x4,y1,y2,y3,y4,arc_rad,xp,yp:integer;
begin
with oval_ptr^ do begin
   arc_rad:=round(width/2);
   if height/2<arc_rad then arc_rad:=round(height/2);
   if arc_rad>7 then arc_rad:=7;
   trans(lux,luy,x1,y1); trans(lux+arc_rad,luy+arc_rad,x2,y2);
   trans(lux+width-arc_rad,luy+height-arc_rad,x3,y3);
   trans(lux+width,luy+height,x4,y4);
   arc_rad:=round(h_mag*arc_rad);
   if part='' then begin
      line(x2,y1,x3,y1); line(x4,y2,x4,y3);
      line(x3,y4,x2,y4); line(x1,y3,x1,y2);
      arc(x2,y2,180,270,arc_rad); arc(x3,y2,270,360,arc_rad);
      arc(x3,y3,0,90,arc_rad); arc(x2,y3,90,180,arc_rad);
   end else begin
      trans(lux+width/2,luy+height/2,xp,yp);
      if length(part)=1 then case part[1] of
         'l': begin
            line(x2,y1,xp,y1); line(xp,y4,x2,y4); line(x1,y3,x1,y2);
            arc(x2,y2,180,270,arc_rad); arc(x2,y3,90,180,arc_rad);
         end;
         'r': begin
            line(xp,y1,x3,y1); line(x4,y2,x4,y3); line(x3,y4,xp,y4);
            arc(x3,y2,270,360,arc_rad); arc(x3,y3,0,90,arc_rad);
         end;
         't': begin
            line(x4,yp,x4,y3); line(x3,y4,x2,y4); line(x1,y3,x1,yp);
            arc(x3,y3,0,90,arc_rad); arc(x2,y3,90,180,arc_rad);
         end;
         'b': begin
            line(x2,y1,x3,y1); line(x4,y2,x4,yp); line(x1,yp,x1,y2);
            arc(x2,y2,180,270,arc_rad); arc(x3,y2,270,360,arc_rad);
         end;
      end {case}
      else case part[1] of
         'l': if part[2]='t' then begin
            line(xp,y4,x2,y4); line(x1,y3,x1,yp);
            arc(x2,y3,90,180,arc_rad);
          end else begin
            line(x2,y1,xp,y1); line(x1,yp,x1,y2);
            arc(x2,y2,180,270,arc_rad);
          end;
         'r': if part[2]='t' then begin
            line(x4,yp,x4,y3); line(x3,y4,xp,y4);
            arc(x3,y3,0,90,arc_rad);
         end else begin
            line(xp,y1,x3,y1); line(x4,y2,x4,yp);
            arc(x3,y2,270,360,arc_rad);
         end;
      end; {case}
   end;
end;
end; {draw_oval}

procedure draw_bezier(ptr:ptr_obj_type);
{JW,GH}
var x,y,sc,scp,xb,xa,yb,ya:real;
    t,xx,yy,mx,my:integer;
    vector :boolean;
    col : word;
begin
   with ptr^ do begin
      vector:= art = bezvec;
      sc:=num/2;
      if sc<1 then sc:=1;
      scp:=sc+1;
      xb:=(width-x_pos)*2;
      xa:=(xx_pos-x_pos)-xb;
      xa:=xa/sc;
      yb:=(height-y_pos)*2;
      ya:=(yy_pos-y_pos)-yb;
      ya:=ya/sc;
      t:=0;
      col := GetColor;
      while t<scp do begin
         x:=t*xa+xb;
         x:=(x/sc)*t;
         y:=t*ya+yb;
         y:=(y/sc)*t;
         trans(x+x_pos,y+y_pos,xx,yy);
         putpixel(xx,yy,col);
         t:=t+2;
         if vector
         then
          if ((t+4)<=scp) and (t+6 > scp)
          then begin
           mx:=xx;
           my:=yy;
          end;
      end;
      if vector
      then begin
       circle(xx,yy,3);
       get_slope(xx-mx,my-yy,h_sl,v_sl,vector);
      end;
   end;
end; {draw_bezier}

procedure redraw_one(obj_ptr :ptr_obj_type);
{JW}
begin
 if (obj_ptr <> nil)
 then
  case obj_ptr^.art of
     txt: draw_text(obj_ptr);
     box: draw_box(obj_ptr);
     lin,vec: draw_line(obj_ptr);
     circ: draw_circ(obj_ptr);
     oval: draw_oval(obj_ptr);
     bezier,
     bezvec: draw_bezier(obj_ptr);
     putaux: draw_unknown_put(obj_ptr);
  end; {case}
end;

procedure redraw(all:boolean);
{JW,GH}
var obj_ptr:ptr_obj_type;
begin
rulers;obj_ptr:=root;
while obj_ptr<>nil do with obj_ptr^ do begin
 if all or not picked
 then
  redraw_one(obj_ptr);
 obj_ptr:=obj_ptr^.next;
end; {while}
end; {redraw}

procedure toggle_snap;
{GH}
var x,y:real;
begin
   opt.snapping:=not opt.snapping;
   if opt.snapping then begin
      wx:=opt.snap_asp*round(wx/opt.snap_asp);
      wy:=opt.snap_asp*round(wy/opt.snap_asp);
      trans(wx,wy,m_xpos,m_ypos);
   end;
end; {toggle_snap}

function mouse_stat(mode:boolean):integer;
{GH}
var ch:char;
    setpos,changed:boolean;
    snap,jump:integer;
begin
mouse_stat:=0;
if keypressed then begin
   ch:=readkey;
   if ch=#0 then begin
      ch:=readkey; setpos:=true;
      if opt.snapping then with opt do begin
         case ch of
            #72: if wy+snap_asp<=m_wy then wy:=wy+snap_asp; {Up}
            #80: if wy-snap_asp>=y0 then wy:=wy-snap_asp; {Down}
            #75: if wx-snap_asp>=x0 then wx:=wx-snap_asp; {Left}
            #77: if wx+snap_asp<=m_wx then wx:=wx+snap_asp; {Right}
            #160: if wy+10*snap_asp<=m_wy then wy:=wy+10*snap_asp; {Ctrl-Up}
            #164: if wy-10*snap_asp>=y0 then wy:=wy-10*snap_asp; {Ctrl-Down}
            #115: if wx-10*snap_asp>=x0 then wx:=wx-10*snap_asp; {Ctrl-Left}
            #116: if wx+10*snap_asp<=m_wx then wx:=wx+10*snap_asp; {Ctrl-Right}
            else setpos:=false;
         end;
         if setpos then trans(wx,wy,m_xpos,m_ypos);
      end else begin
         case ch of
            #72: if m_ypos>min_ypos then dec(m_ypos); {Up}
            #80: if m_ypos<max_ypos then inc(m_ypos); {Down}
            #75: if m_xpos>min_xpos then dec(m_xpos); {Left}
            #77: if m_xpos<max_xpos then inc(m_xpos); {Right}
            #160: if m_ypos-10>=min_ypos then dec(m_ypos,10); {Ctrl-Up}
            #164: if m_ypos+10<=max_ypos then inc(m_ypos,10); {Ctrl-Down}
            #115: if m_xpos-10>=min_xpos then dec(m_xpos,10); {Ctrl-Left}
            #116: if m_xpos+10<=max_xpos then inc(m_xpos,10); {Ctrl-Right}
            else setpos:=false;
         end; {case}
         if setpos then begin
            wx:=x0+m_xpos/h_mag; wy:=y0+(m_y-m_ypos)/v_mag;
         end;
      end;
      if setpos and m_ok then set_mouse_pos(m_xpos,m_ypos);
   end else mouse_stat:=ord(upcase(ch));
end else if m_ok then begin
   get_released_info(0);
   if rel>0 then mouse_stat:=-1 {linke Taste}
   else begin
      get_released_info(1);
      if rel>0 then mouse_stat:=-2 {rechte Taste}
      else begin
         mouse_stat:=0; get_mouse_pos;
       if mode and (work_obj <> nil)
       then begin
        with last_mouse_move do
         if (last_x <> m_xpos) or (last_y <> m_ypos)
         then begin
           gettime(h,mi,s,hs);
           last_x := m_xpos;
           last_y := m_ypos;
         end
         else
          if (hs <> 0) and (get_delay(last_mouse_move) > 100)
          then begin
           redraw(true);
           redraw_one(work_obj);
           put_cursor;
           hs := 0;
          end;
       end;
      end;
   end;
   wx:=x0+m_xpos/h_mag; wy:=y0+(m_y-m_ypos)/v_mag;
{  if mode  {das Verschieben des Fensters durch Mausberhrung mit dem Rand
            funktioniert leider nicht sauber
   then
    with opt do begin
     changed:=false;
     if snapping
     then
      snap := snap_asp
     else
      snap := 1;
     if wy+snap>=m_wy
      then begin
       y0:=y0+snap * 5;
       redraw(true);
       put_cursor;
       wy:=wy+snap;
       m_wy :=m_wy+snap * 5;
       changed:=true;
      end;
     if wy-snap<=y0
      then begin
       y0:=y0-snap * 5;
       redraw(true);
       put_cursor;
       wy:=wy-snap;
       m_wy :=m_wy-snap * 5;
       changed:=true;
      end;
     if wx-snap<=x0
      then begin
       x0:=x0-snap * 5;
       redraw(true);
       put_cursor;
       wx:=wx-snap;
       m_wx :=m_wx-snap * 5;
       changed:=true;
      end;
     if wx+snap>=m_wx
      then begin
       x0:=x0+snap * 5;
       redraw(true);
       put_cursor;
       wx:=wx+snap ;
       m_wx :=m_wx+snap * 5;
       changed:=true;
      end;
     if changed
     then begin
      trans(wx,wy,m_xpos,m_ypos);
     end;
    end;}
   if opt.snapping then begin
      wx:=opt.snap_asp*round(wx/opt.snap_asp);
      wy:=opt.snap_asp*round(wy/opt.snap_asp);
      trans(wx,wy,m_xpos,m_ypos);
   end;
end;
end; {mouse_stat}

procedure get_point(var sx,sy:integer; var x,y:real; var ende:boolean);
{GH}
var stat:integer;
    stop:boolean;
begin
put_cursor; stop:=false;
while not stop do begin
   stat:=mouse_stat(true);
   case stat of
      0: if (m_xpos<>curs_x) or (m_ypos<>curs_y) then begin
         put_cursor; curs_x:=m_xpos; curs_y:=m_ypos; put_cursor;
      end;
      -1,13: begin {linke Taste, ENTER}
         put_cursor; sx:=curs_x; sy:=curs_y; x:=wx; y:=wy;
         ende:=false; stop:=true;
      end;
      -2,27: begin {rechte Taste, ESC}
         put_cursor; sx:=0; sy:=0; x:=0; y:=0;
         ende:=true; stop:=true;
      end;
      ord('P'): toggle_snap;
      ord('E'): begin
         y0:=y0+(m_y div 4)/v_mag; redraw(true); put_cursor;
      end;
      ord('S'): begin
         x0:=x0-(m_x div 4)/h_mag; redraw(true); put_cursor;
      end;
      ord('X'): begin
         y0:=y0-(m_y div 4)/v_mag; redraw(true); put_cursor;
      end;
      ord('D'): begin
         x0:=x0+(m_x div 4)/h_mag; redraw(true); put_cursor;
      end;
   end; {case}
end; {while}
end; {get_point}

procedure get_area(var sx1,sy1,sx2,sy2: integer; var ende:boolean);
{GH}
var x,y:real;
    stat:integer;
    stop:boolean;
begin
message('Lower left corner:'); pict_port;
get_point(sx1,sy1,x,y,ende); sx2:=sx1; sy2:=sy1;
if not ende then begin
   message('Upper right corner:'); pict_port;
   setwritemode(xorput); stop:=false;
   repeat
      stat:=mouse_stat(true);
      case stat of
      0:if (m_xpos<>curs_x) or (m_ypos<>curs_y) then begin
         curs_x:=m_xpos; curs_y:=m_ypos;
         rectangle(sx1,sy1,sx2,sy2);
         if curs_x>sx1 then sx2:=curs_x else sx2:=sx1;
         if curs_y<sy1 then sy2:=curs_y else sy2:=sy1;
         rectangle(sx1,sy1,sx2,sy2);
      end;
      -1,13: stop:=true; {linke Taste, ENTER}
      -2,27: begin       {rechte Taste, ESC}
         ende:=true; stop:=true;
      end;
      ord('P'): toggle_snap;
      end; {case}
   until stop;
   setwritemode(normalput);
end;
end; {get_area}

procedure message(msg:string);
{GH}
begin
   setviewport(hor_splitt+10,10,max_x-1,ver_splitt-2,clipon);
   if msg='' then begin
      clearviewport; msg_line:=0;
   end else begin
      outtextxy(0,msg_line,msg); msg_line:=msg_line+12;
   end;
end; {message}

function yes_no(t1,t2:char):boolean;
{GH}
var stop:boolean;
    stat:integer;
begin
stop:=false; t1:=upcase(t1); t2:=upcase(t2);
repeat
   stat:=mouse_stat(false);
   case stat of
      -1,13: begin {linke Taste, ENTER}
         yes_no:=true; stop:=true;
      end;
      -2,27: begin {rechte Taste, ESC}
         yes_no:=false; stop:=true;
      end;
      else if (chr(stat)=t1) or (chr(stat)=t2) then begin
            yes_no:=chr(stat)=t1; stop:=true;
      end;
   end; {case}
until stop;
end; {yes_no}

procedure get_str(y:integer; var st:string; var ende:boolean);
{JW,GH}
var i,cx,cy,w:integer;
    ch:char;
    ins:boolean;
    vp:viewporttype;

procedure write_str;
{GH}
var j,hx,hy:integer;
begin
   hx:=cx; hy:=cy;
   for j:=i to length(st) do begin
      outtextxy(hx,hy,st[j]); hx:=hx+8;
      if hx>w then begin
         hx:=0; hy:=hy+12;
      end;
   end;
end; {write_str}

begin
getviewsettings(vp); w:=(((vp.x2-vp.x1) div 8)-1)*8;
i:=1; cx:=0; cy:=y; write_str;
ende:=false; ins:=true;
line(cx,cy+8,cx+8,cy+8); setwritemode(xorput);
repeat
if keypressed then begin
   ch:=readkey; line(cx,cy+8,cx+8,cy+8);
   case ch of
      #32..#126,
      '','','',
      '','','',
      'á': begin
         if ins then begin
            setcolor(0); write_str; setcolor(color);
            insert(ch,st,i); write_str;
         end else begin
            if i<=length(st) then begin
               setcolor(0); outtextxy(cx,cy,st[i]); setcolor(color);
            end else st[0]:=chr(i);
            outtextxy(cx,cy,ch); st[i]:=ch;
         end;
         cx:=cx+8; i:=i+1;
         if cx>w then begin
            cx:=0; cy:=cy+12;
         end;
      end;
      #13: ;
      #27: ende:=true;
      #0: begin
         ch:=readkey;
         if (ch=#75) and (i>1) then begin {links}
            i:=i-1; cx:=cx-8;
            if cx<0 then begin
               cx:=w; cy:=cy-12;
            end;
         end;
         if (ch=#77) and (i<=length(st)) then begin {rechts}
            cx:=cx+8; i:=i+1;
            if cx>w then begin
               cx:=0; cy:=cy+12;
            end;
         end;
         if ch=#82 then ins:=not ins; {insert}
         if (ch=#83) and (i<=length(st)) then begin {delete}
            setcolor(0); write_str; setcolor(color);
            delete(st,i,1); write_str;
         end;
      end;
      #8: if i>1 then begin {backspace}
         i:=i-1; cx:=cx-8;
         if cx<0 then begin
            cx:=w; cy:=cy-12;
         end;
         setcolor(0); write_str; setcolor(color);
         delete(st,i,1); write_str;
      end;
   end; {case}
   line(cx,cy+8,cx+8,cy+8);
end else if m_ok then begin
   get_released_info(0); {linke Taste}
   if rel>0 then ch:=#13 else begin
      get_released_info(1); {rechte Taste}
      if rel>0 then begin
         ch:=#27; ende:=true;
      end else ch:=' ';
   end;
end;
until (ch=#13) or (ch=#27);
line(cx,cy+8,cx+8,cy+8); setwritemode(normalput);
end; {get_str}

procedure menu(anz:integer; var wahl:integer);
{GH}
var i,stat:integer;
    save_snap,ende:boolean;
begin
setviewport(hor_splitt+10,ver_splitt+8,max_x-10,max_y-1,clipon);
clearviewport; outtextxy(0,menu_pos[0],funk[0]);
for i:=1 to anz do outtextxy(1,menu_pos[i]+1,funk[i]);
putimage(0,menu_pos[wahl],menu_curs^,xorput);
set_mouse_window(0,1,8,anz);
set_mouse_pos(0,wahl);
set_mouse_speed(12,12); ende:=false;
save_snap:=opt.snapping; if save_snap then toggle_snap;
while not ende do begin
   stat:=mouse_stat(false);
   case stat of
   0: if m_ypos<>wahl then begin
      putimage(0,menu_pos[wahl],menu_curs^,xorput);
      wahl:=m_ypos; putimage(0,menu_pos[wahl],menu_curs^,xorput);
   end;
   -1,13: ende:=true;
   -2,27: begin
      wahl:=0; ende:=true;
   end;
   end; {case}
end; {while}
if save_snap then toggle_snap;
end; {menu}

procedure delete_object_list;
{JW}
var
 hptr:ptr_obj_type;
begin
 hptr:=root;
 while root <> nil do begin
  hptr:=root^.next;
  case root^.art of
   txt,box:if root^.inhalt <> nil
           then
            dispose(root^.inhalt);
  end;
  dispose(root);
  root:=hptr;
 end;
 cur_obj:=nil;
end;

begin
   init;
end.
