home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_2.iso
/
files
/
766b.lha
/
FollowMouse_v1.2
/
FollowMouse.p
< prev
next >
Wrap
Text File
|
1991-03-10
|
20KB
|
609 lines
{
FollowMouse.p Copyright © Kamran Karimi. Shows a pair of small blinking
eyes. Compiled using Maxon KickPascal on an A500
}
Program FollowMouse;
uses Intuition;
Type
Plane = Array[1..39] of Word; { 3*13 = 39;place for the images }
label EndIt;
Var
bool: Boolean;
x1,y1,Old,R,count,CurCoOrd,CurImage,SameImage,PrevCoOrd :integer;
Sec1,Mic1,Sec2,Mic2 : Long;
x,add,Ang,Mx,My :real;
Wind :NewWindow;
Rast :^RastPort;
Win :^Window;
Mes1,Mes2 :^IntuiMessage;
PRG,Name :IntuiText;
ImSquaint,ImStraight,ImDown,ImUp,ImLeft,ImRight,ImRU,ImRD,ImLU,
ImLD,ImF1,ImF2,ImF3,ImF4 :Image;
Down,Up,Left,Right,RU,RD,LU,LD,Squaint,Straight,F1,F2,F3,F4 :^Plane;
Procedure Initialize;
begin
{initializing the images: }
Straight^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000111111000011 ,%1111000000001111 ,%1100001111110000,
%0000111110000001 ,%1111000000001111 ,%1000000111110000,
%0000111111000011 ,%1111000000001111 ,%1100001111110000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
Down^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000011111000011 ,%1110000000000111 ,%1100001111100000,
%0000001110000001 ,%1100000000000011 ,%1000000111000000,
%0000000111000011 ,%1000000000000001 ,%1100001110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
Up^ := Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111000011 ,%1000000000000001 ,%1100001110000000,
%0000001110000001 ,%1100000000000011 ,%1000000111000000,
%0000011111000011 ,%1110000000000111 ,%1100001111100000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
Left^ :=Plane(
%0000000000000000 ,%0000000000000000,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000110000111111 ,%1111000000001100 ,%0011111111110000,
%0000100000011111 ,%1111000000001000 ,%0001111111110000,
%0000110000111111 ,%1111000000001100 ,%0011111111110000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
Right^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000111111111100 ,%0011000000001111 ,%1111110000110000,
%0000111111111000 ,%0001000000001111 ,%1111100000010000,
%0000111111111100 ,%0011000000001111 ,%1111110000110000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
LD^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111000011111 ,%1111000000001110 ,%0001111111110000,
%0000010000001111 ,%1110000000000100 ,%0000111111100000,
%0000001000011111 ,%1100000000000010 ,%0001111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
RD^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111000 ,%0111000000001111 ,%1111100001110000,
%0000011111110000 ,%0010000000000111 ,%1111000000100000,
%0000001111111000 ,%0100000000000011 ,%1111100001000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
RU^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111000 ,%0100000000000011 ,%1111100001000000,
%0000011111110000 ,%0010000000000111 ,%1111000000100000,
%0000111111111000 ,%0111000000001111 ,%1111100001110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
LU^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001000011111 ,%1100000000000010 ,%0001111111000000,
%0000010000001111 ,%1110000000000100 ,%0000111111100000,
%0000111000011111 ,%1111000000001110 ,%0001111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
Squaint^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000111111111100 ,%0011000000000100 ,%0011111111110000,
%0000111111111000 ,%0001000000001000 ,%0001111111110000,
%0000111111111100 ,%0011000000001100 ,%0011111111110000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
F1^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
F2^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001110000001 ,%1100000000000011 ,%1000000111000000,
%0000010001111110 ,%0010000000000100 ,%0111111000100000,
%0000101111111111 ,%1101000000001011 ,%1111111111010000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
F3^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000011111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000100000000000 ,%0001000000001000 ,%0000000000010000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
F4^ :=Plane(
%0000000000000000 ,%0000000000000000 ,%0000000000000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000001111111111 ,%1100000000000011 ,%1111111111000000,
%0000011111111111 ,%1110000000000111 ,%1111111111100000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000111111111111 ,%1111000000001111 ,%1111111111110000,
%0000101111111111 ,%1101000000001011 ,%1111111111010000,
%0000010001111110 ,%0010000000000100 ,%0111111000100000,
%0000001110000001 ,%1100000000000011 ,%1000000111000000,
%0000000111111111 ,%1000000000000001 ,%1111111110000000,
%0000000000111100 ,%0000000000000000 ,%0011110000000000,
%0000000000000000 ,%0000000000000000 ,%0000000000000000 );
{ Image-Structure }
ImStraight:=Image(1,1,
48, { width }
13, { hight }
1, { one Plane }
Straight, { data }
1,0,
Nil); { no further Images }
ImDown:=Image(1,1,
48,
13,
1,
Down,
1,0,
Nil);
ImUp:=Image(1,1,
48,
13,
1,
Up,
1,0,
Nil);
ImRight:=Image(1,1,
48,
13,
1,
Right,
1,0,
Nil);
ImLeft:=Image(1,1,
48,
13,
1,
Left,
1,0,
Nil);
ImRU:=Image(1,1,
48,
13,
1,
RU,
1,0,
Nil);
ImRD:=Image(1,1,
48,
13,
1,
RD,
1,0,
Nil);
ImLU:=Image(1,1,
48,
13,
1,
LU,
1,0,
Nil);
ImLD:=Image(1,1,
48,
13,
1,
LD,
1,0,
Nil);
ImSquaint:=Image(1,1,
48,
13,
1,
Squaint,
1,0,
Nil);
ImF1:=Image(1,1,
48,
13,
1,
F1,
1,0,
Nil);
ImF2:=Image(1,1,
48,
13,
1,
F2,
1,0,
Nil);
ImF3:=Image(1,1,
48,
13,
1,
F3,
1,0,
Nil);
ImF4:=Image(1,1,
48,
13,
1,
F4,
1,0,
Nil);
end;
Function FindWhere : integer;
begin
Mx :=Win^.MouseX;
Mx :=Mx-25; {bring it to...(50 div 2 = 25)}
My :=Win^.MouseY;
My :=My-6; {...the center of the window.(13 div 2 = 6)}
if My<0 then add:=90
else add:=270; {these additions are necessary to gain a 'Normal' angel}
{any body who wants to know more can print the Tan(Mx/My) for some
Mx and My}
if My=0 then My:=1; {avoid division by zero}
x:=Mx/My; {now w'll take the Tan(Mx/My) by the Taylor method}
if abs(x)<1 then
Ang:=x-x*x*x/3+x*x*x*x*x/5
else if x>=1 then
Ang:=3.14/2-1/x+1/(3*x*x*x)
else Ang:=-3.14/2-1/x+1/(3*x*x*x);
Ang:=Ang*180/3.14; {convert it to degrees}
Ang :=Ang+add;
{now we'll decide which image to show}
CurCoOrd := round(Mx + My);
if (abs(Mx)<12) and (abs(My)<9) then begin
FindWhere := 0;
exit;
end;
if (Ang > 5) and (Ang < 175) then begin
if (Ang < 75) then begin
FindWhere := 1;
exit;
end;
if (Ang > 105) then begin
FindWhere := 2;
exit;
end;
FindWhere := 3;
exit;
end;
if (Ang >175) and (Ang <185) then begin
FindWhere := 4;
exit;
end;
if (Ang > 185) and (Ang <255) then begin
FindWhere := 5;
exit;
end;
if (Ang >255) and (Ang <285) then begin
FindWhere := 6;
exit;
end;
if (Ang >285) and (Ang <355) then begin
FindWhere := 7;
exit;
end;
FindWhere := 8;
end;
Procedure ShowImage;
begin
case CurImage of
0: DrawImage(Rast,^ImSquaint, 0, 0);
1: DrawImage(Rast, ^ImRU, 0, 0);
2: DrawImage(Rast,^ImLU, 0, 0);
3: DrawImage(Rast,^ImUp, 0, 0);
4: DrawImage(Rast,^ImLeft, 0, 0);
5: DrawImage(Rast,^ImLD, 0, 0);
6: DrawImage(Rast,^ImDown, 0, 0);
7: DrawImage(Rast,^ImRD, 0, 0);
8: DrawImage(Rast,^ImRight, 0, 0);
end;
end;
Procedure Blink;
begin
DrawImage(Rast,^ImF1, 0, 0);
Delay(1);
DrawImage(Rast,^ImF2, 0, 0);
Delay(1);
DrawImage(Rast,^ImF3, 0, 0);
Delay(1);
DrawImage(Rast,^ImF4, 0, 0);
Delay(1);
DrawImage(Rast,^ImF1, 0, 0);
Delay(12);
DrawImage(Rast,^ImF4, 0, 0);
Delay(1);
DrawImage(Rast,^ImF3, 0, 0);
Delay(1);
DrawImage(Rast,^ImF2, 0, 0);
Delay(1);
DrawImage(Rast,^ImF1, 0, 0);
Delay(3);
end;
Procedure LeftRight;
begin
for count := 1 to 2 do begin
DrawImage(Rast,^ImStraight, 0, 0);
Delay(3);
DrawImage(Rast,^ImRight, 0, 0);
Delay(30);
DrawImage(Rast,^ImStraight, 0, 0);
Delay(6);
DrawImage(Rast,^ImLeft, 0, 0);
Delay(30);
DrawImage(Rast,^ImStraight, 0, 0);
Delay(3)
end;
end;
Procedure GoToSleep;
Begin
DrawImage(Rast,^ImF1, 0, 0);
Delay(2);
DrawImage(Rast,^ImF2, 0, 0);
Delay(2);
DrawImage(Rast,^ImF3, 0, 0);
Delay(2);
DrawImage(Rast,^ImF4, 0, 0);
Delay(10);
end;
Procedure Effect;
begin
SameImage := 0;
bool := WindowToFront(Win);
LeftRight;
GoToSleep;
CurImage := FindWhere;
while(CurCoOrd = PrevCoOrd) do begin
Delay(10);
CurImage := FindWhere;
Inc(SameImage);
if (SameImage = 150) then begin
LeftRight;
SameImage := 0;
ShowImage;
Delay(25);
GoToSleep;
end;
end;
DrawImage(Rast,^ImF3, 0, 0);
Delay(2);
DrawImage(Rast,^ImF2, 0, 0);
Delay(2);
DrawImage(Rast,^ImF1, 0, 0);
Delay(2);
end;
Begin
PrevCoOrd := 0;
PRG:=Intuitext(1,0,0,0,0,Nil ,' FollowMouse',Nil);
Name:=Intuitext(1,0,0,0,10,Nil,'By Kamran Karimi',^PRG);
{ reserve memory: } { 2 = "MEMF_CHIP" }
Straight:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
Squaint:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
Up:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
Down:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
Left:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
Right:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
RU:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
RD:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
LU:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
LD:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
F1:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
F2:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
F3:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
F4:=Ptr( Alloc_Mem(SizeOf(Plane), 2) );
if(Squaint=nil) or (Up=Nil) or (Down=Nil) or (Right=Nil) or (Left=Nil)
or (LU=Nil) or (LD=Nil) or (RU=Nil) or (RD=Nil) or (F1=Nil)
or (F2=Nil) or (F3=Nil) or (F4=Nil) or (Straight=Nil)then goto EndIt;
Initialize;
Old:=SetTaskPri(FindTask(NIL),-2);
Randomize;
x1 := Random(400) + 80;
y1 := Random(140) + 20;
Wind:=NewWindow(x1,y1,150,35,0,1,0,WINDOWDRAG,
Nil,Nil,'FollowMouse',Nil,Nil,0,0,0,0,WBENCHSCREEN);
Win:=OpenWindow(^Wind);
if (Win = Nil) then goto EndIt;
Rast:=Win^.RPort;
PrintItext(Rast,^Name,10,12);
Delay(150);
CloseWindow(Win);
Wind:=NewWindow(x1,y1,50,13,0,0,MOUSEBUTTONS,WINDOWDRAG or RMBTRAP,
Nil,Nil,'FM',Nil,Nil,0,0,0,0,WBENCHSCREEN);
Win:=OpenWindow(^Wind);
if (Win = Nil) then goto Endit;
Rast:=Win^.RPort;
while (True) do {This is the main loop}
begin
Mes1 := Get_Msg(Win^.UserPort);
if(Mes1 <> Nil) then begin
Sec1 := Mes1^.Seconds;
Mic1 := Mes1^.Micros;
end;
Mes2 := Get_Msg(Win^.UserPort);
if(Mes2 <> Nil) then begin
Sec2 := Mes2^.Seconds;
Mic2 := Mes2^.Micros;
end;
if((Mes1 <> Nil) and (Mes2 <> Nil)) then begin
if(DoubleClick(Sec1,Mic1,Sec2,Mic2)) then begin
x1 := SetTaskPri(FindTask(NIL),Old);
goto EndIt;
end;
end;
if(Mes1 <> Nil) then Reply_Msg(Mes1);
if(Mes2 <> Nil) then Reply_Msg(Mes2);
CurImage := FindWhere;
ShowImage;
Delay(3);
if (CurCoOrd = PrevCoOrd) then Inc(SameImage)
else begin
PrevCoOrd := CurCoOrd;
SameImage := 0;
end;
if(SameImage = 180) then begin
Effect;
SameImage := 0;
end;
R := Random(40);
if R>38 then Blink;
end;
EndIt:
Reply_Msg(Mes1);
Reply_Msg(Mes2);
repeat
Mes1 := Get_Msg(Win^.UserPort);
if (Mes1 <> Nil) then Reply_Msg(Mes1);
until (Mes1 = Nil);
CloseWindow(Win);
End.