.
"
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
DisplayMedium subclass:#DeviceDrawable
instanceVariableNames:'device drawableId gcId
realized
deviceFont foreground background'
classVariableNames:'CachedScaledForms CachedScales Lobby'
poolDictionaries:''
category:'Graphics-Support'
!
DeviceDrawable comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.23 1995-06-06 04:05:30 claus Exp $
'!
!DeviceDrawable class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
version
"
$Header: /cvs/stx/stx/libview/Attic/DevDraw.st,v 1.23 1995-06-06 04:05:30 claus Exp $
"
!
documentation
"
I provide the common protocol for any drawable which is associated with a device (i.e. Bitmaps,
Pixmaps, RootWindow and Windows in Xs world, but also postscript printer pages or fax pages).
My instance variables are mainly caching device-related stuff (such as font- and color-Ids)
to avoid needless message traffic. This class is abstract, no direct instances of it
exist in the system.
All real work is done by my device, most drawing requests are simply forwarded to it, others
are simulated by using more basic drawing functions.
The added variables foreground/background are the drawing colors actually
used; these are the real (i.e. non dithered) colors supported by the device.
Direct access to fg/bg is discouraged, since in the future, these may be
totally replaced by paint/bgPaint
(there are some operations and special cases, for which a direct access to
fg/bg makes sense)
Instance variables:
device <Device> the device this drawable is on
drawableId <SmallInteger> my drawableId on the device
gcId <SmallInteger> my gcs ID on the device
realized <Boolean> true if visible (i.e. mapped)
- for bit/pixmaps this is always true
deviceFont <Font> the actual font, currently set in the device
foreground <Color> the device foreground color used for drawing
background <Color> the device background color used for drawing
"
! !
!DeviceDrawable class methodsFor:'initialization'!
initialize
Lobby isNil ifTrue:[
Lobby := Registry new.
]
! !
!DeviceDrawable class methodsFor:'instance creation'!
new
"create a new drawable - take the current display as
its device (for now, this may be changed until the view is
physically created)"
"
'Warning: DeviceDrawables (' print. self name print. ') should not be created with new' printNL.
"
^ self onDevice:Screen current "Display"
!
on:aDevice
"create a new drawable on aDevice"
^ self onDevice:aDevice
!
onDevice:aDevice
"create a new drawable on aDevice"
|newDrawable|
newDrawable := self basicNew.
"
set display before its initialized
- so it can do something useful (i.e. get font sizes etc.) in its
intitialize method(s)
"
newDrawable device:aDevice.
newDrawable initialize.
Lobby register:newDrawable.
^ newDrawable
! !
!DeviceDrawable methodsFor:'instance release'!
disposed
"some Drawable has been collected
- must release operating system resources"
self subclassResponsibility
! !
!DeviceDrawable methodsFor:'initialization'!
initialize
"setup everything for later use; actual work is done in
initColors and initFont, which are usually redefined."
"make certain Workstation is initialized - just a check - will vanish soon"
Display isNil ifTrue:[
'DEVDRAW: Display not initialized when first DeviceDrawable created' errorPrintNL.
Workstation initialize
].
super initialize.
foreground := Black.
background := White.
realized := false
!
createGC
"since we do not need a gc-object for the drawable until something is
really drawn, none is created.
This method is sent, when the first drawing happens"
|fgId bgId p|
gcId := device gcFor:drawableId.
foreground isNil ifTrue:[foreground := Black].
background isNil ifTrue:[background := White].
foreground isColor ifTrue:[
"get device colors from the device indep. colors"
foreground := foreground on:device.
fgId := foreground colorId.
fgId isNil ifTrue:[
(foreground greyIntensity >= 50) ifTrue:[
fgId := device whitepixel
] ifFalse:[
fgId := device blackpixel
]
].
] ifFalse:[
fgId := device blackpixel.
].
background isColor ifTrue:[
background := background on:device.
bgId := background colorId.
bgId isNil ifTrue:[
(background greyIntensity >= 50) ifTrue:[
bgId := device whitepixel
] ifFalse:[
bgId := device blackpixel
]
].
] ifFalse:[
bgId := device whitepixel
].
"now, this is something the device can work with ..."
device setForeground:fgId background:bgId in:gcId.
"switch to paint"
p := paint.
paint := nil.
self paint:p.
((lineWidth ~~ 0)
or:[(lineStyle ~~ #solid)
or:[(capStyle ~~ #butt)
or:[joinStyle ~~ #miter]]]) ifTrue:[
device setLineWidth:lineWidth
style:lineStyle
cap:capStyle
join:joinStyle
in:gcId
].
mask notNil ifTrue:[
(mask depth == 1) ifTrue:[
device setBitmapMask:(mask id) in:gcId
] ifFalse:[
device setPixmapMask:(mask id) in:gcId
].
maskOrigin notNil ifTrue:[
device setMaskOriginX:maskOrigin x y:maskOrigin y in:gcId
]
].
(function ~~ #copy) ifTrue:[device setFunction:function in:gcId].
"defer the getting of a device font
- this is now done when the first drawstring occurs,
since many views (layout-views) will never draw strings and
therefore, the overhead of aquiring a font can be avoided.
"
"
font := font on:device.
id := font fontId.
id notNil ifTrue:[
device setFont:id in:gcId
]
"
!
initGC
"since we do not need a gc-object for the drawable until something is
really drawn, none is created.
This method is sent, when the first drawing happens"
self createGC.
Lobby changed:self.
!
destroy
"when the drawable is destroyed, the associated GC must be destroyed with it"
gcId notNil ifTrue:[
device destroyGC:gcId.
gcId := nil.
Lobby changed:self.
]
!
recreate
"sent after a snapin, reinit draw stuff for new device"
gcId := nil.
foreground notNil ifTrue:[
foreground := foreground on:device
].
background notNil ifTrue:[
background := background on:device
].
paint notNil ifTrue:[
paint := paint on:device
].
bgPaint notNil ifTrue:[
bgPaint := bgPaint on:device
]
!
prepareForReinit
"kludge - clear drawableId and gcId
needed after snapin"
gcId := nil.
drawableId := nil.
deviceFont := nil
!
reinitialize
'reinit of ' errorPrint. self classNameWithArticle errorPrint.
' failed' errorPrintNL
! !
!DeviceDrawable methodsFor:'accessing'!
setDevice:aDevice id:aDrawbleId gcId:aGCId
"private"
device := aDevice.
gcId := aGCId.
drawableId := aDrawbleId
!
device
"return the device, the receiver is associated with"
^ device
!
device:aDevice
"set the device"
device := aDevice
!
id
"return the id of the dravable on the device"
^ drawableId
!
gcId
"return the receivers graphic context id on the device"
^ gcId
!
paint:aColor
"set the drawing color, which may be a real color, a dithered one
or even an image."
|dither map pixelId p|
"/ (aColor ~~ paint) ifTrue:[
aColor notNil ifTrue:[
paint := aColor.
gcId notNil ifTrue:[
paint isColor ifTrue:[
paint := paint on:device.
pixelId := paint colorId.
pixelId notNil ifTrue:[
"
a real (undithered) color
"
mask notNil ifTrue:[
mask := nil.
device setBitmapMask:nil in:gcId
].
(paint ~~ foreground) ifTrue:[
foreground := paint.
device setForeground:pixelId in:gcId
].
^ self
].
"a dithered color"
dither := paint ditherForm.
] ifFalse:[
"mhmh - seems to be some kind of form ..."
paint := paint on:device.
dither := paint
].
"
a dithered color or image
"
(dither depth == 1) ifTrue:[
"a simple 0/1 bitmap"
map := dither colorMap.
"temporary (kludgy) fix for destroyed paint"
p := paint.
map isNil ifTrue:[
self foreground:Color black background:Color white.
] ifFalse:[
self foreground:(map at:2) background:(map at:1).
].
paint := p
] ifFalse:[
(dither depth ~~ device depth) ifTrue:[
dither := dither asFormOn:device.
(dither isNil or:[dither depth ~~ device depth]) ifTrue:[
self error:'bad dither'.
^ self
]
]
].
self mask:dither.
self setMaskOriginX:self viewOrigin x negated
y:self viewOrigin y negated
]
]
"/ ]
!
paint:fgColor on:bgColor
"set the paint and background-paint color.
The bg-paint is used in opaque-draw operations"
|fgId bgId|
((fgColor ~~ paint) or:[bgColor ~~ bgPaint]) ifTrue:[
fgColor notNil ifTrue:[
paint := fgColor
].
bgColor notNil ifTrue:[
bgPaint := bgColor
].
gcId notNil ifTrue:[
paint := paint on:device.
paint isColor ifTrue:[
fgId := paint colorId.
fgId notNil ifTrue:[
mask notNil ifTrue:[
mask := nil.
device setBitmapMask:nil in:gcId
].
bgPaint := bgPaint on:device.
bgPaint isColor ifTrue:[
bgId := bgPaint colorId.
bgId notNil ifTrue:[
"the common case, both are real colors"
(paint ~~ foreground) ifTrue:[
foreground := paint.
(bgPaint ~~ background) ifTrue:[
background := bgPaint.
device setForeground:fgId background:bgId in:gcId.
^ self
].
device setForeground:fgId in:gcId.
^ self
].
(bgPaint ~~ background) ifTrue:[
background := bgPaint.
device setBackground:bgId in:gcId.
].
^ self
].
"bgPaint is dithered, setup paint here, leave bgPaint
till next opaque draw comes around."
(paint ~~ foreground) ifTrue:[
foreground := paint.
device setForeground:fgId in:gcId
].
^ self
]
]
].
"either paint or bgPaint (or both) are dithered colors,
setup for paint, leave bg-problem till next opaque draw
comes around.
"
self paint:paint
]
]
!
backgroundPaint:aColor
"set the background-paint color; this is used in opaque-draw
operations"
(aColor ~~ bgPaint) ifTrue:[
aColor notNil ifTrue:[
bgPaint := aColor.
gcId notNil ifTrue:[
bgPaint isColor ifTrue:[
bgPaint := aColor on:device.
bgPaint colorId notNil ifTrue:[
background := bgPaint.
device setBackground:(bgPaint colorId) in:drawableId.
^ self
]
].
self paint:paint on:aColor
]
]
].
!
paint:fgColor on:bgColor function:f
"set paint, background-paint and function"
self paint:fgColor on:bgColor .
self function:f
!
foreground
"return the current foreground drawing color.
OBSOLETE: use paint:/paint:on:"
^ foreground
!
foreground:aColor
"set the internal foreground color for drawing - aColor must be a real color.
OBSOLETE: this method will vanish; use paint:/paint:on:"
|fgId|
(aColor ~~ foreground) ifTrue:[
aColor notNil ifTrue:[
foreground := aColor.
gcId notNil ifTrue:[
(foreground isMemberOf:SmallInteger) ifTrue:[
fgId := foreground
] ifFalse:[
foreground := foreground on:device.
fgId := foreground colorId.
].
"mhmh the following is a kludge ...."
fgId isNil ifTrue:[
(foreground greyIntensity >= 50) ifTrue:[
fgId := device whitepixel
] ifFalse:[
fgId := device blackpixel
]
].
device setForeground:fgId in:gcId.
paint := foreground
]
]
]
!
background
"return the current background drawing color.
OBSOLETE: use paint:/paint:on:"
^ background
!
background:aColor
"set the internal background color for drawing - aColor must be a real color.
OBSOLETE: this method will vanish; use paint:/paint:on:"
|bgId|
(aColor ~~ background) ifTrue:[
aColor notNil ifTrue:[
background := aColor.
gcId notNil ifTrue:[
background := background on:device.
bgId := background colorId.
"
mhmh the following is a kludge ....
"
bgId isNil ifTrue:[
(background greyIntensity >= 50) ifTrue:[
bgId := device whitepixel
] ifFalse:[
bgId := device blackpixel
]
].
device setBackground:bgId in:gcId
]
]
]
!
foreground:fgColor background:bgColor
"set both internal foreground and internal background colors
- these must be real colors.
OBSOLETE: this method will vanish; use paint:/paint:on:"
|fgPixel bgPixel|
((fgColor ~~ foreground) or:[bgColor ~~ background]) ifTrue:[
fgColor notNil ifTrue:[
foreground := fgColor
].
bgColor notNil ifTrue:[
background := bgColor
].
gcId notNil ifTrue:[
foreground := foreground on:device.
background := background on:device.
fgPixel := foreground colorId.
bgPixel := background colorId.
"mhmh the following is a kludge ...."
fgPixel isNil ifTrue:[
(foreground greyIntensity >= 50) ifTrue:[
fgPixel := device whitepixel
] ifFalse:[
fgPixel := device blackpixel
]
].
bgPixel isNil ifTrue:[
(background greyIntensity >= 50) ifTrue:[
bgPixel := device whitepixel
] ifFalse:[
bgPixel := device blackpixel
]
].
device setForeground:fgPixel background:bgPixel in:gcId.
paint := foreground
]
]
!
function:aSymbol
"set the drawing function if it has changed"
(aSymbol ~~ function) ifTrue:[
function := aSymbol.
gcId notNil ifTrue:[
device setFunction:aSymbol in:gcId
]
]
!
foreground:aColor function:fun
"set the foreground color and function for drawing.
OBSOLETE: this method will vanish; use paint:/paint:on:"
|fgPixel|
((aColor ~~ foreground) or:[fun ~~ function]) ifTrue:[
foreground := aColor.
function := fun.
gcId notNil ifTrue:[
foreground := foreground on:device.
fgPixel := foreground colorId.
"mhmh the following is a kludge ...."
fgPixel isNil ifTrue:[
(foreground greyIntensity >= 50) ifTrue:[
fgPixel := device whitepixel
] ifFalse:[
fgPixel := device blackpixel
]
].
device setForeground:fgPixel in:gcId.
device setFunction:fun in:gcId.
paint := foreground
]
]
!
foreground:fgColor background:bgColor function:fun
"set foreground, background colors and function.
OBSOLETE: this method will vanish; use paint:/paint:on:"
self foreground:fgColor background:bgColor.
self function:fun
!
lineWidth:aNumber
"set the line width for drawing if it has changed"
|n|
(aNumber ~~ lineWidth) ifTrue:[
lineWidth := aNumber.
transformation isNil ifTrue:[
n := aNumber.
] ifFalse:[
n := transformation applyScaleX:aNumber.
n := n rounded
].
gcId notNil ifTrue:[
device setLineWidth:n
style:lineStyle
cap:capStyle
join:joinStyle
in:gcId
]
]
!
lineStyle:aSymbol
"set the style in which lines are drawn -
aSymbol may be #solid, #dashed, #doubleDashed"
(aSymbol ~~ lineStyle) ifTrue:[
lineStyle := aSymbol.
gcId notNil ifTrue:[
device setLineWidth:lineWidth
style:aSymbol
cap:capStyle
join:joinStyle
in:gcId
]
]
!
capStyle:aSymbol
"set the style in which the endpoints of lines
are drawn - aSymbol may be #notLast, #butt, #round, #projecting"
(aSymbol ~~ capStyle) ifTrue:[
capStyle := aSymbol.
gcId notNil ifTrue:[
device setLineWidth:lineWidth
style:lineStyle
cap:aSymbol
join:joinStyle
in:gcId
]
]
!
joinStyle:aSymbol
"set the style in which 2 lines are connected in polygons -
aSymbol may be #miter, #bevel, #round"
(aSymbol ~~ joinStyle) ifTrue:[
joinStyle := aSymbol.
gcId notNil ifTrue:[
device setLineWidth:lineWidth
style:lineStyle
cap:capStyle
join:aSymbol
in:gcId
]
]
!
font:aFont
"set the font for drawing if it has changed"
|id|
(aFont ~~ font) ifTrue:[
aFont notNil ifTrue:[
font := aFont.
gcId notNil ifTrue:[
font := font on:device.
id := font fontId.
id notNil ifTrue:[
device setFont:id in:gcId
]
]
]
]
!
mask:aForm
"set the mask form for drawing"
(aForm ~~ mask) ifTrue:[
mask := aForm.
gcId notNil ifTrue:[
(mask == nil) ifTrue:[
device setBitmapMask:nil in:gcId
] ifFalse:[
(mask depth == 1) ifTrue:[
device setBitmapMask:(aForm id) in:gcId
] ifFalse:[
device setPixmapMask:(aForm id) in:gcId
]
]
]
]
!
setMaskOrigin:aPoint
"set the origin of the fill pattern"
(maskOrigin isNil or:[maskOrigin ~= aPoint]) ifTrue:[
transformation isNil ifTrue:[
maskOrigin := aPoint.
] ifFalse:[
maskOrigin := transformation applyTo:aPoint
].
gcId notNil ifTrue:[
device setMaskOriginX:maskOrigin x rounded
y:maskOrigin y rounded
in:gcId
]
]
!
setMaskOriginX:orgX y:orgY
"set the origin of the pattern"
|x y|
transformation notNil ifTrue:[
x := transformation applyToX:orgX.
y := transformation applyToY:orgY.
] ifFalse:[
x := orgX.
y := orgY
].
(x isMemberOf:SmallInteger) ifFalse:[
x := x rounded
].
(y isMemberOf:SmallInteger) ifFalse:[
y := y rounded
].
(maskOrigin isNil or:[
((x ~~ maskOrigin x) or:[y ~~ maskOrigin y]) ]) ifTrue:[
maskOrigin := x @ y.
gcId notNil ifTrue:[
device setMaskOriginX:x y:y in:gcId
]
]
!
clipRect:aRectangle
"set the clipping rectangle for drawing (in logical coordinates);
a nil argument turn off clipping (i.e. whole view is drawable)"
|x y w h|
aRectangle isNil ifTrue:[
clipRect isNil ifTrue:[^ self].
gcId notNil ifTrue:[
device noClipIn:gcId
]
] ifFalse:[
clipRect notNil ifTrue:[
(clipRect = aRectangle) ifTrue:[^ self]
].
gcId notNil ifTrue:[
x := aRectangle left.
y := aRectangle top.
w := aRectangle width.
h := aRectangle height.
transformation notNil ifTrue:[
x := transformation applyToX:x.
y := transformation applyToY:y.
w := transformation applyScaleX:w.
h := transformation applyScaleY:h.
].
(x isMemberOf:SmallInteger) ifFalse:[
w := w + (x - x truncated).
x := x truncated
].
(y isMemberOf:SmallInteger) ifFalse:[
h := h + (y - y truncated).
y := y truncated
].
(w isMemberOf:SmallInteger) ifFalse:[
w := w truncated + 1
].
(h isMemberOf:SmallInteger) ifFalse:[
h := h truncated + 1
].
device setClipX:x y:y width:w height:h in:gcId
]
].
clipRect := aRectangle
!
clipRect
"return the clipping rectangle for drawing"
|rect|
clipRect isNil ifTrue:[
rect := 0@0 extent:width@height.
transformation notNil ifTrue:[
rect := transformation applyInverseTo:rect.
].
^ rect
].
^ clipRect
!
setGraphicsExposures:aBoolean
"want to if aBoolean is true - or dont want to be notified
of graphics exposures"
gcId notNil ifTrue:[
device setGraphicsExposures:aBoolean in:gcId
]
!
at:aPoint
"return the pixel at the coordinate given by aPoint"
^ device
getPixelX:(aPoint x)
y:(aPoint y)
from:drawableId
!
at:aPoint put:aPixel
"set a pixel"
|oldFg|
oldFg := foreground.
self foreground:aPixel.
self displayPointX:(aPoint x) y:(aPoint y).
self foreground:oldFg
! !
!DeviceDrawable methodsFor:'copying'!
postCopy
"this may not be enough to allow copying of views ..."
super postCopy.
device := drawableId := gcId := nil.
realized := false.
self recreate
! !
!DeviceDrawable methodsFor:'queries'!
horizontalPixelPerMillimeter:millis
"return the number of pixels (not rounded) for millis millimeter"
^ device horizontalPixelPerMillimeter * millis
!
verticalPixelPerMillimeter:millis
"return the number of pixels (not rounded) for millis millimeter"
^ device verticalPixelPerMillimeter * millis
!
horizontalPixelPerMillimeter
"return the number of pixels per millimeter (not rounded)"
^ device horizontalPixelPerMillimeter
!
verticalPixelPerMillimeter
"return the number of pixels per millimeter (not rounded)"
^ device verticalPixelPerMillimeter
!
horizontalIntegerPixelPerMillimeter
"return the (rounded) number of pixels per millimeter"
^ device horizontalPixelPerMillimeter rounded
!
verticalIntegerPixelPerMillimeter
"return the (rounded) number of pixels per millimeter"
^ device verticalPixelPerMillimeter rounded
!
horizontalPixelPerInch
"return the number of horizontal pixels per inch of the display"
^ device horizontalPixelPerMillimeter * 25.4
!
verticalPixelPerInch
"return the number of vertical pixels per inch of the display"
^ device verticalPixelPerMillimeter * 25.4
! !
!DeviceDrawable methodsFor:'evaluating in another context'!
withForeground:fgColor do:aBlock
"evaluate aBlock with changed foreground."
|oldFg|
oldFg := foreground.
self foreground:fgColor.
aBlock value.
self foreground:oldFg
!
withBackground:fgColor do:aBlock
"evaluate aBlock with changed background."
|oldBg|
oldBg := background.
self background:fgColor.
aBlock value.
self background:oldBg
!
withForeground:fgColor background:bgColor do:aBlock
"evaluate aBlock with changed foreground and background."
|oldFg oldBg|
oldFg := foreground.
oldBg := background.
self foreground:fgColor background:bgColor.
aBlock value.
self foreground:oldFg background:oldBg
!
withForeground:fgColor function:aFunction do:aBlock
"evaluate aBlock with changed foreground and function."
|oldFg oldFun|
oldFg := foreground.
oldFun := function.
self foreground:fgColor background:background function:aFunction.
aBlock value.
self foreground:oldFg background:background function:oldFun
!
withForeground:fgColor background:bgColor mask:aMask do:aBlock
"evaluate aBlock with foreground, background and mask"
|oldFg oldBg oldMask|
oldFg := foreground.
oldBg := background.
oldMask := mask.
self foreground:fgColor background:bgColor.
self mask:aMask.
aBlock value.
self foreground:oldFg background:oldBg.
self mask:oldMask
!
withForeground:fgColor background:bgColor function:aFunction do:aBlock
"evaluate aBlock with foreground, background and function"
|oldFg oldBg oldFun|
oldFg := foreground.
oldBg := background.
oldFun := function.
self foreground:fgColor background:bgColor function:aFunction.
aBlock value.
self foreground:oldFg background:oldBg function:oldFun
!
reverseDo:aBlock
"evaluate aBlock with foreground and background interchanged.
This can be reimplemented here in a faster way."
|oldFg oldBg|
oldFg := foreground on:device.
oldBg := background on:device.
self foreground:background background:foreground.
aBlock value.
self foreground:oldFg background:oldBg
!
xoring:aBlock
"evaluate aBlock with function xoring"
|fgPixel bgPixel oldFunction|
fgPixel := (Black on:device) colorId.
bgPixel := (White on:device) colorId.
gcId isNil ifTrue:[
self initGC
].
oldFunction := function.
device setForeground:(fgPixel bitXor:bgPixel)
background:bgPixel
in:gcId.
device setFunction:#xor in:gcId.
aBlock value.
paint := nil. "invalidate"
foreground := Black.
background := White.
device setForeground:fgPixel
background:bgPixel
in:gcId.
device setFunction:oldFunction in:gcId.
function := oldFunction
! !
!DeviceDrawable methodsFor:'drawing'!
displayUnscaledString:aString x:x y:y
"draw a string at the transformed coordinate x/y but do not scale the font.
draw foreground-pixels only (in current paint-color), leaving background as-is."
|pX pY|
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
] ifFalse:[
pX := x.
pY := y.
].
self displayDeviceString:aString from:1 to:(aString size) in:font x:pX y:pY
!
displayUnscaledString:aString from:index1 to:index2 x:x y:y
"draw a substring at the transformed coordinate x/y but do not scale the font.
draw foreground-pixels only (in current paint-color), leaving background as-is."
|pX pY|
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
] ifFalse:[
pX := x.
pY := y.
].
self displayDeviceString:aString from:index1 to:index2 in:font x:pX y:pY
!
displayUnscaledOpaqueString:aString x:x y:y
"draw a string at the transformed coordinate x/y but do not scale the font.
Draw foreground pixels in paint-color, background pixels in bgPaint color."
|pX pY|
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
] ifFalse:[
pX := x.
pY := y.
].
self displayDeviceOpaqueString:aString from:1 to:(aString size) in:font x:pX y:pY
!
displayUnscaledOpaqueString:aString from:index1 to:index2 x:x y:y
"draw a substring at the transformed coordinate x/y but do not scale the font.
Draw foreground pixels in paint-color, background pixels in bgPaint color."
|pX pY|
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
] ifFalse:[
pX := x.
pY := y.
].
self displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:pX y:pY
!
displayString:aString x:x y:y
"draw a string at the coordinate x/y -
draw foreground-pixels only (in current paint-color),
leaving background as-is. If the transformation involves scaling,
the fonts point-size is scaled as appropriate."
|id pX pY fontUsed|
"hook for non-strings (i.e. attributed text)"
aString isString ifFalse:[
^ aString displayOn:self x:x y:y
].
gcId isNil ifTrue:[
self initGC
].
fontUsed := font.
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
transformation scale ~= 1 ifTrue:[
fontUsed := font size:(transformation applyScaleY:font size) rounded.
]
] ifFalse:[
pX := x.
pY := y.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
fontUsed := fontUsed on:device.
id := fontUsed fontId.
id isNil ifTrue:[
"hook for alien fonts"
fontUsed displayString:aString x:x y:y in:self
] ifFalse:[
deviceFont ~~ fontUsed ifTrue:[
device setFont:id in:gcId.
deviceFont := fontUsed
].
device displayString:aString x:pX y:pY in:drawableId with:gcId
]
!
displayString:aString from:index1 to:index2 x:x y:y
"draw a substring at the coordinate x/y -
draw foreground-pixels only (in current paint-color),
leaving background as-is. If the transformation involves scaling,
the fonts point-size is scaled as appropriate."
|id pX pY fontUsed|
"hook for non-strings (i.e. attributed text)"
aString isString ifFalse:[
^ aString displayOn:self x:x y:y from:index1 to:index2
].
gcId isNil ifTrue:[
self initGC
].
fontUsed := font.
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
transformation scale ~= 1 ifTrue:[
fontUsed := font size:(transformation applyScaleY:font size) rounded.
]
] ifFalse:[
pX := x.
pY := y.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
fontUsed := fontUsed on:device.
id := fontUsed fontId.
id isNil ifTrue:[
"hook for alien fonts"
font displayString:aString from:index1 to:index2 x:x y:y in:self.
^ self
].
deviceFont ~~ fontUsed ifTrue:[
device setFont:id in:gcId.
deviceFont := fontUsed
].
device displayString:aString from:index1 to:index2
x:pX y:pY in:drawableId with:gcId
!
displayOpaqueString:aString x:x y:y
"draw a string at the coordinate x/y - draw foreground pixels in paint-color,
background pixels in bgPaint color. If the transformation involves scaling,
the fonts point-size is scaled as appropriate.
Assuming that device can only draw in device colors, we have to handle
the case where paint and/or bgPaint are dithered colors or images."
|id easy fgId bgId pX pY fontUsed|
"
if backgroundPaint color is nil, we assume
this is a non-opaque draw
"
bgPaint isNil ifTrue:[
self displayString:aString x:x y:y.
^ self
].
aString isString ifFalse:[
"
hook for non-strings (i.e. attributed text)
that 'thing' should know how to display itself ...
"
aString displayOpaqueOn:self x:x y:y from:1 to:(aString size).
^ self
].
"
if bgPaint or paint is not a real Color, we have to do it the hard way ...
"
easy := true.
paint isColor ifFalse:[
easy := false
] ifTrue:[
fgId := paint colorId.
fgId isNil ifTrue:[
easy := false
]
].
bgPaint isColor ifFalse:[
easy := false
] ifTrue:[
bgId := bgPaint colorId.
bgId isNil ifTrue:[
easy := false
]
].
easy ifFalse:[
"
for the hard case, use the general drawing method
(no need for optimizations - its slow anyway)
"
self displayOpaqueString:aString
from:1 to:(aString size)
x:x y:y.
^ self
].
gcId isNil ifTrue:[
self initGC
].
fontUsed := font.
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
transformation scale ~= 1 ifTrue:[
fontUsed := font size:(transformation applyScaleY:font size) rounded.
]
] ifFalse:[
pX := x.
pY := y.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
fontUsed := fontUsed on:device.
id := fontUsed fontId.
id isNil ifTrue:[
"
hook for alien fonts
that 'font' should know how to display the string ...
"
fontUsed displayOpaqueString:aString from:1 to:(aString size) x:x y:y in:self.
^ self
].
deviceFont ~~ fontUsed ifTrue:[
device setFont:id in:gcId.
deviceFont := fontUsed
].
device setForeground:fgId background:bgId in:gcId.
foreground := paint.
background := bgPaint.
device displayOpaqueString:aString
x:pX y:pY
in:drawableId with:gcId.
!
displayOpaqueString:aString from:index1 to:index2 x:x y:y
"draw a substring at the coordinate x/y - draw foreground pixels in
paint-color and background pixels in bgPaint-color.
If the transformation involves scaling,
the fonts point-size is scaled as appropriate.
Assuming that device can only draw in device colors, we have to handle
the case where paint and/or bgPaint are dithered colors"
|easy w h savedPaint fgId bgId
id pX pY fontUsed|
"
if backgroundPaint color is nil, we assume
this is a non-opaque draw
"
bgPaint isNil ifTrue:[
self displayString:aString from:index1 to:index2 x:x y:y.
^ self
].
aString isString ifFalse:[
"
hook for non-strings (i.e. attributed text)
that 'thing' should know how to display itself ...
"
aString displayOpaqueOn:self x:x y:y from:index1 to:index2.
^ self
].
gcId isNil ifTrue:[
self initGC
].
fontUsed := font.
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
transformation scale ~= 1 ifTrue:[
fontUsed := font size:(transformation applyScaleY:font size) rounded.
]
] ifFalse:[
pX := x.
pY := y.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
fontUsed := fontUsed on:device.
id := fontUsed fontId.
id isNil ifTrue:[
"
hook for alien fonts
that 'font' should know how to display the string ...
"
fontUsed displayOpaqueString:aString from:index1 to:index2 x:x y:y in:self.
^ self
].
"
if bgPaint or paint is not a real Color, we have to do it the hard way ...
"
easy := true.
paint isColor ifFalse:[
easy := false
] ifTrue:[
fgId := paint colorId.
fgId isNil ifTrue:[
easy := false
]
].
bgPaint isColor ifFalse:[
easy := false
] ifTrue:[
bgId := bgPaint colorId.
bgId isNil ifTrue:[
easy := false
]
].
easy ifTrue:[
deviceFont ~~ fontUsed ifTrue:[
device setFont:id in:gcId.
deviceFont := fontUsed
].
device setForeground:fgId background:bgId in:gcId.
foreground := paint.
background := bgPaint.
device displayOpaqueString:aString
from:index1 to:index2
x:pX y:pY
in:drawableId with:gcId.
^ self
].
w := fontUsed widthOf:aString from:index1 to:index2.
h := fontUsed height.
(fgId notNil and:[function == #copy]) ifTrue:[
deviceFont ~~ fontUsed ifTrue:[
device setFont:id in:gcId.
deviceFont := fontUsed
].
"
only bg is dithered; fill with bg first ...
"
savedPaint := paint.
self paint:bgPaint.
self fillDeviceRectangleX:pX y:(pY - fontUsed ascent) width:w height:h.
self paint:savedPaint.
"
then draw using fgPaint (which is a real color)
"
device displayString:aString
from:index1 to:index2
x:pX y:pY
in:drawableId with:gcId.
^ self
].
self displayDeviceOpaqueString:aString from:index1 to:index2 in:fontUsed x:pX y:pY.
!
displayPointX:x y:y
"draw a point (with current paint-color); apply transformation if nonNil"
|pX pY|
gcId isNil ifTrue:[
self initGC
].
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
] ifFalse:[
pX := x.
pY := y
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
device displayPointX:pX y:pY in:drawableId with:gcId
!
displayLineFromX:x0 y:y0 toX:x1 y:y1
"draw a line (with current paint-color); apply transformation if nonNil"
|pX0 pY0 pX1 pY1|
gcId isNil ifTrue:[
self initGC
].
transformation notNil ifTrue:[
pX0 := transformation applyToX:x0.
pY0 := transformation applyToY:y0.
pX1 := transformation applyToX:x1.
pY1 := transformation applyToY:y1.
] ifFalse:[
pX0 := x0.
pY0 := y0.
pX1 := x1.
pY1 := y1
].
(pX0 isMemberOf:SmallInteger) ifFalse:[
pX0 := pX0 rounded
].
(pY0 isMemberOf:SmallInteger) ifFalse:[
pY0 := pY0 rounded
].
(pX1 isMemberOf:SmallInteger) ifFalse:[
pX1 := pX1 rounded
].
(pY1 isMemberOf:SmallInteger) ifFalse:[
pY1 := pY1 rounded
].
device displayLineFromX:pX0 y:pY0 toX:pX1 y:pY1 in:drawableId with:gcId
!
displayRectangleX:x y:y width:w height:h
"draw a rectangle (with current paint-color).
If transformation is nonNil, drawing is in logical coordinates."
|pX pY nW nH|
gcId isNil ifTrue:[
self initGC
].
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
nW := transformation applyScaleX:w.
nH := transformation applyScaleY:h.
nW < 0 ifTrue:[
nW := nW abs.
pX := pX - nW.
].
nH < 0 ifTrue:[
nH := nH abs.
pY := pY - nH.
].
] ifFalse:[
pX := x.
pY := y.
nW := w.
nH := h
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
(nW isMemberOf:SmallInteger) ifFalse:[
nW := nW rounded
].
(nH isMemberOf:SmallInteger) ifFalse:[
nH := nH rounded
].
"I asked myself many times if we should draw w/h or (w-1)/(h-1) bits -
this one seems mathematically incorrect but allows to draw and fill
a rectangle using the same extents.
I'm not certain if is the right thing to do ...
"
device displayRectangleX:pX y:pY
width:(nW - 1) height:(nH - 1)
in:drawableId with:gcId
!
displayPolygon:aPolygon
"draw (the outline of) a polygon (with current paint-color).
Apply transformation if nonNil"
|newPolygon|
gcId isNil ifTrue:[
self initGC
].
transformation notNil ifTrue:[
newPolygon := aPolygon collect:[:point | transformation applyTo:point].
] ifFalse:[
newPolygon := aPolygon
].
(newPolygon findFirst:[:p |
(p isPoint not
or:[(p x isMemberOf:SmallInteger) not
or:[(p y isMemberOf:SmallInteger) not]])
]) ~~ 0 ifTrue:[
newPolygon := newPolygon collect:[:p | p asPoint rounded]
].
device displayPolygon:newPolygon in:drawableId with:gcId
!
displayArcX:x y:y w:w h:h from:startAngle angle:angle
"draw an arc; apply transformation if nonNil"
|pX pY nW nH|
gcId isNil ifTrue:[
self initGC
].
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
nW := transformation applyScaleX:w.
nH := transformation applyScaleY:h.
nW < 0 ifTrue:[
nW := nW abs.
pX := pX - nW.
].
nH < 0 ifTrue:[
nH := nH abs.
pY := pY - nH.
].
] ifFalse:[
pX := x.
pY := y.
nW := w.
nH := h.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
(nW isMemberOf:SmallInteger) ifFalse:[
nW := nW rounded
].
(nH isMemberOf:SmallInteger) ifFalse:[
nH := nH rounded
].
device
displayArcX:pX y:pY
w:nW h:nH
from:startAngle angle:angle
in:drawableId with:gcId
!
displayUnscaledForm:formToDraw x:x y:y
"draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
current paint-color, leaving pixels with 0-bits unchanged
(i.e. only 1-bits are drawn from the form).
If its a deep form (i.e. a pixmap) the current paint
settings are ignored and the form is drawn as-is.
Care must be taken, that the paint color is correctly allocated
(by sending #on: to the color) before doing so.
Using functions other than #copy only makes sense if you are
certain, that the colors are real colors (actually, only for
noColor or allColor).
The origins coordinate is transformed, but the image itself is unscaled."
|w h pX pY nW nH|
w := formToDraw width.
h := formToDraw height.
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
transformation scale ~= 1 ifTrue:[
nW := (transformation applyScaleX:w) rounded.
nH := (transformation applyScaleY:h) rounded.
] ifFalse:[
nW := w.
nH := h.
]
] ifFalse:[
pX := x.
pY := y.
nW := w.
nH := h.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
self displayDeviceForm:formToDraw x:pX y:pY
!
displayUnscaledOpaqueForm:formToDraw x:x y:y
"draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
current paint-color, 0 bits in background color.
If its a deep form (i.e. a pixmap) the current paint
settings are ignored and the form is drawn as-is (opaque).
The origins coordinate is transformed, but the image itself is unscaled."
|w h pX pY nW nH|
w := formToDraw width.
h := formToDraw height.
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
transformation scale ~= 1 ifTrue:[
nW := (transformation applyScaleX:w) rounded.
nH := (transformation applyScaleY:h) rounded.
] ifFalse:[
nW := w.
nH := h.
]
] ifFalse:[
pX := x.
pY := y.
nW := w.
nH := h.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
self displayDeviceOpaqueForm:formToDraw x:pX y:pY
!
displayForm:formToDraw x:x y:y
"draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
current paint-color, leaving pixels with 0-bits unchanged
(i.e. only 1-bits are drawn from the form).
If its a deep form (i.e. a pixmap) the current paint
settings are ignored and the form is drawn as-is.
Care must be taken, that the paint color is correctly allocated
(by sending #on: to the color) before doing so.
Using functions other than #copy only makes sense if you are
certain, that the colors are real colors (actually, only for
noColor or allColor)."
|w h aForm pX pY nW nH|
w := formToDraw width.
h := formToDraw height.
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
transformation scale ~= 1 ifTrue:[
nW := (transformation applyScaleX:w) rounded.
nH := (transformation applyScaleY:h) rounded.
] ifFalse:[
nW := w.
nH := h.
]
] ifFalse:[
pX := x.
pY := y.
nW := w.
nH := h.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
((nW ~= w) or:[nH ~= h]) ifTrue:[
aForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
] ifFalse:[
aForm := formToDraw
].
self displayDeviceForm:aForm x:pX y:pY
!
displayOpaqueForm:formToDraw x:x y:y
"draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
current paint-color and 0-bits in the bgPaint color.
If its a deep form (i.e. a pixmap) the current paint/bgPaint
settings are ignored and the form drawn as-is.
In the 1-plane case, special care must be taken if paint and/or bgPaint
dithered colors or patterns, since are that the colors are correctly allocated (by sending #on:
to the colors) before doing so.
If there is a transformation, the image is scaled as appropiate."
|w h aForm pX pY nW nH|
bgPaint isNil ifTrue:[
self displayForm:formToDraw x:x y:y.
^ self
].
w := formToDraw width.
h := formToDraw height.
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
transformation scale ~= 1 ifTrue:[
nW := (transformation applyScaleX:w) rounded.
nH := (transformation applyScaleY:h) rounded.
] ifFalse:[
nW := w.
nH := h.
]
] ifFalse:[
pX := x.
pY := y.
nW := w.
nH := h.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
((nW ~= w) or:[nH ~= h]) ifTrue:[
CachedScaledForms notNil ifTrue:[
(CachedScales at:formToDraw ifAbsent:[]) = transformation scale ifTrue:[
aForm := CachedScaledForms at:formToDraw ifAbsent:[].
]
].
aForm isNil ifTrue:[
aForm := formToDraw magnifiedBy:(nW / w) @ (nH / h).
CachedScaledForms isNil ifTrue:[
CachedScaledForms := WeakIdentityDictionary new.
CachedScales := WeakIdentityDictionary new.
].
CachedScaledForms at:formToDraw put:aForm.
CachedScales at:formToDraw put:transformation scale.
]
] ifFalse:[
aForm := formToDraw
].
self displayDeviceOpaqueForm:aForm x:pX y:pY
! !
!DeviceDrawable methodsFor:'bit blitting'!
copyPlaneFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
"copy one plane from aDrawable into the receiver. 0's are drawn in
background, while 1's are drawn with foreground color.
The depth of aDrawable must (should) be 1.
All coordinates are in device coordinates."
|id|
id := aDrawable id.
"temporary ...
this fixes a problem after restart on another display,
when a file-bitmap wasnt found. In this case, the id of the
bitmap will be nil. This will be fixed soon.
"
id isNil ifTrue:[
'DEVDRAW: invalid copyPlane - ignored' errorPrintNL.
^ self
].
gcId isNil ifTrue:[
self initGC
].
device
copyPlaneFromId:id
x:srcX y:srcY
to:drawableId
x:dstX y:dstY
width:w
height:h
with:gcId
!
copyFrom:aDrawable x:srcX y:srcY toX:dstX y:dstY width:w height:h
"copy from aDrawable into the receiver;
the source may be the receiver as well - in this case its a scroll.
All coordinates are in device coordinates."
|id|
id := aDrawable id.
"temporary ...
this fixes a problem after restart on another display,
when a file-bitmap wasnt found. In this case, the id of the
bitmap will be nil. This will be fixed soon.
"
id isNil ifTrue:[
'DEVDRAW: invalid bitmap copy - ignored' errorPrintNL.
^ self
].
gcId isNil ifTrue:[
self initGC
].
"this is a workaround for a bug (or a feature ?) in many X-servers;
copy is only copy if fg==1 and bg==0"
"No: it was my fault - shame, shame
((aDrawable == self) and:[function == #copy]) ifTrue:[
device setForeground:1 background:0 in:gcId.
background := nil.
foreground := nil.
paint := nil
].
"
((aDrawable depth == 1) and:[device depth ~~ 1]) ifTrue:[
device
copyPlaneFromId:id
x:srcX y:srcY
to:drawableId
x:dstX y:dstY
width:w
height:h
with:gcId
] ifFalse:[
device
copyFromId:id
x:srcX y:srcY
to:drawableId
x:dstX y:dstY
width:w
height:h
with:gcId
]
! !
!DeviceDrawable methodsFor:'filling'!
fillArcX:x y:y w:w h:h from:startAngle angle:angle
"draw a filled arc; apply transformation if nonNil"
|pX pY nW nH|
gcId isNil ifTrue:[
self initGC
].
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
nW := transformation applyScaleX:w.
nH := transformation applyScaleY:h.
nW < 0 ifTrue:[
nW := nW abs.
pX := pX - nW.
].
nH < 0 ifTrue:[
nH := nH abs.
pY := pY - nH.
].
] ifFalse:[
pX := x.
pY := y.
nW := w.
nH := h.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
(nW isMemberOf:SmallInteger) ifFalse:[
nW := nW rounded
].
(nH isMemberOf:SmallInteger) ifFalse:[
nH := nH rounded
].
device
fillArcX:pX y:pY
w:nW h:nH
from:startAngle angle:angle
in:drawableId with:gcId
!
fillRectangleX:x y:y width:w height:h
"draw a filled rectangle; apply transformation if nonNil"
|pX pY nW nH|
gcId isNil ifTrue:[
self initGC
].
transformation notNil ifTrue:[
pX := transformation applyToX:x.
pY := transformation applyToY:y.
nW := transformation applyScaleX:w.
nH := transformation applyScaleY:h.
nW < 0 ifTrue:[
nW := nW abs.
pX := pX - nW.
].
nH < 0 ifTrue:[
nH := nH abs.
pY := pY - nH.
].
] ifFalse:[
pX := x.
pY := y.
nW := w.
nH := h.
].
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
(nW isMemberOf:SmallInteger) ifFalse:[
nW := nW rounded
].
(nH isMemberOf:SmallInteger) ifFalse:[
nH := nH rounded
].
device
fillRectangleX:pX
y:pY
width:nW
height:nH
in:drawableId with:gcId
!
fillPolygon:aPolygon
"draw a filled polygon; apply transformation if nonNil"
|newPolygon|
gcId isNil ifTrue:[
self initGC
].
transformation notNil ifTrue:[
newPolygon := aPolygon collect:[:point | transformation applyTo:point].
] ifFalse:[
newPolygon := aPolygon
].
(newPolygon findFirst:[:p |
(p isPoint not
or:[(p x isMemberOf:SmallInteger) not
or:[(p y isMemberOf:SmallInteger) not]])
]) ~~ 0 ifTrue:[
newPolygon := newPolygon collect:[:p | p asPoint rounded]
].
device
fillPolygon:newPolygon
in:drawableId
with:gcId
! !
!DeviceDrawable methodsFor:'drawing in device coordinates'!
fillDeviceRectangleX:x y:y width:w height:h
"draw a filled rectangle in device coordinate space.
This ignores any transformations. The coordinates must be integers."
gcId isNil ifTrue:[
self initGC
].
device
fillRectangleX:x
y:y
width:w
height:h
in:drawableId with:gcId
!
displayDeviceLineFromX:x0 y:y0 toX:x1 y:y1
"draw a line (with current paint-color) in device coordinate space.
This ignores any transformations. The coordinates must be integers."
gcId isNil ifTrue:[
self initGC
].
device displayLineFromX:x0 y:y0 toX:x1 y:y1 in:drawableId with:gcId
!
displayDeviceOpaqueForm:aForm x:x y:y
"draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
current paint-color and 0-bits in the bgPaint color.
If its a deep form (i.e. a pixmap) the current paint/bgPaint
settings are ignored and the form drawn as-is.
In the 1-plane case, special care must be taken if paint and/or bgPaint
dithered colors or patterns, since are that the colors are correctly allocated (by sending #on:
to the colors) before doing so.
Drawing is in device coordinates; no scaling is done."
|id w h easy savedPaint bgForm fgForm tmpForm
fgId bgId noColor allColor allBits dx dy
pX pY|
bgPaint isNil ifTrue:[
self displayDeviceForm:aForm x:x y:y.
^ self
].
w := aForm width.
h := aForm height.
pX := x.
pY := y.
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
id := aForm id.
"temporary ..."
id isNil ifTrue:[
id := (aForm on:device) id.
id isNil ifTrue:[
'DEVDRAW: invalid form draw - ignored' errorPrintNL.
^ self
].
].
gcId isNil ifTrue:[
self initGC
].
"
a deep form ignores paint/bgPaint settings
"
(aForm depth ~~ 1) ifTrue:[
device
copyFromId:id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
^ self
].
"the following code is somewhat complicated, since it has to deal
with dithered fg/bg colors, which cannot be done directly on most
devices (actually, a test for the devices capabilities has to be added here)
(just assume drawing a bitmap with dithered fg/bg colors ... sigh)
"
"
if bgPaint or paint is not a real color, we have to do it the hard way ...
"
easy := true.
paint isColor ifFalse:[
easy := false
] ifTrue:[
fgId := paint colorId.
fgId isNil ifTrue:[
easy := false
]
].
bgPaint isColor ifFalse:[
easy := false
] ifTrue:[
bgId := bgPaint colorId.
bgId isNil ifTrue:[
easy := false
]
].
easy ifTrue:[
"
easy: both paint and bgPaint are real colors
"
((foreground ~~ paint) or:[background ~~ bgPaint]) ifTrue:[
device setForeground:fgId background:bgId in:gcId.
foreground := paint.
background := bgPaint.
].
device
copyPlaneFromId:id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
^ self
].
"
hard case: paint and/or bgPaint are dithered or patterns
"
allColor := Color allColor.
allBits := allColor colorId.
(fgId notNil and:[function == #copy]) ifTrue:[
"
only bg is dithered; fill with bg first ...
"
savedPaint := paint.
self paint:bgPaint.
self fillDeviceRectangleX:pX y:pY width:w height:h.
self paint:savedPaint.
"
if paint color is all-0 or all-1's, we can do it in one
operation ...
"
((fgId ~~ ((1 bitShift:device depth)-1))
and:[fgId ~~ allBits]) ifTrue:[
"
clear fg-bits ...
"
device setForeground:0 background:allBits in:gcId.
device setFunction:#and in:gcId.
device
copyPlaneFromId:id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
].
fgId ~~ 0 ifTrue:[
"
or-in fg-bits ...
"
device setForeground:fgId background:0 in:gcId.
device setFunction:#or in:gcId.
device
copyPlaneFromId:id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
].
"
flush foreground/background cache
"
foreground := nil.
background := nil.
device setFunction:function in:gcId.
^ self
].
(bgId notNil and:[function == #copy]) ifTrue:[
"
only fg is dithered; fill with fg first ...
"
self fillDeviceRectangleX:pX y:pY width:w height:h.
"
if paint color is all-0 or all-1's, we can do it in one
operation ...
"
((bgId ~~ ((1 bitShift:device depth)-1))
and:[bgId ~~ allBits]) ifTrue:[
"
clear bg-bits ...
"
device setForeground:allBits background:0 in:gcId.
device setFunction:#and in:gcId.
device
copyPlaneFromId:id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
].
"
or-in bg-bits ...
"
bgId ~~ 0 ifTrue:[
device setForeground:0 background:bgId in:gcId.
device setFunction:#or in:gcId.
device
copyPlaneFromId:id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
].
"
flush foreground/background cache
"
foreground := nil.
background := nil.
device setFunction:function in:gcId.
^ self
].
"
very hard case; both fg and bg are dithered colors
"
noColor := Color noColor.
"
create temp-forms;
"
bgForm := Form width:w height:h depth:device depth on:device.
fgForm := Form width:w height:h depth:device depth on:device.
tmpForm := Form width:w height:h depth:device depth on:device.
"
fill
"
dx := dy := 0.
maskOrigin notNil ifTrue:[
dx := maskOrigin x.
dy := maskOrigin y
].
bgForm paint:bgPaint.
bgForm setMaskOriginX:(x negated + dx) y:(y negated + dy).
bgForm fillRectangleX:0 y:0 width:w height:h.
fgForm paint:paint.
fgForm setMaskOriginX:(x negated + dx) y:(y negated + dy).
fgForm fillRectangleX:0 y:0 width:w height:h.
"
stamp-out background
"
bgForm paint:noColor on:allColor.
bgForm function:#and.
bgForm displayOpaqueForm:aForm x:0 y:0.
"
stamp-out foreground
"
fgForm paint:allColor on:noColor.
fgForm function:#and.
fgForm displayOpaqueForm:aForm x:0 y:0.
"
clear tempform
"
tmpForm paint:noColor.
tmpForm fillRectangleX:0 y:0 width:w height:h.
"
merge fg-temp and bg-temp into tmp
"
tmpForm function:#or.
tmpForm paint:noColor on:allColor.
tmpForm copyFrom:fgForm x:0 y:0 toX:0 y:0 width:w height:h.
tmpForm copyFrom:bgForm x:0 y:0 toX:0 y:0 width:w height:h.
"
finally, draw it
"
device setForeground:0 background:allBits in:gcId.
device
copyFromId:tmpForm id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
"
flush foreground/background cache
"
foreground := nil.
background := nil.
!
displayDeviceForm:aForm x:x y:y
"draw a form; if its a 1-plane bitmap, 1-bits are drawn in the
current paint-color, leaving pixels with 0-bits unchanged
(i.e. only 1-bits are drawn from the form).
No transformation or scaling is done.
If its a deep form (i.e. a pixmap) the current paint
settings are ignored and the form is drawn as-is.
Care must be taken, that the paint color is correctly allocated
(by sending #on: to the color) before doing so.
Using functions other than #copy only makes sense if you are
certain, that the colors are real colors (actually, only for
noColor or allColor)."
|id w h easy paintDither tmpForm
fgId noColor allColor allBits pX pY|
w := aForm width.
h := aForm height.
pX := x.
pY := y.
(pX isMemberOf:SmallInteger) ifFalse:[
pX := pX rounded
].
(pY isMemberOf:SmallInteger) ifFalse:[
pY := pY rounded
].
id := aForm id.
"temporary ..."
id isNil ifTrue:[
id := (aForm on:device) id.
id isNil ifTrue:[
'DEVDRAW: invalid form draw - ignored' errorPrintNL.
^ self
].
].
gcId isNil ifTrue:[
self initGC
].
"
a deep form ignores paint/bgPaint settings
"
(aForm depth ~~ 1) ifTrue:[
device
copyFromId:id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
^ self
].
"
the following code is somewhat complicated, since it has to deal
with dithered paint colors, which cannot be done directly on most
devices (actually, a test for the devices capabilities has to be added here)
(just assume drawing a bitmap with dithered paint color ... sigh)
"
"
if paint is not a real color, we have to do it the hard way ...
"
easy := (function == #copy).
easy ifTrue:[
paint isColor ifFalse:[
paintDither := paint.
easy := false
] ifTrue:[
paintDither := paint ditherForm.
paintDither notNil ifTrue:[
easy := false.
]
].
].
allColor := Color allColor.
allBits := allColor colorId.
easy ifTrue:[
"
paint is a real color
"
"
if paint color is all-0 or all-1's, we can do it in one
operation ...
"
fgId := paint colorId.
((fgId ~~ ((1 bitShift:device depth)-1))
and:[fgId ~~ allBits]) ifTrue:[
"
clear fg-bits ...
"
device setForeground:0 background:allBits in:gcId.
device setFunction:#and in:gcId.
device
copyPlaneFromId:id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
].
fgId ~~ 0 ifTrue:[
"
or-in fg-bits ...
"
device setForeground:fgId background:0 in:gcId.
device setFunction:#or in:gcId.
device
copyPlaneFromId:id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
].
"
flush foreground/background cache
"
foreground := nil.
background := nil.
device setFunction:function in:gcId.
^ self
].
"
hard case; paint is a dithered color
"
noColor := Color noColor.
"
create temp-form;
"
tmpForm := Form width:w height:h depth:device depth on:device.
"
fill tempform
"
tmpForm paint:paint.
tmpForm fillRectangleX:0 y:0 width:w height:h.
"
stamp out background
"
tmpForm paint:allColor on:noColor.
tmpForm function:#and.
tmpForm displayOpaqueForm:aForm x:0 y:0.
"
stamp out foreground from destination
"
device setForeground:0 background:allBits in:gcId.
device setFunction:#and in:gcId.
device
copyPlaneFromId:aForm id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
"
or-in temp into destination
"
device setForeground:allBits background:0 in:gcId.
device setFunction:#or in:gcId.
device
copyFromId:tmpForm id
x:0 y:0
to:drawableId
x:pX y:pY
width:w
height:h
with:gcId.
"
flush foreground/background cache
"
foreground := nil.
background := nil.
device setFunction:function in:gcId.
!
displayDeviceString:aString x:x y:y
"draw a string at the coordinate x/y -
draw foreground-pixels only (in current paint-color), leaving background as-is.
No translation or scaling is done"
self displayDeviceString:aString from:1 to:(aString size) in:font x:x y:y
!
displayDeviceString:aString from:index1 to:index2 x:x y:y
"draw a substring at the coordinate x/y -
draw foreground-pixels only (in current paint-color), leaving background as-is.
No translation or scaling is done"
self displayDeviceString:aString from:index1 to:index2 in:font x:x y:y
!
displayDeviceString:aString from:index1 to:index2 in:font x:x y:y
"draw a substring at the coordinate x/y -
draw foreground-pixels only (in current paint-color), leaving background as-is.
No translation or scaling is done"
|id pX pY fontUsed|
"hook for non-strings (i.e. attributed text)"
aString isString ifFalse:[
^ aString displayOn:self x:x y:y from:index1 to:index2
].
gcId isNil ifTrue:[
self initGC
].
pX := x.
pY := y.
(x isMemberOf:SmallInteger) ifFalse:[
pX := x rounded
].
(y isMemberOf:SmallInteger) ifFalse:[
pY := y rounded
].
fontUsed := font on:device.
id := fontUsed fontId.
id isNil ifTrue:[
"hook for alien fonts"
font displayString:aString from:index1 to:index2 x:x y:y in:self
] ifFalse:[
deviceFont ~~ fontUsed ifTrue:[
device setFont:id in:gcId.
deviceFont := fontUsed
].
device displayString:aString from:index1 to:index2
x:pX y:pY in:drawableId with:gcId
]
!
displayDeviceOpaqueString:aString x:x y:y
"draw a string at the coordinate x/y - draw foreground pixels in
paint-color and background pixels in bgPaint-color.
No translation or scaling is done"
self displayDeviceOpaqueString:aString from:1 to:(aString size) in:font x:x y:y
!
displayDeviceOpaqueString:aString from:index1 to:index2 x:x y:y
"draw a substring at the coordinate x/y - draw foreground pixels in
paint-color and background pixels in bgPaint-color.
Assuming that device can only draw in device colors, we have to handle
the case where paint and/or bgPaint are dithered colors.
No translation or scaling is done."
self displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y
!
displayDeviceOpaqueString:aString from:index1 to:index2 in:font x:x y:y
"draw a substring at the coordinate x/y - draw foreground pixels in
paint-color and background pixels in bgPaint-color.
Assuming that device can only draw in device colors, we have to handle
the case where paint and/or bgPaint are dithered colors.
No translation or scaling is done."
|easy w h savedPaint fgId bgId allColor allBits noColor
id bgForm fgForm tmpForm maskForm dx dy pX pY fontUsed|
"
if backgroundPaint color is nil, we assume
this is a non-opaque draw
"
bgPaint isNil ifTrue:[
self displayDeviceString:aString from:index1 to:index2 x:x y:y.
^ self
].
aString isString ifFalse:[
"
hook for non-strings (i.e. attributed text)
that 'thing' should know how to display itself ...
"
aString displayOpaqueOn:self x:x y:y from:index1 to:index2.
^ self
].
gcId isNil ifTrue:[
self initGC
].
pX := x.
pY := y.
(x isMemberOf:SmallInteger) ifFalse:[
pX := x rounded
].
(y isMemberOf:SmallInteger) ifFalse:[
pY := y rounded
].
fontUsed := font on:device.
id := fontUsed fontId.
id isNil ifTrue:[
"
hook for alien fonts
that 'font' should know how to display the string ...
"
font displayOpaqueString:aString from:index1 to:index2 x:x y:y in:self.
^ self
].
deviceFont ~~ fontUsed ifTrue:[
device setFont:id in:gcId.
deviceFont := fontUsed
].
"
if bgPaint or paint is not a real Color, we have to do it the hard way ...
"
easy := true.
paint isColor ifFalse:[
easy := false
] ifTrue:[
fgId := paint colorId.
fgId isNil ifTrue:[
easy := false
]
].
bgPaint isColor ifFalse:[
easy := false
] ifTrue:[
bgId := bgPaint colorId.
bgId isNil ifTrue:[
easy := false
]
].
easy ifTrue:[
device setForeground:fgId background:bgId in:gcId.
foreground := paint.
background := bgPaint.
device displayOpaqueString:aString
from:index1 to:index2
x:pX y:pY
in:drawableId with:gcId.
^ self
].
w := fontUsed widthOf:aString from:index1 to:index2.
h := fontUsed height.
(fgId notNil and:[function == #copy]) ifTrue:[
"
only bg is dithered; fill with bg first ...
"
savedPaint := paint.
self paint:bgPaint.
self fillRectangleX:pX y:(pY - fontUsed ascent) width:w height:h.
self paint:savedPaint.
"
then draw using fgPaint (which is a real color)
"
device displayString:aString
from:index1 to:index2
x:pX y:pY
in:drawableId with:gcId.
^ self
].
allColor := Color allColor.
allBits := allColor colorId.
"
the code below is correct, but some (all?) implementations of the
X Window system seem to not support ALU-functions when drawing opaque strings.
Therefore we use the slower code below.
"
"/ (bgId notNil and:[function == #copy]) ifTrue:[
"/ "
"/ only fg is dithered; fill with fg first ...
"/ "
"/ self fillRectangleX:pX y:(pY - fontUsed ascent) width:w height:h.
"/
"/ "
"/ if bgPaint color is all-0 or all-1's, we can do it in one
"/ operation ...
"/ "
"/ ((bgId ~~ ((1 bitShift:device depth)-1))
"/ and:[bgId ~~ allBits]) ifTrue:[
"/ "
"/ clear bg bits ...
"/ "
"/ device setForeground:allBits background:0 in:gcId.
"/ device setFunction:#and in:gcId.
"/ device displayOpaqueString:aString
"/ from:index1 to:index2
"/ x:pX y:pY
"/ in:drawableId with:gcId.
"/ ].
"/
"/ "
"/ or-in bg bits ...
"/ "
"/ bgId ~~ 0 ifTrue:[
"/ device setForeground:0 background:bgId in:gcId.
"/ device setFunction:#or in:gcId.
"/ device displayOpaqueString:aString
"/ from:index1 to:index2
"/ x:pX y:pY
"/ in:drawableId with:gcId.
"/ ].
"/ "
"/ flush foreground/background cache
"/ "
"/ foreground := nil.
"/ background := nil.
"/ device setFunction:function in:gcId.
"/ ^ self
"/ ].
"
hard case, both fg and bg are dithered colors/images
"
noColor := Color noColor.
"
create temp-forms;
"
bgForm := Form width:w height:h depth:device depth on:device.
fgForm := Form width:w height:h depth:device depth on:device.
tmpForm := Form width:w height:h depth:device depth on:device.
maskForm := Form width:w height:h depth:device depth on:device.
"
fill
"
dx := 0.
dy := fontUsed ascent.
maskOrigin notNil ifTrue:[
dx := maskOrigin x.
dy := dy + maskOrigin y
].
bgForm paint:bgPaint.
bgForm setMaskOriginX:(pX negated + dx) y:(pY negated + dy).
bgForm fillRectangleX:0 y:0 width:w height:h.
fgForm paint:paint.
fgForm setMaskOriginX:(pX negated + dx) y:(pY negated + dy).
fgForm fillRectangleX:0 y:0 width:w height:h.
"
stamp-out background (have now bg-bits with fg=0 in bgForm)
"
bgForm font:fontUsed.
bgForm paint:noColor on:allColor.
bgForm function:#and.
bgForm displayString:aString
from:index1 to:index2
x:0 y:fontUsed ascent.
"
stamp-out foreground
"
maskForm font:fontUsed.
maskForm paint:allColor on:noColor.
maskForm displayOpaqueString:aString
from:index1 to:index2
x:0 y:fontUsed ascent.
fgForm function:#and.
fgForm copyFrom:maskForm x:0 y:0 toX:0 y:0 width:w height:h.
"
clear tempform
"
tmpForm paint:noColor.
tmpForm fillRectangleX:0 y:0 width:w height:h.
"
merge fg-temp and bg-temp into tmp
"
tmpForm function:#or.
tmpForm paint:noColor on:allColor.
tmpForm copyFrom:fgForm x:0 y:0 toX:0 y:0 width:w height:h.
tmpForm copyFrom:bgForm x:0 y:0 toX:0 y:0 width:w height:h.
"
finally, draw it
"
device setForeground:0 background:allBits in:gcId.
device
copyFromId:tmpForm id
x:0 y:0
to:drawableId
x:pX y:pY-fontUsed ascent
width:w
height:h
with:gcId.
"
flush foreground/background cache
"
foreground := nil.
background := nil.
! !