[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]