rbogen%dreams@Sun.COM (Richard Bogen) (01/04/90)
% This toy program demonstrates cycloids which are curves
% traced out by a fixed point attached to one curve which
% rolls on the inside or outside of another. In this case
% it is a circle rolling on another circle. The fixed point
% is the endpoint of a line attached to the center of the
% rolling circle.
%
% I wanted to use an overlay canvas to keep the picture of
% the rolling circle separate from the cycloid curve which
% is traced out but had problems when rapidly switching
% back and forth between a canvas and its overlay.
%
% If anyone can make improvements to this program I would
% greatly appreciate receiving them.
%
% Richard A. Bogen - Sun Microsystems, Inc. - 1/3/90
%
% SAVE THIS FILE AS cycloids.ps; then psh it.
%--------------------------------------------------------------
/xsize 1152 def
/ysize 900 def
/cx xsize 2 div def
/cy ysize 2 div def
/q 1 def % the amount in degrees to rotate on each iteration
/t 0 def % the angle of the line on the rolling circle
/oldx -1 def
/Color 0 0 1 rgbcolor def % change to your favorite color
/titlefont /Helvetica-Bold findfont 30 scalefont def
/descrfont /Times-Italic findfont 24 scalefont def
/dotitle {titlefont setfont 0 cy 50 sub moveto
erasepage (Demo of Epi & Hypo Cycloids) cshow
descrfont setfont
0 cy 100 sub moveto cshow
0 cy 130 sub moveto } def
% Lets have a fullscreen!
/can framebuffer newcanvas def
cx cy translate
cx neg cy neg xsize ysize rectpath
can reshapecanvas
can setcanvas
can /Mapped true put
/ov can createoverlay def
(Drag mouse to choose size of diameter of fixed circle)
dotitle
(Click any mouse button to end selection) cshow
0 0 moveto (+) show
ov setcanvas
/circle {newpath 0 360 arc stroke} def
/circle1 {dup mul exch dup mul add sqrt
/r1 exch def newpath 0 0 r1 0 360 arc } def
100 0 setcursorlocation
0 0 {circle1} getanimated waitprocess aload pop
can setcanvas
(Drag mouse to choose size of diameter of rolling circle)
dotitle
(Click any mouse button to end selection) cshow
circle1 stroke
0 0 moveto (+) show
ov setcanvas
/circle2 {pop dup r1 sub /r2 exch def newpath 0 r2 0 360 arc } def
r1 50 add 0 setcursorlocation
0 0 {circle2} getanimated waitprocess aload pop
can setcanvas
(Drag mouse to choose length of line attached to center)
dotitle
( of rolling circle. Click any mouse button to start demo) cshow
0 0 r1 circle
0 0 moveto (+) show
circle2 stroke
/s r1 r2 add def
/a r1 r2 div q mul def
ov setcanvas
s 25 setcursorlocation
s 0 {lineto} getanimated waitprocess aload pop
can setcanvas
dup mul exch s sub dup mul add sqrt /d exch def
(After viewing output click any mouse button to exit demo)
dotitle
0 0 r1 circle
createevent dup begin
/Name [/LeftMouseButton /MiddleMouseButton /RightMouseButton] def
/Canvas can def
end expressinterest
{pause .9 setgray
s 0 r2 circle s 0 moveto
t cos r2 d add mul neg
t sin r2 d add mul
.5 setgray rlineto currentpoint stroke
Color setcolor
oldx -1 ne {oldx oldy moveto 2 copy lineto stroke} if
/oldy exch def /oldx exch def
/t t a add def
countinputqueue 0 gt {exit} if
q rotate
} loop
/delta .03 def
initmatrix
8 { erasepage
0 0 moveto
(That's All Folks!) cshow
delta sleep
/delta delta 1.5 div def
0 -20 translate} repeat
framebuffer setcanvas
can /Mapped false put