//{$R-,I-,S-,D-,L-,O+,F+}
unit Edith;
 Interface
 uses //dos,graph,crt,
sysUtils, friend,grafik,common;
 var prompt,space : string[100];
            point : record p1,p2,p3,p4:word end;
 procedure screenToDisk(x1,y1,x2,y2:word; patternPath:pathStr);
 procedure screenFromDisk(var patternPath:pathStr);
 procedure Ed(patternPath:pathStr);
 Implementation

            var          FillInfo : FillSettingsType;
                        GraphMode : integer;
                         TextInfo : TextSettingsType;
                 newColor,BkC,GrC : word;
otx,oty,x0,x1,y0,y1,rx1,ry1,alpha : integer;
          font,direction,charSize : word;
put,ctrl_sign,rect,lines,grot,draw,
killGrot,killFig,triang,thick,circ,
                 box,vert,overlap : boolean;
                          extChar : char;
                          circles : record crcX,crcY,radius:word end;
                        triangles : record trgA,trgB,trgC,gamma:integer end;
                             mode : (travel,blaze,span);
                           schiff : byte;
                            error : integer;
 type wrdary = array[0..128] of word;

  var ScrFile : file of wrdAry;
        mpAry : wrdAry;


  procedure screenToDisk(x1,y1,x2,y2:word; patternPath:pathStr);
   var i,j,l:word;
   drName:DirStr;
   procedure swap(var a,b:word);
    var c:word;
    begin
     if a>b then begin c:=a; a:=b;b:=c end;
    end;{swap}
   begin
    repeat inc(extChar); until not FileExists(patternPath+'.gr'+extChar);
    assign(ScrFile,patternPath+'.gr'+extChar);
    RewRite(ScrFile);
    {-------------------------------------------------parametry grafiki}
    swap(x1,x2); swap(y1,y2);
    mpAry[0]:=x1; mpAry[1]:=y1; mpAry[2]:=x2; mpAry[3]:=y2;
//    mpAry[4]:=GetGraphMode;
    i:=5;
//    drName:=GetDriverName+'????????';
    while i-4<length(drName)+2 do
     begin
      mpAry[i]:=10*byte(drName[i])+byte(drName[i+1]);
      inc(i,2);
     end;
     write(ScrFile,mpAry);
     l:=0;
     for j:=y1 to y2 do
      for i:=x1 to x2 do
       begin
//        mpAry[l]:=GetPixel(i,j);
        inc(l);
        if l=127 then
         begin
          l:=0;
          write(ScrFile,mpAry);
         end;
       end;
     write(ScrFile,mpAry);
    Close(ScrFile);
   end;{screenToDisk}

  procedure screenFromDisk(var patternPath:pathStr);
   var i,j,l : word;
        path : pathStr;
      drName : DirStr;
     konwert : NameStr absolute mpAry;

   begin

    path:=patternPath+'.gr'+extChar;
    repeat
    // write(cons,'Podaj sciezke dostepu do slajdu ');
     repeat
//      supposeRead(path);
//      fileInfor(path,patternPath);
     until FileExists(path);
   //  write(cons,'OK? - t/n');
    until true;//reaDkey in ['t','T'];
    assign(ScrFile,Path);
    Reset(ScrFile);
    {-------------------------------------------------parametry grafiki}
    Read(ScrFile,mpAry);
    rx1:=mpAry[0]; ry1:=mpAry[1]; x1:=mpAry[2]; y1:=mpAry[3];
    GraphMode:=mpAry[0];
    i:=5;
//    drName:=GetDriverName;
    while i-4<length(drName) do
     begin
      if mpAry[i]<>10*byte(drName[i])+byte(drName[i+1]) then
       begin
       // writeln(cons,#7#7'obraz zapisany pod sterownikiem ',Konwert);
       end;
      inc(i,2);
     end;
     inc(i);
     Read(ScrFile,mpAry);
     l:=0;
     graphInit;
     for j:=ry1 to y1 do
      for i:=rx1 to x1 do
       begin
//        PutPixel(i,j,mpAry[l]);
        inc(l);
        if l=127 then
         begin
          l:=0;
          Read(ScrFile,mpAry);
         end;
       end;
    Close(ScrFile);
   end;{screenFromDisk}

 procedure Ed(patternPath:pathStr);

   var   puffer : string;
             ii : word;
           sign : char;
     esc,finish : boolean;
       ViewPort : ViewPortType;
fontinfo,directionInfo,charSizeInfo : NameStr;
           info : DirStr;
            bug : integer;

 procedure Commander;

  procedure range_check;
   begin
    if x0<0 then x0:=0;
    if y0<0 then y0:=0;
    if y1<0 then y1:=0;
    if x1<0 then x1:=0;
//    if x1>GetMaxX then x1:=GetMaxX;
//    if y1>GetMaxY then y1:=GetMaxY;
   end;{range_check}

 function atan(x1,y1,x2,y2:real):real;
  var x,y,alfa:real;
  begin
   x:=x2-x1; y:=y2-y1;
   alfa:=abs(y);                               {y dzielone przez jakiekol-}
   if alfa<3e-39*1.7e38 then                   {wiek x nie moze przekroczyc}
   alfa:= 3e-39*1.7e38;                        {zakresu real}
   alfa:=alfa/1.7e38;
   if abs(x)>alfa then
   begin
    alfa:= arctan(abs(y/x))*57.29577951;
    if x>0 then
     if y>=0 then atan:=alfa
     else         atan:=360-alfa
    else
     if y>=0 then atan:=180-alfa
     else         atan:=180+alfa
   end{x<>0}
  else
   if y=0 then atan:=0
   else
    if y>0 then atan:=90
    else atan:=270
  end;{atan}

  procedure revol(zx,zy,a,b,alpha:real;var c,d:integer);
   begin
    c:=round((a-zx)*cos(alpha)-(b-zy)*sin(alpha)+zx);
    d:=round((a-zx)*sin(alpha)+(b-zy)*cos(alpha)+zy);
   end;{revol}

  procedure triangle(x1,y1,x2,y2:integer; zx,zy:real;alpha:real);
  var Ax,Ay,Bx,By,Cx,Cy : integer;
   begin
    alpha:=pi*alpha/180;
    Ax:=x1;            Ay:=y2;
    Bx:=x2;            By:=y2;
    Cx:=(x2+x1) div 2; Cy:=y1;
    revol(zx,zy,Cx,Cy,alpha,Cx,Cy);
    revol(zx,zy,Ax,Ay,alpha,Ax,Ay);
    revol(zx,zy,Bx,By,alpha,Bx,By);
//    line(Ax,Ay,Bx,By);
  //  line(Bx,By,Cx,Cy);
    //line(Cx,Cy,Ax,Ay);
   end;

  procedure rect_angle(x1,y1,x2,y2:integer; zx,zy,alpha:real;schiff:byte);
  var Ax,Ay,Bx,By,Cx,Cy,Dx,Dy : integer;
   begin
    if (alpha=0) and (schiff=0) and not box then// rectangle(x1,y1,x2,y2)
    else
     begin
      alpha:=pi*alpha/180;
      Ax:=x1;            Ay:=y1;
      Bx:=x2;            By:=y1;
      Cx:=x1;            Cy:=y2;
      Dx:=x2;            Dy:=y2;
      case schiff of
       1 : begin Cx:=Ax-Dy+Ay; Dx:=Dx-Dy+Ay end;
       2 : begin Cx:=Ax+Dy-Ay; Dx:=Bx+Dy-Ay end;
       3 : begin By:=Ay-Dx+Ax; Dy:=Dy-Dx+Ax end;
       4 : begin By:=Ay+Dx-Ax; Dy:=Dy+Dx-Ax end;
      end;{case schiff}
      revol(zx,zy,Ax,Ay,alpha,Ax,Ay);
      revol(zx,zy,Bx,By,alpha,Bx,By);
      revol(zx,zy,Cx,Cy,alpha,Cx,Cy);
      revol(zx,zy,Dx,Dy,alpha,Dx,Dy);
//      line(Ax,Ay,Bx,By);
  //    line(Bx,By,Dx,Dy);
    //  line(Cx,Cy,Dx,Dy);
      //line(Ax,Ay,Cx,Cy);
     end;
   end; {rect_angle}

  procedure coord(var x,y:integer; sign:char;c:shortint);
   begin  {-----------------Modyfikowac pozycje kursora}
(*    case sign of
      #71 : x:=-(c-1)*GetMaxX div 2;               { Home  }
      #79 : x:=GetMaxX-8*charSize+2*(c-1)*GetMaxX; { End   }
      #75 : dec(x,c);                              { Left  }
      #77 : inc(x,c);                              { Right }
     #115 : dec(x,8*charSize*c);                   {^Left  }
     #116 : inc(x,8*charSize*c);                   {^Right }
      #72 : dec(y,c);                              { Up    }
      #80 : inc(y,c);                              { Down  }
      #73 : dec(y,8*charSize*c);                   { PgUp  }
      #81 : inc(y,8*charSize*c);                   { PgDn  }
    end;{case}        *)
//    PutImage(otx,oty,prompt,XORPut);
    otx:=x1; oty:=y1;
//    PutImage(otx,oty,prompt,XORPut);
   end;{coord}

 procedure line_fig;
  var zx,zy:real;
  begin
   zx:=(rx1+x1)/2; zy:=(ry1+y1)/2;
//   if box then rectangle(rx1,ry1,x1,y1);
   if rect then rect_angle(rx1,ry1,x1,y1,zx,zy,alpha,schiff);
   if triang then  triangle(rx1,ry1,x1,y1,zx,zy,alpha);
//   if lines then line(rx1,ry1,x1,y1);
   if grot and lines then
    if killGrot then
     triangle(x1-3,y1,x1+3,y1+8,x1,y1,atan(rx1,ry1,x1,y1)+90)
    else killGrot:=true;
  end;{line_fig}

 procedure arc_fig_reset;
  begin
   if circ then
    with circles do
     begin             {kasuje ostatnie kolo}
//      setColor(getBkColor);
//      circle(crcX,crcY,radius);
  //    setColor(newColor);
     end;
  end;{arc_fig_reset}

 procedure Kill_fig;
  begin
   if killFig then
     begin
//      PutImage(x1,y1,prompt,XORPut);
      line_fig;
      arc_fig_reset;
//      PutImage(x1,y1,prompt,XORPut);
     end
   else killFig:=true;
  end;{kill_fig}

  procedure arc_fig_set;
   begin
    if circ then
     with circles do
      begin             {kresli kolo}
       crcX:=(x1+rx1) div 2;
       crcY:=(y1+ry1) div 2;
       radius:=round(sqrt(sqr((x1-rx1)/2)+sqr((y1-ry1)/2)));
//       circle(crcX,crcY,radius);
     end;{with}
   end;{arc_fig_set}

  procedure Set_fig;
   begin
//      PutImage(x1,y1,prompt,XORPut);
      range_check;
      x0:=x1; y0:=y1;
      line_fig;
//      if draw then putImage(x1,y1,point,XorPut);
      arc_fig_set;
//      PutImage(x1,y1,prompt,XORPut);
   end;{set_fig}

  procedure angle(c:shortint);
   var angst:namestr;
   begin
    kill_fig;
    inc(alpha,c); alpha:=alpha mod 360;
//    bar(GetMaxX-80,0,GetMaxX,8);
    str(alpha:4,angst);
//    outTextXY(GetMaxX-80,0,'angle'+angst);
    set_fig;
   end;{angle}

  procedure start;
   begin
    rx1:=x1; ry1:=y1;
    killFig:=false; mode:=span;
   end;{start}

  begin
   puffer:=''; esc:=false; finish:=false;
//    while KeyPressed do puffer:=puffer+ReadKey;
    ii:=1;
    WHILE ii<=length(puffer) do
     begin
      sign:=puffer[ii];
      CASE sign of
       #13,#10 : put:=true;  {zaakceptowac figure i wlaczyc tryb travel}
       #27 : esc:=true;      {Esc, wyjsc}
        ^F : begin
//              seTfiLLStyle(1,blue);
//              FloodFill(x1,y1,newColor);
//              error:=graphResult;
             end;
        ^G : begin grot:= not grot; if not grot then killgrot:=false end;
  ^X,^L,^O,^T,^R             {wybor figury do kreslenia}
           :
        begin
         if not (box or rect or lines or circ) then start; {zerowanie wspolrzednych}
         case sign of
          ^X :  box:= not box; {kreslic prostokat}
          ^R :  rect:= not rect; {kreslic rownoleglobok}
          ^L : lines:=not lines;
          ^O : with circles do
               begin             {kresli kolo}
                circ:=not circ;
//                if not circ then with circles do circle(crcX,crcY,radius);
                crcX:=x1; crcY:=y1;
               end;
          ^T :  triang:=not triang;         {kresli trojkat}
         end;{case ^X,^L,^T}
         if not (box or rect or lines or circ) then start; {zerowanie wspolrzednych}
        end;
        #0 :
             begin
              inc(ii);
              sign:=puffer[ii];
//              if sign in [#59,#84,#94] then SetTextStyle(0,0,1);
             if (sign in [#71..#73,#75,#77,#79..#81,#115,#116]) then
              Kill_fig;
              case sign of
              #113 : begin               {a-F10 - zapisac obraz na dysk}
//                      rectangle(rx1,ry1,x1,y1);
                      screenToDisk(rx1,ry1,x1,y1,patternPath);
//                      rectangle(rx1,ry1,x1,y1);
                     end;
//              #119 : bar(0,y1,x1,y1+8);       {Ctrl-HomeKasowacWierszDoKonca}
//              #117 : bar(x1,y1,GetMaxX,y1+8); {Ctrl-EndKasowacWierszDoKonca}
               #65 : mode:=span;              {F7 - rozciagac figure}
               #90 : mode:=travel;            {shift-F7 - przesuwac figure}
              #100 : mode:= blaze;            {Ctrl-F7 - powiekszac figure}

               #15 : angle(-1);         {tab, pomniejszyc kat obrotu o 1 stop}
#71,#79,#75,#77,#115,#116,#72,#80,#73,#81:
                     case mode of
                      travel : begin
                                coord(rx1,ry1,sign,1);
                                coord(x1,y1,sign,1);
                               end;
                       blaze : begin
                                coord(rx1,ry1,sign,-1);
                                coord(x1,y1,sign,1);
                               end;
                       span :  coord(x1,y1,sign,1);
                     end;{case mode}
               {---------------------------------------------------Help`y}
//               #59 : outTextXY(0,0,info);               {F1 - help}
//               #84 : outTextXY(x1,y1,info);             {shift-F1 - help}
              #105 : ctrl_sign:= not ctrl_sign;         {Alt-F2, ^kod}
               #94 : begin
//                      bar(0,0,GetMaxX,20);
//                      outTextXY(2,2,
//'A-F1..A-F5  A-1..A-0  F2    ^F2  A-F2 ^Home   ^End    A-F10    A-F6   ^X   Esc  ');
//                      outTextXY(2,10,
//'pismo       powieksz  kier  nakl  ^#  puc_do  puc_od  na_dysk  rysuj  box  wyjsc');
                     end;

               {--------------------------------------------------Atrybuty}
               #95 : overlap:=not overlap;              {^F2 nakladac?}
               #60 : begin                              { F2, kierunek pisma}
                      vert:=not vert;
                      if vert then direction:=1 else direction:=0;
                     end;
//        #104..#108 : font:= ord(sign)-104;     {alt-F1 - alt-F5 - rodzaj pisma}
        #120..#129 : charSize:=ord(sign)-119;  {alt-1..alt-0 - powiekszenie}
              #109 : draw:= not draw;          {alt-F6 - punktowac linie}
               #38 : begin                     {alt-L grubosc linii}
                      thick:= not thick;
//                      if thick then SetLineStyle(0,0,ThickWidth)
  //                    else SetLineStyle(0,0,NormWidth);
                     end;
               #19 : begin                     {alt-R - skos rownolegloboku}
                      kill_fig;
                      inc(schiff); schiff:= schiff mod 5;
                      set_fig
                     end;  {skos}
              end; {case}
              if sign in [#59,#84,#94,#60,#104..#108,#120..#129] then
               begin
//                SetTextStyle(font,direction,charSize);
//                bug:=graphResult;
                str(charSize,info);
                case font of
                 0 : fontInfo:='zw.';
                 1 : fontInfo:='trip.';
                 2 : fontInfo:='maly ';
                 3 : fontInfo:='san.';
                 4 : fontInfo:='gotyk';
                 else fontInfo:='nieznany font!';
                end;{case{fontInfo}
                case direction  of
                 0 : directionInfo:='poz.';
                 1 : directionInfo:='pion.';
                 else directionInfo:='kier.nieokresl.!';
                end;
                info:=fontInfo+directionInfo+'rozm: '+info;
               end;
         if sign in [#71,#72,#73,#75,#77,#79,#80,#81,#115,#116] then
          Set_fig;
             end; {#0}
      #9 : angle(1);           {tab, powiekszyc kat obrotu o 1 stop}
     else  begin               {-------------------napisy}
            range_check;
            if not overlap then
//             if vert then PutImage(otx,oty,space,CopyPut)
   //          else PutImage(otx,oty,space,CopyPut);
            if sign<>' ' then
//             if ctrl_sign then outTextXY(otx,oty,char(byte(sign)-64))
  //           else outTextXY(otx,oty,sign);
            if vert then dec(oty,8*charSize) else inc(otx,8*charSize);
//            PutImage(otx,oty,prompt,XORPut);
            x0:=x1; y0:=y1;
           end{else}
      END;{case}
      INC(ii)
     end;{WHILE}
   if put then               {zaakceptowac figure i wlaczyc tryb travel}
    begin
     put:=false;
//     repeat until KeyPressed;
     mode:=travel;
     kill_fig;
    end;
  end;{commander}

   begin   (*
    BkC:=GetBkColor;
    GrC:=GetColor;
    GetFillSettings(FillInfo);
    GraphMode:=GetGraphMode;
    GetViewSettings(ViewPort);
    GetTextSettings(TextInfo);
    newColor:=LightGray;
    SetColor(newColor);
    SetBkColor(black);
    SetViewPort(0,0,GetMaxX,GetMaxY,True);
    x1:=ViewPort.x1; y1:=ViewPort.y1; x0:=x1; y0:=y1;
    PutImage(x0,y0,prompt,XORPut);
    SetFillStyle(0,0);
    SetWriteMode(XorPut);
    REPEAT
     PutImage(x1,y1,prompt,XORPut); PutImage(x1,y1,prompt,XORPut);
     commander;
    UNTIL esc or finish;
    SetWriteMode(CopyPut);
    with ViewPort do SetViewPort(x1,y1,x2,y2,clip);
    SetFillStyle(FillInfo.Pattern,FillInfo.Color);
    setColor(GrC);
    setBkColor(BkC);
    with TextInfo do SetTextStyle(font,direction,charSize);*)
   end;{ed}

//   procedure clr; begin clrEol; writeln end;

 Begin
 (*
//  clrScr;
//  TextBackGround(brown); TextColor(yellow);
  Writeln(cons,'4. Edith');
  write(cons,'======================================================');// clr;
  write(cons,'Edytor graficzny, 21.01.93, A. Plucinski, UAM');//clr;
//  TextBackGround(black);
  write(cons,'  ctrl-X - box                          ');
  write(cons,'  ctrl-R - rownoleglobok               '#13#10);
  write(cons,'   alt-R - skos rownolegloboku          ');
  write(cons,'  ctrl-O - kolo                        '#13#10);
  write(cons,'  ctrl-T - trojkat                      ');
  write(cons,'  ctrl-L - linie                       '#13#10);
  write(cons,'  alt-F6 - rysowac linie                ');
  write(cons,'      F7 - rozciagac figure            '#13#10);
  write(cons,'shift-F7 - przesuwac figure             ');
  write(cons,' ctrl-F7 - powiekszac figure           '#13#10);
  write(cons,'     Tab - obroty                       ');
  write(cons,'   alt-L - gruba linia                 '#13#10);
  write(cons,'      F2 - kierunek pisma               ');
  write(cons,'  Alt-F2 - pisac znakami o kodach -64  '#13#10);
  write(cons,'alt-1..0 - rozmiar: 1..10 razy        ');
  write(cons,'alt-F1..F5 - font: zwykly, potrojny, maly'#13#10);
  write(cons,' ctrl-F2 - nakladac napisy/nie nakladac');
  write(cons,'                  sanseriff, gotyk      '#13#10);
  write(cons,'     F1  - Help, nastawy, wykaz w gornym rogu '); //clreol;
  write(cons,#13#10'shift-F1 - Help, nastawy, wykaz w polozeniu kursora');// clreol;
  write(cons,#13#10' ctrl-F1 - Help, wykaz klawiszy i ich funkcji'); //clreol;
// TexTColor(LightGreen);
  write(cons,#13#10' alt-F10 - zapisac obraz na dysk'); //clreol;
// TextColor(yellow);
 write(cons,#13#10'   Enter - pozostawic figure w akt. miejscu i wlaczyc tryb F7');
// clreol;TextBackGround(brown);
  write(cons,'======================================================');//clr;
  *)
  font:=0; direction:=0; charSize:=1;
  rect:=false;circ:=false;lines:=false; grot:=false; draw:=false; vert:=false;
  box:=false;thick:=false;put:=false;triang:=false; mode:=span;
  alpha:=0; schiff:=0;
  overlap:=false;ctrl_sign:=false;
  DrivePath:='C:\tp7';
  drive_path(DrivePath);
  graphInit;
//  GetImage(10,10,18,18,space);
//  line(10,10,18,18);
 // line(10,18,18,10);
  //GetImage(10,10,18,18,prompt);
  //putPixel(0,0,white); getImage(0,0,0,0,Point);
  //putImage(1,1,point,xorPut);
  //closeGraph;
  extChar:=#64;
 end.
