home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Party 1994: Try This At Home
/
disk_image.bin
/
source
/
gallery
/
subdirs.exe
/
MAP
/
PPATH.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-07-16
|
8KB
|
387 lines
{ INSTRUCCIONES:
s : salvar puntos de control a fichero
l : cargar puntos de un fichero
Esc: salir del programa
PgUp/RePág : Zoom hacia dentro
PgDn/AvPág : Zoom hacia fuera
Tab : seleccionar siguiente punto de control (el pto seleccionado
aparece más gordo)
Shift Tab : seleccionar anterior punto de control.
Boton derecho ratón : seleccionar punto de control más cercano al
cursor.
Boton izquierdo ratón : insertar punto de control.
Insert : Insertar punto de control después del actualmente seleccionado
Delete : Borrar punto de control seleccionado
Espacio : cambiar posición del punto de control seleccionado a
la posición del cursor
t : Asociar instante de tiempo al punto de control seleccionado.
}
{$N+}
uses graph, crt;
type real=single;
procedure InitMouse; assembler;
asm
mov ax,0
int $33
mov ax,7
mov cx,0
mov dx,639
int $33
mov ax,8
mov cx,0
mov dx,479
int $33
end;
procedure SetMouse( X,Y : integer ); assembler;
asm
mov ax,4
mov cx,X
mov dx,Y
int $33
end;
procedure GetMouse(var X,Y : integer); assembler;
asm
mov ax,3
int $33
les di, X
mov [es:di], cx
les di, Y
mov [es:di], dx
end;
function GetMouseButton:word; assembler;
asm
mov ax,3
int $33
mov ax, bx
end;
type TPoint = array[0..2] of real;
TSplineFac = array[0..3] of real;
var grd,grm : integer;
MAP : array[0..63,0..63] of byte;
procedure MakeMap;
var x,y : integer;
CharMap, s : string;
I : Text;
begin
assign(I,'map.gri'); reset(I);
y := 0;
repeat
readln(I,s);
if s<>'' then
if s[1]<>';' then begin
if length(s)<>64 then CharMap := ' '+s
else begin
for x := 0 to 63 do
MAP[y,63-x] := Pos(s[x+1],CharMap)-1;
inc(y)
end;
end;
until eof(I);
close(I);
end;
var MX0,MX1,MY0,MY1 : real;
CX, CY : real;
function ScaleX(x:real):integer;
begin
scaleX := round( (x-MX0)/(MX1-MX0)*639 );
end;
function ScaleY(y:real):integer;
begin
scaleY := round( (y-MY0)/(MY1-MY0)*479 );
end;
function UnScaleX(x:real):real;
begin
unscaleX := MX0+x*(MX1-MX0)/639;
end;
function UnScaleY(y:real):real;
begin
unscaleY := MY0+y*(MY1-MY0)/479;
end;
procedure DrawMap;
var i,j : integer;
xs,ys : real;
x0,x1,y0,y1:integer;
xx0,xx1,yy0,yy1:integer;
function Bound(x:integer):integer;
begin
if x<0 then x:=0;
if x>63 then x:=63;
Bound := x;
end;
begin
setcolor( Green );
xx0:=Bound(round(MX0)); xx1:=Bound(round(MX1));
yy0:=Bound(round(MY0)); yy1:=Bound(round(MY1));
for i := xx0 to xx1 do
for j := yy0 to yy1 do
if Map[j,i]<>0 then begin
x0 := ScaleX(i); x1 := ScaleX(i+1);
y0 := ScaleY(j); y1 := ScaleY(j+1);
rectangle( x0,y0, x1,y1 );
line( x0,y0, x1,y1 );
line( x0,y1, x1,y0 );
end;
end;
var NumPts, SelPt : integer;
P : array[1..1000] of TPoint;
procedure DrawSpline;
var i,j,k : integer;
F : array[0..1] of TSplineFac;
t,xx,yy : real;
procedure SplineFac( var F : TSplineFac; xm1,x0,x1,x2 : real );
begin
F[0] := (xm1+4*x0+x1)/6;
F[1] := (-xm1+x1)/2;
F[2] := (xm1+x1)/2-x0;
F[3] := (-xm1+3*(x0-x1)+x2)/6;
end;
function IntToStr( i :integer):string;
var s:string[16];
begin
str(i,s);
IntToStr := s;
end;
begin
setcolor(yellow);
settextstyle(smallfont, horizdir, 2);
for i := 1 to numPts do begin
j := round(scaleX(P[i,0])); k := round(scaleY(P[i,1]));
circle( j, k, 2 );
if P[i,2]<>-1 then outtextxy( j+5, k-3, IntToStr(round(P[i,2])) );
end;
if SelPt<>0 then circle( round(scaleX(P[SelPt,0])), round(scaleY(P[SelPt,1])), 4 );
for i := 2 to NumPts-2 do begin
for j := 0 to 1 do begin
SplineFac( F[j], P[i-1,j], P[i,j], P[i+1,j], P[i+2,j] );
end;
for k := 0 to 20 do begin
t := k/20;
xx := F[0,0]+t*(F[0,1]+t*(F[0,2]+t*F[0,3]));
yy := F[1,0]+t*(F[1,1]+t*(F[1,2]+t*F[1,3]));
putpixel( round(ScaleX(xx)), round(ScaleY(yy)), White );
end;
end;
end;
procedure DrawMouse(b:boolean);
var c:byte;
ccx,ccy : integer;
begin
if b = true then c:=red else c := black;
ccx := scaleX(CX);
ccy := scaleY(CY);
putpixel(ccx-3,ccy-3,c);
putpixel(ccx+3,ccy-3,c);
putpixel(ccx-3,ccy+3,c);
putpixel(ccx+3,ccy+3,c);
putpixel(ccx,ccy,c);
end;
procedure ReDraw;
begin
ClearDevice;
DrawMap;
DrawSpline;
DrawMouse(true);
end;
procedure UpdateMouse;
var ccx, ccy : integer;
begin
GetMouse( ccx, ccy );
if not ( (ccx=scaleX(cx)) and (ccy=scaleY(cy)) ) then begin
DrawMouse(False);
cx := unscaleX(ccx);
cy := unscaleY(ccy);
DrawMouse(True);
end;
end;
var ch : word;
escape : boolean;
procedure ZoomIn;
var xx,yy:real;
begin
xx := MX1-MX0;
MX0 := CX-0.4 *xx;
MX1 := CX+0.4 *xx;
yy := MY1-MY0;
MY0 := CY-0.4 *yy;
MY1 := CY+0.4 *yy;
SetMouse( ScaleX(CX),ScaleY(CY) );
ReDraw;
end;
procedure ZoomOut;
var xx,yy:real;
begin
xx := MX1-MX0;
MX0 := CX-0.6 *xx;
MX1 := CX+0.6 *xx;
yy := MY1-MY0;
MY0 := CY-0.6 *yy;
MY1 := CY+0.6 *yy;
SetMouse( ScaleX(CX),ScaleY(CY) );
ReDraw;
end;
procedure insertpoint;
var i : integer;
begin
if SelPt<NumPts then for i := NumPts+1 downto SelPt+2 do P[i] := P[i-1];
inc(NumPts);
P[SelPt+1,0] := CX;
P[SelPt+1,1] := CY;
P[SelPt+1,2] := -1;
inc(SelPt);
ReDraw;
end;
procedure deletepoint;
var i : integer;
begin
if SelPt<NumPts then for i := SelPt to NumPts-1 do P[i] := P[i+1];
dec(NumPts);
ReDraw;
end;
procedure SavePoints;
var s : string;
f : file;
i : integer;
begin
restorecrtmode;
write('SAVE from file: '); readln(s);
assign(f,s); rewrite(f,1);
blockwrite(f,SelPt,2);
blockwrite(f,NumPts,2);
blockwrite(f,P,NumPts*SizeOf(TPoint));
close(f);
initgraph(grd,grm,'');
redraw;
end;
procedure LoadPoints;
var s : string;
f : file;
i : integer;
begin
restorecrtmode;
write('LOAD to file: '); readln(s);
assign(f,s); reset(f,1);
blockread(f,SelPt,2);
blockread(f,NumPts,2);
blockread(f,P,NumPts*SizeOf(TPoint));
close(f);
initgraph(grd,grm,'');
redraw;
end;
procedure FindClosestPoint;
var i, besti : integer;
d, bestd : real;
begin
besti := 1;
bestd := 1e6;
for i := 1 to NumPts do begin
d := sqr(CX-P[i,0])+sqr(CY-P[i,1]);
if d<bestd then begin
bestd := d;
besti := i
end;
end;
SelPt := besti;
ReDraw;
end;
procedure InputTime;
begin
restorecrtmode;
writeln('Timing for control point ',SelPt,'. ');
writeln;
write('Time (-1=no time restraint): '); readln(P[SelPt,2]);
initgraph(grd,grm,'');
redraw;
end;
BEGIN
writeln('MAP.GRI and EGAVGA.BGI must be in current directory.');
delay(500);
grd := VGA; grm := VGAHi; {640x480}
initgraph( grd,grm, '' );
MakeMap;
MX0:=0; MX1:=64; MY0:=0; MY1:=64;
CX := 32; CY := 32;
InitMouse;
SetMouse( ScaleX(CX), ScaleY(CY) );
escape := false;
NumPts := 0;
SelPt := 0;
ReDraw;
repeat
if keypressed then begin
ch := ord(ReadKey);
if ch=0 then ch := ord(ReadKey)*$100+ch;
case ch of
ord('t'): InputTime;
ord('s'): SavePoints;
ord('l'): LoadPoints;
27: escape := true;
$4900: ZoomIn;
$5100: ZoomOut;
9: begin
inc(SelPt); if SelPt>=NumPts then SelPt := 1;
ReDraw;
end;
$0f00: begin
dec(SelPt); if SelPt<=0 then SelPt := NumPts;
ReDraw;
end;
$5200: InsertPoint;
$5300: DeletePoint;
32: begin
P[SelPt,0] := CX;
P[SelPt,1] := CY;
ReDraw;
end;
end;
end else begin
UpdateMouse;
if GetMouseButton=1 then InsertPoint;
if GetMouseButton=2 then FindClosestPoint;
end;
until escape;
closegraph;
END.