(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "13-Oct-88 17:50:59" {ERINYES}MEDLEY>IDEASKETCH.;1 14200 previous date%: "18-Feb-87 17:04:55" {PHYLUM}IDEASKETCH.;9) (* " Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT IDEASKETCHCOMS) (RPAQQ IDEASKETCHCOMS [(FILES SKETCH) (COMS (* stuff for creating a writing specialized sketch window.) (FNS WRITEW.CREATE SK.TOGGLE.DEFAULT.ARROWHEAD SK.WRITING.MENU SK.ADD.SUBITEM.TO.MENU SK.SEL.AND.MAKE)) (COMS (* stuff to add writingtool to background menu) (P (SK.ADD.SUBITEM.TO.MENU BackgroundMenuCommands 'Sketch '("IdeaSketch" '(WRITEW.CREATE NIL NIL (GETREGION) NIL NIL T T) "Opens an idea sketch window.") T)) (VARS (BackgroundMenu NIL]) (FILESLOAD SKETCH) (* stuff for creating a writing specialized sketch window.) (DEFINEQ (WRITEW.CREATE [LAMBDA (SKETCH SKETCHREGION SCREENREGION TITLE INITIALSCALE BRINGUPMENU INITIALGRID) (* rrb "20-Mar-86 17:50") (* creates a sketch window with a menu that is specialized for writing.) (PROG ((SKW (SKETCHW.CREATE SKETCH SKETCHREGION SCREENREGION TITLE INITIALSCALE (  SK.WRITING.MENU ) INITIALGRID))) (* change some default to more appropriate for writing.) (SK.SET.LINE.LENGTH.MODE SKW 'NO) (SK.SET.MOVE.MODE SKW 'POINTS) (SK.SET.LINE.ARROWHEAD SKW 'LAST) (* set the arrowhead type to line for speed.) (SK.SET.ARROWHEAD.TYPE SKW 'LINE) (SK.SET.TEXT.HORIZ.ALIGN SKW 'LEFT) (SK.SET.TEXT.VERT.ALIGN SKW 'TOP) (RETURN SKW]) (SK.TOGGLE.DEFAULT.ARROWHEAD [LAMBDA (W) (* rrb "12-Jan-85 11:03") (* sets whether or not the default line has an arrowhead.) (PROG [(SKETCHCONTEXT (WINDOWPROP W 'SKETCHCONTEXT] (RETURN (replace (SKETCHCONTEXT SKETCHUSEARROWHEAD) of SKETCHCONTEXT with (COND ((EQ (fetch (SKETCHCONTEXT SKETCHUSEARROWHEAD) of SKETCHCONTEXT ) 'LAST) (* if the last setting was LAST, make it NEITHER) 'NEITHER) (T 'LAST]) (SK.WRITING.MENU [LAMBDA (MENUTITLE) (* rrb "28-Aug-85 11:06") (* returns the control menu for a writing window.) (create MENU ITEMS _ [APPEND '(("Move points" SK.MOVE.POINTS "Moves a collection of control points.")) '((Change SK.CHANGE.ELT "Changes a property of a piece.")) (for ELEMENT in '(TEXTBOX) when [fetch (SKETCHTYPE LABEL) of (SETQ ELEMENT (GETPROP ELEMENT 'SKETCHTYPE] collect (* add the sketch elements that have a label.) (LIST (fetch (SKETCHTYPE LABEL) of ELEMENT) ELEMENT (fetch (SKETCHTYPE DOCSTR) of ELEMENT))) '(("font LARGE" (SK.SEL.AND.MAKE '(TEXT LARGER)) "Makes the font larger.") ("font small" (SK.SEL.AND.MAKE '(TEXT SMALLER)) "Makes the font of selected items smaller.") ("BOLD" (SK.SEL.AND.MAKE '(TEXT BOLD)) "makes selected text bold." (SUBITEMS ("Default BOLD" (SK.SET.DEFAULT.TEXT.FACE '(BOLD REGULAR REGULAR)) "makes the default text bold.") ("Default unbold" (SK.SET.DEFAULT.TEXT.FACE '(MEDIUM REGULAR REGULAR)) "makes the default text unbold."))) ("line size" (SK.SEL.AND.MAKE (LIST 'SIZE (READBRUSHSIZE))) "sets the line size of selected elements." (SUBITEMS ("Default line size" (SK.SET.DEFAULT.BRUSH.SIZE ( READBRUSHSIZE )) "sets the line size of any newly constructed lines." ))) ("More Menu" SK.SKETCH.MENU "pops up the normal sketch command menu.")) '[("Move view" SKETCH.ZOOM "makes a new region the part of the sketch visible." (SUBITEMS ("Move view" SKETCH.ZOOM "changes the scale of the display.") (AutoZoom SKETCH.AUTOZOOM "changes the scale around a selected point.") (Home SKETCH.HOME "returns to the origin at the original scale") ("Fit it" SK.FRAME.IT "moves so that the entire sketch just fits in the window" ) ("Restore view" SK.RESTORE.VIEW "Moves to a previously saved view." (SUBITEMS ("Restore view" SK.RESTORE.VIEW "Moves to a previously saved view." ) ("Save view" SK.NAME.CURRENT.VIEW "saves the current view (position and scale) of the sketch for easy return." ) ("Forget view" SK.FORGET.VIEW "Deletes a previously saved view."))) ("Coord window" ADD.GLOBAL.DISPLAY "creates a window that shows the cursor in global coordinates." (SUBITEMS ("Coord window" ADD.GLOBAL.DISPLAY "creates a window that shows the cursor position in global coordinates." ) ("Grid coord window" ADD.GLOBAL.GRIDDED.DISPLAY "creates a window that shows the grid position nearest the cursor in global coordinates." ))) (New% window SKETCH.NEW.VIEW "opens another viewer onto this sketch"] '[(HardCopy HARDCOPYIMAGEW "sends a copy of the current window contents on the default printer." (SUBITEMS ("To a file" HARDCOPYIMAGEW.TOFILE "Puts image on a file; prompts for filename and format" ) ("To a printer" HARDCOPYIMAGEW.TOPRINTER "Sends image to a printer of your choosing") ("Whole sketch" SK.LIST.IMAGE "Sends the image of the whole sketch at the current scale to the printer." (SUBITEMS ("To a file" HARDCOPYIMAGEW.TOFILE "Puts image on a file; prompts for filename and format" ) ("To a printer" HARDCOPYIMAGEW.TOPRINTER "Sends image to a printer of your choosing" ))) (Hardcopy% Display SK.SET.HARDCOPY.MODE "Makes the display correspond to the hardcopy image on the default printer." ) (Normal% Display SK.UNSET.HARDCOPY.MODE "Changes the display to use display fonts."] [AND ALLOWSKETCHPUTFLG '((Put SK.PUT.ON.FILE "saves this sketch on a file"] [AND ALLOWSKETCHPUTFLG '((Get SK.GET.FROM.FILE "gets a sketch from a file." ] '((Redisplay REDISPLAYW "repaints the sketch image."] CENTERFLG _ T WHENSELECTEDFN _ (FUNCTION SKETCHW.SELECTIONFN) MENUFONT _ (FONTNAMELIST (FONTCREATE BOLDFONT)) TITLE _ MENUTITLE]) (SK.ADD.SUBITEM.TO.MENU [LAMBDA (ITEMLST ITEMLABEL NEWSUBITEM NOERRORFLG) (* rrb "20-Mar-86 17:52") (* adds a new subitem to an item.) (PROG ((ITEMS (COND ((type? MENU ITEMLST) (fetch (MENU ITEMS) of ITEMLST)) (T ITEMLST))) ITEM) (SETQ ITEM (SASSOC ITEMLABEL ITEMS)) [COND [(NULL ITEM) (COND [(SETQ ITEM (MEMBER ITEMLABEL ITEMS)) (* item is standalone.) (RPLACA ITEM (LIST (CAR ITEM) (KWOTE (CAR ITEM)) NIL (LIST 'SUBITEMS NEWSUBITEM] (NOERRORFLG (* couldn't find item.) (RETURN)) (T (ERROR "Couldn't find item in item lst."] [(NULL (CDR ITEM)) (* item is just a label?) (NCONC ITEM (LIST (KWOTE (CAR ITEM)) NIL (LIST 'SUBITEMS NEWSUBITEM] [(NULL (CDDR ITEM)) (* no help string) (NCONC ITEM (LIST NIL (LIST 'SUBITEMS NEWSUBITEM] ((NULL (CDDDR ITEM)) (* no help string) (NCONC1 ITEM (LIST 'SUBITEMS NEWSUBITEM))) ((EQ (CAR (CADDDR ITEM)) 'SUBITEMS) (OR (MEMBER NEWSUBITEM (CADDDR ITEM)) (NCONC1 (CADDDR ITEM) NEWSUBITEM))) (T (* item is of some foreign form splice it in.) (RPLACD (CDDDR ITEM) (CONS (LIST 'SUBITEMS NEWSUBITEM) (CDDDR ITEM] (COND ((type? MENU ITEMLST) (UPDATE/MENU/IMAGE ITEMLST]) (SK.SEL.AND.MAKE [LAMBDA (CHANGECOMMAND W) (* rrb "18-Feb-87 17:04") (* lets the user select elements and applies the given change command to them.) (SK.APPLY.CHANGE.COMMAND (FUNCTION SK.ELEMENTS.CHANGEFN) CHANGECOMMAND (SK.SELECT.MULTIPLE.ITEMS W T) W]) ) (* stuff to add writingtool to background menu) (SK.ADD.SUBITEM.TO.MENU BackgroundMenuCommands 'Sketch '("IdeaSketch" '(WRITEW.CREATE NIL NIL (GETREGION) NIL NIL T T) "Opens an idea sketch window.") T) (RPAQQ BackgroundMenu NIL) (PUTPROPS IDEASKETCH COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1108 13793 (WRITEW.CREATE 1118 . 2379) (SK.TOGGLE.DEFAULT.ARROWHEAD 2381 . 3363) ( SK.WRITING.MENU 3365 . 11174) (SK.ADD.SUBITEM.TO.MENU 11176 . 13274) (SK.SEL.AND.MAKE 13276 . 13791))) )) STOP