Category : Miscellaneous Language Source Code
Archive   : GRAFX.ZIP
Filename : WORM.FOR

c program worm ! draw a worm
subroutine worm
c
real xc(100),yc(100)
integer*2 ich
integer tail
logical erase
c
parameter (a2pi=6.283185307,atorad=a2pi/360.0)
parameter (nc=40,xmax=639.0,ymax=199.0)
c
call window(0.0,0.0,xmax,ymax)
call view(0,0,639,199)
c call gset
call putstr(10,20,' DEMONSTRATION OF COLOR TO ERASE')
call putstr(12,20,' FOR A WHIMSICAL USAGE')
call pause('WHEN READY ') ! display message and pause
call gcls
call atime(iseed)
call info(' NOW WATCH THE WORM: HIT ANY KEY TO STOP ')
xnew=300.0
ynew=100.0
tail=1
erase=.false. ! flag to start erasing
dir=a2pi*rand(iseed)
deld=15.0*atorad
c
c ...start of loop
c
200 continue
call color('WHITE') ! set color on
call circle(xnew,ynew,4.0) ! draw head
xc(tail)=xnew ! save it
yc(tail)=ynew
if(tail.eq.nc)erase=.true. ! is worm full length ??
tail=mod(tail,nc)+1
dir=dir+sign(deld,rand(iseed)-0.5) ! change direction
xnew=mod(xnew+6.0*cos(dir),xmax)
ynew=mod(ynew+2.0*sin(dir),ymax)
if(xnew.lt.0)xnew=xnew+xmax
if(ynew.lt.0)ynew=ynew+ymax
call color('BLACK') ! set color off
if(erase)call circle(xc(tail),yc(tail),4.0) ! erase tail
call ckey(ich) ! stop when a key is pressed
if(ich.ne.0)goto 900
goto 200
900 continue
call color('WHITE') ! set color on
c call aset
return
end