(FILECREATED " 5-Oct-85 09:52:06" {PHYLUM}<PAPERWORKS>SKETCHSTREAM.;26 27941
changes to: (FNS \SKETCHSTREAMINIT \DRAWARC.SKETCH)
(VARS SKETCHSTREAMCOMS)
previous date: "27-Sep-85 10:59:21" {PHYLUM}<PAPERWORKS>SKETCHSTREAM.;24)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SKETCHSTREAMCOMS)
(RPAQQ SKETCHSTREAMCOMS [(* contains the functions needed to support sketch streams. Sketch streams
allow a user program to print, draw, etc. to a stream and builds a
sketch of the result.)
(FNS INSURE.BRUSH OPENSKETCHSTREAM \SKETCHSTREAM.POSITION.CHANGED \SKETCHSTREAMINIT
\SK.SET.FONT \SKSTRM.WINDOW.FROM.STREAM ZOOM.SKETCH.STREAM)
(* fns to support stream operations on sketches)
(FNS \DSPFONT.SKETCH \DSPLEFTMARGIN.SKETCH \DSPRIGHTMARGIN.SKETCH \DSPLINEFEED.SKETCH
\DSPXPOSITION.SKETCH \DSPYPOSITION.SKETCH \DRAWCURVE.SKETCH \DRAWCIRCLE.SKETCH
\FILLCIRCLE.SKETCH \FILLPOLYGON.SKETCH \DRAWELLIPSE.SKETCH \DRAWARC.SKETCH
\DRAWLINE.SKETCH \BOUT.SKETCH \DSPCOLOR.SKETCH \DSPBACKCOLOR.SKETCH \DSPOPERATION.SKETCH
\STRINGWIDTH.SKETCH \BLTSHADE.1BITSKETCH \NEWPAGE.SKETCH \CHARWIDTH.SKETCH
\BITBLT.1BITSKETCH \DSPCLIPPINGREGION.SKETCH \DSPRESET.SKETCH \DSPSCALE.SKETCH
\DRAWPOLYGON.SKETCH)
(ALISTS (IMAGESTREAMTYPES SKETCH))
(GLOBALVARS SketchFDEV)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\SKETCHSTREAMINIT])
(* contains the functions needed to support sketch streams. Sketch streams allow a user
program to print, draw, etc. to a stream and builds a sketch of the result.)
(DEFINEQ
(INSURE.BRUSH
[LAMBDA (BRUSH) (* rrb "20-Dec-84 13:28")
(* returns a full brush if BRUSH is interpretable as a
brush)
(* for now, just check for numbers.)
(COND
((NUMBERP BRUSH)
(create BRUSH
BRUSHSHAPE ←(QUOTE ROUND)
BRUSHSIZE ← BRUSH
BRUSHCOLOR ← 7))
(T BRUSH])
(OPENSKETCHSTREAM
[LAMBDA (TITLE OPTIONS) (* rrb "20-Dec-84 12:12")
(* opens a stream onto a window that will keep a sketch
of what is displayed there.)
(* changes default alignment to left baseline and
default font to the default font of display device.)
(PROG ((SKW (SKETCHW.CREATE NIL (LISTGET OPTIONS (QUOTE SKETCHREGION))
(LISTGET OPTIONS (QUOTE REGION))
TITLE))) (* changes default alignment to left baseline and
default font to the default font of display device.)
(SK.SET.TEXT.HORIZ.ALIGN SKW (QUOTE LEFT))
[SK.SET.FONT SKW (FONTNAMELIST (DEFAULTFONT (QUOTE DISPLAY]
(RETURN (create STREAM
DEVICE ← SketchFDEV
ACCESS ←(QUOTE OUTPUT)
USERCLOSEABLE ← NIL
OUTCHARFN ←(FUNCTION \BOUT.SKETCH)
IMAGEOPS ← \SKETCHIMAGEOPS
IMAGEDATA ← NIL
F1 ← SKW])
(\SKETCHSTREAM.POSITION.CHANGED
[LAMBDA (SKW) (* called whenever the position of a sketch stream
changes.)
(RESET.LINE.BEING.INPUT SKW)
(SKED.CLEAR.SELECTION SKW])
(\SKETCHSTREAMINIT
[LAMBDA NIL (* rrb " 5-Oct-85 09:50")
(* Initializes global variables for the Sketch device)
(* Sketch Streams are referred to only by themselves
so they do not need directory operations.)
(DECLARE (GLOBALVARS SketchFDEV \SKETCHIMAGEOPS))
(SETQ \SKETCHIMAGEOPS (create IMAGEOPS
IMAGETYPE ←(QUOTE SKETCH)
IMFONT ←(FUNCTION \DSPFONT.SKETCH)
IMLEFTMARGIN ←(FUNCTION \DSPLEFTMARGIN.SKETCH)
IMRIGHTMARGIN ←(FUNCTION \DSPRIGHTMARGIN.SKETCH)
IMLINEFEED ←(FUNCTION \DSPLINEFEED.SKETCH)
IMXPOSITION ←(FUNCTION \DSPXPOSITION.SKETCH)
IMYPOSITION ←(FUNCTION \DSPYPOSITION.SKETCH)
IMCLOSEFN ←(FUNCTION NILL)
IMDRAWCURVE ←(FUNCTION \DRAWCURVE.SKETCH)
IMFILLCIRCLE ←(FUNCTION \FILLCIRCLE.SKETCH)
IMFILLPOLYGON ←(FUNCTION \FILLPOLYGON.SKETCH)
IMDRAWPOLYGON ←(FUNCTION \DRAWPOLYGON.SKETCH)
IMDRAWLINE ←(FUNCTION \DRAWLINE.SKETCH)
IMDRAWELLIPSE ←(FUNCTION \DRAWELLIPSE.SKETCH)
IMDRAWCIRCLE ←(FUNCTION \DRAWCIRCLE.SKETCH)
IMBITBLT ←(FUNCTION \BITBLT.1BITSKETCH)
IMBLTSHADE ←(FUNCTION \BLTSHADE.1BITSKETCH)
IMNEWPAGE ←(FUNCTION \NEWPAGE.SKETCH)
IMSCALE ←(FUNCTION \DSPSCALE.SKETCH)
IMSPACEFACTOR ←(FUNCTION \DSPSPACEFACTOR.DISPLAY)
IMFONTCREATE ←(QUOTE DISPLAY)
IMCOLOR ←(FUNCTION \DSPCOLOR.SKETCH)
IMBACKCOLOR ←(FUNCTION \DSPBACKCOLOR.SKETCH)
IMOPERATION ←(FUNCTION \DSPOPERATION.SKETCH)
IMSTRINGWIDTH ←(FUNCTION \STRINGWIDTH.SKETCH)
IMCHARWIDTH ←(FUNCTION \CHARWIDTH.SKETCH)
IMCLIPPINGREGION ←(FUNCTION \DSPCLIPPINGREGION.SKETCH)
IMRESET ←(FUNCTION \DSPRESET.SKETCH)))
(* Most of the fields in the DisplayDevice are empty
to avoid something bad happening.)
(SETQ SketchFDEV (create FDEV
DEVICENAME ←(QUOTE SKETCH)
RESETABLE ← NIL
RANDOMACCESSP ← NIL
PAGEMAPPED ← NIL
CLOSEFILE ←(FUNCTION NILL)
DELETEFILE ←(FUNCTION NILL)
GETFILEINFO ←(FUNCTION NILL)
OPENFILE ←(FUNCTION [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)
NAME])
READPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
SETFILEINFO ←(FUNCTION NILL)
GENERATEFILES ←(FUNCTION \GENERATENOFILES)
TRUNCATEFILE ←(FUNCTION NILL)
WRITEPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
GETFILENAME ←(FUNCTION [LAMBDA (NAME RECOG FDEV)
NAME])
REOPENFILE ←(FUNCTION [LAMBDA (NAME)
NAME])
EVENTFN ←(FUNCTION NILL)
DIRECTORYNAMEP ←(FUNCTION NILL)
HOSTNAMEP ←(FUNCTION NILL)
BIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BOUT ←(FUNCTION \BOUT.SKETCH)
PEEKBIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BACKFILEPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
BLOCKIN ←(FUNCTION \ILLEGAL.DEVICEOP)
BLOCKOUT ←(FUNCTION \ILLEGAL.DEVICEOP)))
(\DEFINEDEVICE NIL SketchFDEV])
(\SK.SET.FONT
[LAMBDA (FONTDESC SKW) (* rrb "12-Dec-84 08:48")
(* sets the default font from a font descriptor.)
(replace (SKETCHCONTEXT SKETCHFONT) of (WINDOWPROP SKW (QUOTE SKETCHCONTEXT))
with (FONTNAMELIST FONTDESC])
(\SKSTRM.WINDOW.FROM.STREAM
[LAMBDA (SKSTRM) (* rrb "12-Dec-84 08:53")
(* returns the window that is associated with a sketch
stream.)
(fetch (STREAM F1) of SKSTRM])
(ZOOM.SKETCH.STREAM
[LAMBDA (REGION SKSTREAM) (* rrb "18-Jul-85 16:52")
(* changes the part of the sketch seen in a sketch
window.)
(PROG1 (SK.REGION.VIEWED (\SKSTRM.WINDOW.FROM.STREAM SKSTREAM))
(AND REGION (COND
((REGIONP REGION) (* move the sketch region to be the new clipping
region.)
(SKETCH.GLOBAL.REGION.ZOOM (\SKSTRM.WINDOW.FROM.STREAM SKSTREAM)
REGION))
(T (\ILLEGAL.ARG REGION])
)
(* fns to support stream operations on sketches)
(DEFINEQ
(\DSPFONT.SKETCH
[LAMBDA (SKETCHSTREAM FONT) (* rrb " 2-Aug-85 10:12")
(* sets the font that a display stream uses to print
characters. SKETCHSTREAM is guaranteed to be a stream
of type sketch)
(PROG ((SKETCHWINDOW (\SKSTRM.WINDOW.FROM.STREAM SKETCHSTREAM))
RESULT)
(SETQ RESULT (DSPFONT FONT SKETCHWINDOW)) (* if the font was changed, update the current font.)
(COND
(FONT (\SKETCHSTREAM.POSITION.CHANGED SKETCHWINDOW)
(\SK.SET.FONT (DSPFONT NIL SKETCHWINDOW)
SKETCHWINDOW)))
(RETURN RESULT])
(\DSPLEFTMARGIN.SKETCH
[LAMBDA (SKSTRM LEFTMARGIN) (* rrb "21-Dec-84 08:55")
(* version which passed the operation through without
doing anything.)
(DSPLEFTMARGIN LEFTMARGIN (\SKSTRM.WINDOW.FROM.STREAM SKSTRM])
(\DSPRIGHTMARGIN.SKETCH
[LAMBDA (SKSTRM RIGHTMARGIN) (* rrb "21-Dec-84 08:55")
(* version which passed the operation through without
doing anything.)
(DSPRIGHTMARGIN RIGHTMARGIN (\SKSTRM.WINDOW.FROM.STREAM SKSTRM])
(\DSPLINEFEED.SKETCH
[LAMBDA (SKSTRM LINEFEED) (* rrb "21-Dec-84 08:55")
(* version which passed the operation through without
doing anything.)
(DSPLINEFEED LINEFEED (\SKSTRM.WINDOW.FROM.STREAM SKSTRM])
(\DSPXPOSITION.SKETCH
[LAMBDA (SKSTRM XPOSITION) (* rrb " 2-Aug-85 09:26")
(* version which passed the operation through without
doing anything.)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKSTRM))
RESULT)
(SETQ RESULT (DSPXPOSITION XPOSITION SKW))
(AND XPOSITION (\SKETCHSTREAM.POSITION.CHANGED SKW))
(RETURN RESULT])
(\DSPYPOSITION.SKETCH
[LAMBDA (SKSTRM YPOSITION) (* rrb " 2-Aug-85 09:25")
(* version which passed the operation through without
doing anything.)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKSTRM))
RESULT)
(SETQ RESULT (DSPYPOSITION YPOSITION SKW))
(AND YPOSITION (\SKETCHSTREAM.POSITION.CHANGED SKW))
(RETURN RESULT])
(\DRAWCURVE.SKETCH
[LAMBDA (SKSTRM KNOTS CLOSED BRUSH DASHING) (* rrb " 4-Sep-85 16:33")
(* draws a spline curve with a given brush.)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKSTRM)))
(\SKETCHSTREAM.POSITION.CHANGED SKW)
(RETURN (SK.ADD.ELEMENT (SK.CURVE.CREATE KNOTS CLOSED [OR (INSURE.BRUSH BRUSH)
(fetch (SKETCHCONTEXT SKETCHBRUSH)
of (WINDOWPROP SKW
(QUOTE
SKETCHCONTEXT]
[OR DASHING (fetch (SKETCHCONTEXT SKETCHDASHING)
of (WINDOWPROP SKW (QUOTE
SKETCHCONTEXT]
(SK.INPUT.SCALE SKW))
SKW])
(\DRAWCIRCLE.SKETCH
[LAMBDA (SKSTRM CENTERX CENTERY RADIUS BRUSH DASHING) (* rrb " 4-Sep-85 16:33")
(* draws a circle on a sketch stream)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKSTRM))
SKCONTEXT) (* put the radius point on a horzontal line.)
(\SKETCHSTREAM.POSITION.CHANGED SKW)
(SETQ SKCONTEXT (WINDOWPROP SKW (QUOTE SKETCHCONTEXT)))
(RETURN (SK.ADD.ELEMENT (SK.CIRCLE.CREATE (create POSITION
XCOORD ← CENTERX
YCOORD ← CENTERY)
(create POSITION
XCOORD ←(PLUS CENTERX RADIUS)
YCOORD ← CENTERY)
(OR (INSURE.BRUSH BRUSH)
(fetch (SKETCHCONTEXT SKETCHBRUSH)
of SKCONTEXT))
(OR DASHING (fetch (SKETCHCONTEXT SKETCHDASHING)
of SKCONTEXT))
(SK.INPUT.SCALE SKW)
(fetch (SKETCHCONTEXT SKETCHFILLING)
of SKCONTEXT))
SKW])
(\FILLCIRCLE.SKETCH
[LAMBDA (SKSTRM CENTERX CENTERY RADIUS TEXTURE) (* rrb "27-Sep-85 09:25")
(* implements fill circle on a sketch stream.)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKSTRM))) (* put the radius point on a horzontal line.)
(\SKETCHSTREAM.POSITION.CHANGED SKW)
(RETURN (SK.ADD.ELEMENT (SK.CIRCLE.CREATE (create POSITION
XCOORD ← CENTERX
YCOORD ← CENTERY)
(create POSITION
XCOORD ← (PLUS CENTERX RADIUS)
YCOORD ← CENTERY)
(create BRUSH
BRUSHSIZE ← 0)
(fetch (SKETCHCONTEXT SKETCHDASHING)
of (WINDOWPROP SKW (QUOTE SKETCHCONTEXT)))
(SK.INPUT.SCALE SKW)
(SK.INSURE.FILLING TEXTURE))
SKW])
(\FILLPOLYGON.SKETCH
[LAMBDA (SKSTRM KNOTS TEXTURE) (* rrb "26-Sep-85 18:04")
(* implements fill polygon on a sketch stream.)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKSTRM)))
(\SKETCHSTREAM.POSITION.CHANGED SKW) (* add a closed wire element with a filling.)
(RETURN (SK.ADD.ELEMENT (SK.WIRE.CREATE KNOTS (create BRUSH
BRUSHSIZE ← 0)
(fetch (SKETCHCONTEXT SKETCHDASHING)
of (WINDOWPROP SKW (QUOTE SKETCHCONTEXT)))
T
(SK.INPUT.SCALE SKW)
NIL
(SK.INSURE.FILLING TEXTURE SKW))
SKW])
(\DRAWELLIPSE.SKETCH
[LAMBDA (SKSTRM CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING)
(* rrb " 4-Sep-85 16:33")
(* draws an ellipse on a sketch stream)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKSTRM))) (* put the radius point on a horzontal line.)
(\SKETCHSTREAM.POSITION.CHANGED SKW) (* have the major radius be the point on the circle,
the minor one be perpendicular to it.)
(RETURN (SK.ADD.ELEMENT (ELLIPSE.CREATE (create POSITION
XCOORD ← CENTERX
YCOORD ← CENTERY)
[create POSITION
XCOORD ←[PLUS CENTERX
(TIMES SEMIMINORRADIUS
(COS (PLUS ORIENTATION
90]
YCOORD ←(PLUS CENTERY
(TIMES SEMIMINORRADIUS
(SIN (PLUS ORIENTATION
90]
[create POSITION
XCOORD ←(PLUS CENTERX (TIMES
SEMIMAJORRADIUS
(COS
ORIENTATION)))
YCOORD ←(PLUS CENTERY (TIMES
SEMIMAJORRADIUS
(SIN
ORIENTATION]
[OR (INSURE.BRUSH BRUSH)
(fetch (SKETCHCONTEXT SKETCHBRUSH)
of (WINDOWPROP SKW (QUOTE SKETCHCONTEXT]
[OR DASHING (fetch (SKETCHCONTEXT SKETCHDASHING)
of (WINDOWPROP SKW (QUOTE
SKETCHCONTEXT]
(SK.INPUT.SCALE SKW))
SKW])
(\DRAWARC.SKETCH
[LAMBDA (SKSTRM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING)
(* rrb " 4-Oct-85 17:35")
(* draws an ellipse on a sketch stream)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKSTRM))) (* put the radius point on a horzontal line.)
(\SKETCHSTREAM.POSITION.CHANGED SKW) (* have the major radius be the point on the circle,
the minor one be perpendicular to it.)
(RETURN (SK.ADD.ELEMENT (ARC.CREATE (create POSITION
XCOORD ← CENTERX
YCOORD ← CENTERY)
[create POSITION
XCOORD ←(PLUS CENTERX
(TIMES
RADIUS
(COS STARTANGLE)))
YCOORD ←(PLUS CENTERY
(TIMES
RADIUS
(SIN STARTANGLE]
[create POSITION
XCOORD ←[PLUS
CENTERX
(TIMES RADIUS
(COS (PLUS STARTANGLE
NDEGREES]
YCOORD ←(PLUS
CENTERY
(TIMES RADIUS
(SIN (PLUS STARTANGLE
NDEGREES]
[OR (INSURE.BRUSH BRUSH)
(fetch (SKETCHCONTEXT SKETCHBRUSH)
of (WINDOWPROP SKW (QUOTE
SKETCHCONTEXT]
[OR DASHING (fetch (SKETCHCONTEXT
SKETCHDASHING)
of (WINDOWPROP
SKW
(QUOTE SKETCHCONTEXT]
(SK.INPUT.SCALE SKW)
NIL
(LESSP NDEGREES 0))
SKW])
(\DRAWLINE.SKETCH
[LAMBDA (SKETCHSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING)
(* rrb " 4-Sep-85 16:34")
(* draws a line on a sketch stream)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKETCHSTREAM)))
(\SKETCHSTREAM.POSITION.CHANGED SKW)
(RETURN (SK.ADD.ELEMENT (WIRE.INPUTFN SKW (LIST (create POSITION
XCOORD ← X1
YCOORD ← Y1)
(create POSITION
XCOORD ← X2
YCOORD ← Y2))
NIL
(OR WIDTH 1)
(SK.INPUT.SCALE SKW)
DASHING)
SKW])
(\BOUT.SKETCH
[LAMBDA (SKETCHSTREAM CHARCODE) (* rrb " 4-Sep-85 16:34")
(* bout function for the device that makes a sketch)
(* It would be faster to keep the characters until a CR or reset line is done but it it unclear what happens if the
last operation is printing.)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKETCHSTREAM)))
(COND
((NULL (WINDOWPROP SKW (QUOTE SELECTION)))
(SKED.SET.SELECTION (create POSITION
XCOORD ←(DSPXPOSITION NIL SKW)
YCOORD ←(DSPYPOSITION NIL SKW))
SKW)))
(SKED.INSERT (LIST CHARCODE)
SKW
(SK.INPUT.SCALE SKW))
(RETURN CHARCODE])
(\DSPCOLOR.SKETCH
[LAMBDA (SKSTRM COLOR) (* rrb "20-Dec-84 10:53")
(* sketch stream function for changing the color.)
(DSPCOLOR COLOR (\SKSTRM.WINDOW.FROM.STREAM SKSTRM])
(\DSPBACKCOLOR.SKETCH
[LAMBDA (SKSTRM COLOR) (* rrb "20-Dec-84 10:52")
(* sketch stream function for changing the background
color.)
(DSPBACKCOLOR COLOR (\SKSTRM.WINDOW.FROM.STREAM SKSTRM])
(\DSPOPERATION.SKETCH
[LAMBDA (SKSTRM OPERATION) (* rrb "20-Dec-84 10:53")
(* sketch stream function for changing the operation.)
(DSPOPERATION OPERATION (\SKSTRM.WINDOW.FROM.STREAM SKSTRM])
(\STRINGWIDTH.SKETCH
[LAMBDA (SKSTRM STR RDTBL) (* rrb "21-Dec-84 08:56")
(* computes the string width for a sketch stream.)
(* calls the display stream function directly and
probably shouldn't.)
(\STRINGWIDTH.DISPLAY (WINDOWPROP (\SKSTRM.WINDOW.FROM.STREAM SKSTRM)
(QUOTE DSP))
STR RDTBL])
(\BLTSHADE.1BITSKETCH
[LAMBDA (TEXTURE SKETCHSTREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION
CLIPPINGREGION) (* rrb " 4-Sep-85 16:35")
(* implements blt shade for a sketch stream.)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKETCHSTREAM)))
(RETURN (SK.ADD.ELEMENT (SK.BOX.CREATE (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM
WIDTH HEIGHT)
(create BRUSH
BRUSHSIZE ← 0)
NIL
(SK.INPUT.SCALE SKW)
TEXTURE)
SKW])
(\NEWPAGE.SKETCH
[LAMBDA (SKSTRM) (* rrb " 1-Aug-85 11:59")
(* NEWPAGE function for sketch streams.)
(* should probably save the current sketch before
resetting it and if DSPRESET ever resets defaults this
shouldn't.)
(\DSPRESET.SKETCH SKSTRM])
(\CHARWIDTH.SKETCH
[LAMBDA (SKSTRM CHARCODE) (* rrb "21-Dec-84 08:54")
(* computes the character width for a sketch stream.)
(* calls the display stream function directly and
probably shouldn't.)
(\CHARWIDTH.DISPLAY (WINDOWPROP (\SKSTRM.WINDOW.FROM.STREAM SKSTRM)
(QUOTE DSP))
CHARCODE])
(\BITBLT.1BITSKETCH
[LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTSTRM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH
HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT
CLIPPEDSOURCEBOTTOM) (* rrb "14-Mar-85 09:09")
(* handles bitblt to a sketch stream.
Does it by creating a bitmap imageobject.)
(COND
((BITMAPP SOURCEBITMAP) (* only handles simple cases.)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM DESTSTRM))
(BMWIDTH (OR WIDTH (BITMAPWIDTH SOURCEBITMAP)))
(BMHEIGHT (OR HEIGHT (BITMAPHEIGHT SOURCEBITMAP)))
BM)
(SETQ BM (BITMAPCREATE BMWIDTH BMHEIGHT))
(BITBLT SOURCEBITMAP SOURCELEFT SOURCEBOTTOM BM 0 0 WIDTH HEIGHT NIL (QUOTE REPLACE)
NIL)
(SK.ADD.ELEMENT (SK.ELEMENT.FROM.IMAGEOBJ (BITMAPTEDITOBJ BM 1 0)
SKW
(create POSITION
XCOORD ← DESTINATIONLEFT
YCOORD ← DESTINATIONBOTTOM))
SKW)))
(T (\BITBLT.1BITDISPLAY SOURCEBITMAP SOURCELEFT SOURCEBOTTOM (WINDOWPROP (
\SKSTRM.WINDOW.FROM.STREAM DESTSTRM)
(QUOTE DSP))
DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION
TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM])
(\DSPCLIPPINGREGION.SKETCH
[LAMBDA (SKSTRM REGION) (* rrb "18-Jul-85 16:48")
(* sets the clipping region in a sketch stream.)
(DSPCLIPPINGREGION REGION (\SKSTRM.WINDOW.FROM.STREAM SKSTRM])
(\DSPRESET.SKETCH
[LAMBDA (SKSTRM) (* rrb " 9-Jul-85 12:42")
(* reset the properties of a sketch stream.)
(PROG ((W (\SKSTRM.WINDOW.FROM.STREAM SKSTRM))
SKETCH OLDSKETCH)
(SKED.CLEAR.SELECTION W)
[WINDOWPROP W (QUOTE SKETCH)
(SETQ SKETCH (COND
((SETQ OLDSKETCH (WINDOWPROP W (QUOTE SKETCH)))
(* copy properties and defaults from old sketch.)
(create SKETCH using OLDSKETCH SKETCHELTS ← NIL))
(T (SKETCH.CREATE NIL] (* for now, don't reset the defaults other than
position.)
(DSPRESET W)
(\DSPXPOSITION.SKETCH SKSTRM (DSPXPOSITION NIL W))
(\DSPYPOSITION.SKETCH SKSTRM (DSPYPOSITION NIL W))
(WINDOWPROP W (QUOTE SCALE)
INITIAL.SCALE)
(SK.UPDATE.REGION.VIEWED W)
(MAP.SKETCHSPEC.INTO.VIEWER SKETCH W)
(SK.CREATE.HOTSPOT.CACHE W)
(WINDOWPROP W (QUOTE GRIDFACTOR)
(SK.DEFAULT.GRIDFACTOR W))
(WINDOWPROP W (QUOTE USEGRID)
NIL)
(WINDOWPROP W (QUOTE SKETCHCHANGED)
NIL])
(\DSPSCALE.SKETCH
[LAMBDA (SKSTRM SCALE) (* rrb "20-May-85 16:43")
(* returns the scale of a sketch stream.)
(PROG ((SKWINDOW (\SKSTRM.WINDOW.FROM.STREAM SKSTRM))
OLDSCALE)
(RETURN (PROG1 (SETQ OLDSCALE (WINDOW.SCALE SKWINDOW))
(AND SCALE (COND
[(NUMBERP SCALE) (* zoom the current sketch view around the center.)
(* don't redraw if scale is the same.)
(OR (EQP OLDSCALE SCALE)
(PROG [NEWWIDTH NEWHEIGHT (CENTERPT (REGION.CENTER
(SK.REGION.VIEWED
SKWINDOW]
[SETQ NEWWIDTH (TIMES SCALE (WINDOWPROP SKWINDOW
(QUOTE WIDTH]
[SETQ NEWHEIGHT (TIMES SCALE (WINDOWPROP SKWINDOW
(QUOTE HEIGHT]
(SKETCH.GLOBAL.REGION.ZOOM
SKWINDOW
(CREATEREGION (DIFFERENCE (fetch (POSITION XCOORD)
of CENTERPT)
(QUOTIENT NEWWIDTH 2))
(DIFFERENCE (fetch (POSITION YCOORD)
of CENTERPT)
(QUOTIENT NEWHEIGHT 2))
NEWWIDTH NEWHEIGHT]
(T (\ILLEGAL.ARG SCALE])
(\DRAWPOLYGON.SKETCH
[LAMBDA (SKETCHSTREAM POINTS CLOSED BRUSH DASHING) (* rrb "26-Sep-85 18:07")
(* draws a polygon on a sketch stream)
(PROG ((SKW (\SKSTRM.WINDOW.FROM.STREAM SKETCHSTREAM)))
(\SKETCHSTREAM.POSITION.CHANGED SKW)
(RETURN (SK.ADD.ELEMENT (SK.WIRE.CREATE POINTS BRUSH DASHING T (SK.INPUT.SCALE SKW)
NIL NIL)
SKW])
)
(ADDTOVAR IMAGESTREAMTYPES (SKETCH (OPENSTREAM OPENSKETCHSTREAM)
(FONTCREATE \CREATEDISPLAYFONT)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SketchFDEV)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\SKETCHSTREAMINIT)
)
(PUTPROPS SKETCHSTREAM COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1619 8238 (INSURE.BRUSH 1629 . 2131) (OPENSKETCHSTREAM 2133 . 3272) (
\SKETCHSTREAM.POSITION.CHANGED 3274 . 3525) (\SKETCHSTREAMINIT 3527 . 6923) (\SK.SET.FONT 6925 . 7291)
(\SKSTRM.WINDOW.FROM.STREAM 7293 . 7604) (ZOOM.SKETCH.STREAM 7606 . 8236)) (8296 27625 (
\DSPFONT.SKETCH 8306 . 9039) (\DSPLEFTMARGIN.SKETCH 9041 . 9386) (\DSPRIGHTMARGIN.SKETCH 9388 . 9736)
(\DSPLINEFEED.SKETCH 9738 . 10077) (\DSPXPOSITION.SKETCH 10079 . 10584) (\DSPYPOSITION.SKETCH 10586 .
11091) (\DRAWCURVE.SKETCH 11093 . 11879) (\DRAWCIRCLE.SKETCH 11881 . 12984) (\FILLCIRCLE.SKETCH 12986
. 13893) (\FILLPOLYGON.SKETCH 13895 . 14636) (\DRAWELLIPSE.SKETCH 14638 . 16319) (\DRAWARC.SKETCH
16321 . 18037) (\DRAWLINE.SKETCH 18039 . 18745) (\BOUT.SKETCH 18747 . 19569) (\DSPCOLOR.SKETCH 19571
. 19864) (\DSPBACKCOLOR.SKETCH 19866 . 20195) (\DSPOPERATION.SKETCH 20197 . 20506) (
\STRINGWIDTH.SKETCH 20508 . 21022) (\BLTSHADE.1BITSKETCH 21024 . 21656) (\NEWPAGE.SKETCH 21658 . 22126
) (\CHARWIDTH.SKETCH 22128 . 22636) (\BITBLT.1BITSKETCH 22638 . 24074) (\DSPCLIPPINGREGION.SKETCH
24076 . 24386) (\DSPRESET.SKETCH 24388 . 25770) (\DSPSCALE.SKETCH 25772 . 27144) (\DRAWPOLYGON.SKETCH
27146 . 27623)))))
STOP