;FOR MAC-*-LISP-*- COMPATIBILITY
;NO ARGUMENTS RETURNS (LINE . COLUMN)
;ONE ARGUMENT DOES MAGIC FUNCTIONS
;TWO ARGUMENTS SETS CURSORPOS TO THERE (ARGS THERE OF NIL MEAN DON'T CHANGE)
;RETURNS T IF IT SUCCEEDED, NIL IF IT DIDN'T

;NOT COMPATIBLE WITH NEWIO FEATURE OF PUTTING A FILE IN THE ARGS.

;	** (c) Copyright 1980 Massachusetts Institute of Technology **

(DEFUN CURSORPOS (&REST ARGS &AUX WHICH-OPERATIONS)
       (SETQ WHICH-OPERATIONS (FUNCALL STANDARD-OUTPUT ':WHICH-OPERATIONS))
       (COND ((MEMQ ':PC-PPR WHICH-OPERATIONS)
	      (LEXPR-FUNCALL #'CURSORPOS-PC-PPR ARGS))
	     ((MEMQ ':SET-CURSORPOS WHICH-OPERATIONS)
	      (LEXPR-FUNCALL #'CURSORPOS-STREAM ARGS))
	     (T (FERROR NIL "Cursorpos where no pc-ppr or stream handler present"))))

(DEFUN CURSORPOS-PC-PPR (&OPTIONAL (ARG1 'NULL) (ARG2 'NULL) &AUX X Y PC-PPR)
  (SETQ PC-PPR (FUNCALL STANDARD-OUTPUT ':PC-PPR))	;Find which piece of paper to use
  (COND ((EQ 'NULL ARG1)    ;NO ARGUMENTS
	 (MULTIPLE-VALUE (X Y) (TV-READ-CURSORPOS PC-PPR))
	 (CONS (// Y (PC-PPR-LINE-HEIGHT PC-PPR))
	       (// X (PC-PPR-CHAR-WIDTH PC-PPR))))
	((NEQ 'NULL ARG2)   ;TWO ARGUMENTS
	 (MULTIPLE-VALUE (X Y) (TV-READ-CURSORPOS PC-PPR))
	 (TV-SET-CURSORPOS PC-PPR
			   (IF ARG2 (* ARG2 (PC-PPR-CHAR-WIDTH PC-PPR)) X)
			   (IF ARG1 (* ARG1 (PC-PPR-LINE-HEIGHT PC-PPR)) Y))
	 T) ;WIN RETURN
	;;ONE ARGUMENT CASES
	((STRING-EQUAL ARG1 'F)	    ;ONE SPACE RIGHT
	 (TV-SPACE PC-PPR)
	 T)
	((STRING-EQUAL ARG1 'B)	    ;ONE SPACE LEFT
	 (TV-BACKSPACE PC-PPR)
	 T)
	((STRING-EQUAL ARG1 'D)	    ;ONE LINE DOWN
	 (MULTIPLE-VALUE (X Y) (TV-READ-CURSORPOS PC-PPR))
	 (TV-SET-CURSORPOS PC-PPR
			   X
			   (+ Y (PC-PPR-LINE-HEIGHT PC-PPR)))
	 T)
	((STRING-EQUAL ARG1 'U)	    ;ONE LINE UP
	 (MULTIPLE-VALUE (X Y) (TV-READ-CURSORPOS PC-PPR))
	 (TV-SET-CURSORPOS PC-PPR
			   X
			   (- Y (PC-PPR-LINE-HEIGHT PC-PPR)))
	 T)
	((STRING-EQUAL ARG1 'C)	    ;CLEAR THE SCREEN
	 (TV-CLEAR-PC-PPR PC-PPR)
	 T)
	((STRING-EQUAL ARG1 'T)	    ;HOME
	 (TV-HOME PC-PPR)
	 T)
	((STRING-EQUAL ARG1 'E)	    ;ERASE SCREEN AFTER CURRENT POINT
	 (TV-CLEAR-EOF PC-PPR)
	 T)
	((STRING-EQUAL ARG1 'L)	    ;ERASE LINE AFTER CURRENT POINT
	 (TV-CLEAR-EOL PC-PPR)
	 T)
	((STRING-EQUAL ARG1 'K)	    ;ERASE CHARACTER AT CURRENT POINT
	 (TV-CLEAR-CHAR PC-PPR)
	 T)
	((STRING-EQUAL ARG1 'X)	    ;BACKSPACE THEN K
	 (TV-BACKSPACE PC-PPR)
	 (TV-CLEAR-CHAR PC-PPR)
	 T)
	((STRING-EQUAL ARG1 'Z)	    ;HOME DOWN
	 (TV-SET-CURSORPOS PC-PPR
			   0
			   (- (PC-PPR-BOTTOM-LIMIT PC-PPR)
			      (PC-PPR-TOP-MARGIN PC-PPR)))
         (AND (PC-PPR-MORE-VPOS PC-PPR)      ;THIS MAY BE NIL
              (SETF (PC-PPR-MORE-VPOS PC-PPR);KLUDGE TO HELP MACSYMA, DISABLE MORE
                    (LOGIOR 100000 (PC-PPR-MORE-VPOS PC-PPR))))       ;ON THIS LINE
	 T)
	(T (FERROR NIL "~S is not a recognized option" ARG1) ;MISSING
	   NIL)  ;THE FERROR IS HERE TO DETECT SCREWUPS, BUT IN ANY CASE RETURN NIL
	))


(DEFUN CURSORPOS-STREAM (&OPTIONAL (ARG1 'NULL) (ARG2 'NULL) &AUX X Y)
       (MULTIPLE-VALUE (X Y) (FUNCALL STANDARD-OUTPUT ':READ-CURSORPOS ':CHARACTER))
       (COND ((EQ 'NULL ARG1)			;; NO ARGUMENTS
	      (CONS Y X))
	     ((NEQ 'NULL ARG2)			;; TWO ARGUMENTS
	      (FUNCALL STANDARD-OUTPUT ':SET-CURSORPOS ':CHARACTER
		       (IF ARG2 ARG2 X)
		       (IF ARG1 ARG1 Y))
	      T)
	     ;; ONE ARGUMENT CASES
	     ((STRING-EQUAL ARG1 'F)		;; ONE SPACE RIGHT
	      (FUNCALL STANDARD-OUTPUT ':SET-CURSORPOS ':CHARACTER
		       (\ (1+ X)
			  (IF (MEMQ ':WIDTH (FUNCALL STANDARD-OUTPUT ':WHICH-OPERATIONS))
			      (FUNCALL STANDARD-OUTPUT ':WIDTH)
			      80.))		;; THIS SUCKS
		       Y)
	      T)
	     ((STRING-EQUAL ARG1 'B)		;; ONE SPACE LEFT
	      (FUNCALL STANDARD-OUTPUT ':TYO 210)
	      T)				
	     ((STRING-EQUAL ARG1 'D)		;; ONE LINE DOWN
	      (FUNCALL STANDARD-OUTPUT ':SET-CURSORPOS ':CHARACTER
		       X
		       (1+ Y))
	      T)
	     ((STRING-EQUAL ARG1 'U)		;; ONE LINE UP
	      (FUNCALL STANDARD-OUTPUT ':SET-CURSORPOS ':CHARACTER
		       X
		       (1- Y))
	      T)
	     ((STRING-EQUAL ARG1 'C)		;; CLEAR THE SCREEN
	      (FUNCALL STANDARD-OUTPUT ':CLEAR-SCREEN)
	      T)
	     ((STRING-EQUAL ARG1 'T)		;; HOME THE CURSOR
	      (FUNCALL STANDARD-OUTPUT ':SET-CURSORPOS ':CHARACTER
		       0
		       0)
	      T)
	     ((STRING-EQUAL ARG1 'E)		;; ERASE SCREEN AFTER CURRENT POINT
	      (FUNCALL STANDARD-OUTPUT ':CLEAR-EOC)
	      T)
	     ((STRING-EQUAL ARG1 'L)		;; ERASE LINE AFTER CURRENT
	      (FUNCALL STANDARD-OUTPUT ':CLEAR-EOL)
	      T)
	     ((STRING-EQUAL ARG1 'K)		;; ERASE CHARACTER AT CURRENT POINT
	      (FUNCALL STANDARD-OUTPUT ':TYO 40)	;; TYO A SPACE
	      (FUNCALL STANDARD-OUTPUT ':TYO 210)	;; FOLLOWED BY A BACKSPACE
	      T)
	     ((STRING-EQUAL ARG1 'X)		;; BACKSPACE THEN A K
	      (FUNCALL STANDARD-OUTPUT ':TYO 210)
	      (CURSORPOS-STREAM 'K))
	     ((STRING-EQUAL ARG1 'Z)		;; HOME DOWN
	      (FUNCALL STANDARD-OUTPUT ':SET-CURSORPOS ':CHARACTER
		       0
		       (IF (MEMQ ':HEIGHT (FUNCALL STANDARD-OUTPUT ':WHICH-OPERATIONS))
			   (1- (FUNCALL STANDARD-OUTPUT ':HEIGHT))
			   23.))
	      T)))