(FILECREATED "20-Mar-86 17:52:35" {PHYLUM}<PAPERWORKS>IDEASKETCH.;8 10388
changes to: (VARS IDEASKETCHCOMS)
(FNS WRITEW.CREATE SK.ADD.SUBITEM.TO.MENU)
previous date: "20-Mar-86 10:18:06" {PHYLUM}<PAPERWORKS>IDEASKETCH.;7)
(* Copyright (c) 1985, 1986 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 (QUOTE Sketch)
(QUOTE ("IdeaSketch"
(QUOTE (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 (QUOTE NO))
(SK.SET.MOVE.MODE SKW (QUOTE POINTS))
(SK.SET.LINE.ARROWHEAD SKW (QUOTE LAST)) (* set the arrowhead type to line for speed.)
(SK.SET.ARROWHEAD.TYPE SKW (QUOTE LINE))
(SK.SET.TEXT.HORIZ.ALIGN SKW (QUOTE LEFT))
(SK.SET.TEXT.VERT.ALIGN SKW (QUOTE 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 (QUOTE SKETCHCONTEXT]
(RETURN (replace (SKETCHCONTEXT SKETCHUSEARROWHEAD) of SKETCHCONTEXT
with (COND
((EQ (fetch (SKETCHCONTEXT SKETCHUSEARROWHEAD) of SKETCHCONTEXT)
(QUOTE LAST)) (* if the last setting was LAST, make it NEITHER)
(QUOTE NEITHER))
(T (QUOTE LAST])
(SK.WRITING.MENU
[LAMBDA (MENUTITLE) (* rrb "28-Aug-85 11:06")
(* returns the control menu for a writing window.)
(create MENU
ITEMS ←[APPEND (QUOTE (("Move points" SK.MOVE.POINTS
"Moves a collection of control points.")))
(QUOTE ((Change SK.CHANGE.ELT "Changes a property of a piece.")))
(for ELEMENT in (QUOTE (TEXTBOX)) when [fetch (SKETCHTYPE LABEL)
of (SETQ ELEMENT
(GETPROP ELEMENT
(QUOTE SKETCHTYPE]
collect (* add the sketch elements that have a label.)
(LIST (fetch (SKETCHTYPE LABEL) of ELEMENT)
ELEMENT
(fetch (SKETCHTYPE DOCSTR) of ELEMENT)))
(QUOTE (("font LARGE" (SK.SEL.AND.MAKE (QUOTE (TEXT LARGER)))
"Makes the font larger.")
("font small" (SK.SEL.AND.MAKE (QUOTE (TEXT SMALLER)))
"Makes the font of selected items smaller.")
("BOLD" (SK.SEL.AND.MAKE (QUOTE (TEXT BOLD)))
"makes selected text bold."
(SUBITEMS ("Default BOLD" (SK.SET.DEFAULT.TEXT.FACE
(QUOTE (BOLD REGULAR REGULAR))
)
"makes the default text bold.")
("Default unbold" (SK.SET.DEFAULT.TEXT.FACE
(QUOTE (MEDIUM REGULAR
REGULAR)))
"makes the default text unbold.")))
("line size" (SK.SEL.AND.MAKE (LIST (QUOTE 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.")))
[QUOTE (("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"]
[QUOTE ((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 (QUOTE ((Put SK.PUT.ON.FILE
"saves this sketch on a file"]
[AND ALLOWSKETCHPUTFLG (QUOTE ((Get SK.GET.FROM.FILE
"gets a sketch from a file."]
(QUOTE ((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 (QUOTE 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 (QUOTE SUBITEMS)
NEWSUBITEM]
[(NULL (CDDR ITEM)) (* no help string)
(NCONC ITEM (LIST NIL (LIST (QUOTE SUBITEMS)
NEWSUBITEM]
((NULL (CDDDR ITEM)) (* no help string)
(NCONC1 ITEM (LIST (QUOTE SUBITEMS)
NEWSUBITEM)))
((EQ (CAR (CADDDR ITEM))
(QUOTE 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 (QUOTE SUBITEMS)
NEWSUBITEM)
(CDDDR ITEM]
(COND
((type? MENU ITEMLST)
(UPDATE/MENU/IMAGE ITEMLST])
(SK.SEL.AND.MAKE
[LAMBDA (CHANGECOMMAND W) (* rrb " 6-Jan-85 19:23")
(* 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)
W])
)
(* stuff to add writingtool to background menu)
(SK.ADD.SUBITEM.TO.MENU BackgroundMenuCommands (QUOTE Sketch)
(QUOTE ("IdeaSketch" (QUOTE (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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1029 10012 (WRITEW.CREATE 1039 . 2035) (SK.TOGGLE.DEFAULT.ARROWHEAD 2037 . 2725) (
SK.WRITING.MENU 2727 . 7639) (SK.ADD.SUBITEM.TO.MENU 7641 . 9586) (SK.SEL.AND.MAKE 9588 . 10010)))))
STOP