(FILECREATED "21-Feb-86 16:41:43" {ERIS}<LISPUSERS>KOTO>WORM.;2
 6357   

      changes to:  (VARS WORMCOMS)

      previous date: "12-Aug-85 09:26:16" {ERIS}<LISPUSERS>KOTO>WORM.;1)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT WORMCOMS)

(RPAQQ WORMCOMS
 ((FNS WORM WORM.ADVANCE-WORM WORM.DRAW-ONE-PART WORM.FIND-COORDINATES 
                          WORM.SQUAR-DISTANCE)
                     (ALISTS (IDLE.FUNCTIONS Worm))))
(DEFINEQ

(WORM

  [LAMBDA (WINDOW)                                           (* sm " 9-Aug-85 17:10")

    (while
 T
       do
 (
DISMISS
 10)
	  (WORM.ADVANCE-WORM
 WINDOW])

(WORM.ADVANCE-WORM

  [LAMBDA (WINDOW)                                           (* sm "12-Aug-85 09:05")

    (
PROG
 (W-REG INC NEW-POS OLD-POS OLD-DIRECTION NEW-DIRECTION LAST-POS LAST-DIRECTION CENTER-POINT)
          (
SETQ
 INC (if
 (
ZEROP
 (
RAND
 0 1))
			THEN
 20
		      ELSE
 -20))
          (
OPENW
 WINDOW)
          (
SETQ
 W-REG (
WINDOWPROP
 WINDOW (
QUOTE
 REGION)))
          (
SETQ
 CENTER-POINT (
CONS
 (
IQUOTIENT
 (fetch
 WIDTH of
 W-REG)
					      2)
				   (
IQUOTIENT
 (fetch
 HEIGHT of
 W-REG)
					      2)))
          (if
 (
NULL
 (
WINDOWPROP
 WINDOW (
QUOTE
 WORM)))
	      then
 (
CLEARW
 WINDOW)
		   [
SETQ
 NEW-POS (
CONS
 (
RAND
 25 (
IPLUS
 (fetch
 WIDTH of
 W-REG)
						       -50))
				       (
RAND
 25 (
IPLUS
 (fetch
 HEIGHT of
 W-REG)
						       -50]
		   (WORM.DRAW-ONE-PART
 (
CAR
 NEW-POS)
				       (
CDR
 NEW-POS)
				       25 WINDOW 0)
		   (
WINDOWPROP
 WINDOW (
QUOTE
 WORM)
			       (
LIST
 (
LIST
 NEW-POS 0)))
		   (
WINDOWPROP
 WINDOW (
QUOTE
 WORM.DIRECTION)
			       0)
		   (for
 I from
 1 to
 9 do
 (WORM.ADVANCE-WORM
 WINDOW))
	    else
 (
PROG
 (CANDIDATE-LIST ITERATIONS DIS MINIMAL-DIS SECOND-ROUND CLOSEST-POINT)
		       (
SETQ
 ITERATIONS 0)
		       [
SETQ
 OLD-POS (
CAR
 (
CAR
 (
WINDOWPROP
 WINDOW (
QUOTE
 WORM]
		   TRY-AGAIN
		       (if
 (
GREATERP
 ITERATIONS 18)
			   then
 (if
 (
NULL
 CANDIDATE-LIST)
				    then
 (
WINDOWPROP
 WINDOW (
QUOTE
 WORM)
						     NIL)
					 (
RETURN
 T))
				(
SETQ
 MINIMAL-DIS MAX.FIXP)
				(for
 W in
 CANDIDATE-LIST when
 (
LESSP
 (
SETQ
 DIS (WORM.SQUAR-DISTANCE

									 (
CAR
 W)
									 CENTER-POINT))
								     MINIMAL-DIS)
				   do
 (
SETQ
 MINIMAL-DIS DIS)
				      (
SETQ
 CLOSEST-POINT W))
				(
SETQ
 NEW-POS (
CAR
 CLOSEST-POINT))
				(
SETQ
 NEW-DIRECTION (
CADR
 CLOSEST-POINT))
				(
WINDOWPROP
 WINDOW (
QUOTE
 WORM.DIRECTION)
					    NEW-DIRECTION)
			 else
 (add
 ITERATIONS 1)
			      (
SETQ
 OLD-DIRECTION (
WINDOWPROP
 WINDOW (
QUOTE
 WORM.DIRECTION)))
			      [
SETQ
 NEW-DIRECTION (
IPLUS
 OLD-DIRECTION (if
 SECOND-ROUND
									   then
 INC
									 else
 (
RAND
 -20 20]
			      (
WINDOWPROP
 WINDOW (
QUOTE
 WORM.DIRECTION)
					  NEW-DIRECTION)
			      (
SETQ
 NEW-POS (WORM.FIND-COORDINATES
 (
CAR
 OLD-POS)
								   (
CDR
 OLD-POS)
								   50 NEW-DIRECTION))
			      (if
 (for
 W in
 (
WINDOWPROP
 WINDOW (
QUOTE
 WORM))
				     always
 (
IGEQ
 (WORM.SQUAR-DISTANCE
 NEW-POS (
CAR
 W))
						  (
ITIMES
 49 49)))
				  then
 (push
 CANDIDATE-LIST (
LIST
 NEW-POS NEW-DIRECTION))
				       (if
 (
NOT
 (
SUBREGIONP
 (
CREATEREGION
 0 0 (fetch
 WIDTH
										 of
 W-REG)
									  (fetch
 HEIGHT of
 W-REG))
							    (
CREATEREGION
 (
IDIFFERENCE
 (
CAR
 NEW-POS)
										       25)
									  (
IDIFFERENCE
 (
CDR
 NEW-POS)
										       25)
									  50 50)))
					   then
 (
SETQ
 SECOND-ROUND T)
						(
GO
 TRY-AGAIN))
				else
 (
SETQ
 SECOND-ROUND T)
				     (
GO
 TRY-AGAIN)))
		       (WORM.DRAW-ONE-PART
 (
CAR
 NEW-POS)
					   (
CDR
 NEW-POS)
					   25 WINDOW NEW-DIRECTION)
		       (
WINDOWADDPROP
 WINDOW (
QUOTE
 WORM)
				      (
LIST
 NEW-POS NEW-DIRECTION)
				      T)
		       [if
 (
GREATERP
 (
LENGTH
 (
WINDOWPROP
 WINDOW (
QUOTE
 WORM)))
				     10)
			   then
 (WORM.DRAW-ONE-PART
 [
CAAR
 (
CAR
 (
LAST
 (
WINDOWPROP
 WINDOW (
QUOTE
 WORM]
						    [
CDAR
 (
CAR
 (
LAST
 (
WINDOWPROP
 WINDOW (
QUOTE
 WORM]
						    25 WINDOW
						    [
CADR
 (
CAR
 (
LAST
 (
WINDOWPROP
 WINDOW (
QUOTE
 WORM]
						    T)
				(
WINDOWDELPROP
 WINDOW (
QUOTE
 WORM)
					       (
CAR
 (
LAST
 (
WINDOWPROP
 WINDOW (
QUOTE
 WORM]
		       (
WINDOWPROP
 WINDOW (
QUOTE
 WORM.DIRECTION)
				   NEW-DIRECTION])

(WORM.DRAW-ONE-PART

  [LAMBDA (X Y RADIUS WINDOW DIRECTION ERASE?)               (* sm " 9-Aug-85 11:58")

    (
PROG
 (POS1 POS2)
          (
FILLCIRCLE
 X Y RADIUS (if
 ERASE?
				     then
 WHITESHADE
				   else
 BLACKSHADE)
		      WINDOW)
          (if
 (
NOT
 ERASE?)
	      then
 (
SETQ
 POS1 (WORM.FIND-COORDINATES
 X Y (
IDIFFERENCE
 RADIUS 6)
						     (
IPLUS
 DIRECTION 90)))
		   (
SETQ
 POS2 (WORM.FIND-COORDINATES
 X Y (
IDIFFERENCE
 RADIUS 6)
						     (
IDIFFERENCE
 DIRECTION 90)))
		   (
FILLCIRCLE
 (
CAR
 POS1)
			       (
CDR
 POS1)
			       3 WHITESHADE WINDOW)
		   (
FILLCIRCLE
 (
CAR
 POS2)
			       (
CDR
 POS2)
			       3 WHITESHADE WINDOW])

(WORM.FIND-COORDINATES

  [LAMBDA (X1 Y1 LENGTH ANGLE)                               (* sm " 8-Aug-85 17:47")

    (
CONS
 (
FIX
 (
FPLUS
 (
FTIMES
 (
COS
 ANGLE)
			      LENGTH)
		      X1))
	  (
FIX
 (
FPLUS
 (
FTIMES
 (
SIN
 ANGLE)
			      LENGTH)
		      Y1])

(WORM.SQUAR-DISTANCE

  [LAMBDA (P1 P2)                                            (* sm " 9-Aug-85 10:24")

    (
IPLUS
 [
ITIMES
 (
ABS
 (
IDIFFERENCE
 (
CAR
 P1)
				     (
CAR
 P2)))
		   (
ABS
 (
IDIFFERENCE
 (
CAR
 P1)
				     (
CAR
 P2]
	   (
ITIMES
 (
ABS
 (
IDIFFERENCE
 (
CDR
 P1)
				     (
CDR
 P2)))
		   (
ABS
 (
IDIFFERENCE
 (
CDR
 P1)
				     (
CDR
 P2])
)

(ADDTOVAR IDLE.FUNCTIONS
 (Worm (QUOTE WORM)))
(PUTPROPS WORM COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (482 6226 (WORM 492 . 674) (WORM.ADVANCE-WORM 676 . 4780) (WORM.DRAW-ONE-PART 4782 . 
5515) (WORM.FIND-COORDINATES 5517 . 5806) (WORM.SQUAR-DISTANCE 5808 . 6224)))))
STOP