(FILECREATED "31-MAY-82 13:33:07" {PHYLUM}<LISPCORE>DEMO>PEANO.;5 2738   

     changes to:  PEANOCOMS PEANOSCALE PLOT PEANOSTEP PEANODEMO PEANO1

     previous date: "31-MAY-82 11:29:44" {PHYLUM}<LISPCORE>DEMO>PEANO.;1)


(* Copyright (c) 1982 by Xerox Corporation)

(PRETTYCOMPRINT PEANOCOMS)

(RPAQQ PEANOCOMS ((FNS PEANODEMO PEANOROTATE PEANO1 PEANOSTEP)
		  (MACROS PLOT)
		  (GLOBALVARS XNOW YNOW ORIENT PEANOSCALE PEANOWINDOW)
		  (VARS PEANOSCALE (PEANOWINDOW NIL))))
(DEFINEQ

(PEANODEMO
  [LAMBDA (LEVEL SCALE)                                      (* rrb "31-MAY-82 12:16")
    (OR LEVEL (SETQ LEVEL 7))
    (COND
      (SCALE (SETQ PEANOSCALE (FIX SCALE)))
      ((FIXP PEANOSCALE))
      (T (SETQ PEANOSCALE 3)))
    (PROGN [COND
	     ((TYPENAMEP PEANOWINDOW (QUOTE WINDOW)))
	     (T (SETQ PEANOWINDOW
		  (CREATEW (create REGION
				   LEFT ← 624
				   BOTTOM ← 402
				   WIDTH ← 396
				   HEIGHT ← 406)
			   "Peano curves"]
	   (CLEARW PEANOWINDOW)
	   (MOVETO PEANOSCALE PEANOSCALE PEANOWINDOW))
    (SETQ XNOW 1)
    (SETQ YNOW 1)
    (SETQ ORIENT 0)
    (PEANO1 LEVEL 1])

(PEANOROTATE
  [LAMBDA (DIRECTION)                                        (* bas: "30-APR-82 19:29")
    (add ORIENT DIRECTION)
    (COND
      ((IGREATERP ORIENT 3)
	(SETQ ORIENT (IDIFFERENCE ORIENT 4)))
      ((ILESSP ORIENT 0)
	(SETQ ORIENT (IPLUS ORIENT 4])

(PEANO1
  [LAMBDA (LEVEL HAND)                                       (* rrb "31-MAY-82 13:17")
    (COND
      ((EQ LEVEL 1)
	(PLOT))
      (T (SETQ LEVEL (SUB1 LEVEL))
	 (PEANOROTATE HAND)
	 (PEANO1 LEVEL (IMINUS HAND))
	 (PEANOSTEP)
	 (PLOT)
	 (PEANOSTEP)
	 (PEANOROTATE (IMINUS HAND))
	 (PEANO1 LEVEL HAND)
	 (PEANOSTEP)
	 (PLOT)
	 (PEANOSTEP)
	 (PEANO1 LEVEL HAND)
	 (PEANOROTATE (IMINUS HAND))
	 (PEANOSTEP)
	 (PLOT)
	 (PEANOSTEP)
	 (PEANO1 LEVEL (IMINUS HAND))
	 (PEANOROTATE HAND)
	 (BLOCK])

(PEANOSTEP
  [LAMBDA NIL                                                (* rrb "31-MAY-82 11:31")
    (SELECTQ ORIENT
	     (0 (SETQ XNOW (ADD1 XNOW)))
	     (1 (SETQ YNOW (ADD1 YNOW)))
	     (2 (SETQ XNOW (SUB1 XNOW)))
	     (3 (SETQ YNOW (SUB1 YNOW)))
	     (ERROR "Step: strange direction" ORIENT))
    (MOVETO (ITIMES XNOW PEANOSCALE)
	    (ITIMES YNOW PEANOSCALE)
	    PEANOWINDOW])
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS PLOT MACRO (NIL (RELDRAWTO PEANOSCALE 0 PEANOSCALE (QUOTE REPLACE)
				     PEANOWINDOW)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS XNOW YNOW ORIENT PEANOSCALE PEANOWINDOW)
)

(RPAQQ PEANOSCALE 3)

(RPAQQ PEANOWINDOW NIL)
(DECLARE: DONTCOPY (PUTPROPS PEANO COPYRIGHT ("Xerox Corporation" 1982)))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (484 2356 (PEANODEMO 494 . 1118) (PEANOROTATE 1120 . 1393) (PEANO1 1395 . 1957) (
PEANOSTEP 1959 . 2354)))))
STOP