00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019 c
00020 c
00021 subroutine heart (x0,y0,r,t)
00022 save
00023 c
00024 pi=3.1415926
00025 ct=cos(pi*t/180.)
00026 st=sin(pi*t/180.)
00027 ax=(180.+28.072487)*pi/180.
00028 c
00029 c--- right hump
00030 call plot(x0,y0,3)
00031 do 5 i=1,100
00032 a=i*.01*ax
00033 x=.25*r*(1.-cos(a))
00034 y=.25*r*sin(a)
00035 xx=x0+x*ct+y*st
00036 yy=y0+y*ct-x*st
00037 call plot(xx,yy,2)
00038 5 continue
00039 call plot(x0-r*st,y0-r*ct,2)
00040 c
00041 c--- left hump
00042 call plot(x0,y0,3)
00043 do 10 i=1,100
00044 a=i*.01*ax
00045 x=.25*r*(cos(a)-1.)
00046 y=.25*r*sin(a)
00047 xx=x0+x*ct+y*st
00048 yy=y0+y*ct-x*st
00049 call plot(xx,yy,2)
00050 10 continue
00051 call plot(x0-r*st,y0-r*ct,2)
00052 c
00053 end
