(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "22-Jul-88 15:32:46" |{MCS:MCS:STANFORD}SKETCHTALK.;26| 20834 previous date%: "13-Jun-88 16:34:08" |{MCS:MCS:STANFORD}SKETCHTALK.;25|) (* " Copyright (c) 1987, 1988 by Stanford University. All rights reserved. ") (PRETTYCOMPRINT SKETCHTALKCOMS) (RPAQQ SKETCHTALKCOMS ((* TALK Sketch Service) (LOCALVARS . T) (FNS TALK.SKETCH.DISPLAY TALK.SKETCH.LISTEN) (FNS TALK.SKETCH.FIND.ELEMENT TALK.SKETCH.FIND.SYMBOLS) (* Sketch Viewer Control Properties) (FNS TALK.SKETCH.WHENADDEDFN TALK.SKETCH.WHENCHANGEDFN TALK.SKETCH.WHENDELETEDFN TALK.SKETCH.WHENMOVEDFN TALK.SKETCH.PREMOVEFN) (FNS TALK.SKETCH.WHENGROUPEDFN TALK.SKETCH.WHENUNGROUPEDFN) (VARS TALK.TO.SKETCH.PROPS TALK.SKETCH.REDISPLAY.PROPS) (* TALK Sketch Actions) (FNS TALK.SKETCH.ADD.ELEMENT TALK.SKETCH.CHANGE.ELEMENT TALK.SKETCH.DELETE.ELEMENTS TALK.SKETCH.MOVE.ELEMENTS TALK.SKETCH.POSITION.ELEMENTS) (VARS TALK.SKETCH.ACTIONS) (* TALK Sketch Data) (VARS TALK.SKETCH.DELETE.ITEMS) (INITVARS TALK.SKETCH.TRACK) (GLOBALVARS TALK.SKETCH.ACTIONS TALK.TO.SKETCH.PROPS TALK.SKETCH.REDISPLAY.PROPS TALK.SKETCH.DELETE.ITEMS TALK.SKETCH.TRACK) (* etc) (FILES TALK SKETCH) (APPENDVARS (GAP.SERVICETYPES (7 Sketch TALK.NS.SERVER)) (TALK.SERVICETYPES (Sketch TALK.SKETCH.DISPLAY TALK.SKETCH.LISTEN)) ) (* Sketch Bug Fixes) (FNS TALK.SKETCH.NOP) (P (CHANGENAME '\SK.PUT.FONT 'SK.INSURE.TEXT 'TALK.SKETCH.NOP)) (ADVISE BITMAPELT.CHANGEFN SK.IMAGEOBJ.CHANGEFN (TEXTUREP :IN SKFILLINGP)) )) (* TALK Sketch Service) (DECLARE%: DOEVAL@COMPILE DONTCOPY (LOCALVARS . T) ) (DEFINEQ (TALK.SKETCH.DISPLAY [LAMBDA (MAINWINDOW WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOL USER) (* ; "Edited 9-Jun-88 16:36 by cdl") (LET (MENUWINDOW) (SKETCH NIL MAINWINDOW) (SKETCH NIL WINDOW) (DETACHWINDOW (SETQ MENUWINDOW (WINDOWPROP WINDOW 'SKETCHFIXEDMENU NIL))) (CLOSEW MENUWINDOW) (DETACHWINDOW (SETQ MENUWINDOW (WINDOWPROP MAINWINDOW 'SKETCHFIXEDMENU NIL))) (CLOSEW MENUWINDOW) (WINDOWPROP MAINWINDOW 'SKETCHFIXEDMENU (ATTACHMENU (LET ((ITEMS (SKETCH.COMMANDMENU.ITEMS NIL T))) (for KEY in TALK.SKETCH.DELETE.ITEMS do (SETQ ITEMS (DREMOVE (SASSOC KEY ITEMS) ITEMS))) (SKETCH.COMMANDMENU ITEMS)) MAINWINDOW 'RIGHT 'TOP)) (WINDOWPROP MAINWINDOW 'SKETCHPOPUPMENU NIL) (WINDOWPROP WINDOW 'SKETCHPOPUPMENU NIL) (for PAIR on TALK.TO.SKETCH.PROPS do (PUTSKETCHPROP MAINWINDOW (CAR PAIR) (CADR PAIR))) (PUTSKETCHPROP MAINWINDOW 'TALK OUTPUTSTREAM) (* Still need to combine the two  prompt windows into one) (WINDOWPROP MAINWINDOW 'SCROLLFN NIL) (WINDOWPROP WINDOW 'SCROLLFN NIL) (PUTWINDOWPROP MAINWINDOW 'DONTQUERYCHANGES T) (PUTWINDOWPROP WINDOW 'DONTQUERYCHANGES T) (RPLACA (CDAR (INSURE.SKETCH MAINWINDOW)) (CONCAT "Talk with " USER)) (WINDOWDELPROP WINDOW 'SHRINKFN 'SK.SHRINK.ICONCREATE) (WINDOWDELPROP WINDOW 'SHRINKFN 'SK.RETURN.TTY) (with REGION (DSPCLIPPINGREGION NIL MAINWINDOW) (SKED.SET.SELECTION (CREATEPOSITION (QUOTIENT WIDTH 2) (QUOTIENT HEIGHT 2)) MAINWINDOW)) (TTY.PROCESS (WINDOWPROP MAINWINDOW 'PROCESS]) (TALK.SKETCH.LISTEN [LAMBDA (MAINWINDOW WINDOW INPUTSTREAM OUTPUTSTREAM PROTOCOLTYPE) (* ; "Edited 7-Jun-88 08:46 by cdl") (* DECLARATIONS%: (RECORD EXPR  (KEY . ARGUMENTS))  (RECORD OPERATION (KEY FUNCTION))) (PROG [OPERATION (EVENTFN (with TALK.PROTOCOLTYPE PROTOCOLTYPE TALK.EVENTFN)) (SKETCH (INSURE.SKETCH (MAINWINDOW WINDOW] (DECLARE (GLOBALVARS TALK.CLOSED.STRING)) (while (OPENWP WINDOW) do (APPLY* EVENTFN INPUTSTREAM OUTPUTSTREAM) (if (NOT (AND (OPENP INPUTSTREAM) (OPENP OUTPUTSTREAM))) then (RETURN)) [SELCHARQ (PEEKCCODE INPUTSTREAM) (^G (TALK.RINGBELLS WINDOW)) (with EXPR (HREAD INPUTSTREAM) (if (SETQ OPERATION (ASSOC KEY TALK.SKETCH.ACTIONS)) then (with OPERATION OPERATION (APPLY FUNCTION (CONS WINDOW ARGUMENTS))) else (PRINTOUT (GETPROMPTWINDOW MAINWINDOW) "Unknown Sketch Talk operation:" %, KEY] (BIN INPUTSTREAM)) (RPLACA (CDAR SKETCH) (CONCAT (CADAR SKETCH) TALK.CLOSED.STRING)) (PUTSKETCHPROP MAINWINDOW 'TALK NIL]) ) (DEFINEQ (TALK.SKETCH.FIND.ELEMENT [LAMBDA (SKETCH SYMBOLS) (* ; "Edited 18-Jun-87 09:21 by cdl") (DECLARE (SPECVARS SYMBOLS)) (SKETCH.LIST.OF.ELEMENTS SKETCH (FUNCTION (LAMBDA (ELEMENT) (EQMEMB (GETSKETCHELEMENTPROP ELEMENT 'TALK) SYMBOLS]) (TALK.SKETCH.FIND.SYMBOLS [LAMBDA (SKETCH ELEMENTS) (* ; "Edited 18-Jun-87 11:11 by cdl") (for ELEMENT in ELEMENTS collect (GETSKETCHELEMENTPROP ELEMENT 'TALK]) ) (* Sketch Viewer Control Properties) (DEFINEQ (TALK.SKETCH.WHENADDEDFN [LAMBDA (VIEWER ELEMENT) (* ; "Edited 23-Jun-87 07:48 by cdl") (LET [(STREAM (GETSKETCHPROP VIEWER 'TALK] (if (AND STREAM (OPENP STREAM)) then (PROG [(SCRATCHSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH] (PUTSKETCHELEMENTPROP ELEMENT 'TALK (GENSYM 'TALK)) (HPRINT `(ADD ,ELEMENT) SCRATCHSTREAM) (SETFILEPTR SCRATCHSTREAM 0) (COPYBYTES SCRATCHSTREAM STREAM) (FORCEOUTPUT STREAM) (CLOSEF? SCRATCHSTREAM]) (TALK.SKETCH.WHENCHANGEDFN [LAMBDA (VIEWER ELEMENT PROPERTY NEWVALUE OLDVALUE) (* ; "Edited 10-Jun-88 09:17 by cdl") (PROG [(STREAM (GETSKETCHPROP VIEWER 'TALK] (if (AND STREAM (OPENP STREAM)) then (SELECTQ PROPERTY (HASBOX (TALK.SKETCH.WHENDELETEDFN VIEWER (LIST OLDVALUE)) (TALK.SKETCH.WHENADDEDFN VIEWER NEWVALUE) (RETURN)) (DATA (SELECTQ NEWVALUE ((NIL CHANGED) (SETQ NEWVALUE OLDVALUE)) NIL)) NIL) (LET [(SCRATCHSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH] (HPRINT `(CHANGE ,(TALK.SKETCH.FIND.SYMBOLS VIEWER (CONS ELEMENT)) ,PROPERTY ,NEWVALUE) SCRATCHSTREAM) (SETFILEPTR SCRATCHSTREAM 0) (COPYBYTES SCRATCHSTREAM STREAM) (FORCEOUTPUT STREAM) (CLOSEF? SCRATCHSTREAM]) (TALK.SKETCH.WHENDELETEDFN [LAMBDA (VIEWER ELEMENTS) (* ; "Edited 23-Jun-87 07:48 by cdl") (PROG [(STREAM (GETSKETCHPROP VIEWER 'TALK] (if (AND STREAM (OPENP STREAM)) then (HPRINT `(DELETE ,(TALK.SKETCH.FIND.SYMBOLS VIEWER ELEMENTS)) STREAM) (FORCEOUTPUT STREAM]) (TALK.SKETCH.WHENMOVEDFN [LAMBDA (VIEWER ELEMENTS DELTA) (* ; "Edited 23-Jun-87 10:14 by cdl") (PROG [(STREAM (GETSKETCHPROP VIEWER 'TALK] (if (AND STREAM (OPENP STREAM)) then [SETQ ELEMENTS (if (EQ (CAR ELEMENTS) T) then [if (NULL TALK.SKETCH.TRACK) then (if (LISTP (CAADR ELEMENTS)) then [for ELEMENT in (CDR ELEMENTS) collect (CONS T (  TALK.SKETCH.FIND.SYMBOLS VIEWER (LIST ELEMENT] else (* Fix for Sketch UNDO/MOVE bug) (with POSITION DELTA (SETQ XCOORD (MINUS XCOORD) ) (SETQ YCOORD (MINUS YCOORD))) (LIST (CONS T (TALK.SKETCH.FIND.SYMBOLS VIEWER (CONS (CDR ELEMENTS] elseif (in (CAR ELEMENTS) always NUMBERP) then [LIST (CONS (CAR ELEMENTS) (TALK.SKETCH.FIND.SYMBOLS VIEWER (LIST (CDR ELEMENTS] else (for ELEMENT in ELEMENTS when (OR (NEQ (CAR ELEMENT) T) (NOT TALK.SKETCH.TRACK)) collect (CONS (CAR ELEMENT) (TALK.SKETCH.FIND.SYMBOLS VIEWER (CONS (CDR ELEMENT] (HPRINT `(MOVE ,ELEMENTS ,DELTA) STREAM) (FORCEOUTPUT STREAM]) (TALK.SKETCH.PREMOVEFN [LAMBDA (VIEWER ELEMENTS ALIGNHOW) (* ; "Edited 23-Jun-87 07:53 by cdl") (LET [(STREAM (GETSKETCHPROP VIEWER 'TALK] (if (AND TALK.SKETCH.TRACK (NULL ALIGNHOW) (EQ (CAR ELEMENTS) T) STREAM (OPENP STREAM)) then (LET [(SYMBOLS (TALK.SKETCH.FIND.SYMBOLS VIEWER (CDR ELEMENTS] (SKETCH.TRACK.ELEMENTS (CDR ELEMENTS) VIEWER [FUNCTION (LAMBDA (POSITION VIEWER STREAM) (HPRINT `(POSITION ,SYMBOLS ,POSITION) STREAM) (FORCEOUTPUT STREAM] NIL NIL STREAM]) ) (DEFINEQ (TALK.SKETCH.WHENGROUPEDFN [LAMBDA (VIEWER ELEMENTS) (* ; "Edited 18-Jun-87 11:02 by cdl") 'DON'T]) (TALK.SKETCH.WHENUNGROUPEDFN [LAMBDA (VIEWER ELEMENTS) (* ; "Edited 18-Jun-87 11:02 by cdl") 'DON'T]) ) (RPAQQ TALK.TO.SKETCH.PROPS (WHENADDEDFN TALK.SKETCH.WHENADDEDFN WHENDELETEDFN TALK.SKETCH.WHENDELETEDFN WHENMOVEDFN TALK.SKETCH.WHENMOVEDFN WHENCHANGEDFN TALK.SKETCH.WHENCHANGEDFN WHENGROUPEDFN TALK.SKETCH.WHENGROUPEDFN WHENUNGROUPEDFN TALK.SKETCH.WHENUNGROUPEDFN PREMOVEFN TALK.SKETCH.PREMOVEFN)) (RPAQQ TALK.SKETCH.REDISPLAY.PROPS ((TEXT FONT) (TEXTBOX FONT BRUSH) (CLOSEDWIRE DASHING))) (* TALK Sketch Actions) (DEFINEQ (TALK.SKETCH.ADD.ELEMENT [LAMBDA (SKETCH ELEMENT) (* ; "Edited 21-Jun-87 11:24 by cdl") (SKETCH.ADD.ELEMENT ELEMENT SKETCH]) (TALK.SKETCH.CHANGE.ELEMENT [LAMBDA (SKETCH ELEMENT PROPERTY VALUE) (* ; "Edited 10-Jun-88 09:35 by cdl") (* DECLARATIONS%: (RECORD ENTRY  (TYPE . PROPERTIES))) (bind ENTRY for ELEMENT in (TALK.SKETCH.FIND.ELEMENT SKETCH ELEMENT) do (PUTSKETCHELEMENTPROP ELEMENT PROPERTY VALUE SKETCH) (if (SETQ ENTRY (ASSOC (SKETCH.ELEMENT.TYPE ELEMENT) TALK.SKETCH.REDISPLAY.PROPS)) then (with ENTRY ENTRY (if (OR (NULL PROPERTIES) (MEMB PROPERTY PROPERTIES)) then (REDISPLAYW SKETCH]) (TALK.SKETCH.DELETE.ELEMENTS [LAMBDA (SKETCH ELEMENTS) (* ; "Edited 18-Jun-87 09:47 by cdl") (for ELEMENT inside (TALK.SKETCH.FIND.ELEMENT SKETCH ELEMENTS) do (SKETCH.DELETE.ELEMENT ELEMENT SKETCH]) (TALK.SKETCH.MOVE.ELEMENTS [LAMBDA (SKETCH ELEMENTS DELTA) (* ; "Edited 18-Jun-87 17:48 by cdl") (for PAIR in ELEMENTS do (SELECTQ (CAR PAIR) (T (SKETCH.MOVE.ELEMENTS (TALK.SKETCH.FIND.ELEMENT SKETCH (CDR PAIR)) DELTA SKETCH)) (bind POSITIONS POSITION CONTROLPT [ELEMENT _ (CAR (TALK.SKETCH.FIND.ELEMENT SKETCH (CDR PAIR] for NUMBER in (CAR PAIR) do (SELECTQ NUMBER ((1 2 3) (SETQ CONTROLPT (SELECTQ NUMBER (1 '1STCONTROLPT) (2 '2NDCONTROLPT) (3 '3RDCONTROLPT) (SHOULDNT))) (with POSITION (SETQ POSITION (COPY (GETSKETCHELEMENTPROP ELEMENT CONTROLPT))) (add XCOORD (fetch (POSITION XCOORD) of DELTA)) (add YCOORD (fetch (POSITION YCOORD) of DELTA))) (PUTSKETCHELEMENTPROP ELEMENT CONTROLPT POSITION SKETCH)) (if [SETQ POSITIONS (COPY (GETSKETCHELEMENTPROP ELEMENT 'DATA] then (with POSITION (CAR (NTH POSITIONS NUMBER)) (add XCOORD (fetch (POSITION XCOORD) of DELTA)) (add YCOORD (fetch (POSITION YCOORD) of DELTA))) (PUTSKETCHELEMENTPROP ELEMENT 'DATA POSITIONS SKETCH]) (TALK.SKETCH.POSITION.ELEMENTS [LAMBDA (SKETCH SYMBOLS POSITION) (* ; "Edited 19-Jun-87 09:17 by cdl") (LET ((ELEMENTS (TALK.SKETCH.FIND.ELEMENT SKETCH SYMBOLS))) (SKETCH.MOVE.ELEMENTS ELEMENTS (with POSITION (GETSKETCHELEMENTPROP (CAR ELEMENTS) '1STCONTROLPT) (create POSITION XCOORD _ (DIFFERENCE (fetch (POSITION XCOORD) of POSITION) XCOORD) YCOORD _ (DIFFERENCE (fetch (POSITION YCOORD) of POSITION) YCOORD))) SKETCH]) ) (RPAQQ TALK.SKETCH.ACTIONS ((ADD TALK.SKETCH.ADD.ELEMENT) (DELETE TALK.SKETCH.DELETE.ELEMENTS) (MOVE TALK.SKETCH.MOVE.ELEMENTS) (CHANGE TALK.SKETCH.CHANGE.ELEMENT) (POSITION TALK.SKETCH.POSITION.ELEMENTS))) (* TALK Sketch Data) (RPAQQ TALK.SKETCH.DELETE.ITEMS (Group UnGroup Put "Move view")) (RPAQ? TALK.SKETCH.TRACK NIL) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TALK.SKETCH.ACTIONS TALK.TO.SKETCH.PROPS TALK.SKETCH.REDISPLAY.PROPS TALK.SKETCH.DELETE.ITEMS TALK.SKETCH.TRACK) ) (* etc) (FILESLOAD TALK SKETCH) (APPENDTOVAR GAP.SERVICETYPES (7 Sketch TALK.NS.SERVER)) (APPENDTOVAR TALK.SERVICETYPES (Sketch TALK.SKETCH.DISPLAY TALK.SKETCH.LISTEN)) (* Sketch Bug Fixes) (DEFINEQ (TALK.SKETCH.NOP [LAMBDA (X) (* ; "Edited 19-Jun-87 07:50 by cdl") X]) ) (CHANGENAME '\SK.PUT.FONT 'SK.INSURE.TEXT 'TALK.SKETCH.NOP) [XCL:REINSTALL-ADVICE 'BITMAPELT.CHANGEFN :AFTER '((:LAST (RPLACA (CDDAR (CADAR !VALUE)) (CADDAR (CAAR !VALUE] [XCL:REINSTALL-ADVICE 'SK.IMAGEOBJ.CHANGEFN :AFTER '((:LAST (RPLACA (CDDAR (CADAR !VALUE)) (CADDAR (CAAR !VALUE] [XCL:REINSTALL-ADVICE '(TEXTUREP :IN SKFILLINGP) :BEFORE '((:LAST (IF (NULL OBJECT) THEN (RETURN T] (READVISE BITMAPELT.CHANGEFN SK.IMAGEOBJ.CHANGEFN (TEXTUREP :IN SKFILLINGP)) (PUTPROPS SKETCHTALK COPYRIGHT ("Stanford University" 1987 1988)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2500 6848 (TALK.SKETCH.DISPLAY 2510 . 4998) (TALK.SKETCH.LISTEN 5000 . 6846)) (6849 7473 (TALK.SKETCH.FIND.ELEMENT 6859 . 7250) (TALK.SKETCH.FIND.SYMBOLS 7252 . 7471)) (7519 13184 ( TALK.SKETCH.WHENADDEDFN 7529 . 8234) (TALK.SKETCH.WHENCHANGEDFN 8236 . 9498) ( TALK.SKETCH.WHENDELETEDFN 9500 . 9896) (TALK.SKETCH.WHENMOVEDFN 9898 . 12275) (TALK.SKETCH.PREMOVEFN 12277 . 13182)) (13185 13493 (TALK.SKETCH.WHENGROUPEDFN 13195 . 13341) (TALK.SKETCH.WHENUNGROUPEDFN 13343 . 13491)) (14060 19099 (TALK.SKETCH.ADD.ELEMENT 14070 . 14242) (TALK.SKETCH.CHANGE.ELEMENT 14244 . 15104) (TALK.SKETCH.DELETE.ELEMENTS 15106 . 15374) (TALK.SKETCH.MOVE.ELEMENTS 15376 . 17890) ( TALK.SKETCH.POSITION.ELEMENTS 17892 . 19097)) (19962 20105 (TALK.SKETCH.NOP 19972 . 20103))))) STOP