Changeset 222

Show
Ignore:
Timestamp:
08/18/11 05:21:39 (3 years ago)
Author:
rjs
Message:

Update.

Location:
trunk/lisp/lmwin
Files:
4 modified

Legend:

Unmodified
Added
Removed
  • trunk/lisp/lmwin/menu.lisp

    r221 r222  
    202202 
    203203;;; Mouse-click handler for menus. 
    204 ;;; The left button "selects".  The meaning of this depends on the type of menu. 
    205 ;;; The middle button calls for documentation. 
    206 ;;; The right button is reserved. 
     204;;; All buttons are treated the same, select the item you are on. 
    207205;;; There are no double-clicks and you can't get to the system command menu. 
    208206;;; Clicking when the menu is not exposed just exposes it. 
    209207 
    210208(DEFMETHOD (BASIC-MENU :MOUSE-BUTTONS) (BD X Y) 
    211   X Y ;ignored, we don't care where the mouse is, the :MOUSE-MOVES method took care of that 
     209  BD X Y ;ignored, we don't care where the mouse is, the :MOUSE-MOVES method took care of that 
    212210  (COND ((NOT EXPOSED-P)        ;Button pushed while not exposed, expose self. 
    213211         (FUNCALL-SELF ':EXPOSE)) 
    214         ((BIT-TEST 2 BD)        ;Middle button, get documentation 
    215          (FUNCALL-SELF ':DOCUMENT)) 
    216212        ((NULL CURRENT-ITEM)) 
    217         (T                      ;Left or Right button, select item. 
     213        (T                      ;Any button, select item. 
    218214         (SETQ LAST-ITEM CURRENT-ITEM 
    219215               CHOSEN-ITEM CURRENT-ITEM)))) 
     
    836832;just complements highlight state. 
    837833(DEFMETHOD (MULTIPLE-MENU-MIXIN :MOUSE-BUTTONS) (BD X Y &AUX ITEM) 
    838   X Y ;ignored, we don't care where the mouse is, the :MOUSE-MOVES method took care of that 
     834  BD X Y ;ignored, we don't care where the mouse is, the :MOUSE-MOVES method took care of that 
    839835  (COND ((NOT EXPOSED-P)        ;Button pushed while not exposed, expose self. 
    840836         (FUNCALL-SELF ':EXPOSE)) 
    841         ((BIT-TEST 2 BD)        ;Middle button, get documentation 
    842          (FUNCALL-SELF ':DOCUMENT)) 
    843837        ((NULL (SETQ ITEM CURRENT-ITEM))) 
    844838        ((AND (NOT (ATOM ITEM)) ;Special-choice selected? 
  • trunk/lisp/lmwin/proces.lisp

    r221 r222  
    9191        STACK-GROUP NIL 
    9292        INITIAL-STACK-GROUP NIL)) 
     93 
     94(DEFMETHOD (PROCESS :AFTER :INIT) (IGNORE) 
     95  (WITHOUT-INTERRUPTS 
     96    (PROCESS-ALL-PROCESSES SELF T))) 
    9397 
    9498(DEFMETHOD (PROCESS :PRINT-SELF) (STREAM &REST IGNORE) 
  • trunk/lisp/lmwin/stream.lisp

    r221 r222  
    751751                                   (+ (SHEET-INSIDE-LEFT) PX4) (+ (SHEET-INSIDE-TOP) PY4) 
    752752                                   ALU SELF)))))))) 
     753 
     754;;; Cubic splines from Rogers and Adams, "Mathematical Elements 
     755;;; for Computer Graphics".  This began as a translation from 
     756;;; a BASIC program, but has been changed a bit.  The original 
     757;;; program uses a full matrix inversion when the boundary conditions 
     758;;; are cyclic or anti-cyclic, which is inefficient; in this version 
     759;;; the special-case tridiagonal solver is extended to handle the 
     760;;; cyclic and anti-cyclic end conditions.  (Also, the original program 
     761;;; has a bug wherein it neglects to initialize one diagonal of the M matrix.) 
     762 
     763;;; The caller has a sequence of points, in PX and PY, through which he 
     764;;; wants a smooth curve drawn.  This program generates Z intermediate 
     765;;; points between each pair of points, returning a sequence of points 
     766;;; in CX and CY that includes the original points with the intermediate 
     767;;; points inserted.  The caller can then plot lines between successive 
     768;;; pairs of points of CX and CY to draw the curve. 
     769 
     770;;; The caller may pass in arrays to be filled in with the answers (used as 
     771;;; CX and CY); they should be (+ N (* Z (- N 1))) long.  If NIL is passed, 
     772;;; this function creates the arrays itself.  If they are not long enough, 
     773;;; they are adjusted with ADJUST-ARRAY-SIZE.  The optional argument C1 is 
     774;;; the initial end condition, one of :RELAXED, :CLAMPED, :CYCLIC, or 
     775;;; :ANTI-CYCLIC; C2 is the final end condition, one of :RELAXED or 
     776;;; :CLAMPED.  The first defaults to :RELAXED, and the second defaults 
     777;;; to the first.  The second must be the same as the first if the 
     778;;; first is :CYCLIC or :ANTI-CYCLIC.  The last four arguments are 
     779;;; the X and Y values to which the endpoints are being clamped if 
     780;;; the corresponding boundary condition is :CLAMPED.  For cyclic splines 
     781;;; that join themselves, the caller must pass the same point twice, as 
     782;;; both the first point and the last point. 
     783 
     784;;; Three values are returned: The two arrays CX and CY, and the number 
     785;;; of elements in the original P array. 
     786 
     787(DEFUN SPLINE (PX PY Z &OPTIONAL CX CY (C1 ':RELAXED) (C2 C1) 
     788               P1-PRIME-X P1-PRIME-Y PN-PRIME-X PN-PRIME-Y 
     789               &AUX N N-1 N-2 N-3 BX BY L UX UY N1 N2 N3 N4 SIGN 
     790                    (ZUNDERFLOW T)) 
     791  (SETQ N (ARRAY-ACTIVE-LENGTH PX)              ;The number of points 
     792        N-1 (1- N) 
     793        N-2 (1- N-1) 
     794        N-3 (1- N-2)) 
     795 
     796  ;; Create the arrays if they were not given them, or redimension them if needed. 
     797  (LET ((CLEN (+ N (* N-1 Z)))) 
     798    (COND ((NULL CX) 
     799           (SETQ CX (MAKE-ARRAY NIL 'ART-Q CLEN))) 
     800          ((< (ARRAY-LENGTH CX) CLEN) 
     801           (SETQ CX (ADJUST-ARRAY-SIZE CX CLEN)))) 
     802    (COND ((NULL CY) 
     803           (SETQ CY (MAKE-ARRAY NIL 'ART-Q CLEN))) 
     804          ((< (ARRAY-LENGTH CY) CLEN) 
     805           (SETQ CY (ADJUST-ARRAY-SIZE CY CLEN))))) 
     806 
     807  ;; Set up L to hold the approximate spline segment lengths. 
     808  ;; The Nth element of L holds the distance between the Nth and N+1st 
     809  ;; points of PX,PY.  The last element of L is not used. 
     810  (SETQ L (MAKE-ARRAY NIL 'ART-Q N)) 
     811  (LOOP FOR J FROM 0 TO N-2 
     812        DO (ASET (SMALL-FLOAT (SQRT (+ (^ (- (AREF PX (1+ J)) (AREF PX J)) 2) 
     813                                       (^ (- (AREF PY (1+ J)) (AREF PY J)) 2)))) 
     814                 L J)) 
     815 
     816  ;; The bulk of the code here is concerned with solving a set of 
     817  ;; simultaneous linear equations, expressed by the matrix equation 
     818  ;; M * U = B.  M is an N by N square matrix, and B and U are N by 1 
     819  ;; column matricies.  U will hold the values of the slope of the curve 
     820  ;; at each point PX, PY. 
     821 
     822  ;; The M matrix is tridiagonal for :RELAXED and :CLAMPED end conditions. 
     823  ;; We represent it by storing M(I,I-1) in N1(I), M(I,I) in N2(I), and 
     824  ;; M(I,I+1) in N3(I).  This means N1(0) and N3(N-1) are unused. 
     825  (SETQ N1 (MAKE-ARRAY NIL 'ART-Q N) 
     826        N2 (MAKE-ARRAY NIL 'ART-Q N) 
     827        N3 (MAKE-ARRAY NIL 'ART-Q N)) 
     828 
     829  ;; These quantities are meaningless, but they get referred to as part 
     830  ;; of array bound conditions; these values just prevent errors from happening. 
     831  (ASET 0.0s0 N1 0) 
     832  (ASET 0.0s0 N3 N-1) 
     833 
     834  (COND ((MEMQ C1 '(:CYCLIC :ANTI-CYCLIC)) 
     835         ;; With these conditions, the M matrix is not quite tri-diagonal; 
     836         ;; it is initialize with a 1 in the upper-right hand corner, and 
     837         ;; during the solution of the equations the whole right column 
     838         ;; gets non-zero values.  Also, it is only N-1 by N-1!  So the upper 
     839         ;; right corner is M(0, N-2).  N4 represents the N-2 column; element 
     840         ;; M(I,N-2) is stored in N4(I).  The last two elements are not 
     841         ;; used, because N4(N-2) = N2(N-2) and N4(N-3) = N3(N-3).  We also 
     842         ;; set up this handy SIGN variable. 
     843         (SETQ N4 (MAKE-ARRAY NIL 'ART-Q (1- N))) 
     844         (SETQ SIGN (IF (EQ C1 ':CYCLIC) 1.0s0 -1.0s0))) 
     845        ((NOT (MEMQ C1 '(:RELAXED :CLAMPED))) 
     846         (FERROR NIL "~S is not known spline type" C1))) 
     847  ;; B is just a column vector, represented normally. 
     848  (SETQ BX (MAKE-ARRAY NIL 'ART-Q N) 
     849        BY (MAKE-ARRAY NIL 'ART-Q N)) 
     850 
     851  ;; Set up the boundary conditions. 
     852  ;; The 0th row of M and B are determined by the initial boundary conditions, 
     853  ;; and the N-1st row is determined by the final boundary condition. 
     854  ;; Note that the 0th row of M is implemented as the 0th element of N2, N3, 
     855  ;; and sometimes N4; N1(0) is not used.  A similar thing is true of the 
     856  ;; N-1st row. 
     857  (SELECTQ C1 
     858    (:CLAMPED 
     859       (ASET 1.0s0 N2 0) 
     860       (ASET 0.0s0 N3 0) 
     861       (ASET P1-PRIME-X BX 0) 
     862       (ASET P1-PRIME-Y BY 0)) 
     863    (:RELAXED 
     864       (ASET 1.0s0 N2 0) 
     865       (ASET 0.5s0 N3 0) 
     866       (LET ((TEM (// 3.0s0 (* 2.0s0 (AREF L 0))))) 
     867         (ASET (* TEM (- (AREF PX 1) (AREF PX 0))) BX 0) 
     868         (ASET (* TEM (- (AREF PY 1) (AREF PY 0))) BY 0))) 
     869    ((:CYCLIC :ANTI-CYCLIC) 
     870       (LET ((S3 (// (AREF L N-2) (AREF L 0)))) 
     871         (ASET (+ 2.0s0 (* S3 2.0s0)) N2 0) 
     872         (ASET S3 N3 0) 
     873         (ASET SIGN N4 0) 
     874         (LET ((TEM (// 3.0s0 (AREF L 0)))) 
     875           (ASET (* TEM (+ (* S3 (- (AREF PX 1) (AREF PX 0))) 
     876                           (* SIGN (// (- (AREF PX N-1) (AREF PX N-2)) S3)))) 
     877                 BX 0) 
     878           (ASET (* TEM (+ (* S3 (- (AREF PY 1) (AREF PY 0))) 
     879                           (* SIGN (// (- (AREF PY N-1) (AREF PY N-2)) S3)))) 
     880                 BY 0))))) 
     881  (SELECTQ C2 
     882    (:CLAMPED 
     883       (ASET 0.0s0 N1 N-1) 
     884       (ASET 1.0s0 N2 N-1) 
     885       (ASET PN-PRIME-X BX N-1) 
     886       (ASET PN-PRIME-Y BY N-1)) 
     887    (:RELAXED 
     888       (ASET 2.0s0 N1 N-1) 
     889       (ASET 4.0s0 N2 N-1) 
     890       (LET ((TEM (// 6.0s0 (AREF L N-2)))) 
     891         (ASET (* TEM (- (AREF PX N-1) (AREF PX N-2))) BX N-1) 
     892         (ASET (* TEM (- (AREF PY N-1) (AREF PY N-2))) BY N-1))) 
     893    ;; Note: there are no final end conditions for :CYCLIC and :ANTI-CYCLIC, 
     894    ;; since they are the same at each end.  The M matrix has no N-1st row, 
     895    ;; either, as it is smaller by one row and one column. 
     896    ) 
     897 
     898  ;; Now fill in the insides of M and B arrays. 
     899  (LOOP FOR J FROM 1 TO N-2 
     900        AS L0 := (AREF L 0) THEN L1 
     901        AS L1 := (AREF L 1) THEN (AREF L J) 
     902        AS PX0 := (AREF PX 0) THEN PX1 
     903        AS PX1 := (AREF PX 1) THEN PX2 
     904        AS PX2 := (AREF PX (1+ J)) 
     905        AS PY0 := (AREF PY 0) THEN PY1 
     906        AS PY1 := (AREF PY 1) THEN PY2 
     907        AS PY2 := (AREF PY (1+ J)) 
     908        DO (ASET L1 N1 J) 
     909           (ASET (* 2 (+ L0 L1)) N2 J) 
     910           (ASET L0 N3 J) 
     911           (IF N4 (ASET 0.0s0 N4 J)) 
     912           (ASET (// (* 3.0s0 (+ (* (^ L0 2) (- PX2 PX1)) (* (^ L1 2) (- PX1 PX0)))) 
     913                     (* L0 L1)) BX J) 
     914           (ASET (// (* 3.0s0 (+ (* (^ L0 2) (- PY2 PY1)) (* (^ L1 2) (- PY1 PY0)))) 
     915                     (* L0 L1)) BY J)) 
     916 
     917  ;; Now that we have the matricies filled in, we solve the equations. 
     918  ;; We use Gaussian elimination, with a special version that takes 
     919  ;; advantage of the sparsity of this tridiagonal or almost-tridiagonal 
     920  ;; matrix to run in time O(n) instead of O(n**3).  No pivoting is used, 
     921  ;; because for any real dat (not all zeroes, for example) the matrix 
     922  ;; is both irreducible and diagonally-dominant, and therefore pivoting 
     923  ;; is not needed (Forsythe and Moler, p. 117,  exercise 23.10). 
     924  ;; The first step is to make the matrix upper-triangular, by making all of 
     925  ;; N1 be zero. 
     926  (LET ((Q (AREF N2 0)))                                ;Normalize row 0. 
     927    (ASET (// (AREF N3 0) Q) N3 0) 
     928    (IF N4 (ASET (// (AREF N4 0) Q) N4 0)) 
     929    (ASET (// (AREF BX 0) Q) BX 0) 
     930    (ASET (// (AREF BY 0) Q) BY 0)) 
     931  (LOOP FOR I FROM 1 TO (IF (NULL N4) N-1 N-2) 
     932        AS N1I := (AREF N1 I) 
     933        WHEN (NOT (ZEROP N1I))                          ;If it is zero already, OK. 
     934        DO (LET ((D (// 1.0s0 N1I))) 
     935             ;; D = M(I-1, I-1) / M(I, I-1)  so multiply row I 
     936             ;;   by D and subtract row I-1 from row I. 
     937             (ASET (- (* D (AREF N2 I)) (AREF N3 (1- I))) N2 I) 
     938             (ASET (* D (AREF N3 I)) N3 I) ; Uses N3(N-1), a garbage element. 
     939             (COND (N4 
     940                    (ASET (- (* D (AREF N4 I)) (AREF N4 (1- I))) N4 I) 
     941                    (IF (= I N-3) 
     942                        ;; In this case, N4(N-4) is above N3(N-3), so 
     943                        ;; it must be subtracted out. 
     944                        (ASET (- (AREF N3 I) (AREF N4 (1- I))) N3 I)))) 
     945             (ASET (- (* D (AREF BX I)) (AREF BX (1- I))) BX I) 
     946             (ASET (- (* D (AREF BY I)) (AREF BY (1- I))) BY I) 
     947             ) 
     948        ;; Next normalize, by dividing row I through by M(I,I). 
     949        ;; This leaves the center diagonal all 1.0s0, which the 
     950        ;; back-solver in R&A doesn't take advantage of. 
     951           (LET ((Q (AREF N2 I))) 
     952             (ASET (// (AREF N3 I) Q) N3 I) 
     953             (IF N4 (ASET (// (AREF N4 I) Q) N4 I)) 
     954             (ASET (// (AREF BX I) Q) BX I) 
     955             (ASET (// (AREF BY I) Q) BY I))) 
     956 
     957  ;; Create the arrays to hold the answers. 
     958  (SETQ UX (MAKE-ARRAY NIL 'ART-Q N)            ;Tangent vector matrix 
     959        UY (MAKE-ARRAY NIL 'ART-Q N)) 
     960 
     961  ;; Backsolve the upper-triangular matrix. 
     962  (COND ((NOT N4) 
     963         ;; Simpler version if there is no N4. 
     964         (ASET (AREF BX N-1) UX N-1) 
     965         (ASET (AREF BY N-1) UY N-1) 
     966         (LOOP FOR J FROM N-2 DOWNTO 0 
     967               DO (LET ((N3J (AREF N3 J))) 
     968                    (ASET (- (AREF BX J) (* N3J (AREF UX (1+ J)))) UX J) 
     969                    (ASET (- (AREF BY J) (* N3J (AREF UY (1+ J)))) UY J)))) 
     970        (T 
     971         ;; Hairier version with N4. 
     972         (LET ((UXN-2 (AREF BX N-2)) 
     973               (UYN-2 (AREF BY N-2))) 
     974           (ASET UXN-2 UX N-2) 
     975           (ASET UYN-2 UY N-2) 
     976           (ASET (- (AREF BX N-3) (* (AREF N3 N-3) UXN-2)) UX N-3) 
     977           (ASET (- (AREF BY N-3) (* (AREF N3 N-3) UYN-2)) UY N-3) 
     978           (LOOP FOR J FROM (1- N-3) DOWNTO 0 
     979                 DO (LET ((N3J (AREF N3 J)) 
     980                          (N4J (AREF N4 J))) 
     981                      (ASET (- (AREF BX J) 
     982                               (* N3J (AREF UX (1+ J))) 
     983                               (* N4J UXN-2)) 
     984                            UX J) 
     985                      (ASET (- (AREF BY J) 
     986                               (* N3J (AREF UY (1+ J))) 
     987                               (* N4J UYN-2)) 
     988                            UY J)))) 
     989         (ASET (* SIGN (AREF UX 0)) UX N-1) 
     990         (ASET (* SIGN (AREF UY 0)) UY N-1))) 
     991 
     992  (MULTIPLE-VALUE (CX CY N) 
     993    (CURGEN N-1 PX PY (1+ Z) CX CY L UX UY))    ;Generate it 
     994 
     995  (RETURN-ARRAY UY) 
     996  (RETURN-ARRAY UX) 
     997  (RETURN-ARRAY BY) 
     998  (RETURN-ARRAY BX) 
     999  (IF N4 (RETURN-ARRAY N4)) 
     1000  (RETURN-ARRAY N3) 
     1001  (RETURN-ARRAY N2) 
     1002  (RETURN-ARRAY N1) 
     1003  (RETURN-ARRAY L) 
     1004 
     1005  (PROG () (RETURN CX CY N))) 
     1006 
     1007;;; Generate the spline curve points. 
     1008;;; This is a separate function because if it got merged, there would 
     1009;;; be too many local variables. 
     1010(DEFUN CURGEN (N-1 PX PY Z CX CY L UX UY) 
     1011  (LOOP WITH I := 0 
     1012        FOR J FROM 0 TO (1- N-1) 
     1013        AS FX1 := (AREF PX J) 
     1014        AND FX2 := (AREF UX J) 
     1015        AS TEMX := (- (AREF PX (1+ J)) FX1) 
     1016        AND TEMX1 := (+ (AREF UX (1+ J)) FX2) 
     1017        AND LEN := (AREF L J) 
     1018        AS LEN^2 := (^ LEN 2) 
     1019        AS LEN^3 := (* LEN^2 LEN) 
     1020        AS FX3 := (- (* (// 3.0s0 LEN^2) TEMX) (// (+ TEMX1 FX2) LEN)) 
     1021        AND FX4 := (+ (* (// -2.0s0 LEN^3) TEMX) (// TEMX1 LEN^2)) 
     1022        AS FY1 := (AREF PY J) 
     1023        AND FY2 := (AREF UY J) 
     1024        AS TEMY := (- (AREF PY (1+ J)) FY1) 
     1025        AND TEMY1 := (+ (AREF UY (1+ J)) FY2) 
     1026        AS FY3 := (- (* (// 3.0s0 LEN^2) TEMY) (// (+ TEMY1 FY2) LEN)) 
     1027        AND FY4 := (+ (* (// -2.0s0 LEN^3) TEMY) (// TEMY1 LEN^2)) 
     1028        DO (LOOP FOR X FROM 0 BY (// LEN Z) TO LEN 
     1029                 WHEN (OR (= J 0) ( X 0)) 
     1030                 DO (ASET (+ FX1 (* FX2 X) (* FX3 (^ X 2)) (* FX4 (^ X 3))) CX I) 
     1031                    (ASET (+ FY1 (* FY2 X) (* FY3 (^ X 2)) (* FY4 (^ X 3))) CY I) 
     1032                    (SETQ I (1+ I))) 
     1033        FINALLY (RETURN CX CY I))) 
     1034 
     1035(DEFMETHOD (GRAPHICS-MIXIN :DRAW-CUBIC-SPLINE) 
     1036           (PX PY Z &OPTIONAL CURVE-WIDTH ALU (C1 ':RELAXED) (C2 C1) 
     1037                       P1-PRIME-X P1-PRIME-Y PN-PRIME-X PN-PRIME-Y) 
     1038  (IF (NULL ALU) 
     1039      (SETQ ALU CHAR-ALUF)) 
     1040  (MULTIPLE-VALUE-BIND (CX CY I) 
     1041      (SPLINE PX PY Z NIL NIL C1 C2 P1-PRIME-X P1-PRIME-Y PN-PRIME-X PN-PRIME-Y) 
     1042    (IF (= CURVE-WIDTH 1) 
     1043        (FUNCALL-SELF ':DRAW-CURVE CX CY I ALU) 
     1044        (FUNCALL-SELF ':DRAW-WIDE-CURVE CX CY CURVE-WIDTH I ALU)))) 
  • trunk/lisp/lmwin/supdup.lisp

    r221 r222  
    10571057           (FUNCALL STREAM ':TYO 377)))))       ;IAC's must be quoted 
    10581058 
    1059 (DEFMETHOD (BASIC-TELNET :BUFFERED-TYO) (CH) 
    1060   (MULTIPLE-VALUE-BIND (IGNORE Y) (FUNCALL-SELF ':READ-CURSORPOS) 
    1061     (COND ((= CH NVT-IAC) 
    1062            (FUNCALL-SELF ':HANDLE-IAC))         ;Perform new telnet negotiations. 
    1063           (( 
     1059(DEFMETHOD (BASIC-TELNET :BUFFERED-TYO) (CH &AUX CH1) 
     1060  (COND ((= CH NVT-IAC) 
     1061         (FUNCALL-SELF ':HANDLE-IAC))           ;Perform new telnet negotiations. 
     1062        (( 
    10641063 CH 200))                               ;Ignore otelnet negotiations 
    1065           ((= CH 7) (TV:BEEP))                  ;^G rings the bell. 
    1066           ((= CH 15) 
    1067            (FUNCALL-SELF ':FORCE-OUTPUT) 
    1068            (FUNCALL-SELF ':SET-CURSORPOS 0 Y)) 
    1069           ((= CH 12) 
    1070            (FUNCALL-SELF ':FORCE-OUTPUT) 
    1071            (FUNCALL-SELF ':INCREMENT-CURSORPOS 0 1 ':CHARACTER) 
    1072            (FUNCALL-SELF ':CLEAR-EOL)) 
    1073           ((AND (= CH 177) SIMULATE-IMLAC-FLAG) ;Escape character 
    1074            (FUNCALL-SELF ':HANDLE-IMLAC-ESCAPE)) 
    1075           (T 
    1076            (AND ( 
     1064        ((= CH 7) (TV:BEEP))                    ;^G rings the bell. 
     1065        ((AND (= CH 15) 
     1066              (IF (= (SETQ CH1 (NVT-NETI)) 12)  ;CR LF is NVT newline "character" 
     1067                  NIL                           ;Output normally 
     1068                  (FUNCALL-SELF ':FORCE-OUTPUT) 
     1069                  (MULTIPLE-VALUE-BIND (IGNORE Y) (FUNCALL-SELF ':READ-CURSORPOS) 
     1070                    (FUNCALL-SELF ':SET-CURSORPOS 0 Y)) 
     1071                  (ZEROP CH1))))                ;CR NUL is bare carriage return 
     1072        ((AND (= CH 177) SIMULATE-IMLAC-FLAG)   ;Escape character 
     1073         (FUNCALL-SELF ':HANDLE-IMLAC-ESCAPE)) 
     1074        (T 
     1075         (AND ( 
    10771076 CH 10) ( 
    10781077 CH 15) ( CH 13)       ;Convert formatting controls 
    1079                 (SETQ CH (+ CH 200)))           ;to Lisp machine char set. 
    1080            (DO () ((ARRAY-PUSH OUTPUT-BUFFER CH)) 
    1081              (FUNCALL-SELF ':FORCE-OUTPUT)))))) 
     1078              (SETQ CH (+ CH 200)))             ;to Lisp machine char set. 
     1079         (DO () ((ARRAY-PUSH OUTPUT-BUFFER CH)) 
     1080           (FUNCALL-SELF ':FORCE-OUTPUT))))) 
    10821081 
    10831082;;;New telnet protocol IAC handler