(FILECREATED " 8-JUL-82 09:46:03" {PHYLUM}<VANLEHN>GAO>PAGE.;114
 49173  

      changes to:  (VARS PAGEFNS)

      previous date: " 7-JUL-82 10:07:15" {PHYLUM}<VANLEHN>GAO>PAGE.;113)


(PRETTYCOMPRINT PAGECOMS)

(RPAQQ PAGECOMS
 ((* RECORDS BOX TOKEN PAGE)
		 (VARS * PAGEVARS)
		 (FNS * PAGEFNS)
		 (LOCALVARS . T)
		 (GLOBALVARS * PAGEGLOBALS)))



(* RECORDS BOX TOKEN PAGE)



(RPAQQ PAGEVARS
 (ALGEBRA/CHARACTERS ALGEBRA/LETTERS BACK/SPACE BAR/BOX/HEIGHT BAR/HEIGHT 
				    BROKEN/BAR/FLG CARTESIAN/MENU/CMD/NAMES CROSS/OUT/NAME (
				      CARTESIAN/MENU)
				    (CHARHEIGHT/GRID)
				    (CHARWIDTH/GRID)
				    EQ/SIGNS
				    (GRID/HEIGHT)
				    (GRID/WIDTH)
				    LEFT/PARENTHESES OP/SIGNS TAB/CHARACTER (PAGE/WINDOW)
				    (PAGE)
				    (PAGE/EDITOR/MENU)
				    PARENTHESES PARENTHESIS/WIDTH TAB/CHARACTER (BAR/Y/OFFSET)
				    (GRID/Y/OFFSET)
				    (PAGES/MENU)))

(RPAQQ ALGEBRA/CHARACTERS
 (1 2 3 4 5 6 7 8 9 0 %( %) + - %[ %] * X Y Z U V M N O P Q R S T K L W H I 
			     J a b c d e f g h i j k l m n o p q r s t u v w x y z { %| } E F A B G C 
			     D / < = >))

(RPAQQ ALGEBRA/LETTERS
 (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m 
			  n o p q r s t u v w x y z))

(RPAQQ BACK/SPACE
 %
)

(RPAQQ BAR/BOX/HEIGHT
 8)

(RPAQQ BAR/HEIGHT
 12)

(RPAQQ BROKEN/BAR/FLG
 NIL)

(RPAQQ CARTESIAN/MENU/CMD/NAMES
 ((Parse (QUOTE Parse)
					"Calls parser on the current page")
				 (Get (QUOTE Get)
				      
		   "Retrieves a stored problem set from the data base,
erasing the current page.")
				 (Put (QUOTE Put)
				      "Stores the current problem set in the data base.")
				 (Quit (QUOTE Quit)
				       "Return from editing the page.")
				 (Clear (QUOTE Clear)
					
			"Erases the whole problem set; deletes all symbols,
deselects all boxes.")
				 (Delete (QUOTE Delete)
					 "Deletes a symbol.")
				 (Scratch (QUOTE Scratch)
					  "Crosses out a symbol.")
				 (Unscratch (QUOTE Unscratch)
					    "Removes a scratch mark from a symbol.")
				 (Box (QUOTE Box)
				      "Selects a box on the page.")
				 (UnBox (QUOTE UnBox)
					"Deletes a box.")
				 (Brackets (QUOTE Brackets)
					   "Draws a large pair of square brackets.")
				 (Bar (QUOTE Bar)
				      "Draws a horizontal bar.")))

(RPAQQ CROSS/OUT/NAME
 XOUT)

(RPAQQ CARTESIAN/MENU
 NIL)

(RPAQQ CHARHEIGHT/GRID
 NIL)

(RPAQQ CHARWIDTH/GRID
 NIL)

(RPAQQ EQ/SIGNS
 (= > <))

(RPAQQ GRID/HEIGHT
 NIL)

(RPAQQ GRID/WIDTH
 NIL)

(RPAQQ LEFT/PARENTHESES
 (%( %[ { LPAREN))

(RPAQQ OP/SIGNS
 (+ - * /))

(RPAQQ TAB/CHARACTER
 %	)

(RPAQQ PAGE/WINDOW
 NIL)

(RPAQQ PAGE
 NIL)

(RPAQQ PAGE/EDITOR/MENU
 NIL)

(RPAQQ PARENTHESES
 (%( %) %[ %] { } LPAREN RPAREN))

(RPAQQ PARENTHESIS/WIDTH
 10)

(RPAQQ TAB/CHARACTER
 %	)

(RPAQQ BAR/Y/OFFSET
 NIL)

(RPAQQ GRID/Y/OFFSET
 NIL)

(RPAQQ PAGES/MENU
 NIL)

(RPAQQ PAGEFNS
 (ASK/PAGE BLANK/AREAP BLANK/BOX BLANK/CART/POS BOX/INSIDE/BOX? COLLECT/CROSS/OUTS 
			 COLLECT/NON/CROSS/OUTS COVERS/BOX? BOX/OVERLAP/BOX? BOX/INSIDE/REGIONP 
			 BUSY/WAIT CART/ADVANCE/POS CART/MAKE/BAR CART/MAKE/BAR/TOKEN 
			 CART/MAKE/PARENS CART/MOVE/POSITION CART/READ/CHAR CART/READ/GOOD/CHAR 
			 CARTESIAN/MENU CLEAR/PAGE/SELECTIONS CROSS/HATCH/BOX DEFINE/PAGE/WINDOW 
			 DEFINE/TOKEN/WINDOW DELETE/TOKEN DESELECT/TOKEN DISPLAY/PAGE DISPLAY/TOKEN 
			 DISPLAY/TOKENS&SELECTED DRAW/BAR DRAW/CHAR/TOKEN DRAW/LPAREN DRAW/RPAREN 
			 DSP/GRID/POS EQUAL/PAGES ERASE/TOKEN FETCH/PAGE FIND/TOKEN/CONTAINING/XY 
			 FLASH/SCREEN GET/BOX GET/REGION/IN/WINDOW GETPG! GETREGION/GRIDIFIER 
			 GRID/WIDTH/OF/CHAR GRIDIFY/POSITION INDEX/PAGE INIT/PAGE INVERT/BOX 
			 INVERT/PROMPT/CURSOR/AT/XY INVERT/TOKEN MAKE/EXAMPLE EXAMPLE/FROM/INDEX 
			 MOVE/BOX/DESTRUCTIVELY MOVE/TOK/OR/CURSOR MOVE/TOKEN MOVE/TOKEN/LOOP 
			 ON/PROMPT/CURSOR PAGE/EDITOR PAGE/EDITOR/LOOP PAGE/STATE/BUTTON PG 
			 REDISPLAY/PAGE SAVE/PAGE SCRATCH/BOX SELECT/BOX SELECT/TOKEN TOKEN/HEIGHT 
			 TOKEN/WIDTH TOKLST/AS/MENU UNSCRATCH/TOKEN))
(DEFINEQ

(ASK/PAGE

  [LAMBDA (DEFAULT)                                          (* kvl " 1-MAY-82 11:35")

                                                             (* returns one of the available gaos on a menu)

    (OR (BOUNDP (QUOTE PAGEDB))
	(SETQ PAGEDB NIL))
    (OR (BOUNDP (QUOTE PAGES/MENU))
	(SETQ PAGES/MENU))
    (OR PAGES/MENU (SETQ PAGES/MENU (create
 MENU
					    ITEMS ←(for
 P in
 PAGEDB
						      collect
 (LIST (fetch
 PAGE/NAME of
 P)
								    (KWOTE P)))
					    TITLE ←"Pick a problem set"
					    CENTERFLG ← T)))
    (OR (COPY (MENU PAGES/MENU))
	DEFAULT])

(BLANK/AREAP

  [LAMBDA (L R TOP BOT)                                      (* kvl " 1-MAY-82 11:28")

                                                             (* true iff there is not token in the current page that 

							     overlaps the given rectangle.

							     Inputs in grid coordinates.)

    (DECLARE
 (SPECVARS PAGE))
    (OR (EQ L R)
	(EQ TOP BOT)
	(for
 TOK in
 (fetch
 PAGE/TOKENS of
 PAGE) bind
 B
	   always
 (OR (ILEQ (fetch
 BOXR of
 (SETQ B (fetch
 TOKEN/BOX of
 TOK)))
			    L)
		      (ILEQ R (fetch
 BOXL of
 B))
		      (ILEQ (fetch
 BOXT of
 B)
			    BOT)
		      (ILEQ TOP (fetch
 BOXB of
 B])

(BLANK/BOX

  [LAMBDA (B)
    (BLANK/AREAP
 (fetch
 BOXL of
 B)
		 (fetch
 BOXR of
 B)
		 (fetch
 BOXT of
 B)
		 (fetch
 BOXB of
 B])

(BLANK/CART/POS

  [LAMBDA (X Y)                                              (* kvl "13-APR-82 14:52")

    (BLANK/AREAP
 X (IPLUS X CHARWIDTH/GRID)
		 (IPLUS Y CHARHEIGHT/GRID)
		 Y])

(BOX/INSIDE/BOX?

  [LAMBDA (B1 B2)                                            (* kvl " 4-MAY-82 22:48")

                                                             (* true if B1 is inside B2)

    (AND (AND (ILEQ (fetch
 BOXL of
 B2)
		    (fetch
 BOXL of
 B1))
	      (IGEQ (fetch
 BOXR of
 B2)
		    (fetch
 BOXR of
 B1)))
	 (AND (ILEQ (fetch
 BOXB of
 B2)
		    (fetch
 BOXB of
 B1))
	      (IGEQ (fetch
 BOXT of
 B2)
		    (fetch
 BOXT of
 B1])

(COLLECT/CROSS/OUTS

  [LAMBDA (TOKS)
    (DECLARE
 (SPECVARS PAGE))                                (* kvl " 7-JUN-82 21:27")

    (for
 TOK in
 (OR TOKS (fetch
 PAGE/TOKENS of
 PAGE)) collect
 TOK
       when
 (EQ (fetch
 TOKEN/NAME of
 TOK)
		CROSS/OUT/NAME])

(COLLECT/NON/CROSS/OUTS

  [LAMBDA (TOKS)
    (DECLARE
 (SPECVARS PAGE))                                (* kvl " 7-JUN-82 21:27")

    (for
 TOK in
 (OR TOKS (fetch
 PAGE/TOKENS of
 PAGE)) collect
 TOK
       unless
 (EQ (fetch
 TOKEN/NAME of
 TOK)
		  CROSS/OUT/NAME])

(COVERS/BOX?

  [LAMBDA (NODES BOX)                                        (* kvl "27-MAY-82 11:46")

                                                             (* true if none of the nodes overlap, and the union of 

							     their coverage covers the box's contents.)

    (DECLARE
 (SPECVARS PAGE))
    (AND [for
 TOK in
 (fetch
 PAGE/TOKENS of
 PAGE) when
 (BOX/OVERLAP/BOX?
 (fetch
 TOKEN/BOX
									   of
 TOK)
									BOX)
	    always
 (for
 N in
 NODES thereis
 (BOX/INSIDE/BOX?
 (fetch
 TOKEN/BOX of
 TOK)
							    (fetch
 FF/BOX of
 N]
	 (for
 NL on
 NODES never
 (for
 N2 in
 (CDR NL) thereis
 (BOX/OVERLAP/BOX?
 (fetch
 FF/BOX
										 of
 (CAR NL))
									      (fetch
 FF/BOX
										 of
 N2])

(BOX/OVERLAP/BOX?

  [LAMBDA (B1 B2)                                            (* kvl "25-MAY-82 10:46")

                                                             (* overlap = not outside)

    (NOT (OR (ILEQ (fetch
 BOXR of
 B1)
		   (fetch
 BOXL of
 B2))
	     (IGEQ (fetch
 BOXL of
 B1)
		   (fetch
 BOXR of
 B2))
	     (ILEQ (fetch
 BOXT of
 B1)
		   (fetch
 BOXB of
 B2))
	     (IGEQ (fetch
 BOXB of
 B1)
		   (fetch
 BOXT of
 B2])

(BOX/INSIDE/REGIONP

  [LAMBDA (R BOX)                                            (* kvl "22-APR-82 18:57")

                                                             (* true if the box is in the region)

    (AND (INSIDEP R (ITIMES GRID/WIDTH (fetch
 BOXL of
 BOX))
		  (ITIMES GRID/HEIGHT (fetch
 BOXB of
 BOX)))
	 (INSIDEP R (ITIMES GRID/WIDTH (fetch
 BOXR of
 BOX))
		  (ITIMES GRID/HEIGHT (fetch
 BOXT of
 BOX])

(BUSY/WAIT

  [LAMBDA (MILLISECS TTY/ABORTS)                             (* kvl "23-APR-82 10:39")

    (bind
 (FINI ←(IPLUS MILLISECS (CLOCK 0))) bind
 (NOW ←(MAKENUMBER 1 1)) do
 (CLOCK0 NOW)
       repeatuntil
 (OR (IGREATERP NOW FINI)
		       (AND TTY/ABORTS (OR (READP T)
					   (NOT (MOUSESTATE UP])

(CART/ADVANCE/POS

  [LAMBDA (POS INITADVANCE)                                  (* kvl "13-APR-82 19:39")

                                                             (* advances the position in the grid by one character, 

							     skipping over occupied areas.

							     Side effects POS)

    (replace
 XCOORD of
 POS with
 (IPLUS INITADVANCE (fetch
 XCOORD of
 POS)))
    [until
 (BLANK/CART/POS
 (fetch
 XCOORD of
 POS)
			   (fetch
 YCOORD of
 POS))
       do
 (replace
 XCOORD of
 POS with
 (ADD1 (fetch
 XCOORD of
 POS]
    (DSP/GRID/POS
 POS])

(CART/MAKE/BAR

  [LAMBDA NIL                                                (* kvl "13-APR-82 17:47")

                                                             (* draws a horizontal bar from the given starting place 

							     to where ever the user lets the button up.)

    (PROG (SGX SGY)
          (until
 (MOUSESTATE (NOT UP)) do
)
          (SETQ SGX (IQUOTIENT (LASTMOUSEX)
			       GRID/WIDTH))
          (SETQ SGY (IQUOTIENT (LASTMOUSEY)
			       GRID/HEIGHT))
          (COND
	    ((NOT (BLANK/AREAP
 SGX (ADD1 SGX)
			       (ADD1 SGY)
			       SGY))
	      (FLASH/SCREEN
)
	      (RETURN))
	    (T (repeatuntil
 (MOUSESTATE UP) bind
 NEWX (Y ←(IPLUS BAR/Y/OFFSET (ITIMES GRID/HEIGHT SGY)
								 ))
						 (X ←(ITIMES GRID/WIDTH SGX))
		  do
 (MOVETO X Y)
		     (DRAWTO (SETQ NEWX (ITIMES GRID/WIDTH (IQUOTIENT (LASTMOUSEX)
								      GRID/WIDTH)))
			     Y 2 (QUOTE INVERT))
		     (MOVETO X Y)
		     (DRAWTO NEWX Y 2 (QUOTE INVERT))
		  finally
 [COND
			    ((ILESSP NEWX X)
			      (SETQ NEWX (PROG1 X (SETQ X NEWX]
			  (SETQ NEWX (IQUOTIENT NEWX GRID/WIDTH))
			  (SETQ X (IQUOTIENT X GRID/WIDTH))
			  (AND (EQ NEWX X)
			       (RETURN))
			  (CART/MAKE/BAR/TOKEN
 X NEWX SGY])

(CART/MAKE/BAR/TOKEN

  [LAMBDA (L R Y)                                            (* kvl " 7-JUN-82 20:38")

                                                             (* inputs in grid coordinates)

    (DECLARE
 (SPECVARS PAGE))
    (COND
      [(BLANK/AREAP
 L R (ADD1 Y)
		    Y)
	(COND
	  [BROKEN/BAR/FLG (for
 IR from
 (IPLUS L CHARWIDTH/GRID) to
 R by
 CHARWIDTH/GRID as
 IL
			     by
 CHARWIDTH/GRID from
 L bind
 (TOP ←(ADD1 Y))
			     do
 (push
 (fetch
 PAGE/TOKENS of
 PAGE)
				      (create
 TOKEN
					      TOKEN/NAME ←(QUOTE BAR)
					      TOKEN/BOX ←(create
 BOX
								 BOXL ← IL
								 BOXR ← IR
								 BOXT ← TOP
								 BOXB ← Y)))
				(DISPLAY/TOKEN
 (CAR (fetch
 PAGE/TOKENS of
 PAGE]
	  (T (push
 (fetch
 PAGE/TOKENS of
 PAGE)
		   (create
 TOKEN
			   TOKEN/NAME ←(QUOTE BAR)
			   TOKEN/BOX ←(create
 BOX
					      BOXL ← L
					      BOXR ← R
					      BOXT ←(ADD1 Y)
					      BOXB ← Y)))
	     (DISPLAY/TOKEN
 (CAR (fetch
 PAGE/TOKENS of
 PAGE]
      (T (FLASH/SCREEN
])

(CART/MAKE/PARENS

  [LAMBDA (B)                                                (* kvl " 7-JUN-82 20:38")

                                                             (* draws parentheses around box sketched by user.)

    (OR (AND B (PROG ((W (IMAX 1 (IQUOTIENT (fetch
 BOX/HEIGHT of
 B)
					    3)))
		      LP RP)
		     (SETQ LP (create
 BOX
				      BOXL ←(fetch
 BOXL of
 B)
				      BOXR ←(IPLUS W (fetch
 BOXL of
 B))
				      BOXT ←(fetch
 BOXT of
 B)
				      BOXB ←(fetch
 BOXB of
 B)))
		     (OR (BLANK/BOX
 LP)
			 (RETURN NIL))
		     (SETQ RP (create
 BOX
				      BOXL ←(IDIFFERENCE (fetch
 BOXR of
 B)
							 W)
				      BOXR ←(fetch
 BOXR of
 B)
				      BOXT ←(fetch
 BOXT of
 B)
				      BOXB ←(fetch
 BOXB of
 B)))
		     (OR (BLANK/BOX
 RP)
			 (RETURN NIL))
		     (SETQ LP (create
 TOKEN
				      TOKEN/NAME ←(QUOTE LPAREN)
				      TOKEN/BOX ← LP))
		     (SETQ RP (create
 TOKEN
				      TOKEN/NAME ←(QUOTE RPAREN)
				      TOKEN/BOX ← RP))
		     (DISPLAY/TOKEN
 LP)
		     (DISPLAY/TOKEN
 RP)
		     (push
 (fetch
 PAGE/TOKENS of
 PAGE)
			   LP RP)
		     (RETURN T)))
	(FLASH/SCREEN
])

(CART/MOVE/POSITION

  [LAMBDA (POS)                                              (* kvl "22-APR-82 22:12")

                                                             (* follows mouse, moving caret when it stays in the 

							     clipping region. Won't move into occupied area.)

    (until
 (MOUSESTATE UP) when
 (INSIDEP R (LASTMOUSEX)
					 (LASTMOUSEY))
       finally
 (COND
		 ((AND GX GY)
		   (replace
 XCOORD of
 POS with
 GX)
		   (replace
 YCOORD of
 POS with
 GY)
		   (DSP/GRID/POS
 POS)
		   (INVERT/PROMPT/CURSOR/AT/XY
 GX GY T)))
       bind
 NGX NGY GX GY (R ←(DSPCLIPPINGREGION NIL PAGE/WINDOW))
       do
 (SETQ NGX (IQUOTIENT (LASTMOUSEX)
			       GRID/WIDTH))
	  (SETQ NGY (IQUOTIENT (LASTMOUSEY)
			       GRID/HEIGHT))
	  (COND
	    ((AND (EQ GX NGX)
		  (EQ GY NGY)))
	    ((BLANK/CART/POS
 NGX NGY)
	      (AND GX GY (INVERT/PROMPT/CURSOR/AT/XY
 GX GY T))
	      (INVERT/PROMPT/CURSOR/AT/XY
 NGX NGY T)
	      (SETQ GX NGX)
	      (SETQ GY NGY])

(CART/READ/CHAR

  [LAMBDA (C FONT POS W)                                     (* kvl " 1-MAY-82 11:29")

                                                             (* C is any ascii character. POS is the display position

							     just before it was typed. Side effects PAGE and POS)

    (DECLARE
 (SPECVARS PAGE))
    (COND
      [(EQ C BACK/SPACE)
	(COND
	  ((fetch
 PAGE/TOKENS of
 PAGE)
	    (ERASE/TOKEN
 (CAR (fetch
 PAGE/TOKENS of
 PAGE)))
	    [replace
 XCOORD of
 POS with
 (fetch
 BOXL of
 (fetch
 TOKEN/BOX
							  of
 (CAR (fetch
 PAGE/TOKENS of
 PAGE]
	    [replace
 YCOORD of
 POS with
 (fetch
 BOXB of
 (fetch
 TOKEN/BOX
							  of
 (CAR (fetch
 PAGE/TOKENS of
 PAGE]
	    (pop
 (fetch
 PAGE/TOKENS of
 PAGE))
	    (CART/ADVANCE/POS
 POS 0))
	  (T (FLASH/SCREEN
]
      (T (DSPBACKUP (SETQ W (CHARWIDTH (CHCON1 C)
				       FONT)))
	 (COND
	   ((FMEMB C ALGEBRA/CHARACTERS)
	     (CART/READ/GOOD/CHAR
 C POS W)
	     (CART/ADVANCE/POS
 POS 1))
	   ((OR (EQ C (QUOTE % ))
		(EQ C TAB/CHARACTER))
	     (CART/ADVANCE/POS
 POS 1))
	   (T (FLASH/SCREEN
])

(CART/READ/GOOD/CHAR

  [LAMBDA (C POS WIDTH)                                      (* kvl " 7-JUN-82 20:38")

                                                             (* concatenates consequtive digits on the same line to 

							     become numbers, other characters just pushed on to the 

							     cart.)

    (DECLARE
 (SPECVARS PAGE))
    (PROG [(TOK (create
 TOKEN
			TOKEN/NAME ← C
			TOKEN/BOX ←(create
 BOX
					   BOXL ←(fetch
 XCOORD of
 POS)
					   BOXR ←(IPLUS (fetch
 XCOORD of
 POS)
							(ADD1 (IQUOTIENT WIDTH GRID/WIDTH)))
					   BOXB ←(fetch
 YCOORD of
 POS)
					   BOXT ←(IPLUS (fetch
 YCOORD of
 POS)
							CHARHEIGHT/GRID]
          (COND
	    [(BLANK/AREAP
 (fetch
 BOXL of
 (fetch
 TOKEN/BOX of
 TOK))
			  (fetch
 BOXR of
 (fetch
 TOKEN/BOX of
 TOK))
			  (fetch
 BOXT of
 (fetch
 TOKEN/BOX of
 TOK))
			  (fetch
 BOXB of
 (fetch
 TOKEN/BOX of
 TOK]
	    (T (FLASH/SCREEN
)
	       (RETURN)))
          (push
 (fetch
 PAGE/TOKENS of
 PAGE)
		TOK)
          (DISPLAY/TOKEN
 (CAR (fetch
 PAGE/TOKENS of
 PAGE])

(CARTESIAN/MENU

  [LAMBDA NIL                                                (* kvl " 6-JUL-82 13:12")

                                                             (* asks user for choice and does it.)

    (DECLARE
 (SPECVARS PAGE))
    (OR CARTESIAN/MENU (SETQ CARTESIAN/MENU (create
 MENU
						    ITEMS ← CARTESIAN/MENU/CMD/NAMES
						    CHANGEOFFSETFLG ← T)))
    (SELECTQ (MENU CARTESIAN/MENU)
	     [Parse (COND
		      ((GETD (QUOTE FORMPARSE))
			(FORMPARSE (fetch
 PAGE/TOKENS of
 PAGE)
				   NIL
				   (fetch
 PAGE/ID of
 PAGE)
				   T))
		      (T (PROMPTPRINT "Need to load file FORMPARSE and a grammar"]
	     [Unscratch (UNSCRATCH/TOKEN
 (TOKLST/AS/MENU
 (COLLECT/CROSS/OUTS
]
	     (Scratch (SCRATCH/BOX
 (GET/BOX
)))
	     [Delete (DELETE/TOKEN
 (TOKLST/AS/MENU
 (fetch
 PAGE/TOKENS of
 PAGE]
	     (Bar (CART/MAKE/BAR
))
	     (Brackets (CART/MAKE/PARENS
 (GET/BOX
)))
	     (Quit (RETFROM (QUOTE PAGE/EDITOR/LOOP)))
	     (Box (SELECT/BOX
 (GET/BOX
)))
	     [UnBox (DESELECT/TOKEN
 (TOKLST/AS/MENU
 (fetch
 PAGE/SELECTED of
 PAGE]
	     (Put (SAVE/PAGE
 PAGE))
	     (Clear (SETQ PAGE (create
 PAGE
				       PAGE/NAME ←(fetch
 PAGE/NAME of
 PAGE)))
		    (WINDOWPROP PAGE/WINDOW (QUOTE PAGE)
				PAGE)
		    (REDISPLAY/PAGE
 PAGE/WINDOW))
	     (Get (SETQ PAGE (ASK/PAGE
 PAGE))
		  (WINDOWPROP PAGE/WINDOW (QUOTE PAGE)
			      PAGE)
		  (REDISPLAY/PAGE
 PAGE/WINDOW))
	     (FLASH/SCREEN
])

(CLEAR/PAGE/SELECTIONS

  [LAMBDA NIL
    (DECLARE
 (SPECVARS PAGE))                                (* kvl "25-JUN-82 12:34")

    (for
 TOK in
 (fetch
 PAGE/SELECTED of
 PAGE) do
 (INVERT/TOKEN
 TOK PAGE/WINDOW))
    (replace
 PAGE/SELECTED of
 PAGE with
 NIL])

(CROSS/HATCH/BOX

  [LAMBDA (B MODE W)                                         (* kvl "10-JUN-82 10:33")

    (MOVETO (ITIMES GRID/WIDTH (fetch
 BOXL of
 B))
	    (ITIMES GRID/HEIGHT (fetch
 BOXT of
 B))
	    W)
    (DRAWTO (ITIMES GRID/WIDTH (fetch
 BOXR of
 B))
	    (ITIMES GRID/HEIGHT (fetch
 BOXB of
 B))
	    1 MODE W)
    (MOVETO (ITIMES GRID/WIDTH (fetch
 BOXL of
 B))
	    (ITIMES GRID/HEIGHT (fetch
 BOXB of
 B))
	    W)
    (DRAWTO (ITIMES GRID/WIDTH (fetch
 BOXR of
 B))
	    (ITIMES GRID/HEIGHT (fetch
 BOXT of
 B))
	    1 MODE W])

(DEFINE/PAGE/WINDOW

  [LAMBDA (TITLE)                                            (* kvl "10-JUN-82 10:02")

    (PROG (FONT)
          (SETQ PAGE/WINDOW (DEFINE/TOKEN/WINDOW
 TITLE))
          (WINDOWPROP PAGE/WINDOW (QUOTE BUTTONEVENTFN)
		      (QUOTE PAGE/EDITOR))
          [WINDOWPROP PAGE/WINDOW (QUOTE CLOSEFN)
		      (FUNCTION (LAMBDA (W)
			  (SETQ PAGE/WINDOW NIL]
      PAGE/WINDOW])

(DEFINE/TOKEN/WINDOW

  [LAMBDA (TITLE)                                            (* kvl "10-JUN-82 10:01")

                                                             (* also sets some cursors up in global variable for 

							     efficiency Set right margin to prevent LISP from 

							     inserting returns.)

    (PROG (W FONT)
          (SETQ W (CREATEW NIL (OR TITLE "Page")))
          (DSPFONT (SETQ FONT (FONTCREATE (QUOTE HELVETICA)
					  18))
		   W)
          (OR CHARWIDTH/GRID (SETQ CHARWIDTH/GRID 2))
          (SETQ GRID/WIDTH (ADD1 (IQUOTIENT (CHARWIDTH (CHCON1 5)
						       FONT)
					    CHARWIDTH/GRID)))
          (OR CHARHEIGHT/GRID (SETQ CHARHEIGHT/GRID 2))
          (SETQ GRID/HEIGHT (ADD1 (IQUOTIENT (FONTHEIGHT FONT)
					     CHARHEIGHT/GRID)))
          (SETQ GRID/Y/OFFSET (FONTPROP FONT (QUOTE DESCENT)))
          (SETQ BAR/Y/OFFSET (LRSH GRID/HEIGHT 1))
          (DSPOPERATION (QUOTE PAINT)
			W)
          (DSPRIGHTMARGIN 10000 W)
          (WINDOWPROP W (QUOTE BUTTONEVENTFN)
		      NIL)
          (WINDOWPROP W (QUOTE SCROLLFN)
		      NIL)
          [WINDOWPROP W (QUOTE EXTENT)
		      (create
 REGION
			      LEFT ← 0
			      BOTTOM ←(IMINUS (fetch
 TOP of
 (DSPCLIPPINGREGION NIL W)))
			      WIDTH ←(ITIMES 2 (fetch
 WIDTH of
 (DSPCLIPPINGREGION NIL W)))
			      HEIGHT ←(ITIMES 2 (fetch
 HEIGHT of
 (DSPCLIPPINGREGION NIL W]
          (WINDOWPROP W (QUOTE RESHAPEFN)
		      (QUOTE RESHAPEBYREPAINTFN))
          (WINDOWPROP W (QUOTE REPAINTFN)
		      (QUOTE REDISPLAY/PAGE))
          (RETURN W])

(DELETE/TOKEN

  [LAMBDA (TOK)                                              (* kvl " 1-MAY-82 11:29")

    (COND
      ((FMEMB TOK (fetch
 PAGE/TOKENS of
 PAGE))
	(ERASE/TOKEN
 TOK)
	(replace
 PAGE/TOKENS of
 PAGE with
 (REMOVE TOK (fetch
 PAGE/TOKENS of
 PAGE])

(DESELECT/TOKEN

  [LAMBDA (TOK)                                              (* kvl " 1-MAY-82 11:29")

                                                             (* finds the selected token in the list and removes it 

							     from the selected list)

    (COND
      ((FMEMB TOK (fetch
 PAGE/SELECTED of
 PAGE))
	(INVERT/TOKEN
 TOK)
	(replace
 PAGE/SELECTED of
 PAGE with
 (REMOVE TOK (fetch
 PAGE/SELECTED of
 PAGE])

(DISPLAY/PAGE

  [LAMBDA (PG
 W)                                             (* kvl "10-JUN-82 15:40")

    (DECLARE
 (SPECVARS PAGE))
    (OR PG (SETQ PG PAGE))
    (OR W (SETQ W PAGE/WINDOW))
    (COND
      [(EQUAL/PAGES
 PG (WINDOWPROP W (QUOTE PAGE]
      (T (CLEARW W)
	 (WINDOWPROP W (QUOTE TITLE)
		     (fetch
 PAGE/NAME of
 PG))
	 (DISPLAY/TOKENS&SELECTED
 PG W)
	 (WINDOWPROP W (QUOTE PAGE)
		     PG])

(DISPLAY/TOKEN

  [LAMBDA (TOK MODE W)                                       (* kvl "10-JUN-82 10:38")

                                                             (* puts up the given token in the window.)

    (OR MODE (SETQ MODE (QUOTE INVERT)))
    (OR W (SETQ W PAGE/WINDOW))
    (PROG ((NAME (fetch
 TOKEN/NAME of
 TOK))
	   (B (fetch
 TOKEN/BOX of
 TOK)))
          (DSPOPERATION MODE W)
          (COND
	    ((OR (FIXP NAME)
		 (FMEMB NAME ALGEBRA/CHARACTERS))
	      (DRAW/CHAR/TOKEN
 NAME B W))
	    ((EQ NAME (QUOTE BAR))
	      (DRAW/BAR
 MODE B W))
	    ((EQ NAME (QUOTE LPAREN))
	      (DRAW/LPAREN
 MODE B W))
	    ((EQ NAME (QUOTE RPAREN))
	      (DRAW/RPAREN
 MODE B W))
	    ((EQ NAME (QUOTE XOUT))
	      (CROSS/HATCH/BOX
 B MODE W))
	    (T (ERROR NAME " strange cartesian token"])

(DISPLAY/TOKENS&SELECTED

  [LAMBDA (PG
 W)                                             (* kvl "25-JUN-82 13:22")

    (OR PG (ERROR "Need page"))
    (OR W (ERROR "need window"))
    (for
 TOK in
 (fetch
 PAGE/TOKENS of
 PG) do
 (DISPLAY/TOKEN
 TOK (QUOTE INVERT)
							    W))
    (for
 TOK in
 (fetch
 PAGE/SELECTED of
 PG) do
 (INVERT/TOKEN
 TOK W])

(DRAW/BAR

  [LAMBDA (MODE B W)                                         (* kvl "10-JUN-82 10:31")

    (PROG (Y)
          (MOVETO (ADD1 (ITIMES GRID/WIDTH (fetch
 BOXL of
 B)))
		  [SETQ Y (IPLUS BAR/Y/OFFSET (ITIMES GRID/HEIGHT (fetch
 BOXB of
 B]
		  W)
          (DRAWTO (SUB1 (ITIMES GRID/WIDTH (fetch
 BOXR of
 B)))
		  Y 2 MODE W])

(DRAW/CHAR/TOKEN

  [LAMBDA (NAME B W)                                         (* kvl "10-JUN-82 10:30")

    (MOVETO (IPLUS (ITIMES (fetch
 BOXL of
 B)
			   GRID/WIDTH)
		   (LRSH (IDIFFERENCE (ITIMES GRID/WIDTH (IDIFFERENCE (fetch
 BOXR of
 B)
								      (fetch
 BOXL of
 B)))
				      (STRINGWIDTH NAME (DSPFONT NIL W)))
			 1))
	    (IPLUS (ITIMES (fetch
 BOXB of
 B)
			   GRID/HEIGHT)
		   GRID/Y/OFFSET)
	    W)
    (PRIN3 NAME W])

(DRAW/LPAREN

  [LAMBDA (MODE B W)                                         (* kvl "10-JUN-82 10:32")

                                                             (* bottom middle then top)

    (PROG (C X Y Z)
          (MOVETO (SETQ Z (SUB1 (ITIMES (fetch
 BOXR of
 B)
					GRID/WIDTH)))
		  (SETQ Y (ADD1 (ITIMES (fetch
 BOXB of
 B)
					GRID/HEIGHT)))
		  W)
          (SETQ X (IPLUS -2 (LRSH (IPLUS (ITIMES (fetch
 BOXL of
 B)
						 GRID/WIDTH)
					 (ITIMES (fetch
 BOXR of
 B)
						 GRID/WIDTH))
				  1)))
          (DRAWTO X Y 2 MODE W)
          (MOVETO X (IPLUS Y 2)
		  W)
          (DRAWTO X (SETQ Y (IDIFFERENCE (ITIMES (fetch
 BOXT of
 B)
						 GRID/HEIGHT)
					 4))
		  2 MODE W)
          (MOVETO X (SETQ Y (ADD1 Y))
		  W)
          (DRAWTO Z Y 2 MODE W])

(DRAW/RPAREN

  [LAMBDA (MODE B W)                                         (* kvl "10-JUN-82 10:33")

                                                             (* bottom middle then top)

    (PROG (C X Y L)
          (MOVETO (SETQ L (ITIMES (fetch
 BOXL of
 B)
				  GRID/WIDTH))
		  (SETQ Y (ADD1 (ITIMES (fetch
 BOXB of
 B)
					GRID/HEIGHT)))
		  W)
          [SETQ X (ADD1 (SETQ C (LRSH (IPLUS (ITIMES (fetch
 BOXL of
 B)
						     GRID/WIDTH)
					     (ITIMES (fetch
 BOXR of
 B)
						     GRID/WIDTH))
				      1]
          (DRAWTO X Y 2 MODE W)
          (MOVETO C (IPLUS Y 2)
		  W)
          (DRAWTO C (SETQ Y (IDIFFERENCE (ITIMES (fetch
 BOXT of
 B)
						 GRID/HEIGHT)
					 4))
		  2 MODE W)
          (MOVETO X (SETQ Y (ADD1 Y))
		  W)
          (DRAWTO L Y 2 MODE W])

(DSP/GRID/POS

  [LAMBDA (POS)                                              (* kvl "13-APR-82 15:19")

                                                             (* positions the display stream so that the next 

							     printing action will occur in the given grid position.)

    (DSPXPOSITION (ITIMES GRID/WIDTH (fetch
 XCOORD of
 POS)))
    (DSPYPOSITION (IPLUS GRID/Y/OFFSET (ITIMES GRID/HEIGHT (fetch
 YCOORD of
 POS])

(EQUAL/PAGES

  [LAMBDA (PG1 PG2)                                          (* kvl "10-JUN-82 10:56")

                                                             (* used to tell if a window is displaying the page given

							     to DISPLAY/PAGE.)

    (AND (EQ PG1 PG2)
	 (EQ (fetch
 PAGE/TOKENS of
 PG1)
	     (fetch
 PAGE/TOKENS of
 PG2))
	 (EQ (fetch
 PAGE/SELECTED of
 PG1)
	     (fetch
 PAGE/SELECTED of
 PG2])

(ERASE/TOKEN

  [LAMBDA (TOK W)                                            (* kvl "13-APR-82 16:09")

                                                             (* flips the regions of token.)

    (OR W (SETQ W PAGE/WINDOW))
    (BITBLT NIL NIL NIL W (ITIMES GRID/WIDTH (fetch
 BOXL of
 (fetch
 TOKEN/BOX of
 TOK)))
	    (ITIMES GRID/HEIGHT (fetch
 BOXB of
 (fetch
 TOKEN/BOX of
 TOK)))
	    (ITIMES GRID/WIDTH (fetch
 BOX/WIDTH of
 (fetch
 TOKEN/BOX of
 TOK)))
	    (ITIMES GRID/HEIGHT (fetch
 BOX/HEIGHT of
 (fetch
 TOKEN/BOX of
 TOK)))
	    (QUOTE TEXTURE)
	    (QUOTE REPLACE)
	    (DSPTEXTURE NIL W])

(FETCH/PAGE

  [LAMBDA (TOKS)                                             (* kvl " 6-JUL-82 15:12")

                                                             (* returns a page from the index whose tokens are equal 

							     to those given)

    (for
 P in
 PAGE/INDEX thereis
 (EQUAL (fetch
 PAGE/TOKENS of
 P)
					TOKS])

(FIND/TOKEN/CONTAINING/XY

  [LAMBDA (X Y TOKLST)                                       (* kvl "13-APR-82 19:53")

                                                             (* returns the token from the list that contains XY, if 

							     any.)

    (for
 TOK in
 TOKLST bind
 B (GX ←(IQUOTIENT X GRID/WIDTH))
			    (GY ←(IQUOTIENT Y GRID/HEIGHT))
       thereis
 (AND (ILEQ (fetch
 BOXL of
 (SETQ B (fetch
 TOKEN/BOX of
 TOK)))
			  GX)
		    (ILESSP GX (fetch
 BOXR of
 B))
		    (ILEQ (fetch
 BOXB of
 B)
			  GY)
		    (ILESSP GY (fetch
 BOXT of
 B])

(FLASH/SCREEN

  [LAMBDA NIL                                                (* kvl "13-APR-82 18:01")

    (RESETFORM (VIDEOCOLOR (NOT (VIDEOCOLOR)))
	       (BUSY/WAIT
 250])

(GET/BOX

  [LAMBDA (W)                                                (* kvl " 4-MAY-82 22:11")

    (PROG ((R (GET/REGION/IN/WINDOW
))
	   (CL (DSPCLIPPINGREGION NIL W)))
          (OR (AND (ILESSP (fetch
 LEFT of
 CL)
			   (fetch
 LEFT of
 R))
		   (IGREATERP (fetch
 RIGHT of
 CL)
			      (fetch
 RIGHT of
 R))
		   (ILESSP (fetch
 BOTTOM of
 CL)
			   (fetch
 BOTTOM of
 R))
		   (IGREATERP (fetch
 TOP of
 CL)
			      (fetch
 TOP of
 R)))
	      (RETURN NIL))
          (RETURN (create
 BOX
			  BOXL ←(IQUOTIENT (fetch
 LEFT of
 R)
					   GRID/WIDTH)
			  BOXR ←(ADD1 (IQUOTIENT (fetch
 RIGHT of
 R)
						 GRID/WIDTH))
			  BOXB ←(IQUOTIENT (fetch
 BOTTOM of
 R)
					   GRID/HEIGHT)
			  BOXT ←(ADD1 (IQUOTIENT (fetch
 TOP of
 R)
						 GRID/HEIGHT])

(GET/REGION/IN/WINDOW

  [LAMBDA NIL                                                (* kvl " 4-MAY-82 22:10")

                                                             (* translates region into window coordiantes)

    (PROG [(R (GETREGION 0 0 NIL (FUNCTION GETREGION/GRIDIFIER)))
	   (WR (WINDOWPROP PAGE/WINDOW (QUOTE REGION)))
	   (BORDERWIDTH (WINDOWPROP PAGE/WINDOW (QUOTE BORDER]
          [replace
 LEFT of
 R with
 (IPLUS (WXOFFSET NIL PAGE/WINDOW)
					 (IDIFFERENCE (fetch
 LEFT of
 R)
						      (IPLUS BORDERWIDTH (fetch
 LEFT of
 WR]
          [replace
 BOTTOM of
 R with
 (IPLUS (WYOFFSET NIL PAGE/WINDOW)
					   (IDIFFERENCE (fetch
 BOTTOM of
 R)
							(IPLUS BORDERWIDTH (fetch
 BOTTOM
									      of
 WR]
          (RETURN R])

(GETPG!

  [LAMBDA (PG/ID)
    (for
 PG in
 PAGE/INDEX thereis
 (EQ PG/ID (fetch
 PAGE/ID of
 PG])

(GETREGION/GRIDIFIER

  [LAMBDA (FIXED MOVING)                                     (* kvl " 4-MAY-82 22:08")

                                                             (* given two position in absolute coordinates make them 

							     lie on grid.)

    (COND
      ((NULL MOVING)                                         (* first call. Return fixed point.)

	(OR (type?
 POSITION FIXED)
	    (SHOULDNT))
	(GRIDIFY/POSITION
 FIXED))
      ((type?
 POSITION MOVING)
	(GRIDIFY/POSITION
 MOVING))
      (T (SHOULDNT])

(GRID/WIDTH/OF/CHAR

  [LAMBDA (VAL)                                              (* kvl "29-MAY-82 09:32")

    (ADD1 (IQUOTIENT (STRINGWIDTH VAL (DSPFONT NIL PAGE/WINDOW))
		     GRID/WIDTH])

(GRIDIFY/POSITION

  [LAMBDA (POS)                                              (* kvl " 4-MAY-82 22:23")

                                                             (* given position in absolute coordinates, positions it 

							     on the grid. Truncates it to grid point, then converts 

							     back into absolute.)

    (PROG ((WR (WINDOWPROP PAGE/WINDOW (QUOTE REGION)))
	   (BORDERWIDTH (WINDOWPROP PAGE/WINDOW (QUOTE BORDER)))
	   P)
          [SETQ P (create
 POSITION
			  XCOORD ←[IPLUS (WXOFFSET NIL PAGE/WINDOW)
					 (IDIFFERENCE (fetch
 XCOORD of
 POS)
						      (IPLUS BORDERWIDTH (fetch
 LEFT of
 WR]
			  YCOORD ←(IPLUS (WYOFFSET NIL PAGE/WINDOW)
					 (IDIFFERENCE (fetch
 YCOORD of
 POS)
						      (IPLUS BORDERWIDTH (fetch
 BOTTOM of
 WR]
          (replace
 XCOORD of
 P with
 (ITIMES GRID/WIDTH (IQUOTIENT (fetch
 XCOORD of
 P)
								  GRID/WIDTH)))
          (replace
 YCOORD of
 P with
 (ITIMES GRID/HEIGHT (IQUOTIENT (fetch
 YCOORD of
 P)
								   GRID/HEIGHT)))
          [replace
 XCOORD of
 P with
 (IPLUS (fetch
 XCOORD of
 P)
					   BORDERWIDTH
					   (IDIFFERENCE (fetch
 LEFT of
 WR)
							(WXOFFSET NIL PAGE/WINDOW]
          [replace
 YCOORD of
 P with
 (IPLUS (fetch
 YCOORD of
 P)
					   BORDERWIDTH
					   (IDIFFERENCE (fetch
 BOTTOM of
 WR)
							(WYOFFSET NIL PAGE/WINDOW]
          (RETURN P])

(INDEX/PAGE

  [LAMBDA (PG
)                                               (* kvl "27-JUN-82 14:28")

                                                             (* given a page record without an id, puts the page on 

							     the PAGE/INDEX and returns the modified record.)

    (replace
 PAGE/ID of
 PG with
 PAGE/ID/COUNTER)
    (SETQ PAGE/ID/COUNTER (ADD1 PAGE/ID/COUNTER))
    (push
 PAGE/INDEX PG)
    [OR (fetch
 PAGE/NAME of
 PG)
	(replace
 PAGE/NAME of
 PG with
 (CONCAT "Page " (fetch
 PAGE/ID of
 PG]
    PG])

(INIT/PAGE

  [LAMBDA NIL                                                (* kvl " 5-JUL-82 21:30")

    (DECLARE
 (SPECVARS PAGE))
    (INDEX/PAGE
 PAGE)
    (COND
      (PROBLEM/DISPLAY/FLG (OR PAGE/WINDOW (SETQ PAGE/WINDOW (DEFINE/TOKEN/WINDOW
 "Current page")))
			   (replace
 PAGE/SELECTED of
 PAGE with
 NIL)
			   (WINDOWPROP PAGE/WINDOW (QUOTE PAGE)
				       PAGE)
			   (REDISPLAY/PAGE
 PAGE/WINDOW)))
    (replace
 PAGE/NEST of
 PAGE with
 (FORMPARSE (fetch
 PAGE/TOKENS of
 PAGE)
					       NIL
					       (fetch
 PAGE/ID of
 PAGE)))
    (COND
      (PARSE/PAGE/DFLG (OR PAGE/PARSE/WINDOW (SETQ PAGE/PARSE/WINDOW (DEFINE/PAGE/PARSE/WINDOW 
											"Current"
											       
										      PAGE/WINDOW)))
		       (DISPLAY/NEST (fetch
 PAGE/NEST of
 PAGE)
				     PAGE/PARSE/WINDOW])

(INVERT/BOX

  [LAMBDA (B W)                                              (* kvl " 7-JUN-82 21:43")

    (BITBLT NIL NIL NIL W (ITIMES GRID/WIDTH (fetch
 BOXL of
 B))
	    (ITIMES GRID/HEIGHT (fetch
 BOXB of
 B))
	    (IMAX 1 (ITIMES GRID/WIDTH (fetch
 BOX/WIDTH of
 B)))
	    (IMAX 1 (ITIMES GRID/HEIGHT (fetch
 BOX/HEIGHT of
 B)))
	    (QUOTE TEXTURE)
	    (QUOTE INVERT)
	    BLACKSHADE])

(INVERT/PROMPT/CURSOR/AT/XY

  [LAMBDA (X Y NOWAIT)                                       (* kvl "22-APR-82 21:02")

    (BITBLT NIL 0 0 (CURRENTDISPLAYSTREAM)
	    (ITIMES X GRID/WIDTH)
	    (ITIMES Y GRID/HEIGHT)
	    (ITIMES CHARWIDTH/GRID GRID/WIDTH)
	    (ITIMES CHARHEIGHT/GRID GRID/HEIGHT)
	    (QUOTE TEXTURE)
	    (QUOTE INVERT)
	    BLACKSHADE)
    (OR NOWAIT (BUSY/WAIT
 500 T])

(INVERT/TOKEN

  [LAMBDA (TOK W)                                            (* kvl "13-APR-82 19:46")

                                                             (* flips the regions of token.)

    (INVERT/BOX
 (fetch
 TOKEN/BOX of
 TOK)
		(OR W PAGE/WINDOW])

(MAKE/EXAMPLE

  [LAMBDA (NAME)                                             (* kvl " 6-JUL-82 13:26")

    (bind
 PREV TOKS (X ←(create
 EXAMPLE (SETQ EXP/NAME NAME))) first
 (PAGE/EDITOR
)
								     (replace
 EXP/STARTING/TOKENS
									of
 X
									with
 (fetch
 PAGE/TOKENS
										of
 PAGE))
								     (SETQ PREV
								       (create
 PAGE copying
 PAGE))
       repeatuntil
 (ASK/POLAR
 "Done?") finally
 (replace
 EXP/DELTA/TOKENS of
 X
						  with
 (REVERSE (fetch
 EXP/DELTA/TOKENS of
 X)))
					       (RETURN X)
       do
 (PAGE/EDITOR
)
	  (COND
	    ((LDIFFERENCE (fetch
 PAGE/TOKENS of
 PREV)
			  (fetch
 PAGE/TOKENS of
 PAGE))
	      (printout
 T "Some tokens disappeared. Try again. " T)
	      (SETQ PAGE PREV))
	    ((SETQ TOKS (LDIFFERENCE (fetch
 PAGE/TOKENS of
 PAGE)
				     (fetch
 PAGE/TOKENS of
 PREV)))
	      (push
 (fetch
 EXP/DELTA/TOKENS of
 X)
		    (COPY TOKS))
	      (SETQ PREV (create
 PAGE copying
 PAGE)))
	    ((ASK/POLAR
 "No tokens added. Is that ok? ")
	      (push
 (fetch
 EXP/DELTA/TOKENS of
 X)
		    NIL))
	    (T (SETQ PAGE PREV])

(EXAMPLE/FROM/INDEX

  [LAMBDA (SPGID NAME)                                       (* kvl " 7-JUL-82 10:04")

                                                             (* walks down list of pages)

    (for
 ID from
 SPGID by
 1 bind
 PGS PG
       do
 (COND
	    [(NULL (SETQ PG (GETPG!
 ID]
	    [(NOT (PROGN (DISPLAY/PAGE
 PG PAGE/WINDOW)
			 (ASK/POLAR
 "Take it?"]
	    ((NOT (ASK/POLAR
 "Done? "))
	      (push
 PGS (GETPG ID)))
	    (T (push
 PGS (GETPG ID))
	       (SETQ PGS (REVERSE PGS))
	       (RETURN (create
 EXAMPLE
			       EXP/NAME ← NAME
			       EXP/STARTING/TOKENS ←(COPY (fetch
 PAGE/TOKENS of
 (CAR PGS)))
			       EXP/DELTA/TOKENS ←(for
 B in
 PGS as
 A in
 (CDR PGS)
						    collect
 (COPY (LDIFFERENCE (fetch
 PAGE/TOKENS
										  of
 A)
									       (fetch
 PAGE/TOKENS
										  of
 B])

(MOVE/BOX/DESTRUCTIVELY

  [LAMBDA (BOX NEWX NEWY)                                    (* kvl "22-APR-82 18:28")

    (PROG ((GX (IQUOTIENT NEWX GRID/WIDTH))
	   (GY (IQUOTIENT NEWY GRID/HEIGHT))
	   (W (fetch
 BOX/WIDTH of
 BOX))
	   (H (fetch
 BOX/HEIGHT of
 BOX)))
          (replace
 BOXL of
 BOX with
 GX)
          (replace
 BOXB of
 BOX with
 GY)
          (replace
 BOXR of
 BOX with
 (IPLUS W GX))
          (replace
 BOXT of
 BOX with
 (IPLUS H GY])

(MOVE/TOK/OR/CURSOR

  [LAMBDA (POS X Y)                                          (* kvl " 4-MAY-82 21:38")

    (PROG (TOK)
          (COND
	    ((SETQ TOK (FIND/TOKEN/CONTAINING/XY
 X Y (fetch
 PAGE/TOKENS of
 PAGE)))
	      (MOVE/TOKEN
 TOK))
	    (T (CART/MOVE/POSITION
 POS])

(MOVE/TOKEN

  [LAMBDA (TOK)                                              (* kvl " 1-MAY-82 11:29")

                                                             (* deletes token, then moves it with cursor until button

							     press. If it is currently visible, its positioned 

							     there.)

    (DECLARE
 (SPECVARS PAGE))
    (AND TOK (until
 DONE bind
 VISIBLE DONE DOWN? X Y R [OLDY ←(ITIMES GRID/HEIGHT
								      (fetch
 BOXB
									 of
 (fetch
 TOKEN/BOX
									       of
 TOK]
			      [OLDX ←(ITIMES GRID/WIDTH (fetch
 BOXL of
 (fetch
 TOKEN/BOX of
 TOK]
			      (DS ←(WINDOWPROP PAGE/WINDOW (QUOTE DSP)))
		first
 (SETQ R (DSPCLIPPINGREGION NIL DS))
		      (CURSORPOSITION (create
 POSITION
					      XCOORD ← OLDX
					      YCOORD ← OLDY)
				      DS)
		      (DELETE/TOKEN
 TOK)
		do
 [COND
		     (DOWN? (SETQ DONE (MOUSESTATE UP)))
		     (T (SETQ DOWN? (NOT (MOUSESTATE UP]
		   (SETQ Y (LASTMOUSEY DS))
		   (SETQ X (LASTMOUSEX DS))
		   (COND
		     ((AND (IEQP X OLDX)
			   (IEQP Y OLDY)))
		     (T (COND
			  (VISIBLE (ERASE/TOKEN
 TOK)
				   (SETQ VISIBLE NIL)))
			(MOVE/BOX/DESTRUCTIVELY
 (fetch
 TOKEN/BOX of
 TOK)
						X Y)
			(COND
			  [(NOT (BOX/INSIDE/REGIONP
 R (fetch
 TOKEN/BOX of
 TOK]
			  [(NOT (BLANK/BOX
 (fetch
 TOKEN/BOX of
 TOK]
			  (T (SETQ VISIBLE T)
			     (DISPLAY/TOKEN
 TOK)))
			(SETQ OLDX X)
			(SETQ OLDY Y)))
		finally
 (AND VISIBLE (push
 (fetch
 PAGE/TOKENS of
 PAGE)
					   TOK])

(MOVE/TOKEN/LOOP

  [LAMBDA (TOK)                                              (* kvl "23-APR-82 11:19")

    (until
 DONE bind
 R DONE DOWN? X Y VISIBLE←T
		     [OLDY ←(ITIMES GRID/HEIGHT (fetch
 BOXB of
 (fetch
 TOKEN/BOX of
 TOK]
		     [OLDX ←(ITIMES GRID/WIDTH (fetch
 BOXL of
 (fetch
 TOKEN/BOX of
 TOK]
		     (DS ←(WINDOWPROP PAGE/WINDOW (QUOTE DSP)))
       first
 (SETQ R (DSPCLIPPINGREGION NIL DS))
	     (CURSORPOSITION (create
 POSITION
				     XCOORD ← OLDX
				     YCOORD ← OLDY)
			     DS)
       do
 [COND
	    (DOWN? (SETQ DONE (MOUSESTATE UP)))
	    (T (SETQ DOWN? (NOT (MOUSESTATE UP]
	  (SETQ Y (LASTMOUSEY DS))
	  (SETQ X (LASTMOUSEX DS))
	  (COND
	    ((AND (IEQP X OLDX)
		  (IEQP Y OLDY)))
	    (T (COND
		 (VISIBLE (INVERT/TOKEN
 TOK)
			  (DISPLAY/TOKEN
 TOK (QUOTE INVERT))
			  (SETQ VISIBLE NIL)))
	       (MOVE/BOX/DESTRUCTIVELY
 (fetch
 TOKEN/BOX of
 TOK)
				       X Y)
	       (COND
		 [(NOT (BOX/INSIDE/REGIONP
 R (fetch
 TOKEN/BOX of
 TOK]
		 [(NOT (BLANK/BOX
 (fetch
 TOKEN/BOX of
 TOK]
		 (T (SETQ VISIBLE T)
		    (DISPLAY/TOKEN
 TOK (QUOTE INVERT))
		    (INVERT/TOKEN
 TOK)))
	       (SETQ OLDX X)
	       (SETQ OLDY Y)))
       finally
 (COND
		 (VISIBLE (INVERT/TOKEN
 TOK)
			  (RETURN TOK])

(ON/PROMPT/CURSOR

  [LAMBDA (CX CY X Y)                                        (* kvl "22-APR-82 22:16")

    (AND (ILEQ CX X)
	 (ILEQ CY Y)
	 (ILEQ X (IPLUS CX (ITIMES CHARWIDTH/GRID GRID/WIDTH)))
	 (ILEQ Y (IPLUS CY (ITIMES CHARHEIGHT/GRID GRID/HEIGHT])

(PAGE/EDITOR

  [LAMBDA NIL                                                (* kvl "10-JUN-82 10:57")

    (DECLARE
 (SPECVARS PAGE))
    (OR PAGE (SETQ PAGE (create
 PAGE
				PAGE/NAME ← "New problem")))
    (OR PAGE/WINDOW (DEFINE/PAGE/WINDOW
 "Page editor"))
    (DISPLAY/PAGE
 PAGE PAGE/WINDOW)
    (CLEARBUF T)
    (RESETFORM (TTYDISPLAYSTREAM PAGE/WINDOW)
	       (RESETFORM (PAGEHEIGHT 0)
			  (RESETFORM (CONTROL T)
				     (PAGE/EDITOR/LOOP
])

(PAGE/EDITOR/LOOP

  [LAMBDA NIL                                                (* kvl "22-APR-82 22:09")

                                                             (* replaces standard io wait loop.

							     Exited via RETFROM under menu.)

    (CURRENTDISPLAYSTREAM PAGE/WINDOW)
    (PROG ((FONT (DSPFONT))
	   POS CLIPPING/REGION)
      START
          (SETQ CLIPPING/REGION (DSPCLIPPINGREGION))
          (SETQ POS (create
 POSITION
			    XCOORD ←(IQUOTIENT (LRSH (fetch
 WIDTH of
 CLIPPING/REGION)
						     1)
					       GRID/WIDTH)
			    YCOORD ←(IQUOTIENT (LRSH (fetch
 HEIGHT of
 CLIPPING/REGION)
						     1)
					       GRID/HEIGHT)))
          (CART/ADVANCE/POS
 POS 0)
      LOOP(COND
	    ((READP T)
	      (CART/READ/CHAR
 (READC T)
			      FONT POS))
	    ((MOUSESTATE LEFT)
	      (MOVE/TOK/OR/CURSOR
 POS (LASTMOUSEX)
				  (LASTMOUSEY)))
	    ((LASTMOUSESTATE MIDDLE)
	      (CARTESIAN/MENU
)
	      (CART/ADVANCE/POS
 POS 0))
	    ((LASTMOUSESTATE RIGHT)
	      (DOWINDOWCOM PAGE/WINDOW)
	      (GO START)))
          (COND
	    ((NOT (READP T))                                 (* blink caret)

	      (INVERT/PROMPT/CURSOR/AT/XY
 (fetch
 XCOORD of
 POS)
					  (fetch
 YCOORD of
 POS)
					  NIL)
	      (INVERT/PROMPT/CURSOR/AT/XY
 (fetch
 XCOORD of
 POS)
					  (fetch
 YCOORD of
 POS)
					  NIL)))
          (GO LOOP])

(PAGE/STATE/BUTTON

  [LAMBDA NIL                                                (* kvl "22-APR-82 16:08")

    (PAGE/EDITOR
])

(PG

  [LAMBDA (PG
)                                               (* kvl "23-MAY-82 16:51")

    (DISPLAY/NEST (fetch
 PAGE/NEST of
 (GETPG PG])

(REDISPLAY/PAGE

  [LAMBDA (W)                                                (* kvl "10-JUN-82 10:53")

                                                             (* hung on windows REPAINTFN)

    (PROG [(PG
 (WINDOWPROP W (QUOTE PAGE]
          (DSPFILL NIL (DSPTEXTURE NIL PAGE/WINDOW)
		   (QUOTE REPLACE)
		   W)
          (WINDOWPROP W (QUOTE TITLE)
		      (fetch
 PAGE/NAME of
 PG))
          (DISPLAY/TOKENS&SELECTED
 PG W])

(SAVE/PAGE

  [LAMBDA (THEPG)                                            (* kvl " 4-MAY-82 16:09")

    (OR (BOUNDP (QUOTE PAGEDB))
	(SETQ PAGEDB NIL))
    (OR (BOUNDP (QUOTE PAGES/MENU))
	(SETQ PAGES/MENU))
    (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
	       (PROG ((PG/TAIL (for
 X on
 PAGEDB when
 (EQUAL (fetch
 PAGE/NAME of
 (CAR X))
							    (fetch
 PAGE/NAME of
 THEPG))
				  do
 (RETURN X)))
		      NAME)
		     [COND
		       (PG/TAIL (printout
 T "There already exists a problem set with the name "
					  (fetch
 PAGE/NAME of
 THEPG)
					  T)
				(COND
				  ((ASK/POLAR
 
				      "Would you like to over-write it with the current version?")
				    (RPLACA PG/TAIL (create
 PAGE copying
 THEPG PAGE/NEST ← NIL))
				    (SETQ PAGES/MENU NIL)
				    (MARKASCHANGED (QUOTE PAGEDB)
						   (QUOTE VAR))
				    (RETURN]
		 L   (printout
 T 
			    "Please type a string (in double quotes) describing the problem set:"
			       T)
		     (SETQ NAME (READ))
		     (OR (STRINGP NAME)
			 (GO L))
		     (replace
 PAGE/NAME of
 THEPG with
 NAME)
		     (push
 PAGEDB (create
 PAGE copying
 THEPG PAGE/NEST ← NIL))
		     (SETQ PAGES/MENU NIL)
		     (MARKASCHANGED (QUOTE PAGEDB)
				    (QUOTE VAR])

(SCRATCH/BOX

  [LAMBDA (BOX)                                              (* kvl " 7-JUN-82 20:38")

    (PROG ((TOK (create
 TOKEN
			TOKEN/BOX ← BOX
			TOKEN/NAME ← CROSS/OUT/NAME)))
          (push
 (fetch
 PAGE/TOKENS of
 PAGE)
		TOK)
          (CROSS/HATCH/BOX
 BOX (QUOTE PAINT))
          (RETURN TOK])

(SELECT/BOX

  [LAMBDA (B)                                                (* kvl " 7-JUN-82 20:38")

    (COND
      (B (SELECT/TOKEN
 (create
 TOKEN
			       TOKEN/BOX ← B)))
      (T (FLASH/SCREEN
])

(SELECT/TOKEN

  [LAMBDA (TOK W)                                            (* kvl "25-JUN-82 12:34")

                                                             (* flips the given region and saves the fact that its 

							     inverted.)

    (DECLARE
 (SPECVARS PAGE))
    (COND
      ((FMEMB TOK (fetch
 PAGE/SELECTED of
 PAGE)))
      (T (push
 (fetch
 PAGE/SELECTED of
 PAGE)
	       TOK)
	 (INVERT/TOKEN
 TOK W])

(TOKEN/HEIGHT

  [LAMBDA (VAL DEFAULT/BOX)                                  (* kvl "28-MAY-82 14:33")

    (COND
      ((FMEMB VAL (QUOTE (LPAREN RPAREN)))
	(fetch
 BOX/HEIGHT of
 DEFAULT/BOX))
      ((EQ VAL (QUOTE BAR))
	1)
      (T CHARHEIGHT/GRID])

(TOKEN/WIDTH

  [LAMBDA (TNAME DEFAULT/BOX)                                (* kvl "27-MAY-82 14:02")

                                                             (* returns the grid width of the token if its a 

							     character. If its a bar, then the width of the given 

							     box.)

    (COND
      ((EQ TNAME (QUOTE BAR))
	(fetch
 BOX/WIDTH of
 DEFAULT/BOX))
      (T (GRID/WIDTH/OF/CHAR
 TNAME])

(TOKLST/AS/MENU

  [LAMBDA (TOKLST)                                           (* kvl "16-MAR-82 22:51")

                                                             (* tracks mouse through carts, deletes when it goes up.)

    (until
 (MOUSESTATE (NOT UP)) do
)
    (until
 (MOUSESTATE UP) bind
 OLDTOK TOK do
 (SETQ TOK (FIND/TOKEN/CONTAINING/XY
 (LASTMOUSEX)
										  (LASTMOUSEY)
										  TOKLST))
					      (AND OLDTOK (NEQ OLDTOK TOK)
						   (INVERT/TOKEN
 OLDTOK))
					      (AND TOK (NEQ OLDTOK TOK)
						   (INVERT/TOKEN
 TOK))
					      (SETQ OLDTOK TOK)
       finally
 (COND
		 (TOK (INVERT/TOKEN
 TOK)
		      (RETURN TOK])

(UNSCRATCH/TOKEN

  [LAMBDA (TOK)                                              (* kvl " 7-JUN-82 20:31")

                                                             (* finds the selected token in the list and removes it 

							     from the selected list)

    (DECLARE
 (SPECVARS PAGE))
    (COND
      ((FMEMB TOK (fetch
 PAGE/TOKENS of
 PAGE))
	(CROSS/HATCH/BOX
 (fetch
 TOKEN/BOX of
 TOK)
			 (QUOTE ERASE))
	(replace
 PAGE/TOKENS of
 PAGE with
 (REMOVE TOK (fetch
 PAGE/TOKENS of
 PAGE])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)

(RPAQQ PAGEGLOBALS
 (ALGEBRA/CHARACTERS ALGEBRA/LETTERS BACK/SPACE BAR/BOX/HEIGHT BAR/HEIGHT 
				       BROKEN/BAR/FLG CARTESIAN/MENU/CMD/NAMES CARTESIAN/MENU 
				       CHARHEIGHT/GRID CHARWIDTH/GRID EQ/SIGNS GRID/HEIGHT GRID/WIDTH 
				       LEFT/PARENTHESES OP/SIGNS TAB/CHARACTER PAGE/WINDOW 
				       PAGE/EDITOR/MENU PARENTHESES PARENTHESIS/WIDTH TAB/CHARACTER 
				       PAGES/MENU BAR/Y/OFFSET GRID/Y/OFFSET CROSS/OUT/NAME))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS ALGEBRA/CHARACTERS ALGEBRA/LETTERS BACK/SPACE BAR/BOX/HEIGHT BAR/HEIGHT 
	  BROKEN/BAR/FLG CARTESIAN/MENU/CMD/NAMES CARTESIAN/MENU CHARHEIGHT/GRID CHARWIDTH/GRID 
	  EQ/SIGNS GRID/HEIGHT GRID/WIDTH LEFT/PARENTHESES OP/SIGNS TAB/CHARACTER PAGE/WINDOW 
	  PAGE/EDITOR/MENU PARENTHESES PARENTHESIS/WIDTH TAB/CHARACTER PAGES/MENU BAR/Y/OFFSET 
	  GRID/Y/OFFSET CROSS/OUT/NAME)
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (4059 48224 (ASK/PAGE 4069 . 4680) (BLANK/AREAP 4682 . 5376) (BLANK/BOX 5378 . 5541) (
BLANK/CART/POS 5543 . 5737) (BOX/INSIDE/BOX? 5739 . 6247) (COLLECT/CROSS/OUTS 6249 . 6543) (
COLLECT/NON/CROSS/OUTS 6545 . 6847) (COVERS/BOX? 6849 . 7671) (BOX/OVERLAP/BOX? 7673 . 8171) (
BOX/INSIDE/REGIONP 8173 . 8625) (BUSY/WAIT 8627 . 8952) (CART/ADVANCE/POS 8954 . 9582) (CART/MAKE/BAR 
9584 . 10839) (CART/MAKE/BAR/TOKEN 10841 . 11948) (CART/MAKE/PARENS 11950 . 13180) (CART/MOVE/POSITION
 13182 . 14219) (CART/READ/CHAR 14221 . 15407) (CART/READ/GOOD/CHAR 15409 . 16575) (CARTESIAN/MENU 
16577 . 18104) (CLEAR/PAGE/SELECTIONS 18106 . 18404) (CROSS/HATCH/BOX 18406 . 19004) (
DEFINE/PAGE/WINDOW 19006 . 19411) (DEFINE/TOKEN/WINDOW 19413 . 21007) (DELETE/TOKEN 21009 . 21301) (
DESELECT/TOKEN 21303 . 21765) (DISPLAY/PAGE 21767 . 22204) (DISPLAY/TOKEN 22206 . 23044) (
DISPLAY/TOKENS&SELECTED 23046 . 23445) (DRAW/BAR 23447 . 23809) (DRAW/CHAR/TOKEN 23811 . 24284) (
DRAW/LPAREN 24286 . 25102) (DRAW/RPAREN 25104 . 25932) (DSP/GRID/POS 25934 . 26388) (EQUAL/PAGES 26390
 . 26845) (ERASE/TOKEN 26847 . 27512) (FETCH/PAGE 27514 . 27871) (FIND/TOKEN/CONTAINING/XY 27873 . 
28489) (FLASH/SCREEN 28491 . 28675) (GET/BOX 28677 . 29524) (GET/REGION/IN/WINDOW 29526 . 30330) (
GETPG! 30332 . 30448) (GETREGION/GRIDIFIER 30450 . 30996) (GRID/WIDTH/OF/CHAR 30998 . 31197) (
GRIDIFY/POSITION 31199 . 32669) (INDEX/PAGE 32671 . 33245) (INIT/PAGE 33247 . 34106) (INVERT/BOX 34108
 . 34529) (INVERT/PROMPT/CURSOR/AT/XY 34531 . 34929) (INVERT/TOKEN 34931 . 35211) (MAKE/EXAMPLE 35213
 . 36428) (EXAMPLE/FROM/INDEX 36430 . 37337) (MOVE/BOX/DESTRUCTIVELY 37339 . 37851) (
MOVE/TOK/OR/CURSOR 37853 . 38154) (MOVE/TOKEN 38156 . 39723) (MOVE/TOKEN/LOOP 39725 . 41055) (
ON/PROMPT/CURSOR 41057 . 41319) (PAGE/EDITOR 41321 . 41794) (PAGE/EDITOR/LOOP 41796 . 43227) (
PAGE/STATE/BUTTON 43229 . 43365) (PG 43367 . 43527) (REDISPLAY/PAGE 43529 . 43986) (SAVE/PAGE 43988 . 
45276) (SCRATCH/BOX 45278 . 45609) (SELECT/BOX 45611 . 45828) (SELECT/TOKEN 45830 . 46285) (
TOKEN/HEIGHT 46287 . 46551) (TOKEN/WIDTH 46553 . 46990) (TOKLST/AS/MENU 46992 . 47679) (
UNSCRATCH/TOKEN 47681 . 48222)))))
STOP