(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED " 7-Nov-88 14:26:49" {QV}<NOTECARDS>1.3M>MAPS>QUADFUNS.;2 12138
changes to%: (FNS GET.QUAD.TREE)
previous date%: " 7-Jan-88 17:34:26" {QV}<NOTECARDS>1.3L>MAPS>QUADFUNS.;3)
(* "
Copyright (c) 1985, 1987, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT QUADFUNSCOMS)
(RPAQQ QUADFUNSCOMS
((DECLARE%: DONTCOPY (PROPS (QUADFUNS MAKEFILE-ENVIRONMENT)
(QUADFUNS FILETYPE)))
(VARS MaxQuadTreeLevel QUADTREE)
(GLOBALVARS QUADTREE.HIGHRES QUADTREE.LOWRES QUADTREEDIRECTORY)
(INITVARS QUADTREE.HIGHRES QUADTREE.LOWRES)
(RECORDS QUADLEAF QUADNODE)
(FNS ADD.TO.QUAD.TREE CREATE.QUAD.STRUCTURE DRAW.FROM.TREE DRAW.MAP.FROM.TREE FIRST.QUADRANT
FOURTH.QUADRANT GET.QUAD.TREE PUT.SEGS.TO.QUAD.TREE SECOND.QUADRANT SPAWN.QUAD.LEAF
SPAWN.QUAD.NODE THIRD.QUADRANT)))
(DECLARE%: DONTCOPY
(PUTPROPS QUADFUNS MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS QUADFUNS FILETYPE :TCOMPL)
)
(RPAQQ MaxQuadTreeLevel 5)
(RPAQQ QUADTREE NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS QUADTREE.HIGHRES QUADTREE.LOWRES QUADTREEDIRECTORY)
)
(RPAQ? QUADTREE.HIGHRES NIL)
(RPAQ? QUADTREE.LOWRES NIL)
(DECLARE%: EVAL@COMPILE
(TYPERECORD QUADLEAF (REGION SEGMENTLST))
(TYPERECORD QUADNODE (REGION QUAD1 QUAD2 QUAD3 QUAD4))
)
(DEFINEQ
(ADD.TO.QUAD.TREE
(LAMBDA (TREE REGION INDEX) (* Feuerman " 7-NOV-83 16:10")
(COND
((REGIONSINTERSECTP REGION (fetch REGION of TREE))
(COND
((EQUAL (CAR TREE)
'QUADLEAF)
(* TREE is a LEAF, and the segment is in the region represented by this leaf,
so add it to the segment list)
(replace SEGMENTLST of TREE with (NCONC1 (fetch SEGMENTLST of TREE)
INDEX)))
(T (ADD.TO.QUAD.TREE (fetch QUAD1 of TREE)
REGION INDEX)
(ADD.TO.QUAD.TREE (fetch QUAD2 of TREE)
REGION INDEX)
(ADD.TO.QUAD.TREE (fetch QUAD3 of TREE)
REGION INDEX)
(ADD.TO.QUAD.TREE (fetch QUAD4 of TREE)
REGION INDEX)))))))
(CREATE.QUAD.STRUCTURE
(LAMBDA NIL (* Feuerman " 7-NOV-83 14:38")
(create QUADNODE
REGION ← (CREATEREGION 0 0 (CONSTANT (EXPT 2 20))
(CONSTANT (EXPT 2 20)))
QUAD1 ← (SPAWN.QUAD.NODE (CREATEREGION (CONSTANT (EXPT 2 19))
(CONSTANT (EXPT 2 19))
(CONSTANT (EXPT 2 19))
(CONSTANT (EXPT 2 19)))
2)
QUAD2 ← (SPAWN.QUAD.NODE (CREATEREGION 0 (CONSTANT (EXPT 2 19))
(CONSTANT (EXPT 2 19))
(CONSTANT (EXPT 2 19)))
2)
QUAD3 ← (SPAWN.QUAD.NODE (CREATEREGION 0 0 (CONSTANT (EXPT 2 19))
(CONSTANT (EXPT 2 19)))
2)
QUAD4 ← (SPAWN.QUAD.NODE (CREATEREGION (CONSTANT (EXPT 2 19))
0
(CONSTANT (EXPT 2 19))
(CONSTANT (EXPT 2 19)))
2))))
(DRAW.FROM.TREE
[LAMBDA (TREE S1 DSP LONGOFF LATOFF LONGSC LATSC CLIPW CLIPE CLIPS CLIPN)
(* ; "Edited 7-Jan-88 13:15 by Trigg")
(* ;;
"rht 1/7/87: Changed calls to WINDOWPROP to STREAMPROP since there's no easily available window.")
(COND
((REGIONSINTERSECTP (CREATEREGION CLIPW CLIPS (IDIFFERENCE CLIPE CLIPW)
(IDIFFERENCE CLIPN CLIPS))
(fetch REGION of TREE))
(COND
((EQUAL (CAR TREE)
'QUADNODE)
(DRAW.FROM.TREE (fetch QUAD1 of TREE)
S1 DSP LONGOFF LATOFF LONGSC LATSC CLIPW CLIPE CLIPS CLIPN)
(DRAW.FROM.TREE (fetch QUAD2 of TREE)
S1 DSP LONGOFF LATOFF LONGSC LATSC CLIPW CLIPE CLIPS CLIPN)
(DRAW.FROM.TREE (fetch QUAD3 of TREE)
S1 DSP LONGOFF LATOFF LONGSC LATSC CLIPW CLIPE CLIPS CLIPN)
(DRAW.FROM.TREE (fetch QUAD4 of TREE)
S1 DSP LONGOFF LATOFF LONGSC LATSC CLIPW CLIPE CLIPS CLIPN))
(T (for SEG in (fetch SEGMENTLST of TREE)
do (COND
([NOT (FMEMB SEG (STREAMPROP DSP 'DRAWNSEGMENTS]
(PROG (NPTS SEGRANK S W N E)
(SETFILEPTR S1 SEG)
(SETQ NPTS (BIN16 S1))
(SETQ SEGRANK (BIN16 S1))
(SETQ S (BIN20 S1))
(SETQ W (BIN20 S1))
(SETQ N (BIN20 S1))
(SETQ E (BIN20 S1))
(PLOTSEGMENT DSP S1 NPTS LONGOFF LONGSC LATOFF LATSC SEGRANK)
(STREAMADDPROP DSP 'DRAWNSEGMENTS SEG])
(DRAW.MAP.FROM.TREE
[LAMBDA (TREE MAPFILE DSP LONGOFF LATOFF LONGSC LATSC CLIPW CLIPE CLIPS CLIPN)
(* ; "Edited 7-Jan-88 17:30 by Trigg")
(* ;; "rht 1/7/87: Changed calls to WINDOWPROP to STREAMPROP since there's no easily available window. Also changed to use streams and close when done so we cut the proliferation of openstreams.")
(LET [(MAPFILESTREAM (OPENSTREAM MAPFILE 'INPUT]
(STREAMPROP DSP 'DRAWNSEGMENTS NIL)
(DRAW.FROM.TREE TREE MAPFILESTREAM DSP LONGOFF LATOFF LONGSC LATSC CLIPW CLIPE CLIPS CLIPN)
(CLOSEF MAPFILESTREAM)
(STREAMPROP DSP 'DRAWNSEGMENTS NIL])
(FIRST.QUADRANT
(LAMBDA (REGION) (* Feuerman " 7-NOV-83 14:47")
(CREATEREGION (PLUS (fetch LEFT of REGION)
(IQUOTIENT (fetch WIDTH of REGION)
2))
(PLUS (fetch BOTTOM of REGION)
(IQUOTIENT (fetch HEIGHT of REGION)
2))
(IQUOTIENT (fetch WIDTH of REGION)
2)
(IQUOTIENT (fetch HEIGHT of REGION)
2))))
(FOURTH.QUADRANT
(LAMBDA (REGION) (* Feuerman " 7-NOV-83 14:50")
(CREATEREGION (PLUS (fetch LEFT of REGION)
(IQUOTIENT (fetch WIDTH of REGION)
2))
(fetch BOTTOM of REGION)
(IQUOTIENT (fetch WIDTH of REGION)
2)
(IQUOTIENT (fetch HEIGHT of REGION)
2))))
(GET.QUAD.TREE
[LAMBDA (MAPFILE) (* ; "Edited 7-Nov-88 14:24 by Randy.Gobbel")
(* ;; "Returns a new quad tree with indices into MAPFILE. If a quad tree mapfile exists, it just reads it in, otherwise the file is created for future use.")
(* ;; "rht 4/22/85: Modified to now use the QUADFUNSDIRECTORY variable for accessing quadtreehigh and quadtreelow.")
(* ;; "FGH 9/27/85 Changed QUADTREEDIRECTORY to MAPFILESDIRECTORIES and changed the name of the quadtree files to have a .quadtree extension.")
(* ;; "RG 11/04/88 Changed call to BREAK1 to conform to Medley conventions")
(LET (TREE FILENAME BASENAME)
[SETQ BASENAME (PACKFILENAME 'EXTENSION 'QUADTREE 'NAME (FILENAMEFIELD MAPFILE 'NAME]
[SETQ FILENAME (OR (FINDFILE BASENAME NIL MAPFILESDIRECTORIES)
(BREAK1 (FINDFILE BASENAME NIL MAPFILESDIRECTORIES)
T GET.QUAD.TREE NIL NIL '("Cannot find the quad tree data file."
"You probably need to reset MAPFILESDIRECTORIES!!
Type '↑' to abort."]
(SETQ FILENAME (OPENSTREAM FILENAME 'INPUT))
(PROMPTPRINT "Reading from quad tree file")
(SETQ TREE (READ FILENAME))
(CLOSEF FILENAME)
TREE])
(PUT.SEGS.TO.QUAD.TREE
(LAMBDA (MAPFILE QUADTREE) (* Feuerman " 2-Mar-85 15:04")
(PROG ((S1 (\GETOFD (OR (OPENP MAPFILE)
(OPENFILE MAPFILE 'INPUT))))
N S E W NPTS SEGRANK SAVE.INDEX)
(SETFILEPTR S1 0)
(until (EOFP S1) do (SETQ SAVE.INDEX (GETFILEPTR S1))
(SETQ NPTS (BIN16 S1))
(SETQ SEGRANK (BIN16 S1))
(SETQ S (BIN20 S1))
(SETQ W (BIN20 S1))
(SETQ N (BIN20 S1))
(SETQ E (BIN20 S1))
(COND
((LESSP E W)
(SETQ W 0)
(SETQ E (CONSTANT (EXPT 2 20)))))
(COND
((LESSP N S)
(SETQ S 0)
(SETQ N (CONSTANT (EXPT 2 20)))))
(ADD.TO.QUAD.TREE QUADTREE (CREATEREGION W S (IDIFFERENCE E W)
(IDIFFERENCE N S))
SAVE.INDEX)
(SETFILEPTR S1 (IPLUS (GETFILEPTR S1)
(LLSH NPTS 2)
8)))
(RETURN QUADTREE))))
(SECOND.QUADRANT
(LAMBDA (REGION) (* Feuerman " 7-NOV-83 14:49")
(CREATEREGION (fetch LEFT of REGION)
(PLUS (fetch BOTTOM of REGION)
(IQUOTIENT (fetch HEIGHT of REGION)
2))
(IQUOTIENT (fetch WIDTH of REGION)
2)
(IQUOTIENT (fetch HEIGHT of REGION)
2))))
(SPAWN.QUAD.LEAF
(LAMBDA (REGION) (* Feuerman " 7-NOV-83 14:58")
(create QUADLEAF
REGION ← REGION)))
(SPAWN.QUAD.NODE
(LAMBDA (REGION LEVEL) (* Feuerman " 7-NOV-83 14:58")
(COND
((LESSP LEVEL MaxQuadTreeLevel)
(create QUADNODE
REGION ← REGION
QUAD1 ← (SPAWN.QUAD.NODE (FIRST.QUADRANT REGION)
(ADD1 LEVEL))
QUAD2 ← (SPAWN.QUAD.NODE (SECOND.QUADRANT REGION)
(ADD1 LEVEL))
QUAD3 ← (SPAWN.QUAD.NODE (THIRD.QUADRANT REGION)
(ADD1 LEVEL))
QUAD4 ← (SPAWN.QUAD.NODE (FOURTH.QUADRANT REGION)
(ADD1 LEVEL))))
(T (SPAWN.QUAD.LEAF REGION)))))
(THIRD.QUADRANT
(LAMBDA (REGION) (* Feuerman " 7-NOV-83 14:50")
(CREATEREGION (fetch LEFT of REGION)
(fetch BOTTOM of REGION)
(IQUOTIENT (fetch WIDTH of REGION)
2)
(IQUOTIENT (fetch HEIGHT of REGION)
2))))
)
(PUTPROPS QUADFUNS COPYRIGHT ("Xerox Corporation" 1985 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1508 12048 (ADD.TO.QUAD.TREE 1518 . 2494) (CREATE.QUAD.STRUCTURE 2496 . 3761) (
DRAW.FROM.TREE 3763 . 5688) (DRAW.MAP.FROM.TREE 5690 . 6408) (FIRST.QUADRANT 6410 . 6971) (
FOURTH.QUADRANT 6973 . 7440) (GET.QUAD.TREE 7442 . 8812) (PUT.SEGS.TO.QUAD.TREE 8814 . 10327) (
SECOND.QUADRANT 10329 . 10783) (SPAWN.QUAD.LEAF 10785 . 10952) (SPAWN.QUAD.NODE 10954 . 11686) (
THIRD.QUADRANT 11688 . 12046)))))
STOP