[Back to TURTLE SWAG index] [Back to Main SWAG index] [Original]

    (* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
       ³ Programated by Vladimir Zahoransky                        ³
       ³                Vladko software                            ³
       ³ Contact      : zahoran@cezap.ii.fmph.uniba.sk             ³
       ³ Program tema : Unit - turtle graphic with untypefiles     ³
       ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ *)

    {    Well this is very usefull unit. This unit can write all turtle
      work and then can read it. If you want to save your work, you have
      3 possibilitis :
      1: write your file system
      2: write dates to file with screensaver metod
      3: use this unit
      4: write unit working with binary type file (okorfwb.pas)

        Well, first possibility is for profesional programers, because it is
      not easy to define structures for turtle commands.
        Secend passibility is good if you want then convert it to image
      format for example gif, pcx, bmp, jpg ... . If you want then to step
      the drawing then it is unpassible.
       Third passibility is good for all who want to use turtle commands and
      want sometimes step it. If you want to have fast picture then use
      passibility 2.
      Fourth passibility is good for good programers. This unit can work with
       penetrate cycles. (realisated with rekusion outside) This is very usefull
       end effektive unit if you have some commands repeated. This effekt can
       be realizated only with binary type files!

        Here is a table for prepare a file for work :

       ÚÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
       ³ Code ³ File type work                  ³
       ÃÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
       ³  0   ³ Rewrite(f,Flenght);             ³
       ³  1   ³ Append file with Flenght        ³
       ³  2   ³ Reset file if exist with Flengt ³
       ÀÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

         This code table is a table for update the files for ower work :
        (All codes are value for CX register. (this is for all who know
         assembler))

       ÚÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
       ³ Code ³ File type      ³
       ÃÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
       ³  0   ³ Normal    file ³
       ³  1   ³ ReadOnly  file ³
       ³  2   ³ Hide      file ³
       ³  4   ³ System    file ³
       ÀÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

         Good is if you have some commands for work with files. I am giveing
      you this :

       ÚÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
       ³ Code ³ File type   ³
       ÃÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
       ³  0   ³ Exist  file ³
       ³  1   ³ Copy   file ³
       ³  2   ³ Rename file ³
       ³  3   ³ Delete file ³
       ÀÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

        How to use this commands ? In my programing life unpraktic to know a lot
      of commands. A lot of programers want to know a good parameter then names.
      My system is : Know which parameter what do. This is usefull, because
      you can to print tables (here are three) and work with tables.
        If you have this system in all file commands then it is perfekt. If
      you want to update it then it is make your command and work item (in case)
      it general command. (command with case)

       How to work with turtle commands? It is very easy. In your program write
     uses okorf; Then work with commands how we use okor.pas. This program work
     okor.pas and write it to untype binary file. All commands in this unit
     work okor.pas and write to file. This unit can write unit commands. (cakaj
     cakajklaves and zmaz1;

       And here is dictionary :

       ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
       ³    Name     ³ In English  ³
       ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´
       ³ Zmaz1       ³ ClearScreen ³
       ³ Cakaj       ³ Wait        ³
       ³ CakajKlaves ³ Wait key    ³
       ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

         Good modification is if you have source of your metod (or tpu) and
      you write to file only imput parameters and in file viewer will read
      it and make your metod. Good is if you modify unit okorfr.pas.

         Well, this unit okorfw.pas and okorfr.pas are working with statical
      metods. It will be good if you work with statical unit then all units
      in turtle are statical. Statical unit (with statical metods) is not
      so good, but for all who don't work with turtle or don't know this
      collection is it good. Well if you are skiful (expert) then you can
      work with all versions. Who want dynamical fileturtle unit here is -
      in swag. This unit can work once with one file. It is not so bed, but
      if you want to work once with lot of files then good is to realise it
      with DDS. (dynamical date structure)  See Dokorfw.pas or Dokorfr.pas.
    }

    unit oKorFW;

    interface

    uses
      graph, crt;

    type
      KorFW=object
        Procedure Init(x,y,u:real);
        Procedure Koniec;
        Procedure Domov;
        Procedure Dopredu(D:real);
        Procedure Vpravo(u:real);
        Procedure Vlavo(u:real);
        Procedure ZmenSmer(u:real);
        Procedure ZmenXY(x,y:real);
        Procedure PresunXY(x,y:real);
        Procedure Ukaz;
        Procedure Skry;
        Procedure PH;
        Procedure PD;
        Procedure ZmenFP(nfp:integer);
        Procedure ZmenHP(nhp:integer);
        Procedure Pis(s:string);
        Procedure Vypln(fv:byte);
        Function  XSur:real;
        Function  YSur:real;
        Function  Smer:real;
        Function  Dole:boolean;
        Function  Ukazana:boolean;
        Function  FP:byte;
        Function  HP:byte;
        Function  Smerom(x,y:real):real;
      Private
        XSur0,YSur0,Smer0:real;
        Dole0,Ukazana0:boolean;
        FP0,HP0: byte;
        dXSur,dYSur,dSmer:real;
        Procedure ukaz0;
      End;

      Procedure Zmaz1;
      Procedure CakajKlaves;
      Procedure Cakaj(n:integer);

      Procedure Fileinit(Filename:string;code:Byte);
      Procedure FileDone(Filename:string);
      Procedure Filetype(Filename:string;code:Byte);
      Procedure Filework(Filename:string;code:Byte);

    var
      Klaves:integer;
      krokuj:boolean;
      X0,Y0:integer;
      f:file;
      p:byte;
      Openfile:string;
      kod:byte;

    implementation

    Const Driver_Path='C:\language\Bp7\bgi';
              Flenght=1;
                  rad=pi/180;

    Function FileExist(filename : String) : Boolean; Assembler;
    ASM
            PUSH   DS
            LDS    SI, [filename]
            XOR    AH, AH
            LODSB
            XCHG   AX, BX
            MOV    Byte Ptr [SI+BX], 0
            MOV    DX, SI
            MOV    AX, 4300h
            INT    21h
            MOV    AL, False
            JC     @1
            INC    AX
    @1:     POP    DS
    end;

    Function HideFile(FileName : String) : Byte; Assembler;
    Asm
      Push DS
      LDS DX, FileName
      Inc DX
      Mov AH, 43h
      Mov AL, 1
      Mov CX, 2
      Int 21h
      JC @Done
      Mov AL, 0
      @Done:
      Pop DS
    End;

    Function SystemFile(FileName : String) : Byte; Assembler;
    Asm
      Push DS
      LDS DX, FileName
      Inc DX
      Mov AH, 43h
      Mov AL, 1
      Mov CX, 4
      Int 21h
      JC @Done
      Mov AL, 0
      @Done:
      Pop DS
    End;

    Function ReadOnlyFile(FileName : String) : Byte; Assembler;
    Asm
      Push DS
      LDS DX, FileName
      Inc DX
      Mov AH, 43h
      Mov AL, 1
      Mov CX, 1
      Int 21h
      JC @Done
      Mov AL, 0
      @Done:
      Pop DS
    End;

    Function NormalFile(FileName : String) : Byte; Assembler;
    Asm
      Push DS
      LDS DX, FileName
      Inc DX
      Mov AH, 43h
      Mov AL, 1
      Mov CX, 0
      Int 21h
      JC @Done
      Mov AL, 0
      @Done:
      Pop DS
    End;

    Function DeleteFile(FileName : string) : integer; assembler;
    Asm
      push ds
      lds si,FileName
      inc byte ptr [si]
      mov bl,byte ptr [si]
      xor bh,bh
      mov dx,si
      inc dx
      mov byte ptr [si+bx],0
      mov ah,41h
      int 21h
      jc  @error
      xor ax,ax
    @error:
      dec byte ptr [si]
      pop ds
    End;

    Function CopyFile(Outname:string):Integer;
    Var InFile, OutFile : File;
        Buffer          : Array[1..8192] Of Char;
        NumberRead,
        NumberWritten   : Word;
    begin
       Assign( InFile, OpenFile);
       Reset ( InFile, 1 );
       Assign  ( OutFile,Outname);
       ReWrite ( OutFile, 1 );
       Repeat
          BlockRead ( InFile, Buffer, Sizeof( Buffer ), NumberRead );
          BlockWrite( OutFile, Buffer, NumberRead, NumberWritten );
       Until (NumberRead = 0) or (NumberRead <> NumberWritten);
       Close( InFile );
       Close( OutFile );
       Copyfile:=ioresult;
    end;

      Function RenameFile(Filename:string):integer;
      Begin
      CopyFile(Filename);
      Close(f);
      DeleteFile(Openfile);
      OpenFIle:=Filename;
      Fileinit(Filename,kod);
      Renamefile:=ioresult;
      End;

      Procedure CakajKlaves;
      begin
        P:=13;
        Blockwrite(f,p,1);
        Klaves:=ord(readkey); if Klaves=0 then Klaves:=-ord(readkey);
        if Klaves=27 then
        begin
          CloseGraph;
          halt;
        end;
      end;

      Procedure test;
      var
        b:boolean;
      begin
        b:=krokuj;
        while keypressed or b do
        begin
          CakajKlaves;
          if Klaves=19 then b:=not b else b:=false;
        end;
      end;

      Procedure Fileinit(Filename:string;code:Byte);
      Begin
      Assign(f,Filename);

      Case code of
                0: Begin Rewrite(F,1);
                         OpenFIle:=Filename;
                         End;
                1: If fileexist(Filename) Then Begin
                                               Reset(f,Flenght);
                                               OpenFIle:=Filename;
                                               Seek(f,Filesize(f));
                                               End
                                          Else Writeln('File not exist!');
                2: If fileexist(Filename) Then Begin
                                               Reset(f,Flenght);
                                               OpenFIle:=Filename;
                                               End
                                          Else Writeln('File not exist!');
      End;
      kod:=code;
      End;

      Procedure FileDone(Filename:string);
      Begin
      Close(f);
      End;

      Procedure Filetype(Filename:string;code:Byte);
      Var vb:Byte;
      Begin
      Case code of
      0: vb:=NormalFile(Filename);
      1: vb:=ReadOnlyFile(Filename);
      2: vb:=HideFile(Filename);
      4: vb:=SystemFile(Filename);
      End;
      If vb<>0 Then Writeln(#7,'Problem with files.');
      End;

      Procedure Filework(Filename:string;code:Byte);
      Var vb:Integer;
      Begin

      Case code of
      0: IF Fileexist (Filename) then vb:=0 else vb:=1;
      1: vb:=CopyFile(Filename);
      2: vb:=RenameFile(Filename);
      3: vb:=DeleteFile(Filename);
      End;
      If vb<>0 Then Writeln(#7,'Problem with files.');
      End;

      Procedure KorFW.Init(x,y,u:real);
      begin
        p:=0;
        blockwrite(f,p,1);
        blockwrite(f,x,6);
        blockwrite(f,y,6);
        blockwrite(f,u,6);
        XSur0:=x;
        YSur0:=y;
        Smer0:=u;
        FP0:=7;
        HP0:=NormWidth;
        Dole0:=true;
        Ukazana0:=false;
        dSmer:=u;
        dXSur:=x;
        dYSur:=y;
      end;

      Procedure KorFW.Koniec;
      Begin
      CloseGraph;
      Halt;
      End;

      Procedure KorFW.Domov;
      begin
        p:=1;
        blockwrite(f,p,1);
        ZmenXY(dXSur,dYSur);
        ZmenSmer(dSmer);
      end;

      Procedure KorFW.Dopredu(d:real);
      begin
        p:=2;
        blockwrite(f,p,1);
        blockwrite(f,d,6);
        ZmenXY(XSur0+sin(Smer0*rad)*d,YSur0+cos(Smer0*rad)*d);
      end;

      Procedure KorFW.Vpravo(u:real);
      begin
        p:=3;
        blockwrite(f,p,1);
        blockwrite(f,u,6);
        ZmenSmer(Smer0+u);
      end;

      Procedure KorFW.Vlavo(u:real);
      begin
        p:=4;
        blockwrite(f,p,1);
        blockwrite(f,u,6);
        ZmenSmer(Smer0-u);
      end;

      Procedure KorFW.ZmenSmer(u:real);
      begin
        P:=14;
        Blockwrite(f,p,1);
        Blockwrite(f,u,6);
        ukaz0;
        Smer0:=u;
        while Smer0<0 do Smer0:=Smer0+360;
        while Smer0>=360 do Smer0:=Smer0-360;
        ukaz0;
        test;
      end;

      Procedure KorFW.ZmenXY(x,y:real);
      begin
        P:=16;
        Blockwrite(f,p,1);
        Blockwrite(f,x,6);
        Blockwrite(f,y,6);
        if not Dole0 then Begin
        PresunXY(x,y)
        End
        else
        begin
          ukaz0;
          MoveTo(trunc(XSur0)+X0,Y0-trunc(YSur0));
          SetColor(FP0); SetLineStyle(SolidLn,0,HP0);
          XSur0:=x;
          YSur0:=y;
          LineTo(trunc(XSur0)+X0,Y0-trunc(YSur0));
          ukaz0;
          test;
        end;
      end;

      Procedure KorFW.PresunXY(x,y:real);
      begin
        P:=15;
        Blockwrite(f,p,1);
        Blockwrite(f,x,6);
        Blockwrite(f,y,6);
        ukaz0;
        XSur0:=x;
        YSur0:=y;
        MoveTo(trunc(XSur0)+X0,Y0-trunc(YSur0));
        ukaz0;
        test;
      end;

      Procedure KorFW.PH;
      begin
        p:=5;
        blockwrite(f,p,1);
        Dole0:=false;
        test;
      end;

      Procedure KorFW.PD;
      begin
        p:=6;
        blockwrite(f,p,1);
        Dole0:=true;
        test;
      end;

      Procedure KorFW.Ukaz;
      begin
        p:=7;
        blockwrite(f,p,1);
        if not Ukazana0 then
        begin
          Ukazana0:=true;
          ukaz0;
        end;
        test;
      end;

      Procedure KorFW.Skry;
      begin
        p:=8;
        blockwrite(f,p,1);
        if Ukazana0 then
        begin
          ukaz0;
          Ukazana0:=false;
        end;
        test;
      end;

      Procedure KorFW.ZmenFP(nfp:integer);
      begin
        p:=9;
        blockwrite(f,p,1);
        blockwrite(f,nfp,2);
        FP0:=abs(nfp) mod 16;
        test;
      end;

      Procedure KorFW.ZmenHP(nhp:integer);
      begin
        P:=10;
        Blockwrite(f,p,1);
        Blockwrite(f,nhp,2);
        if nhp>1 then HP0:=ThickWidth
        else HP0:=NormWidth;
        test;
      end;

      Function KorFW.XSur:real;
      begin
        XSur:=Xsur0;
      end;

      Function KorFW.YSur:real;
      begin
        YSur:=Ysur0;
      end;

      Function KorFW.Smer:real;
      begin
        Smer:=Smer0;
      end;

      Function KorFW.Dole:boolean;
      begin
        Dole:=Dole0;
      end;

      Function KorFW.Ukazana:boolean;
      begin
        Ukazana:=Ukazana0;
      end;

      Function KorFW.FP:byte;
      begin
        FP:=FP0;
      end;

      Function KorFW.HP:byte;
      begin
        HP:=HP0;
      end;

      Procedure KorFW.Vypln(fv:byte);
      begin
        P:=11;
        Blockwrite(f,p,1);
        Blockwrite(f,fv,1);
        ukaz0;
        SetFillStyle(1,abs(fv) mod 16);
        FloodFill(trunc(XSur0)+X0,Y0-trunc(YSur0),FP0);
        ukaz0;
        test;
      end;

      function KorFW.Smerom(x,y:real):real;
      var
        u:real;
      begin
        x:=x-XSur0;
        y:=y-YSur0;
        if y=0 then
          if x=0 then u:=0
          else if x<0 then u:=270 else u:=90
        else
          if y>0 then
            if x>=0 then u:=arctan(x/y)*180/pi
            else u:=360-arctan(-x/y)*180/pi
          else
           if x>=0 then u:=180-arctan(-x/y)*180/pi
           else u:=180+arctan(x/y)*180/pi;
        Smerom:=u;
      end;

      procedure KorFW.Pis(s:string);
      begin
        P:=12;
        Blockwrite(f,p,1);
        Blockwrite(f,s,Sizeof(s));
        ukaz0;
        SetColor(FP0);
        OutTextXY(trunc(XSur0)+X0,Y0-trunc(YSur0),s);
        ukaz0;
        test;
      end;

      procedure KorFW.Ukaz0;
      {const
        dt=8; ut=75; ut0=0;}
      const
        dt=10; ut=45; ut0=30;
      var
        x,y,s,d0,d1:real;

        procedure krok(u,d:real);
        begin
          s:=s+u;
          x:=x+sin(s*rad)*d; y:=y+cos(s*rad)*d;
          LineTo(trunc(x)+X0,Y0-trunc(y));
        end;

      begin
        if not Ukazana0 then exit;
        MoveTo(trunc(XSur0)+X0,Y0-trunc(YSur0));
        SetWriteMode(XORPut);
        SetColor(15); SetLineStyle(SolidLn,0,NormWidth);
        x:=XSur0;
        y:=YSur0;
        s:=Smer0;
        d0:=dt/cos(-ut0*rad);
        d1:=dt/cos((ut+ut0)*rad);
        krok(90+ut0,d0);
        krok(ut-180,d1);
        krok(-2*(ut+ut0),d1);
        krok(ut-180,d0);
        SetWriteMode(NormalPut);
      end;

      procedure Zmaz1;    {Before you use Zmaz1, then hide all turtles !!!}
      begin
        P:=17;
        Blockwrite(f,p,1);
        ClearViewPort;
        test;
      end;

    procedure Cakaj(n:integer);
    const
      cas=1000;
    var
      i:integer;
    begin
        P:=18;
        Blockwrite(f,p,1);
        Blockwrite(f,n,2);
      i:=cas;
      repeat
        test;
        dec(i);
        if i<1 then
        begin
          dec(n);
          i:=cas;
        end;
      until n<=0;
    end;

    var
      gd,gm:integer;

    begin

      gd:=vga;
      gm:=vgahi;
      InitGraph(gd,gm,Driver_path);

      if GraphResult<>0 then
      begin
        writeln('Problem with graphic driver!');
        halt;
      end;

      X0:=GetMaxX div 2+1;
      Y0:=GetMaxY div 2+1;
      Klaves:=0;
      krokuj:=false;
    end.

[Back to TURTLE SWAG index] [Back to Main SWAG index] [Original]