# HG changeset patch # User Jan Vrany # Date 1459699769 -3600 # Node ID c3b4c3c664d4fedbc14bdad9760a6c1c1df65995 # Parent d047c5fb149a5f5bd08b0dc711cb9f886d1c135d# Parent 2fa50ee614e9975b3d4fbb8b7bafbbf52257b385 Merge diff -r d047c5fb149a -r c3b4c3c664d4 Depth1Image.st --- a/Depth1Image.st Sun Apr 03 16:05:41 2016 +0100 +++ b/Depth1Image.st Sun Apr 03 17:09:29 2016 +0100 @@ -11,6 +11,8 @@ " "{ Package: 'stx:libview' }" +"{ NameSpace: Smalltalk }" + Image subclass:#Depth1Image instanceVariableNames:'' classVariableNames:'' @@ -82,19 +84,20 @@ OBJ b = __INST(bytes); OBJ w = __INST(width); - if (__bothSmallInteger(x, y) && __isSmallInteger(w)) { - if (__isByteArrayLike(b)) { - int _w = __intVal(w); - int _y = __intVal(y); - int _x = __intVal(x); - unsigned _byte; - int _idx; + if (__bothSmallInteger(x, y) + && __isSmallInteger(w) + && __isByteArrayLike(b) + && (__INST(pixelFunction)==nil) ) { + int _w = __intVal(w); + int _y = __intVal(y); + int _x = __intVal(x); + unsigned _byte; + int _idx; - _idx = ((_w + 7) >> 3) * _y + (_x >> 3); - if ((unsigned)_idx < __byteArraySize(b)) { - _byte = __ByteArrayInstPtr(b)->ba_element[_idx]; - RETURN( (_byte & (0x80 >> (_x & 7))) ? __MKSMALLINT(1) : __MKSMALLINT(0) ); - } + _idx = ((_w + 7) >> 3) * _y + (_x >> 3); + if ((unsigned)_idx < __byteArraySize(b)) { + _byte = __ByteArrayInstPtr(b)->ba_element[_idx]; + RETURN( (_byte & (0x80 >> (_x & 7))) ? __MKSMALLINT(1) : __MKSMALLINT(0) ); } } %}. @@ -781,10 +784,10 @@ !Depth1Image class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libview/Depth1Image.st,v 1.65 2014-06-05 15:41:27 stefan Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libview/Depth1Image.st,v 1.65 2014-06-05 15:41:27 stefan Exp $' + ^ '$Header$' ! ! diff -r d047c5fb149a -r c3b4c3c664d4 Depth24Image.st --- a/Depth24Image.st Sun Apr 03 16:05:41 2016 +0100 +++ b/Depth24Image.st Sun Apr 03 17:09:29 2016 +0100 @@ -113,13 +113,33 @@ pixelAtX:x y:y "retrieve a pixel at x/y; return a color. Pixels start at x=0 , y=0 for upper left pixel, end at - x = width-1, y=height-1 for lower right pixel" + x = width-1, y=height-1 for lower right pixel. + The pixel value contains r/g/b in msb order (i.e. r at high, b at low bits)" |index "{ Class: SmallInteger }" rVal "{ Class: SmallInteger }" gVal "{ Class: SmallInteger }" bVal "{ Class: SmallInteger }"| +%{ /* NOCONTEXT */ + OBJ b = __INST(bytes); + OBJ w = __INST(width); + + if (__isByteArrayLike(b) + && __bothSmallInteger(x, y) + && __isSmallInteger(w) + && (__INST(pixelFunction)==nil) ) { + int _idx; + + _idx = ((__intVal(w) * __intVal(y)) + __intVal(x))*3; + if (((unsigned)(_idx+2)) < __byteArraySize(b)) { + unsigned char *pPix = &(__ByteArrayInstPtr(b)->ba_element[_idx]); + unsigned int _pix; + _pix = (((pPix[0]<<8)+pPix[1])<<8)+pPix[2]; + RETURN( __MKSMALLINT(_pix) ); + } + } +%}. pixelFunction notNil ifTrue:[^ pixelFunction value:x value:y]. index := 1 + (((width * y) + x) * 3). @@ -2612,8 +2632,9 @@ image than using valueAtX:y:, since some processing can be avoided when going from pixel to pixel. However, for real image processing, specialized methods should be written. - Notice that the pixelValue is the r/g/b value packed into an integer - (r bitShift:16) bitOr:(g bitSHift:8) bitOr:b" + Notice that the pixelValue is the r/g/b value packed into an MSB integer + (r bitShift:16) bitOr:(g bitSHift:8) bitOr:b + i.e. r is the first byte, but high in the passed pixel value." |srcIndex "{ Class: SmallInteger }" x1 "{ Class: SmallInteger }" @@ -2630,11 +2651,11 @@ srcIndex := 1 + (((width * y) + x1) * 3). x1 to:x2 do:[:x | - r := bytes at:(srcIndex). - g := bytes at:(srcIndex + 1). - b := bytes at:(srcIndex + 2). - srcIndex := srcIndex + 3. - aBlock value:x value:(((r bitShift:16) bitOr:(g bitShift:8)) bitOr:b) + r := bytes at:(srcIndex). + g := bytes at:(srcIndex + 1). + b := bytes at:(srcIndex + 2). + srcIndex := srcIndex + 3. + aBlock value:x value:(((r bitShift:16) bitOr:(g bitShift:8)) bitOr:b) ] "Created: 7.6.1996 / 19:09:40 / cg" diff -r d047c5fb149a -r c3b4c3c664d4 Depth32Image.st --- a/Depth32Image.st Sun Apr 03 16:05:41 2016 +0100 +++ b/Depth32Image.st Sun Apr 03 17:09:29 2016 +0100 @@ -1,5 +1,3 @@ -"{ Encoding: utf8 }" - " COPYRIGHT (c) 1995 by Claus Gittinger All Rights Reserved @@ -210,10 +208,34 @@ pixelAtX:x y:y "retrieve a pixel at x/y; return a pixelValue. Pixels start at x=0 , y=0 for upper left pixel, end at - x = width-1, y=height-1 for lower right pixel" + x = width-1, y=height-1 for lower right pixel. + The pixel value contains r/g/b/a in msb order (i.e. r at high, a at low bits)" |pixelIndex "{ Class: SmallInteger }"| +%{ /* NOCONTEXT */ + OBJ b = __INST(bytes); + OBJ w = __INST(width); + + if (__isByteArrayLike(b) + && __bothSmallInteger(x, y) + && __isSmallInteger(w) + && (__INST(pixelFunction)==nil) ) { + int _idx; + + _idx = ((__intVal(w) * __intVal(y)) + __intVal(x))*4; + if (((unsigned)(_idx+3)) < __byteArraySize(b)) { + unsigned char *pPix = &(__ByteArrayInstPtr(b)->ba_element[_idx]); + unsigned int _pix; + _pix = (((((pPix[0]<<8)+pPix[1])<<8)+pPix[2])<<8)+pPix[3]; +#if __POINTER_SIZE__ == 8 + RETURN( __MKSMALLINT(_pix) ); +#else + RETURN( __MKUINT(_pix) ); +#endif + } + } +%}. pixelFunction notNil ifTrue:[^ pixelFunction value:x value:y]. pixelIndex := 1 + (((width * y) + x) * 4). diff -r d047c5fb149a -r c3b4c3c664d4 Depth48Image.st --- a/Depth48Image.st Sun Apr 03 16:05:41 2016 +0100 +++ b/Depth48Image.st Sun Apr 03 17:09:29 2016 +0100 @@ -1,5 +1,3 @@ -"{ Encoding: utf8 }" - " COPYRIGHT (c) 2009 by eXept Software AG All Rights Reserved @@ -74,7 +72,8 @@ pixelAtX:x y:y "retrieve a pixel at x/y; return a pixelValue. Pixels start at x=0 , y=0 for upper left pixel, end at - x = width-1, y=height-1 for lower right pixel" + x = width-1, y=height-1 for lower right pixel. + The pixel value contains r/g/b in msb order (i.e. r at high, a at low bits)" |pixelIndex "{ Class: SmallInteger }"| diff -r d047c5fb149a -r c3b4c3c664d4 Depth64Image.st --- a/Depth64Image.st Sun Apr 03 16:05:41 2016 +0100 +++ b/Depth64Image.st Sun Apr 03 17:09:29 2016 +0100 @@ -1,5 +1,3 @@ -"{ Encoding: utf8 }" - " COPYRIGHT (c) 2009 by eXept Software AG All Rights Reserved @@ -74,7 +72,8 @@ pixelAtX:x y:y "retrieve a pixel at x/y; return a pixelValue. Pixels start at x=0 , y=0 for upper left pixel, end at - x = width-1, y=height-1 for lower right pixel" + x = width-1, y=height-1 for lower right pixel. + The pixel value contains r/g/b/a in msb order (i.e. r at high, a at low bits)" |pixelIndex "{ Class: SmallInteger }"| diff -r d047c5fb149a -r c3b4c3c664d4 Depth8Image.st --- a/Depth8Image.st Sun Apr 03 16:05:41 2016 +0100 +++ b/Depth8Image.st Sun Apr 03 17:09:29 2016 +0100 @@ -1,5 +1,3 @@ -"{ Encoding: utf8 }" - " COPYRIGHT (c) 1993 by Claus Gittinger All Rights Reserved @@ -90,7 +88,8 @@ if (__isByteArrayLike(b) && __bothSmallInteger(x, y) - && __isSmallInteger(w) ) { + && __isSmallInteger(w) + && (__INST(pixelFunction)==nil) ) { int _idx, _pix; _idx = (__intVal(w) * __intVal(y)) + __intVal(x); @@ -2464,10 +2463,10 @@ !Depth8Image class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.123 2015-04-13 17:26:00 cg Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libview/Depth8Image.st,v 1.123 2015-04-13 17:26:00 cg Exp $' + ^ '$Header$' ! ! diff -r d047c5fb149a -r c3b4c3c664d4 DeviceGraphicsContext.st --- a/DeviceGraphicsContext.st Sun Apr 03 16:05:41 2016 +0100 +++ b/DeviceGraphicsContext.st Sun Apr 03 17:09:29 2016 +0100 @@ -122,7 +122,7 @@ (self class name,' [warning]: no Display') infoPrintCR. Smalltalk openDisplay. - device := Screen current. + device := Screen current ? Display. device isNil ifTrue:[ self error:'no screen device' ] ]. ]. diff -r d047c5fb149a -r c3b4c3c664d4 DisplayRootView.st --- a/DisplayRootView.st Sun Apr 03 16:05:41 2016 +0100 +++ b/DisplayRootView.st Sun Apr 03 17:09:29 2016 +0100 @@ -240,13 +240,10 @@ reinitialize "reinit after snapin" - |dev| - self recreate. self createRootWindow. - dev := self graphicsDevice. - width := dev width. - height := dev height. + width := device width. + height := device height. realized := true. ! ! @@ -294,9 +291,6 @@ This is done by performing an action (enabling button events of root window), which will fail if a window manager is running." - |device| - - device := self graphicsDevice. device isWindowsPlatform ifTrue:[^ true]. device class deviceErrorSignal handle:[:ex | ^ false. diff -r d047c5fb149a -r c3b4c3c664d4 DisplaySurface.st --- a/DisplaySurface.st Sun Apr 03 16:05:41 2016 +0100 +++ b/DisplaySurface.st Sun Apr 03 17:09:29 2016 +0100 @@ -496,7 +496,7 @@ |id| cursor isNil ifTrue:[ ^ self]. - cursor := cursor onDevice:self graphicsDevice. + cursor := cursor onDevice:device. cursor isNil ifTrue:[ ^ self]. id := cursor id. diff -r d047c5fb149a -r c3b4c3c664d4 Font.st --- a/Font.st Sun Apr 03 16:05:41 2016 +0100 +++ b/Font.st Sun Apr 03 17:09:29 2016 +0100 @@ -283,7 +283,7 @@ Obsolete - use #graphicsDevice" - self obsoleteMethodWarning:'2013-07-25'. + self obsoleteMethodWarning:'use #graphicsDevice (2013-07-25)'. ^ device ! diff -r d047c5fb149a -r c3b4c3c664d4 Form.st --- a/Form.st Sun Apr 03 16:05:41 2016 +0100 +++ b/Form.st Sun Apr 03 17:09:29 2016 +0100 @@ -1797,7 +1797,7 @@ localColorMap := BlackAndWhiteColorMap. ]. ]. - self graphicsDevice notNil ifTrue:[ + device notNil ifTrue:[ gc createPixmapWidth:w height:h depth:d. realized := true. ]. @@ -1897,7 +1897,7 @@ localColorMap := BlackAndWhiteColorMap. ]. - self graphicsDevice notNil ifTrue:[ + device notNil ifTrue:[ gc createBitmapFromArray:bytes width:w height:h. realized := true. ]. diff -r d047c5fb149a -r c3b4c3c664d4 Image.st --- a/Image.st Sun Apr 03 16:05:41 2016 +0100 +++ b/Image.st Sun Apr 03 17:09:29 2016 +0100 @@ -1203,31 +1203,31 @@ fromSubForm:aRectangle in:aForm "create & return an subImage given a aForm" - |depth device vis img photometric| + |depth formsDevice vis img photometric| depth := aForm depth. - device := aForm device. + formsDevice := aForm device. photometric := (depth > 8) ifTrue:#rgb ifFalse:#palette. - (device notNil and:[depth == device depth]) ifTrue:[ - "/ - "/ for truecolor displays, return a Depth24Image - "/ (must do this for depth15 & depth16 displays, since - "/ Depth16Image has no way to specify r/g/b masks ...) - "/ - vis := device visualType. - (vis == #TrueColor or:[vis == #DirectColor]) ifTrue:[ - depth > 8 ifTrue:[ - depth := 24. - ] - ]. + (formsDevice notNil and:[depth == formsDevice depth]) ifTrue:[ + "/ + "/ for truecolor displays, return a Depth24Image + "/ (must do this for depth15 & depth16 displays, since + "/ Depth16Image has no way to specify r/g/b masks ...) + "/ + vis := formsDevice visualType. + (vis == #TrueColor or:[vis == #DirectColor]) ifTrue:[ + depth > 8 ifTrue:[ + depth := 24. + ] + ]. ]. img := self newForDepth:depth. img photometric:photometric. - device isNil ifTrue:[ - ^ img from:aForm in:aRectangle. + formsDevice isNil ifTrue:[ + ^ img from:aForm in:aRectangle. ]. ^ img from:aForm in:aRectangle @@ -2427,23 +2427,23 @@ and it may not work from within a buttonMotion (use with a false grabArg then)." - |org ext device cH bW bH| - - device := aView graphicsDevice. - org := device translatePoint:(0@0) fromView:aView toView:nil. + |org ext viewsDevice cH bW bH| + + viewsDevice := aView graphicsDevice. + org := viewsDevice translatePoint:(0@0) fromView:aView toView:nil. ext := aView extent. withDecoration ifTrue:[ - device isWindowsPlatform ifTrue:[ - cH := device captionHeight. - bW := (device getSystemMetrics: #SM_CXFRAME ) + viewsDevice isWindowsPlatform ifTrue:[ + cH := viewsDevice captionHeight. + bW := (viewsDevice getSystemMetrics: #SM_CXFRAME ) "+ ( device getSystemMetrics: #borderFrameWidth )". - bH := (device getSystemMetrics: #SM_CYFRAME ) + bH := (viewsDevice getSystemMetrics: #SM_CYFRAME ) " + ( device getSystemMetrics: #borderFrameHeight )". org := org - (bW @ (bH + cH)). ext := ext + ((bW + bW) @ (bH+bH+cH)). ]. ]. - ^ self fromScreen:(org extent:ext) on:device grab:doGrab + ^ self fromScreen:(org extent:ext) on:viewsDevice grab:doGrab " Transcript topView raise. (Image fromView:Transcript topView grab:false withDecoration:false) inspect @@ -5779,7 +5779,8 @@ |map clr mappedRowPixels samePhotometric h "{ Class: SmallInteger }" w "{ Class: SmallInteger }" - a r g b rgbPixel| + a r g b rgbPixel + myDepth otherDepth| width := anImage width. height := anImage height. @@ -5803,23 +5804,24 @@ self mask:anImage mask. samePhotometric := (photometric == anImage photometric). - - ((self depth = anImage depth) - and:[samePhotometric]) ifTrue:[ + myDepth := self depth. + otherDepth := anImage depth. + + ((myDepth = otherDepth) and:[samePhotometric]) ifTrue:[ self bits:(anImage bits copy). ^ self. ]. - self bits:(ByteArray uninitializedNew:(self bytesPerRow * height)). - - self depth >= anImage depth ifTrue:[ - anImage depth <= 12 ifTrue:[ + self bits:(ByteArray new: "uninitializedNew:"(self bytesPerRow * height)). + + myDepth >= otherDepth ifTrue:[ + otherDepth <= 12 ifTrue:[ "/ if my depth is greater, all colors can be represented, "/ and the loop can be done over pixel values ... (colorMap isNil or:[samePhotometric not]) ifTrue:[ - map := Array new:(1 bitShift:anImage depth). + map := Array new:(1 bitShift:otherDepth). 1 to:map size do:[:i | clr := anImage colorFromValue:(i - 1). map at:i put:(self valueFromColor:clr). @@ -5842,18 +5844,21 @@ ]. "/ a hack, for now - alpha is in the low-byte !!!!!! - (self depth == 24 and:[anImage depth == 32]) ifTrue:[ + (myDepth == 24 and:[otherDepth == 32]) ifTrue:[ (samePhotometric and:[photometric == #rgb]) ifTrue:[ "/ can do the bits by simple stripping off the alpha channel - anImage valuesFromX:0 y:0 toX:(width-1) y:(height-1) do:[:x :y :pixel | - "/ bgra-pixel - a := pixel bitAnd:16rFF. - r := (pixel bitShift:-8) bitAnd:16rFF. - g := (pixel bitShift:-16) bitAnd:16rFF. - b := (pixel bitShift:-24) bitAnd:16rFF. - rgbPixel := r + (g bitShift:8) + (b bitShift:16). - self pixelAtX:x y:y put:rgbPixel - ]. + self copyPixels32AlphaLowTo24From:anImage. +"/ anImage valuesFromX:0 y:0 toX:(width-1) y:(height-1) do:[:x :y :pixel | +"/ |a r g b rgbPixel| +"/ +"/ "/ bgra-pixel +"/ "/ a := pixel bitAnd:16rFF. +"/ r := (pixel bitShift:-8) bitAnd:16rFF. +"/ g := (pixel bitShift:-16) bitAnd:16rFF. +"/ b := (pixel bitShift:-24) bitAnd:16rFF. +"/ rgbPixel := r + (g bitShift:8) + (b bitShift:16). +"/ self pixelAtX:x y:y put:rgbPixel +"/ ]. ^ self ]. ]. @@ -6663,6 +6668,64 @@ "Created: / 17-07-2012 / 12:13:18 / anwild" ! +copyPixels32AlphaLowTo24From:anImage + "tuned helper to copy pixels from a 32bit argb (alpha in low byte) + to me as a 24bit non-alpha rgb image" + + |imageBits| + + imageBits := anImage bits. +%{ + OBJ _myBits = __INST(bytes); + OBJ w = __INST(width); + OBJ h = __INST(height); + + if (__isByteArrayLike(_myBits) + && __isByteArrayLike(imageBits) + && __bothSmallInteger(w, h)) { + int _idx; + int _w = __intVal(w); + int _h = __intVal(h); + int _mySize = __byteArraySize(_myBits); + int _imgSize = __byteArraySize(imageBits); + char *_myBitsPtr = __ByteArrayInstPtr(_myBits)->ba_element; + char *_imgBitsPtr = __ByteArrayInstPtr(imageBits)->ba_element; + char *_myBitsEndPtr = _myBitsPtr + (_w * _h * 3); + char *_imgBitsEndPtr = _imgBitsPtr + (_w * _h * 4); + + if ((_w * _h * 3) > _mySize) goto error; + if ((_w * _h * 4) > _imgSize) goto error; + + while (_myBitsPtr < _myBitsEndPtr) { + // fetch r,g,b skip a + unsigned char _r = _imgBitsPtr[0]; + unsigned char _g = _imgBitsPtr[1]; + unsigned char _b = _imgBitsPtr[2]; + _myBitsPtr[0] = _r; + _myBitsPtr[1] = _g; + _myBitsPtr[2] = _b; + _myBitsPtr += 3; + _imgBitsPtr += 4; + } + RETURN( self ); + } +error: ; + console_printf("Image: oops - bits-size in copyPixels32\n"); +%}. + + anImage valuesFromX:0 y:0 toX:(self width-1) y:(self height-1) do:[:x :y :pixel | + |a r g b rgbPixel| + + "/ bgra-pixel + "/ a := pixel bitAnd:16rFF. + r := (pixel bitShift:-8) bitAnd:16rFF. + g := (pixel bitShift:-16) bitAnd:16rFF. + b := (pixel bitShift:-24) bitAnd:16rFF. + rgbPixel := r + (g bitShift:8) + (b bitShift:16). + self pixelAtX:x y:y put:rgbPixel + ]. +! + rgbImageAsFormOn:aDevice "convert am rgb image to a device-form on aDevice. Return the device-form." @@ -7732,8 +7795,8 @@ eR eRB eB eLB | depth > 8 ifTrue:[ - self error:'unimplemented conversion'. - ^ nil + self error:'unimplemented conversion'. + ^ nil ]. w := width. @@ -7753,176 +7816,176 @@ bitCnt := 8. self depth <= 12 ifTrue:[ - "/ fetch scaled brightness values outside of loop into a table; - "/ use table-value in loop - - greyValues := self greyMapForRange:(greyLevels). - - greyPixels := greyValues collect:[:v | v isNil ifTrue:[ - 0 - ] ifFalse:[ - v truncated]]. - - greyPixels := ByteArray withAll:greyPixels. - - greyErrors := greyValues collect:[:v | v isNil ifTrue:[ - 0 - ] ifFalse:[ - ((v - v truncated) * 1024) truncated - ]]. - - 0 to:(h-1) do:[:y | - nextDst := dstIndex + bytesPerOutRow. - byte := 0. - - t := errorArray. - errorArray := nextErrorArray. - nextErrorArray := t. - - nextErrorArray atAllPut:0. - - self valuesAtY:y from:0 to:(w-1) do:[:x :value | - |e "{ Class: SmallInteger }" - pixel "{ Class: SmallInteger }" - error "{ Class: SmallInteger }" - e16 "{ Class: SmallInteger }" - xE "{ Class: SmallInteger }" - xN "{ Class: SmallInteger }" | - - pixel := greyPixels at:(value + 1). - - "/ adjust error - xE := x + 2. - error := (greyErrors at:(value + 1)) + (errorArray at:xE). - - byte := byte bitShift:depth. - error > 512 "0.5" ifTrue:[ - pixel := pixel + 1. - e := error - 1024 "1.0" - ] ifFalse:[ - e := error - ]. - byte := byte bitOr:pixel. - - e ~= 0 ifTrue:[ - e16 := e // 16. - - eR := e16 * 7. "/ 7/16 to right - eRB := e16 * 1. "/ 1/16 to right below - eB := e16 * 5. "/ 5/16 to below - eLB := e - eR - eRB - eB. "/ 3/16 to left below - - xN := xE + 1. - eR ~= 0 ifTrue:[ - errorArray at:xN put:(errorArray at:xN) + eR. - ]. - eRB ~= 0 ifTrue:[ - nextErrorArray at:xN put:(nextErrorArray at:xN) + eRB. - ]. - eB ~= 0 ifTrue:[ - nextErrorArray at:xE put:(nextErrorArray at:xE) + eB. - ]. - eLB ~= 0 ifTrue:[ - xN := xE - 1. - nextErrorArray at:xN put:(nextErrorArray at:xN) + eLB. - ]. - ]. - - bitCnt := bitCnt - depth. - bitCnt == 0 ifTrue:[ - outBits at:dstIndex put:byte. - dstIndex := dstIndex + 1. - byte := 0. - bitCnt := 8. - ]. - - ]. - bitCnt ~~ 8 ifTrue:[ - byte := byte bitShift:bitCnt. - outBits at:dstIndex put:byte. - bitCnt := 8. - ]. - - dstIndex := nextDst. - ]. + "/ fetch scaled brightness values outside of loop into a table; + "/ use table-value in loop + + greyValues := self greyMapForRange:(greyLevels). + + greyPixels := greyValues collect:[:v | v isNil ifTrue:[ + 0 + ] ifFalse:[ + v truncated]]. + + greyPixels := ByteArray withAll:greyPixels. + + greyErrors := greyValues collect:[:v | v isNil ifTrue:[ + 0 + ] ifFalse:[ + ((v - v truncated) * 1024) truncated + ]]. + + 0 to:(h-1) do:[:y | + nextDst := dstIndex + bytesPerOutRow. + byte := 0. + + t := errorArray. + errorArray := nextErrorArray. + nextErrorArray := t. + + nextErrorArray atAllPut:0. + + self valuesAtY:y from:0 to:(w-1) do:[:x :value | + |e "{ Class: SmallInteger }" + pixel "{ Class: SmallInteger }" + error "{ Class: SmallInteger }" + e16 "{ Class: SmallInteger }" + xE "{ Class: SmallInteger }" + xN "{ Class: SmallInteger }" | + + pixel := greyPixels at:(value + 1). + + "/ adjust error + xE := x + 2. + error := (greyErrors at:(value + 1)) + (errorArray at:xE). + + byte := byte bitShift:depth. + error > 512 "0.5" ifTrue:[ + pixel := pixel + 1. + e := error - 1024 "1.0" + ] ifFalse:[ + e := error + ]. + byte := byte bitOr:pixel. + + e ~= 0 ifTrue:[ + e16 := e // 16. + + eR := e16 * 7. "/ 7/16 to right + eRB := e16 "* 1". "/ 1/16 to right below + eB := e16 * 5. "/ 5/16 to below + eLB := e - eR - eRB - eB. "/ 3/16 to left below + + xN := xE + 1. + eR ~= 0 ifTrue:[ + errorArray at:xN put:(errorArray at:xN) + eR. + ]. + eRB ~= 0 ifTrue:[ + nextErrorArray at:xN put:(nextErrorArray at:xN) + eRB. + ]. + eB ~= 0 ifTrue:[ + nextErrorArray at:xE put:(nextErrorArray at:xE) + eB. + ]. + eLB ~= 0 ifTrue:[ + xN := xE - 1. + nextErrorArray at:xN put:(nextErrorArray at:xN) + eLB. + ]. + ]. + + bitCnt := bitCnt - depth. + bitCnt == 0 ifTrue:[ + outBits at:dstIndex put:byte. + dstIndex := dstIndex + 1. + byte := 0. + bitCnt := 8. + ]. + + ]. + bitCnt ~~ 8 ifTrue:[ + byte := byte bitShift:bitCnt. + outBits at:dstIndex put:byte. + bitCnt := 8. + ]. + + dstIndex := nextDst. + ]. ] ifFalse:[ - 0 to:(h-1) do:[:y | - nextDst := dstIndex + bytesPerOutRow. - byte := 0. - - t := errorArray. - errorArray := nextErrorArray. - nextErrorArray := t. - - nextErrorArray atAllPut:0. - - self colorsAtY:y from:0 to:(w-1) do:[:x :clr | - |e "{ Class: SmallInteger }" - pixel "{ Class: SmallInteger }" - error "{ Class: SmallInteger }" - e16 "{ Class: SmallInteger }" - xE "{ Class: SmallInteger }" - xN "{ Class: SmallInteger }" | - - grey := (clr brightness * greyLevels). - pixel := grey truncated. - error := ((grey - pixel) * 1024) truncated. - - "/ adjust error - xE := x + 2. - error := error + (errorArray at:xE). - - byte := byte bitShift:depth. - error > 512 "0.5" ifTrue:[ - pixel := pixel + 1. - e := error - 1024 "1.0" - ] ifFalse:[ - e := error - ]. - - byte := byte bitOr:pixel. - - e ~= 0 ifTrue:[ - e16 := e // 16. - - eR := e16 * 7. "/ 7/16 to right - eRB := e16 * 1. "/ 1/16 to right below - eB := e16 * 5. "/ 5/16 to below - eLB := e - eR - eRB - eB. "/ 3/16 to left below - - xN := xE + 1. - eR ~= 0 ifTrue:[ - errorArray at:xN put:(errorArray at:xN) + eR. - ]. - eRB ~= 0 ifTrue:[ - nextErrorArray at:xN put:(nextErrorArray at:xN) + eRB. - ]. - eB ~= 0 ifTrue:[ - nextErrorArray at:xE put:(nextErrorArray at:xE) + eB. - ]. - eLB ~= 0 ifTrue:[ - xN := xE - 1. - nextErrorArray at:xN put:(nextErrorArray at:xN) + eLB. - ]. - ]. - - bitCnt := bitCnt - depth. - bitCnt == 0 ifTrue:[ - outBits at:dstIndex put:byte. - dstIndex := dstIndex + 1. - byte := 0. - bitCnt := 8. - ]. - - ]. - bitCnt ~~ 8 ifTrue:[ - byte := byte bitShift:bitCnt. - outBits at:dstIndex put:byte. - bitCnt := 8. - ]. - - dstIndex := nextDst. - ]. + 0 to:(h-1) do:[:y | + nextDst := dstIndex + bytesPerOutRow. + byte := 0. + + t := errorArray. + errorArray := nextErrorArray. + nextErrorArray := t. + + nextErrorArray atAllPut:0. + + self colorsAtY:y from:0 to:(w-1) do:[:x :clr | + |e "{ Class: SmallInteger }" + pixel "{ Class: SmallInteger }" + error "{ Class: SmallInteger }" + e16 "{ Class: SmallInteger }" + xE "{ Class: SmallInteger }" + xN "{ Class: SmallInteger }" | + + grey := (clr brightness * greyLevels). + pixel := grey truncated. + error := ((grey - pixel) * 1024) truncated. + + "/ adjust error + xE := x + 2. + error := error + (errorArray at:xE). + + byte := byte bitShift:depth. + error > 512 "0.5" ifTrue:[ + pixel := pixel + 1. + e := error - 1024 "1.0" + ] ifFalse:[ + e := error + ]. + + byte := byte bitOr:pixel. + + e ~= 0 ifTrue:[ + e16 := e // 16. + + eR := e16 * 7. "/ 7/16 to right + eRB := e16 "* 1". "/ 1/16 to right below + eB := e16 * 5. "/ 5/16 to below + eLB := e - eR - eRB - eB. "/ 3/16 to left below + + xN := xE + 1. + eR ~= 0 ifTrue:[ + errorArray at:xN put:(errorArray at:xN) + eR. + ]. + eRB ~= 0 ifTrue:[ + nextErrorArray at:xN put:(nextErrorArray at:xN) + eRB. + ]. + eB ~= 0 ifTrue:[ + nextErrorArray at:xE put:(nextErrorArray at:xE) + eB. + ]. + eLB ~= 0 ifTrue:[ + xN := xE - 1. + nextErrorArray at:xN put:(nextErrorArray at:xN) + eLB. + ]. + ]. + + bitCnt := bitCnt - depth. + bitCnt == 0 ifTrue:[ + outBits at:dstIndex put:byte. + dstIndex := dstIndex + 1. + byte := 0. + bitCnt := 8. + ]. + + ]. + bitCnt ~~ 8 ifTrue:[ + byte := byte bitShift:bitCnt. + outBits at:dstIndex put:byte. + bitCnt := 8. + ]. + + dstIndex := nextDst. + ]. ]. ^ outBits @@ -7967,64 +8030,64 @@ byte := 0. self depth <= 12 ifTrue:[ - "/ fetch scaled brightness values outside of loop into a table; - "/ use table-value in loop - - greyValues := self greyMapForRange:(255 * 1024). - greyValues := greyValues collect:[:v | v rounded]. - - 0 to:(h-1) do:[:y | - nextDst := dstIndex + bytesPerMonoRow. - - t := errorArray. - errorArray := nextErrorArray. - nextErrorArray := t. - - nextErrorArray atAllPut:0. - - self valuesAtY:y from:0 to:(w-1) do:[:x :pixel | + "/ fetch scaled brightness values outside of loop into a table; + "/ use table-value in loop + + greyValues := self greyMapForRange:(255 * 1024). + greyValues := greyValues collect:[:v | v rounded]. + + 0 to:(h-1) do:[:y | + nextDst := dstIndex + bytesPerMonoRow. + + t := errorArray. + errorArray := nextErrorArray. + nextErrorArray := t. + + nextErrorArray atAllPut:0. + + self valuesAtY:y from:0 to:(w-1) do:[:x :pixel | %{ - int __grey, __e; - int __byte = __intVal(byte); - OBJ *__errorArray = __ArrayInstPtr(errorArray)->a_element; - OBJ *__nextErrorArray = __ArrayInstPtr(nextErrorArray)->a_element; - int __x = __intVal(x); - int __eR, __eB, __eRB, __eLB, __eI; - int __bitCnt = __intVal(bitCnt); - - __grey = __intVal(__ArrayInstPtr(greyValues)->a_element[__intVal(pixel)]); - __grey += __intVal(__errorArray[__x+1]); - - __byte <<= 1; - if (__grey > 127*1024) { - __e = __grey - (255*1024); - __byte |= 1; - } else { - __e = __grey; - } - if (__e) { - __eI = __e >> 4; - __eR = __eI * 7; - __eRB = __eI * 1; - __eB = __eI * 5; - __eLB = __e - __eR - __eRB - __eB; - __errorArray[__x+2] = __MKSMALLINT(__intVal(__errorArray[__x+2]) + __eR); - __nextErrorArray[__x+2] = __MKSMALLINT(__intVal(__nextErrorArray[__x+2]) + __eRB); - __nextErrorArray[__x+1] = __MKSMALLINT(__intVal(__nextErrorArray[__x+1]) + __eB); - __nextErrorArray[__x ] = __MKSMALLINT(__intVal(__nextErrorArray[__x ]) + __eLB); - - } - __bitCnt--; - if (__bitCnt == 0) { - int __dstIndex = __intVal(dstIndex); - - __ByteArrayInstPtr(monoBits)->ba_element[__dstIndex-1] = __byte; - dstIndex = __MKSMALLINT(__dstIndex + 1); - __byte = 0; - __bitCnt = 8; - } - byte = __MKSMALLINT(__byte); - bitCnt = __MKSMALLINT(__bitCnt); + int __grey, __e; + int __byte = __intVal(byte); + OBJ *__errorArray = __ArrayInstPtr(errorArray)->a_element; + OBJ *__nextErrorArray = __ArrayInstPtr(nextErrorArray)->a_element; + int __x = __intVal(x); + int __eR, __eB, __eRB, __eLB, __eI; + int __bitCnt = __intVal(bitCnt); + + __grey = __intVal(__ArrayInstPtr(greyValues)->a_element[__intVal(pixel)]); + __grey += __intVal(__errorArray[__x+1]); + + __byte <<= 1; + if (__grey > 127*1024) { + __e = __grey - (255*1024); + __byte |= 1; + } else { + __e = __grey; + } + if (__e) { + __eI = __e >> 4; + __eR = __eI * 7; + __eRB = __eI * 1; + __eB = __eI * 5; + __eLB = __e - __eR - __eRB - __eB; + __errorArray[__x+2] = __MKSMALLINT(__intVal(__errorArray[__x+2]) + __eR); + __nextErrorArray[__x+2] = __MKSMALLINT(__intVal(__nextErrorArray[__x+2]) + __eRB); + __nextErrorArray[__x+1] = __MKSMALLINT(__intVal(__nextErrorArray[__x+1]) + __eB); + __nextErrorArray[__x ] = __MKSMALLINT(__intVal(__nextErrorArray[__x ]) + __eLB); + + } + __bitCnt--; + if (__bitCnt == 0) { + int __dstIndex = __intVal(dstIndex); + + __ByteArrayInstPtr(monoBits)->ba_element[__dstIndex-1] = __byte; + dstIndex = __MKSMALLINT(__dstIndex + 1); + __byte = 0; + __bitCnt = 8; + } + byte = __MKSMALLINT(__byte); + bitCnt = __MKSMALLINT(__bitCnt); %}. "/ |eI "{ Class: SmallInteger }" @@ -8077,91 +8140,91 @@ "/ byte := 0. "/ bitCnt := 8. "/ ]. - 0 - ]. - bitCnt ~~ 8 ifTrue:[ - byte := byte bitShift:bitCnt. - monoBits at:dstIndex put:byte. - bitCnt := 8. - byte := 0. - ]. - - dstIndex := nextDst. - ]. + 0 + ]. + bitCnt ~~ 8 ifTrue:[ + byte := byte bitShift:bitCnt. + monoBits at:dstIndex put:byte. + bitCnt := 8. + byte := 0. + ]. + + dstIndex := nextDst. + ]. ] ifFalse:[ - 'Image [info]: slow floydSteinberg dither ..' infoPrintCR. - - 0 to:(h-1) do:[:y | - nextDst := dstIndex + bytesPerMonoRow. - - t := errorArray. - errorArray := nextErrorArray. - nextErrorArray := t. - - nextErrorArray atAllPut:0. - - self colorsAtY:y from:0 to:(w-1) do:[:x :clr | - |eI "{ Class: SmallInteger }" - xE "{ Class: SmallInteger }" - xN "{ Class: SmallInteger }" | - - "/ get the colors grey value [0 .. 1] - grey := (clr brightness * 255). - - "/ adjust error - xE := x + 2. - grey := (grey + (errorArray at:xE)) rounded. - - byte := byte bitShift:1. - grey > 127 ifTrue:[ - byte := byte bitOr:1. "/ white - e := grey - 255 - ] ifFalse:[ - e := grey "/ black - ]. - - e ~= 0 ifTrue:[ - eD := e. - eI := e // 16. - eR := eI * 7. "/ 7/16 to right - eRB := eI * 1. "/ 1/16 to right below - eB := eI * 5. "/ 5/16 to below - eLB := eD - eR - eRB - eB. "/ 3/16 to left below - - xN := xE + 1. - eR ~= 0 ifTrue:[ - errorArray at:xN put:(errorArray at:xN) + eR. - ]. - eRB ~= 0 ifTrue:[ - nextErrorArray at:xN put:(nextErrorArray at:xN) + eRB. - ]. - eB ~= 0 ifTrue:[ - nextErrorArray at:xE put:(nextErrorArray at:xE) + eB. - ]. - eLB ~= 0 ifTrue:[ - xN := xE - 1. - nextErrorArray at:xN put:(nextErrorArray at:xN) + eLB. - ]. - ]. - - bitCnt := bitCnt - 1. - bitCnt == 0 ifTrue:[ - monoBits at:dstIndex put:byte. - dstIndex := dstIndex + 1. - byte := 0. - bitCnt := 8. - ]. - - ]. - bitCnt ~~ 8 ifTrue:[ - byte := byte bitShift:bitCnt. - monoBits at:dstIndex put:byte. - bitCnt := 8. - byte := 0. - ]. - - dstIndex := nextDst. - ]. + 'Image [info]: slow floydSteinberg dither ..' infoPrintCR. + + 0 to:(h-1) do:[:y | + nextDst := dstIndex + bytesPerMonoRow. + + t := errorArray. + errorArray := nextErrorArray. + nextErrorArray := t. + + nextErrorArray atAllPut:0. + + self colorsAtY:y from:0 to:(w-1) do:[:x :clr | + |eI "{ Class: SmallInteger }" + xE "{ Class: SmallInteger }" + xN "{ Class: SmallInteger }" | + + "/ get the colors grey value [0 .. 1] + grey := (clr brightness * 255). + + "/ adjust error + xE := x + 2. + grey := (grey + (errorArray at:xE)) rounded. + + byte := byte bitShift:1. + grey > 127 ifTrue:[ + byte := byte bitOr:1. "/ white + e := grey - 255 + ] ifFalse:[ + e := grey "/ black + ]. + + e ~= 0 ifTrue:[ + eD := e. + eI := e // 16. + eR := eI * 7. "/ 7/16 to right + eRB := eI "* 1". "/ 1/16 to right below + eB := eI * 5. "/ 5/16 to below + eLB := eD - eR - eRB - eB. "/ 3/16 to left below + + xN := xE + 1. + eR ~= 0 ifTrue:[ + errorArray at:xN put:(errorArray at:xN) + eR. + ]. + eRB ~= 0 ifTrue:[ + nextErrorArray at:xN put:(nextErrorArray at:xN) + eRB. + ]. + eB ~= 0 ifTrue:[ + nextErrorArray at:xE put:(nextErrorArray at:xE) + eB. + ]. + eLB ~= 0 ifTrue:[ + xN := xE - 1. + nextErrorArray at:xN put:(nextErrorArray at:xN) + eLB. + ]. + ]. + + bitCnt := bitCnt - 1. + bitCnt == 0 ifTrue:[ + monoBits at:dstIndex put:byte. + dstIndex := dstIndex + 1. + byte := 0. + bitCnt := 8. + ]. + + ]. + bitCnt ~~ 8 ifTrue:[ + byte := byte bitShift:bitCnt. + monoBits at:dstIndex put:byte. + bitCnt := 8. + byte := 0. + ]. + + dstIndex := nextDst. + ]. ]. ^ monoBits @@ -13435,9 +13498,9 @@ numRedBits := bitsPerSample at:1. numGreenBits := bitsPerSample at:2. numBlueBits := bitsPerSample at:3. - r := (r = 0) ifTrue:[0] ifFalse:[(100 / ((1 bitShift:numRedBits)-1) * r)]. - g := (g = 0) ifTrue:[0] ifFalse:[(100 / ((1 bitShift:numGreenBits)-1) * g)]. - b := (b = 0) ifTrue:[0] ifFalse:[(100 / ((1 bitShift:numBlueBits)-1) * b)]. + (r == 0) ifFalse:[ r := (100 / ((1 bitShift:numRedBits)-1) * r)]. + (g == 0) ifFalse:[ g := (100 / ((1 bitShift:numGreenBits)-1) * g)]. + (b == 0) ifFalse:[ b := (100 / ((1 bitShift:numBlueBits)-1) * b)]. ^ Color redPercent:r greenPercent:g bluePercent:b ]. @@ -13451,10 +13514,10 @@ numGreenBits := bitsPerSample at:2. numBlueBits := bitsPerSample at:3. numAlphaBits := bitsPerSample at:4. - r := (r = 0) ifTrue:[0] ifFalse:[(100 / ((1 bitShift:numRedBits)-1) * r)]. - g := (g = 0) ifTrue:[0] ifFalse:[(100 / ((1 bitShift:numGreenBits)-1) * g)]. - b := (b = 0) ifTrue:[0] ifFalse:[(100 / ((1 bitShift:numBlueBits)-1) * b)]. - a := (a = 0) ifTrue:[0] ifFalse:[(100 / ((1 bitShift:numAlphaBits)-1) * a)]. + (r == 0) ifFalse:[ r := (100 / ((1 bitShift:numRedBits)-1) * r)]. + (g == 0) ifFalse:[ g := (100 / ((1 bitShift:numGreenBits)-1) * g)]. + (b == 0) ifFalse:[ b := (100 / ((1 bitShift:numBlueBits)-1) * b)]. + (a == 0) ifFalse:[ a := (100 / ((1 bitShift:numAlphaBits)-1) * a)]. ^ Color redPercent:r greenPercent:g bluePercent:b alphaPercent:a ]. diff -r d047c5fb149a -r c3b4c3c664d4 ModalBox.st --- a/ModalBox.st Sun Apr 03 16:05:41 2016 +0100 +++ b/ModalBox.st Sun Apr 03 17:09:29 2016 +0100 @@ -311,8 +311,8 @@ "/ label := 'Popup'. UseTransientViews ifFalse:[ - (PopUpView shadowsOnDevice:self graphicsDevice) ifTrue:[ - shadowView := (ShadowView onDevice:self graphicsDevice) for:self + (PopUpView shadowsOnDevice:device) ifTrue:[ + shadowView := (ShadowView onDevice:device) for:self ]. form := Form width:8 height:8 @@ -325,7 +325,7 @@ 2r00001111 2r00011111 ] - onDevice:self graphicsDevice. + onDevice:device. resizeButton := Button label:form in:self. resizeButton origin:1.0 @ 1.0 corner:1.0@1.0. resizeButton activeForegroundColor:(resizeButton foregroundColor). @@ -348,7 +348,7 @@ 2r00000000 2r00000000 ] - onDevice:self graphicsDevice. + onDevice:device. moveButton := Button label:form in:self. moveButton origin:0.0 @ 0.0 corner:0.0@0.0. moveButton activeForegroundColor:(moveButton foregroundColor). @@ -403,7 +403,7 @@ |newExtent maxExtent| newExtent := self preferredExtent. - newExtent := newExtent min:(self graphicsDevice extent). + newExtent := newExtent min:(device extent). maxExtent := self maxExtent. maxExtent notNil ifTrue:[ @@ -437,12 +437,12 @@ shown ifTrue:[ delta := width - newExtent x. newLeft := left + delta. - (((newLeft @ top) extent:newExtent) containsPoint:self graphicsDevice pointerPosition + (((newLeft @ top) extent:newExtent) containsPoint:device pointerPosition ) ifFalse:[ newLeft := left ]. newLeft < 0 ifTrue:[newLeft := 0]. - screenWidth := self graphicsDevice usableWidth. + screenWidth := device usableWidth. newLeft + newExtent x > screenWidth ifTrue:[ newLeft := screenWidth - newExtent x ]. @@ -471,7 +471,7 @@ |r| - r := self graphicsDevice rectangleFromUser:(self origin corner:self corner) keepExtent:true. + r := device rectangleFromUser:(self origin corner:self corner) keepExtent:true. shadowView notNil ifTrue:[ shadowView unmap ]. @@ -492,7 +492,7 @@ |r| - r := self graphicsDevice rectangleFromUser:(self origin corner:self corner). + r := device rectangleFromUser:(self origin corner:self corner). shadowView notNil ifTrue:[ shadowView unmap ]. @@ -596,7 +596,7 @@ We need a short delay here, since at this time, the expose event has not yet arrived. " - self graphicsDevice sync. "/ thats a round trip, to ensure that all expose events are present..." + device sync. "/ thats a round trip, to ensure that all expose events are present..." Delay waitForSeconds:0.05. masterGroup processExposeEvents ]. @@ -764,7 +764,7 @@ showAtCenter "make myself visible at the screen center." - self showAt:(self graphicsDevice centerOfMonitorHavingPointer) center:true + self showAt:(device centerOfMonitorHavingPointer) center:true " |b| @@ -783,14 +783,14 @@ |first pointerPosition positionOffset pos monitorBounds alignedPos| "/ ****** MULTI SCREEN - pointerPosition := self graphicsDevice pointerPosition. + pointerPosition := device pointerPosition. self fixSize. positionOffset := self positionOffset. pos := alignedPos := pointerPosition - positionOffset. UserPreferences current forceWindowsIntoMonitorBounds ifTrue:[ - monitorBounds := self graphicsDevice monitorBoundsAt:pointerPosition. + monitorBounds := device monitorBoundsAt:pointerPosition. alignedPos := (pos x max:monitorBounds left) @ (pos y max:monitorBounds top). ]. @@ -821,7 +821,7 @@ ]. "/ cannot use: - "/ self showAt:(self graphicsDevice pointerPosition - self positionOffset). + "/ self showAt:(device pointerPosition - self positionOffset). "/ because the resizing must be done before the "/ positionOffset is grabbed (it may change due to the resize) @@ -843,7 +843,7 @@ |pos newX| - pos := self graphicsDevice pointerPosition - self positionOffset. + pos := device pointerPosition - self positionOffset. ((Rectangle origin:pos extent:self extent) intersects: (aView origin corner: aView corner)) @@ -852,8 +852,8 @@ try to the right of the untouchable view " newX := (aView origin x + aView width). - newX + width > self graphicsDevice usableWidth ifTrue:[ - newX := self graphicsDevice usableWidth - width + newX + width > device usableWidth ifTrue:[ + newX := device usableWidth - width ]. pos x:newX. diff -r d047c5fb149a -r c3b4c3c664d4 PopUpView.st --- a/PopUpView.st Sun Apr 03 16:05:41 2016 +0100 +++ b/PopUpView.st Sun Apr 03 17:09:29 2016 +0100 @@ -11,6 +11,8 @@ " "{ Package: 'stx:libview' }" +"{ NameSpace: Smalltalk }" + TopView subclass:#PopUpView instanceVariableNames:'shadowView haveControl exclusivePointer mapTime previousPointerGrab previousKeyboardGrab' @@ -174,7 +176,7 @@ showAtPointer "realize the view at the current pointer position" - self showAt:(self graphicsDevice pointerPosition) resizing:true + self showAt:(device pointerPosition) resizing:true ! showCenteredIn:aView @@ -206,13 +208,13 @@ !PopUpView methodsFor:'grabbing'! grabKeyboard - previousKeyboardGrab := self graphicsDevice activeKeyboardGrab. + previousKeyboardGrab := device activeKeyboardGrab. "/ Transcript show:'k-ggg by '; show:self; show:'[',self identityHash printString,']'; showCR:' - previous is ' , previousKeyboardGrab printString. ^ super grabKeyboard ! grabPointerWithCursor:aCursorOrNil - previousPointerGrab := self graphicsDevice activePointerGrab. + previousPointerGrab := device activePointerGrab. "/ Transcript show:'ggg by '; show:self; show:'[',self identityHash printString,']'; showCR:' - previous is ' , previousPointerGrab printString. ^ super grabPointerWithCursor:aCursorOrNil ! @@ -221,7 +223,7 @@ "/ Transcript show:'k-uuu by '; show:self; show:'[',self identityHash printString,']'; showCR:' - previous is ' , previousKeyboardGrab printString. super ungrabKeyboard. previousKeyboardGrab notNil ifTrue:[ - self graphicsDevice grabKeyboardInView:previousKeyboardGrab + device grabKeyboardInView:previousKeyboardGrab ]. ! @@ -229,7 +231,7 @@ "/ Transcript show:'uuu by '; show:self; show:'[',self identityHash printString,']'; showCR:' - previous is ' , previousPointerGrab printString. super ungrabPointer. previousPointerGrab notNil ifTrue:[ - self graphicsDevice grabPointerInView:previousPointerGrab + device grabPointerInView:previousPointerGrab ]. ! ! @@ -257,7 +259,7 @@ super initStyle. DefaultBorderColor notNil ifTrue:[ - self borderColor:(DefaultBorderColor onDevice:self graphicsDevice). + self borderColor:(DefaultBorderColor onDevice:device). ]. (bw := DefaultBorderWidth) isNil ifTrue:[ bw := (styleSheet is3D ifTrue:[0] ifFalse:[1]). @@ -271,8 +273,8 @@ ]. self level:l. - (self class shadowsOnDevice:self graphicsDevice) ifTrue:[ - shadowView := (ShadowView onDevice:self graphicsDevice) for:self. + (self class shadowsOnDevice:device) ifTrue:[ + shadowView := (ShadowView onDevice:device) for:self. ]. "Modified: / 4.12.1998 / 15:11:28 / cg" @@ -293,8 +295,8 @@ releasePointer "release the mouse pointer" - self graphicsDevice activePointerGrab == self ifTrue:[ - self graphicsDevice ungrabPointer. + device activePointerGrab == self ifTrue:[ + device ungrabPointer. ]. "Modified: 12.5.1996 / 22:04:09 / cg" @@ -438,10 +440,10 @@ !PopUpView class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.62 2014-02-18 15:05:32 stefan Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.62 2014-02-18 15:05:32 stefan Exp $' + ^ '$Header$' ! ! diff -r d047c5fb149a -r c3b4c3c664d4 ShadowView.st --- a/ShadowView.st Sun Apr 03 16:05:41 2016 +0100 +++ b/ShadowView.st Sun Apr 03 17:09:29 2016 +0100 @@ -11,6 +11,8 @@ " "{ Package: 'stx:libview' }" +"{ NameSpace: Smalltalk }" + SimpleView subclass:#ShadowView instanceVariableNames:'myView shadowLength shadowClr imageUnderShadow' classVariableNames:'' @@ -124,7 +126,7 @@ shadowClr := StyleSheet at:#popUpShadowColor. "the length of the shadow from myView" - shadowLength := self graphicsDevice pixelPerMillimeter. + shadowLength := device pixelPerMillimeter. "/ shadowLength := (self graphicsDevice pixelPerMillimeter * 2.0) rounded. ! @@ -136,7 +138,7 @@ rS gS bS rM gM bM rSN gSN bSN pix r g b graphicsDevice| myView notNil ifTrue:[ - graphicsDevice := self graphicsDevice. + graphicsDevice := device. self origin:(myView origin + (myView borderWidth * 2) + shadowLength) extent:(myView extent). @@ -262,11 +264,11 @@ "sent after a snapin or a migration, reinit for new device" shadowClr notNil ifTrue:[ - shadowClr := shadowClr onDevice:self graphicsDevice + shadowClr := shadowClr onDevice:device ]. "the length of the shadow from myView" - shadowLength := self graphicsDevice pixelPerMillimeter. + shadowLength := device pixelPerMillimeter. super recreate. self backingStore:false. @@ -287,10 +289,10 @@ !ShadowView class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libview/ShadowView.st,v 1.37 2014-02-18 16:49:08 stefan Exp $' + ^ '$Header$' ! version_CVS - ^ '$Header: /cvs/stx/stx/libview/ShadowView.st,v 1.37 2014-02-18 16:49:08 stefan Exp $' + ^ '$Header$' ! ! diff -r d047c5fb149a -r c3b4c3c664d4 SimpleView.st --- a/SimpleView.st Sun Apr 03 16:05:41 2016 +0100 +++ b/SimpleView.st Sun Apr 03 17:09:29 2016 +0100 @@ -842,19 +842,20 @@ If its later realized and no superview has ever been set, it will come up as a topview." - |newView device| + |newView viewsDevice| newView := self basicNew. aView notNil ifTrue:[ - newView initializeForDevice:(aView graphicsDevice). + viewsDevice := aView graphicsDevice. "/ newView container:aView. ] ifFalse:[ - newView initializeForDevice:Screen current - ]. - (newView device supportsNativeWidgetType:newView nativeWindowType) ifTrue:[ - newView beNativeWidget. - device := Screen current - ]. + viewsDevice := Screen current + ]. + newView device:viewsDevice. + (viewsDevice supportsNativeWidgetType:newView nativeWindowType) ifTrue:[ + newView beNativeWidget + ]. + newView initialize. aView notNil ifTrue:[aView addSubView:newView]. ^ newView @@ -899,14 +900,14 @@ Used with popUpMenus, which should be created on the device of its masterView." - |device| + |viewsDevice| anotherView notNil ifTrue:[ - device := anotherView graphicsDevice. + viewsDevice := anotherView graphicsDevice. ] ifFalse:[ - device := Screen current. - ]. - ^ self onDevice:device + viewsDevice := Screen current. + ]. + ^ self onDevice:viewsDevice "Modified: 28.5.1996 / 20:25:05 / cg" ! @@ -1994,18 +1995,18 @@ "set the borderShape to aForm" aForm isNil ifTrue:[ - viewShape := nil. - self drawableId notNil ifTrue:[ - self graphicsDevice setWindowBorderShape:nil in:self drawableId - ] + viewShape := nil. + self drawableId notNil ifTrue:[ + device setWindowBorderShape:nil in:self drawableId + ] ] ifFalse:[ - viewShape isNil ifTrue:[ - viewShape := ArbitraryViewShape new - ]. - viewShape borderShapeForm:aForm. - self drawableId notNil ifTrue:[ - self graphicsDevice setWindowBorderShape:(aForm id) in:self drawableId - ] + viewShape isNil ifTrue:[ + viewShape := ArbitraryViewShape new + ]. + viewShape borderShapeForm:aForm. + self drawableId notNil ifTrue:[ + device setWindowBorderShape:(aForm id) in:self drawableId + ] ] "Modified: 18.9.1997 / 11:09:40 / cg" @@ -2238,11 +2239,11 @@ self assert:(something notNil) message:'invalid viewBackground argument'. something isColor ifTrue:[ - self graphicsDevice hasGrayscales ifTrue:[ - avgColor := something averageColorIn:(0@0 corner:7@7). - shadowColor := avgColor darkened "on:device". - lightColor := avgColor lightened "on:device". - ] + device hasGrayscales ifTrue:[ + avgColor := something averageColorIn:(0@0 corner:7@7). + shadowColor := avgColor darkened "on:device". + lightColor := avgColor lightened "on:device". + ] ]. super viewBackground:something @@ -2265,19 +2266,19 @@ "set the viewShape to aForm" aForm isNil ifTrue:[ - viewShape := nil. - self drawableId notNil ifTrue:[ - self graphicsDevice setWindowShape:nil in:self drawableId - ] + viewShape := nil. + self drawableId notNil ifTrue:[ + device setWindowShape:nil in:self drawableId + ] ] ifFalse:[ - viewShape isNil ifTrue:[ - viewShape := ArbitraryViewShape new - ]. - - viewShape viewShapeForm:aForm. - self drawableId notNil ifTrue:[ - self graphicsDevice setWindowShape:(aForm id) in:self drawableId - ] + viewShape isNil ifTrue:[ + viewShape := ArbitraryViewShape new + ]. + + viewShape viewShapeForm:aForm. + self drawableId notNil ifTrue:[ + device setWindowShape:(aForm id) in:self drawableId + ] ] "Modified: 18.9.1997 / 11:11:04 / cg" @@ -3000,7 +3001,7 @@ deviceLeft deviceRight deviceTop deviceBottom origin corner referencePoint| - myDevice := self graphicsDevice. + myDevice := device. newTop := top. newLeft := left. @@ -3090,40 +3091,40 @@ |extent shapeForm borderForm w h f lw| - self graphicsDevice supportsRoundShapedViews ifTrue:[ - "/ TODO: add code for round shaped view (mswin) - ]. - - self graphicsDevice supportsArbitraryShapedViews ifTrue:[ - extent := self extent. - w := extent x. - h := extent y. - borderForm := Form extent:extent. - shapeForm := Form extent:extent. - - borderForm fillArcX:0 y:0 - width:w - height:h - from:0 - angle:360. - - opaque ifFalse:[ - f := borderForm. - borderForm foreground:(Color colorId:0). - ] ifTrue:[ - f := shapeForm. - shapeForm foreground:(Color colorId:1). - ]. - - f fillArcX:(lw := gc lineWidth) y:lw - width:w - (bw * 2) - height:h - (bw * 2) - from:0 - angle:360. - - self borderShape:borderForm. - self viewShape:shapeForm. - ^ self. +"/ device supportsRoundShapedViews ifTrue:[ +"/ "/ TODO: add code for round shaped view (mswin) +"/ ]. + + device supportsArbitraryShapedViews ifTrue:[ + extent := self extent. + w := extent x. + h := extent y. + borderForm := Form extent:extent. + shapeForm := Form extent:extent. + + borderForm fillArcX:0 y:0 + width:w + height:h + from:0 + angle:360. + + opaque ifFalse:[ + f := borderForm. + borderForm foreground:(Color colorId:0). + ] ifTrue:[ + f := shapeForm. + shapeForm foreground:(Color colorId:1). + ]. + + f fillArcX:(lw := gc lineWidth) y:lw + width:w - (bw * 2) + height:h - (bw * 2) + from:0 + angle:360. + + self borderShape:borderForm. + self viewShape:shapeForm. + ^ self. "/ "/ extent := self extent. @@ -3173,29 +3174,29 @@ "/ "/ TODO: add code for mswin "/ ]. - self graphicsDevice supportsArbitraryShapedViews ifTrue:[ - extent := self extent. - w := extent x. - h := extent y. - borderForm := Form extent:extent. - shapeForm := Form extent:extent. - - borderForm - fillRectangleX:0 y:0 - width:w - height:h. - - f := borderForm. - borderForm foreground:(Color colorId:0). - - borderForm - fillRectangleX:bw y:bw - width:w - (bw * 2) - height:h - (bw * 2). - - self borderShape:borderForm. - self viewShape:shapeForm. - ^ self. + device supportsArbitraryShapedViews ifTrue:[ + extent := self extent. + w := extent x. + h := extent y. + borderForm := Form extent:extent. + shapeForm := Form extent:extent. + + borderForm + fillRectangleX:0 y:0 + width:w + height:h. + + f := borderForm. + borderForm foreground:(Color colorId:0). + + borderForm + fillRectangleX:bw y:bw + width:w - (bw * 2) + height:h - (bw * 2). + + self borderShape:borderForm. + self viewShape:shapeForm. + ^ self. ] ! @@ -3343,17 +3344,17 @@ sumX := 0. sumY := 0. [currentView notNil] whileTrue:[ - (currentView == aView) ifTrue:[ - ^ (sumX @ sumY) - ]. - bw := currentView borderWidth. - sumX := sumX + (currentView left) + bw. - sumY := sumY + (currentView top) + bw. - currentView := currentView superView - ]. - (aView isNil or:[aView == self graphicsDevice rootView]) ifTrue:[ - "return relative to screen ..." - ^ (sumX @ sumY) + (currentView == aView) ifTrue:[ + ^ (sumX @ sumY) + ]. + bw := currentView borderWidth. + sumX := sumX + (currentView left) + bw. + sumY := sumY + (currentView top) + bw. + currentView := currentView superView + ]. + (aView isNil or:[aView == device rootView]) ifTrue:[ + "return relative to screen ..." + ^ (sumX @ sumY) ]. ^ nil @@ -3792,7 +3793,7 @@ "bring to back" self drawableId isNil ifTrue:[self create]. - self graphicsDevice lowerWindow:self drawableId + device lowerWindow:self drawableId " Transcript topView lower @@ -3809,7 +3810,7 @@ or mark as #beScreenDialog before opening" self drawableId isNil ifTrue:[self create]. - self graphicsDevice raiseWindowToTop:self drawableId + device raiseWindowToTop:self drawableId " Transcript topView raise @@ -3963,14 +3964,14 @@ the model first, then use the views menu. " (menuHolder respondsTo:sym) ifFalse:[ - (self respondsTo:sym) ifTrue:[ - menuHolder := self - ] + (self respondsTo:sym) ifTrue:[ + menuHolder := self + ] ]. sym numArgs > 0 ifTrue:[ - "/ squeak compatibility (with args): create the empty menu here, let model add items - ^ menuHolder perform:sym withOptionalArgument:(Menu new) and:(self graphicsDevice shiftDown). + "/ squeak compatibility (with args): create the empty menu here, let model add items + ^ menuHolder perform:sym withOptionalArgument:(Menu new) and:(device shiftDown). ]. " @@ -4439,7 +4440,7 @@ visible." self beVisible. - self graphicsDevice sync. "that's a round-trip; when returning, the view is definitely visible" + device sync. "that's a round-trip; when returning, the view is definitely visible" "/ realized := true. "/ shown := true. @@ -4859,11 +4860,11 @@ "common code for addSubView* methods" aView container:self. - (aView graphicsDevice ~~ self graphicsDevice) ifTrue:[ - 'SimpleView [warning]: subview (' errorPrint. aView class name errorPrint. - ') has different device than me (' errorPrint. - self class name errorPrint. ').' errorPrintCR. - aView device:self graphicsDevice + (aView graphicsDevice ~~ device) ifTrue:[ + 'SimpleView [warning]: subview (' errorPrint. aView class name errorPrint. + ') has different device than me (' errorPrint. + self class name errorPrint. ').' errorPrintCR. + aView device:device ]. "Created: 9.5.1996 / 00:46:59 / cg" @@ -4940,7 +4941,7 @@ cursors := bitmaps collect:[:form | (Cursor sourceForm:form maskForm:maskForm hotX:8 - hotY:8) onDevice:self graphicsDevice]. + hotY:8) onDevice:device]. process := [ Delay waitForSeconds:0.25. @@ -5335,33 +5336,33 @@ count == 0 ifTrue:[^ self]. (count < 0) ifTrue:[ - leftFg := shadowColor. - leftHalfFg := halfShadowColor. - count := count negated. + leftFg := shadowColor. + leftHalfFg := halfShadowColor. + count := count negated. ] ifFalse:[ - leftFg := lightColor. - leftHalfFg := halfLightColor. + leftFg := lightColor. + leftHalfFg := halfLightColor. ]. leftHalfFg isNil ifTrue:[ - leftHalfFg := leftFg + leftHalfFg := leftFg ]. ((edgeStyle == #soft) and:[level > 0]) ifTrue:[ - paint := leftHalfFg + paint := leftHalfFg ] ifFalse:[ - paint := leftFg + paint := leftFg ]. super paint:paint. super lineWidth:0. b := height - 1. 0 to:(count - 1) do:[:i | - super displayDeviceLineFromX:i y:i toX:i y:(b - i) + super displayDeviceLineFromX:i y:i toX:i y:(b - i) ]. ((edgeStyle == #soft) and:[level > 2]) ifTrue:[ - super paint:(self graphicsDevice blackColor). - super displayDeviceLineFromX:0 y:0 toX:0 y:b. + super paint:(device blackColor). + super displayDeviceLineFromX:0 y:0 toX:0 y:b. ]. self edgeDrawn:#left. @@ -5460,7 +5461,7 @@ super displayDeviceLineFromX:i y:y+i toX:(r - i) y:y+i ]. ((edgeStyle == #soft) and:[level > 2]) ifTrue:[ - super paint:(self graphicsDevice blackColor). + super paint:(device blackColor). super displayDeviceLineFromX:0 y:y+0 toX:r y:y+0. ]. @@ -5505,7 +5506,7 @@ super displayDeviceLineFromX:i y:i toX:(r - i) y:i ]. ((edgeStyle == #soft) and:[level > 2]) ifTrue:[ - super paint:(self graphicsDevice blackColor). + super paint:(device blackColor). super displayDeviceLineFromX:0 y:0 toX:r y:0. ]. @@ -5854,74 +5855,74 @@ (superView isNil and:[self drawableId notNil]) ifTrue:[ - "/ have to be careful - some window managers (motif) wrap another - "/ view around and the reported origin is relative to that. - "/ not relative to the screen. - p := self graphicsDevice translatePoint:0@0 fromView:self toView:nil. - p := p + self borderWidth. - left := p x. - top := p y. + "/ have to be careful - some window managers (motif) wrap another + "/ view around and the reported origin is relative to that. + "/ not relative to the screen. + p := device translatePoint:0@0 fromView:self toView:nil. + p := p + self borderWidth. + left := p x. + top := p y. ]. ((width ~~ newWidth) or:[height ~~ newHeight]) ifTrue:[ - realized ifFalse:[ - width := newWidth. - height := newHeight. - self extentChangedFlag:true. - ^ self - ]. - - ((newWidth <= width) and:[newHeight <= height]) ifTrue:[ - how := #smaller - ] ifFalse:[ - ((newWidth >= width) and:[newHeight >= height]) ifTrue:[ - how := #larger - ] - ]. - - margin ~~ 0 ifTrue:[ - mustRedrawBottomEdge := newHeight < height. - mustRedrawRightEdge := newWidth < width. - anyEdge := mustRedrawBottomEdge or:[mustRedrawRightEdge]. - - mustRedrawPreviousRightBorderArea := newWidth > width. - mustRedrawPreviousBottomBorderArea := newHeight > height. - ] ifFalse:[ - anyEdge := false - ]. - - mustRedrawPreviousRightBorderArea ifTrue:[ - self invalidateDeviceRectangle:((width-margin)@0 extent:margin@height) repairNow:false. - ]. - mustRedrawPreviousBottomBorderArea ifTrue:[ - self invalidateDeviceRectangle:((0 @ (height-margin)) extent:width@margin) repairNow:false. - ]. - - width := newWidth. - height := newHeight. - - "recompute inner-clip if needed" - self setInnerClip. - - " - must first process pending exposes; - otherwise, those may be drawn at a wrong position - " + realized ifFalse:[ + width := newWidth. + height := newHeight. + self extentChangedFlag:true. + ^ self + ]. + + ((newWidth <= width) and:[newHeight <= height]) ifTrue:[ + how := #smaller + ] ifFalse:[ + ((newWidth >= width) and:[newHeight >= height]) ifTrue:[ + how := #larger + ] + ]. + + margin ~~ 0 ifTrue:[ + mustRedrawBottomEdge := newHeight < height. + mustRedrawRightEdge := newWidth < width. + anyEdge := mustRedrawBottomEdge or:[mustRedrawRightEdge]. + + mustRedrawPreviousRightBorderArea := newWidth > width. + mustRedrawPreviousBottomBorderArea := newHeight > height. + ] ifFalse:[ + anyEdge := mustRedrawPreviousRightBorderArea := mustRedrawPreviousBottomBorderArea := false + ]. + + mustRedrawPreviousRightBorderArea ifTrue:[ + self invalidateDeviceRectangle:((width-margin)@0 extent:margin@height) repairNow:false. + ]. + mustRedrawPreviousBottomBorderArea ifTrue:[ + self invalidateDeviceRectangle:((0 @ (height-margin)) extent:width@margin) repairNow:false. + ]. + + width := newWidth. + height := newHeight. + + "recompute inner-clip if needed" + self setInnerClip. + + " + must first process pending exposes; + otherwise, those may be drawn at a wrong position + " "/ claus: no; expose events are in the same queue as configure events; "/ which is exactly for that reason ... "/ windowGroup notNil ifTrue:[ "/ windowGroup processExposeEvents "/ ]. - self sizeChanged:how. - - (anyEdge and:[shown]) ifTrue:[ - mustRedrawBottomEdge ifTrue:[ - self invalidateDeviceRectangle:((0 @ (height-margin)) extent:width@margin) repairNow:false. - ]. - mustRedrawRightEdge ifTrue:[ - self invalidateDeviceRectangle:((width-margin)@0 extent:margin@height) repairNow:false. - ]. + self sizeChanged:how. + + (anyEdge and:[shown]) ifTrue:[ + mustRedrawBottomEdge ifTrue:[ + self invalidateDeviceRectangle:((0 @ (height-margin)) extent:width@margin) repairNow:false. + ]. + mustRedrawRightEdge ifTrue:[ + self invalidateDeviceRectangle:((width-margin)@0 extent:margin@height) repairNow:false. + ]. "/ OLD code: "/ self clippingRectangle:nil. "/ mustRedrawBottomEdge ifTrue:[ @@ -5931,11 +5932,11 @@ "/ self drawRightEdge "/ ]. "/ self deviceClippingRectangle:innerClipRect - ] + ] ]. originChanged ifTrue:[ - self changed:#origin. + self changed:#origin. ]. "Modified: / 10.10.2001 / 14:14:19 / cg" @@ -6089,17 +6090,17 @@ (dropTypeSymbol == WindowEvent dropType_file or:[dropTypeSymbol == WindowEvent dropType_directory]) ifTrue:[ - dropObjects := Array with:(DropObject newFile:dropValue) + dropObjects := Array with:(DropObject newFile:dropValue) ] ifFalse:[ - dropTypeSymbol == WindowEvent dropType_files ifTrue:[ - dropObjects := (dropValue collect:[:fn | DropObject newFile:fn]) - ] ifFalse:[ - dropTypeSymbol == WindowEvent dropType_text ifTrue:[ - dropObjects := Array with:(DropObject newText:dropValue) - ] ifFalse:[ - dropObjects := Array with:(DropObject new:dropValue) - ] - ] + dropTypeSymbol == WindowEvent dropType_files ifTrue:[ + dropObjects := (dropValue collect:[:fn | DropObject newFile:fn]) + ] ifFalse:[ + dropTypeSymbol == WindowEvent dropType_text ifTrue:[ + dropObjects := Array with:(DropObject newText:dropValue) + ] ifFalse:[ + dropObjects := Array with:(DropObject new:dropValue) + ] + ] ]. "/ Transcript showCR:'Drop:'. @@ -6108,7 +6109,7 @@ "/ Transcript show:' Data:'; showCR:dropObjects. self alienDrop:dropObjects position:dropPosition. - self graphicsDevice dragFinish:dropHandle. + device dragFinish:dropHandle. "Modified: / 13-10-2006 / 10:10:23 / cg" ! @@ -6997,8 +6998,8 @@ sendDisplayEvent ifTrue:[ "/ translate to screen coordinates - pointXLated := self device translatePoint:aPoint from:(self id) to:(self device rootWindowId). - self device + pointXLated := device translatePoint:aPoint from:(self id) to:(device rootWindowId). + device sendKeyOrButtonEvent:ev type x:pointXLated x y:pointXLated y keyOrButton:(ev isKeyEvent ifTrue:[ev rawKey] ifFalse:[ev button]) @@ -7021,7 +7022,7 @@ self subViews do:[:each | |whichView| - whichView := each simulateUserEvent:ev at:(self graphicsDevice translatePoint:aPoint fromView:self toView:each). + whichView := each simulateUserEvent:ev at:(device translatePoint:aPoint fromView:self toView:each). whichView notNil ifTrue:[^ whichView]. ]. targetView := self. @@ -7029,7 +7030,7 @@ ]. targetView notNil ifTrue:[ - pointXLated := self device translatePoint:aPoint fromView:self toView:targetView. + pointXLated := device translatePoint:aPoint fromView:self toView:targetView. ev x:(pointXLated x). ev y:(pointXLated y). ev view:targetView. @@ -7051,15 +7052,15 @@ self stopButtonLongPressedHandlerProcess. p := - [ - Delay waitForSeconds:0.7. - self sensor leftButtonPressed ifTrue:[ - "/ simulate a right-button press - self buttonPress:2 x:0 y:0 - ] - ] newProcess. - - self graphicsDevice buttonLongPressedHandlerProcess:p. + [ + Delay waitForSeconds:0.7. + self sensor leftButtonPressed ifTrue:[ + "/ simulate a right-button press + self buttonPress:2 x:0 y:0 + ] + ] newProcess. + + device buttonLongPressedHandlerProcess:p. p resume. ! @@ -7068,10 +7069,10 @@ |p| - (p := self graphicsDevice buttonLongPressedHandlerProcess) notNil ifTrue:[ + (p := device buttonLongPressedHandlerProcess) notNil ifTrue:[ "/ Transcript showCR:'stop'. - self graphicsDevice buttonLongPressedHandlerProcess:nil. - p terminate. + device buttonLongPressedHandlerProcess:nil. + p terminate. ]. ! ! @@ -7082,7 +7083,7 @@ wg := self windowGroup. wg notNil ifTrue:[ - self graphicsDevice isWindowsPlatform ifTrue:[ + device isWindowsPlatform ifTrue:[ wg focusView:aConsumer byTab:true. ] ifFalse:[ aConsumer requestFocus. @@ -7352,7 +7353,7 @@ and:[superView notNil and:[styleSheet notNil]]) ifTrue:[ (styleSheet at:#'focus.showBorder' default:true) ifTrue:[ - graphicsDevice := self graphicsDevice. + graphicsDevice := device. (graphicsDevice supportsWindowBorder:(bd := DefaultFocusBorderWidth)) ifFalse:[ (graphicsDevice supportsWindowBorder:(bd := 1)) ifFalse:[ @@ -7396,7 +7397,7 @@ explicit ifTrue:[ (self drawableId notNil and:[superView notNil]) ifTrue:[ (styleSheet at:#'focus.showBorder' default:true) ifTrue:[ - graphicsDevice := self graphicsDevice. + graphicsDevice := device. (graphicsDevice supportsWindowBorder:(bd := self borderWidth)) ifFalse:[ (graphicsDevice supportsWindowBorder:(bd := 1)) ifFalse:[ @@ -7495,13 +7496,13 @@ forceUngrabKeyboard "force a keyboard ungrab - even if was not the grabber" - self graphicsDevice ungrabKeyboard. + device ungrabKeyboard. ! forceUngrabPointer "force a pointer ungrab - even if was not the grabber" - self graphicsDevice ungrabPointer + device ungrabPointer ! grabKeyboard @@ -7510,7 +7511,7 @@ Returns true, if the grab was sucessfull (could fail, if some other application has a grab - but thats very unlikely)." - ^ self graphicsDevice grabKeyboardInView:self. + ^ device grabKeyboardInView:self. ! grabPointer @@ -7537,12 +7538,11 @@ "/ "/ now, flush all pointer events "/ sensor flushMotionEventsFor:nil "/ ]. - aCursorOrNil notNil ifTrue:[ - cursor := (aCursorOrNil onDevice:self graphicsDevice). - ^ self graphicsDevice grabPointerInView:self withCursor:cursor - ]. - ^ self graphicsDevice grabPointerInView:self + cursor := (aCursorOrNil onDevice:device). + ^ device grabPointerInView:self withCursor:cursor + ]. + ^ device grabPointerInView:self ! ungrabKeyboard @@ -7550,15 +7550,15 @@ |sensor| - self graphicsDevice activeKeyboardGrab == self ifTrue:[ - (sensor := self sensor) notNil ifTrue:[ - "/ make certain all X events have been received - self graphicsDevice sync. - "/ now all events have been received. - "/ now, flush all pointer events - sensor flushKeyboardFor:self - ]. - self graphicsDevice ungrabKeyboard. + device activeKeyboardGrab == self ifTrue:[ + (sensor := self sensor) notNil ifTrue:[ + "/ make certain all X events have been received + device sync. + "/ now all events have been received. + "/ now, flush all pointer events + sensor flushKeyboardFor:self + ]. + device ungrabKeyboard. ]. ! @@ -7567,15 +7567,15 @@ |sensor| - self graphicsDevice activePointerGrab == self ifTrue:[ - (sensor := self sensor) notNil ifTrue:[ - "/ make certain all X events have been received - self graphicsDevice sync. - "/ now all events have been received. - "/ now, flush all pointer events - sensor flushMotionEventsFor:self - ]. - self graphicsDevice ungrabPointer. + device activePointerGrab == self ifTrue:[ + (sensor := self sensor) notNil ifTrue:[ + "/ make certain all X events have been received + device sync. + "/ now all events have been received. + "/ now, flush all pointer events + sensor flushMotionEventsFor:self + ]. + device ungrabPointer. ] ! ! @@ -7705,32 +7705,32 @@ viewBackground := DefaultViewBackgroundColor. DefaultLightColor notNil ifTrue:[ - lightColor := DefaultLightColor. + lightColor := DefaultLightColor. ] ifFalse:[ - self graphicsDevice hasGrayscales ifTrue:[ - (viewBackground isImageOrForm and:[viewBackground colorMap isNil]) ifTrue:[ - lightColor := viewBackground averageColor lightened. - ] ifFalse:[ - lightColor := viewBackground lightened. - ]. - DefaultLightColor := lightColor. - ] ifFalse:[ - " - this seems strange: on B&W screens, we create the light color - darker than normal viewBackground (White) - - to make the boundary of the view visible - " - lightColor := Color gray:50 - ] + device hasGrayscales ifTrue:[ + (viewBackground isImageOrForm and:[viewBackground colorMap isNil]) ifTrue:[ + lightColor := viewBackground averageColor lightened. + ] ifFalse:[ + lightColor := viewBackground lightened. + ]. + DefaultLightColor := lightColor. + ] ifFalse:[ + " + this seems strange: on B&W screens, we create the light color + darker than normal viewBackground (White) - + to make the boundary of the view visible + " + lightColor := Color gray:50 + ] ]. DefaultShadowColor notNil ifTrue:[ - shadowColor := DefaultShadowColor. + shadowColor := DefaultShadowColor. ] ifFalse:[ - shadowColor := self blackColor. + shadowColor := self blackColor. ]. ((DefaultBorderWidth ? 1) ~= 0 and:[DefaultBorderColor notNil]) ifTrue:[ - self border:(SimpleBorder width:(DefaultBorderWidth ? 1) color:DefaultBorderColor) + self border:(SimpleBorder width:(DefaultBorderWidth ? 1) color:DefaultBorderColor) ]. "/ font := self defaultFont. -- already done in #initialize @@ -7859,16 +7859,16 @@ "if I have already been reinited - return" self drawableId notNil ifTrue:[ - ^ self + ^ self ]. " superView must be there, first " superView notNil ifTrue:[ - (sv := superView view) id isNil ifTrue:[ - sv reinitialize - ] + (sv := superView view) id isNil ifTrue:[ + sv reinitialize + ] ]. "reinit cursor" @@ -7880,18 +7880,18 @@ "if I was mapped, do it again" realized ifTrue:[ - "only remap if I have a superview - otherwise, I might be - a hidden iconView or menu ..." - superView notNil ifTrue:[ + "only remap if I have a superview - otherwise, I might be + a hidden iconView or menu ..." + superView notNil ifTrue:[ "/ shown ifTrue:[ - self graphicsDevice - moveResizeWindow:self drawableId x:left y:top width:width height:height; - mapWindow:self drawableId + device + moveResizeWindow:self drawableId x:left y:top width:width height:height; + mapWindow:self drawableId "/ mapView:self id:self drawableId iconified:false "/ atX:left y:top width:width height:height "/ minExtent:(self minExtent) maxExtent:(self maxExtent) "/ ]. - ]. + ]. ]. "restore controller" @@ -8375,17 +8375,17 @@ |subViews| (subViews := self subViews) notNil ifTrue:[ - subViews do:[:v| |p| - (ignoreInvisible or:[v shown]) ifTrue:[ - ( (aPoint x between:(v left) and:(v right)) - and:[aPoint y between:(v top) and:(v bottom)] - ) ifTrue:[ - "/ found a subview - the point is there - p := self graphicsDevice translatePoint:aPoint fromView:self toView:v. - ^ v detectViewAt:p ignoreInvisible:ignoreInvisible. - ] - ] - ] + subViews do:[:v| |p| + (ignoreInvisible or:[v shown]) ifTrue:[ + ( (aPoint x between:(v left) and:(v right)) + and:[aPoint y between:(v top) and:(v bottom)] + ) ifTrue:[ + "/ found a subview - the point is there + p := device translatePoint:aPoint fromView:self toView:v. + ^ v detectViewAt:p ignoreInvisible:ignoreInvisible. + ] + ] + ] ]. "/ no subview - the point is here ^ self @@ -8417,50 +8417,50 @@ bw := self borderWidth ? 0. superView isNil ifTrue:[ - inRect := 0@0 extent:self graphicsDevice extent + inRect := 0@0 extent:device extent ] ifFalse:[ - inRect := superView viewRectangle. + inRect := superView viewRectangle. ]. bw2 := bw * 2. rel := aPoint x. rel isInteger ifFalse:[ - newX := (rel * (inRect width + bw2)) asInteger + inRect left. - (bw ~~ 0) ifTrue:[ - newX := newX - bw - ]. + newX := (rel * (inRect width + bw2)) asInteger + inRect left. + (bw ~~ 0) ifTrue:[ + newX := newX - bw + ]. ] ifTrue:[ - newX := rel + newX := rel ]. rel := aPoint y. rel isInteger ifFalse:[ - newY := (rel * (inRect height + bw2)) asInteger + inRect top. - (bw ~~ 0) ifTrue:[ - newY := newY - bw - ]. + newY := (rel * (inRect height + bw2)) asInteger + inRect top. + (bw ~~ 0) ifTrue:[ + newY := newY - bw + ]. ] ifTrue:[ - newY := rel + newY := rel ]. insets notNil ifTrue:[ - i := insets at:1. "top" - (i ~~ 0) ifTrue:[ - newX := newX - i - ]. - i := insets at:3. "left" - (i ~~ 0) ifTrue:[ - newX := newX - i - ]. - i := insets at:2. "right" - (i ~~ 0) ifTrue:[ - newY := newY - i - ]. - i := insets at:4. "bottom" - (i ~~ 0) ifTrue:[ - newY := newY - i - ]. + i := insets at:1. "top" + (i ~~ 0) ifTrue:[ + newX := newX - i + ]. + i := insets at:3. "left" + (i ~~ 0) ifTrue:[ + newX := newX - i + ]. + i := insets at:2. "right" + (i ~~ 0) ifTrue:[ + newY := newY - i + ]. + i := insets at:4. "bottom" + (i ~~ 0) ifTrue:[ + newY := newY - i + ]. ]. ^ newX @ newY ! @@ -8546,7 +8546,7 @@ "/ (otherwise, we could not move unmapped views around ... "/ self drawableId notNil ifTrue:[ - self graphicsDevice moveWindow:self drawableId x:left y:top + device moveWindow:self drawableId x:left y:top ] ifFalse:[ self originChangedFlag:true ] @@ -8661,19 +8661,19 @@ "have to tell X, when extent of view is changed" sameOrigin ifTrue:[ - self graphicsDevice resizeWindow:self drawableId width:width height:height. + device resizeWindow:self drawableId width:width height:height. ] ifFalse:[ "claus: some xservers seem to do better when resizing first ...." " (how == #smaller) ifTrue:[ - self graphicsDevice resizeWindow:drawableId width:width height:height. - self graphicsDevice moveWindow:drawableId x:left y:top + device resizeWindow:drawableId width:width height:height. + device moveWindow:drawableId x:left y:top ] ifFalse:[ - self graphicsDevice moveResizeWindow:drawableId x:left y:top width:width height:height + device moveResizeWindow:drawableId x:left y:top width:width height:height ]. " - self graphicsDevice moveResizeWindow:self drawableId x:left y:top + device moveResizeWindow:self drawableId x:left y:top width:width height:height. ]. @@ -8756,39 +8756,39 @@ bw := self borderWidth ? 0. superView isNil ifTrue:[ - superWidth := self graphicsDevice width + bw. - superHeight := self graphicsDevice height + bw. - superLeft := superTop := 0. + superWidth := device width + bw. + superHeight := device height + bw. + superLeft := superTop := 0. ] ifFalse:[ - inRect := superView viewRectangle. - superWidth := inRect width. - superHeight := inRect height. - superLeft := inRect left. - superTop := inRect top. + inRect := superView viewRectangle. + superWidth := inRect width. + superHeight := inRect height. + superLeft := inRect left. + superTop := inRect top. ]. rel := p x. rel isInteger ifTrue:[ - newX := rel + newX := rel ] ifFalse:[ - newX := (rel * superWidth) asInteger + superLeft. - (bw ~~ 0) ifTrue:[ - rel ~= 1.0 ifTrue:[ - newX := newX - bw - ] - ] + newX := (rel * superWidth) asInteger + superLeft. + (bw ~~ 0) ifTrue:[ + rel ~= 1.0 ifTrue:[ + newX := newX - bw + ] + ] ]. rel := p y. rel isInteger ifTrue:[ - newY := rel + newY := rel ] ifFalse:[ - newY := (rel * superHeight) asInteger + superTop. - (bw ~~ 0) ifTrue:[ - rel ~= 1.0 ifTrue:[ - newY := newY - bw - ] - ] + newY := (rel * superHeight) asInteger + superTop. + (bw ~~ 0) ifTrue:[ + rel ~= 1.0 ifTrue:[ + newY := newY - bw + ] + ] ]. ^ newX @ newY @@ -8864,22 +8864,22 @@ "/ focusViewInWindowGroup := windowGroup focusView. "/ focusViewToCheck := focusViewInWindowGroup. - focusViewOnDisplay := self graphicsDevice focusView. + focusViewOnDisplay := device focusView. focusViewToCheck := focusViewOnDisplay. focusViewToCheck == self ifTrue:[ ^ true ]. focusViewToCheck notNil ifTrue:[ - (focusViewToCheck isComponentOf: self) ifTrue:[ ^ true ]. - - "mhmh - is there a delegation to me ?" - (delegate := focusViewToCheck delegate) notNil ifTrue:[ - delegate == self ifTrue:[^ true]. - "/ no: delegate does not understand this (EnterFieldGroup or KbdForwarder) - "/ we will see, if commenting this leads to problems... - "/ (delegate isComponentOf: self) ifTrue:[ ^ true ]. - ^ delegate askFor:#delegatesTo: with:self - ] + (focusViewToCheck isComponentOf: self) ifTrue:[ ^ true ]. + + "mhmh - is there a delegation to me ?" + (delegate := focusViewToCheck delegate) notNil ifTrue:[ + delegate == self ifTrue:[^ true]. + "/ no: delegate does not understand this (EnterFieldGroup or KbdForwarder) + "/ we will see, if commenting this leads to problems... + "/ (delegate isComponentOf: self) ifTrue:[ ^ true ]. + ^ delegate askFor:#delegatesTo: with:self + ] ]. ^ false @@ -8995,17 +8995,17 @@ "/ focusViewInWindowGroup := windowGroup focusView. "/ focusViewToCheck := focusViewInWindowGroup. - focusViewOnDisplay := self graphicsDevice focusView. + focusViewOnDisplay := device focusView. focusViewToCheck := focusViewOnDisplay. focusViewToCheck == self ifTrue:[ ^ true ]. focusViewToCheck notNil ifTrue:[ - "mhmh - is there a delegation to me ?" - (delegate := focusViewToCheck delegate) notNil ifTrue:[ - delegate == self ifTrue:[^ true]. - ^ delegate askFor:#delegatesTo: with:self - ] + "mhmh - is there a delegation to me ?" + (delegate := focusViewToCheck delegate) notNil ifTrue:[ + delegate == self ifTrue:[^ true]. + ^ delegate askFor:#delegatesTo: with:self + ] ]. ^ false @@ -9474,11 +9474,11 @@ This does not make the view visible (needs a #map for that)" self drawableId isNil ifTrue:[ - " - make certain that superview is created also - " - superView notNil ifTrue:[ - superView view create. + " + make certain that superview is created also + " + superView notNil ifTrue:[ + superView view create. "/ "and put my controller into the superviews controller list" "/ controller notNil ifTrue:[ @@ -9486,42 +9486,42 @@ "/ controller manager:(superView controller manager) "/ ] "/ ] - ] ifFalse:[ - "/ - "/ if the display is not already dispatching events, - "/ this starts the event process. - "/ - self graphicsDevice startDispatch - ]. - - cursor notNil ifTrue:[ - cursor := cursor onDevice:self graphicsDevice. - ]. - - self extentChangedBeforeCreatedFlag ifTrue:[ - "/ this is true, if the extent was changed before - "/ this view was created (and therefore, no sizeChangeEvent - "/ was sent to me, which would notify children.) - "/ have to do this here. - self sizeChanged:nil. "/ must tell children (if any) - ]. - self hasExplicitExtent ifFalse:[ - self resize - ]. - - self physicalCreate. - - viewBackground notNil ifTrue:[ - self setViewBackground - ]. - - self initEvents. - - " - this is the first create, - force sizechange messages to be sent to the view - " - self originChangedFlag:true extentChangedFlag:true + ] ifFalse:[ + "/ + "/ if the display is not already dispatching events, + "/ this starts the event process. + "/ + device startDispatch + ]. + + cursor notNil ifTrue:[ + cursor := cursor onDevice:device. + ]. + + self extentChangedBeforeCreatedFlag ifTrue:[ + "/ this is true, if the extent was changed before + "/ this view was created (and therefore, no sizeChangeEvent + "/ was sent to me, which would notify children.) + "/ have to do this here. + self sizeChanged:nil. "/ must tell children (if any) + ]. + self hasExplicitExtent ifFalse:[ + self resize + ]. + + self physicalCreate. + + viewBackground notNil ifTrue:[ + self setViewBackground + ]. + + self initEvents. + + " + this is the first create, + force sizechange messages to be sent to the view + " + self originChangedFlag:true extentChangedFlag:true ] "Modified: 28.3.1997 / 13:50:17 / cg" @@ -9546,15 +9546,11 @@ but possibly slower, since resources are reallocated over and over. If you redefine this method, make certain that 'super fetchDeviceResources' is always sent." - - |device| shadowColor notNil ifTrue:[ - device := self graphicsDevice. shadowColor := shadowColor onDevice:device ]. lightColor notNil ifTrue:[ - device isNil ifTrue:[ device := self graphicsDevice]. lightColor := lightColor onDevice:device ]. @@ -9611,7 +9607,7 @@ self originFromRelativeOrigin:relativeOrigin ] ifFalse:[ shown ifTrue:[ - self graphicsDevice moveWindow:self drawableId x:left y:top. + device moveWindow:self drawableId x:left y:top. ] ifFalse:[ self pixelOrigin:left@top ]. @@ -9712,61 +9708,61 @@ (unless you have a dictator as windowManager ;-). If the iconified argument is true, the window is created as icon initially. Notice: - Actually, this method is only valid for topViews; - however, it is defined here to allow things like 'Button new realize'" + Actually, this method is only valid for topViews; + however, it is defined here to allow things like 'Button new realize'" |subs| realized ifFalse:[ - self drawableId isNil ifTrue:[ - " - first time ? - yes, realize (implies a map) - " - self realizeKeepingGroup:false at:aPoint iconified:iconified - ] ifFalse:[ - " - no, map only - " - realized := true. - aPoint isNil ifTrue:[ - iconified ifTrue:[ - self graphicsDevice - mapView:self id:self drawableId iconified:iconified - atX:0 y:0 - width:width height:height - minExtent:(self minExtent) maxExtent:(self maxExtent). - ] ifFalse:[ - self graphicsDevice mapWindow:self drawableId. - ] - ] ifFalse:[ - left := aPoint x. - top := aPoint y. - self graphicsDevice - mapView:self id:self drawableId iconified:iconified - atX:left y:top - width:width height:height - minExtent:(self minExtent) maxExtent:(self maxExtent). - ]. - - "/ - "/ implies that all realized subviews - "/ are now also mapped - "/ - "/ not needed for topViews - the mapped event does exactly the same - "/ however, X does not generate mapped events for non-topViews - "/ when a view gets deiconified. - - superView notNil ifTrue:[ - (subs := self subViews) notNil ifTrue:[ - subs do:[:v | - v realized "shown" ifFalse:[ - v mapped - ] - ] - ] - ] - ]. + self drawableId isNil ifTrue:[ + " + first time ? + yes, realize (implies a map) + " + self realizeKeepingGroup:false at:aPoint iconified:iconified + ] ifFalse:[ + " + no, map only + " + realized := true. + aPoint isNil ifTrue:[ + iconified ifTrue:[ + device + mapView:self id:self drawableId iconified:iconified + atX:0 y:0 + width:width height:height + minExtent:(self minExtent) maxExtent:(self maxExtent). + ] ifFalse:[ + device mapWindow:self drawableId. + ] + ] ifFalse:[ + left := aPoint x. + top := aPoint y. + device + mapView:self id:self drawableId iconified:iconified + atX:left y:top + width:width height:height + minExtent:(self minExtent) maxExtent:(self maxExtent). + ]. + + "/ + "/ implies that all realized subviews + "/ are now also mapped + "/ + "/ not needed for topViews - the mapped event does exactly the same + "/ however, X does not generate mapped events for non-topViews + "/ when a view gets deiconified. + + superView notNil ifTrue:[ + (subs := self subViews) notNil ifTrue:[ + subs do:[:v | + v realized "shown" ifFalse:[ + v mapped + ] + ] + ] + ] + ]. ] "Modified: 23.8.1996 / 14:53:55 / stefan" @@ -10043,22 +10039,22 @@ "recreate (i.e. tell X about me) after a snapin or a migration" self drawableId isNil ifTrue:[ - super recreate. - self physicalCreate. - - viewBackground notNil ifTrue:[ - self setViewBackground - ]. - - " - XXX has to be changed: eventmasks are device specific - - XXX will not allow restart on another Workstation-type. - XXX event masks must become symbolic - " - eventMask isNil ifTrue:[ - eventMask := self graphicsDevice defaultEventMask - ]. - self graphicsDevice setEventMask:eventMask in:self drawableId + super recreate. + self physicalCreate. + + viewBackground notNil ifTrue:[ + self setViewBackground + ]. + + " + XXX has to be changed: eventmasks are device specific - + XXX will not allow restart on another Workstation-type. + XXX event masks must become symbolic + " + eventMask isNil ifTrue:[ + eventMask := device defaultEventMask + ]. + device setEventMask:eventMask in:self drawableId ] ! @@ -10086,14 +10082,14 @@ are known to ignore this ..." realized ifFalse:[ - " - now, make the view visible - " - realized := true. - self graphicsDevice - mapView:self id:self drawableId iconified:false - atX:left y:top width:width height:height - minExtent:(self minExtent) maxExtent:(self maxExtent) + " + now, make the view visible + " + realized := true. + device + mapView:self id:self drawableId iconified:false + atX:left y:top width:width height:height + minExtent:(self minExtent) maxExtent:(self maxExtent) ] "Created: 8.5.1996 / 09:33:06 / cg" @@ -10134,17 +10130,17 @@ "rerealize myself with all subviews" self drawableId notNil ifTrue:[ - realized := true. - self realizeAllSubViews. - superView isNil ifTrue:[ - self graphicsDevice - mapView:self id:self drawableId iconified:false - atX:left y:top width:width height:height - minExtent:(self minExtent) maxExtent:(self maxExtent) - ] ifFalse:[ - self graphicsDevice - mapWindow:self drawableId - ]. + realized := true. + self realizeAllSubViews. + superView isNil ifTrue:[ + device + mapView:self id:self drawableId iconified:false + atX:left y:top width:width height:height + minExtent:(self minExtent) maxExtent:(self maxExtent) + ] ifFalse:[ + device + mapWindow:self drawableId + ]. ] "Modified: 28.1.1997 / 17:59:28 / cg" @@ -10176,24 +10172,24 @@ "unmap the view - the view stays created (but invisible), and can be remapped again later." realized ifTrue:[ - realized := false. - self drawableId notNil ifTrue:[ - self graphicsDevice unmapWindow:self drawableId. - - "/ make it go away immediately - "/ (this hides the subview killing) - self flush. - ]. - - "/ Normally, this is not correct with X, where the - "/ unmap is an asynchronous operation. - "/ (shown is cleared also in unmapped event) - "/ Do it anyway, to avoid synchronisation problems. - - shown ifTrue:[ - shown := false. - self changed:#visibility. - ] + realized := false. + self drawableId notNil ifTrue:[ + device unmapWindow:self drawableId. + + "/ make it go away immediately + "/ (this hides the subview killing) + self flush. + ]. + + "/ Normally, this is not correct with X, where the + "/ unmap is an asynchronous operation. + "/ (shown is cleared also in unmapped event) + "/ Do it anyway, to avoid synchronisation problems. + + shown ifTrue:[ + shown := false. + self changed:#visibility. + ] ]. " @@ -10203,9 +10199,9 @@ top extent:200@200. sub := View - origin:0.2@0.2 - corner:0.8@0.8 - in:top. + origin:0.2@0.2 + corner:0.8@0.8 + in:top. sub viewBackground:Color red. sub hiddenOnRealize:true. @@ -10540,12 +10536,12 @@ self clippingRectangle:area. self clearExposedAreaInRedraw ifTrue:[ - "/ win95 workaround: non-existing bg-pixmap support (obsolete) - (viewBackground isImageOrForm and:[ self graphicsDevice supportsAnyViewBackgroundPixmaps not ]) ifTrue:[ - self fillRectangleWithViewBackgroundX:x y:y width:w height:h - ] ifFalse:[ - self clearRectangleX:x y:y width:w height:h. - ] + "/ win95 workaround: non-existing bg-pixmap support (obsolete) + (viewBackground isImageOrForm and:[ device supportsAnyViewBackgroundPixmaps not ]) ifTrue:[ + self fillRectangleWithViewBackgroundX:x y:y width:w height:h + ] ifFalse:[ + self clearRectangleX:x y:y width:w height:h. + ] ]. self renderOrRedraw. @@ -10621,7 +10617,7 @@ "return the amount to scroll when stepping left/right. Subclasses may want to redefine this." - ^ (self graphicsDevice horizontalPixelPerMillimeter * 20) asInteger + ^ (device horizontalPixelPerMillimeter * 20) asInteger ! pageDown @@ -10847,7 +10843,7 @@ "return the amount to scroll when stepping up/down (also used for mouseWheel). Subclasses may want to redefine this." - ^ (self graphicsDevice verticalPixelPerMillimeter * 20) asInteger + ^ (device verticalPixelPerMillimeter * 20) asInteger ! widthForScrollBetween:yStart and:yEnd @@ -11273,7 +11269,7 @@ ^ self ]. "/ the following allows for hooks to add a bell sound or other whenever a dialog opens - self graphicsDevice modalWindowListenersDo:[:listener | listener aboutToOpenWindow:self]. + device modalWindowListenersDo:[:listener | listener aboutToOpenWindow:self]. "/ the following raises the corresponding mainview, so the dialog shows above "/ any currently covered view. However, be careful if being debugged, or if this dialog @@ -11297,7 +11293,7 @@ This is currently used for X, to tell the Window Manager That this view should be always on top of the mainView" self drawableId isNil ifTrue:[self create]. - self graphicsDevice setTransient:self drawableId for:mainView id. + device setTransient:self drawableId for:mainView id. ] ]. @@ -11408,7 +11404,7 @@ "open up the view modeless - positions the view (i.e. circumvents window managers positioning)" - ^ self openModalAt:(self graphicsDevice centerOfMonitorHavingPointer - (self extent//2)). + ^ self openModalAt:(device centerOfMonitorHavingPointer - (self extent//2)). " View new openModal @@ -11421,7 +11417,7 @@ ! openModalAtPointer - ^ self openModalAt:(self graphicsDevice pointerPosition) + ^ self openModalAt:(device pointerPosition) " View new openModalAtPointer @@ -11491,25 +11487,25 @@ self drawableId isNil ifTrue:[self create]. windowGroup isNil ifTrue:[ - newGroup := true. - windowGroup := self windowGroupClass new. + newGroup := true. + windowGroup := self windowGroupClass new. ] ifFalse:[ - newGroup := false. + newGroup := false. ]. windowGroup addTopView:self. "/ the following allows for hooks to be informed whenever a non-modal view opens - self graphicsDevice nonModalWindowListenersDo:[:listener | listener aboutToOpenWindow:self]. + device nonModalWindowListenersDo:[:listener | listener aboutToOpenWindow:self]. newGroup ifTrue:[ - (aPoint isNil and:[iconified not]) ifTrue:[ - windowGroup startupWith:[self realize]. - ] ifFalse:[ - windowGroup startupWith:[self realizeKeepingGroup:false at:aPoint iconified:iconified]. - ]. + (aPoint isNil and:[iconified not]) ifTrue:[ + windowGroup startupWith:[self realize]. + ] ifFalse:[ + windowGroup startupWith:[self realizeKeepingGroup:false at:aPoint iconified:iconified]. + ]. ] ifFalse:[ - self realizeInGroup. + self realizeInGroup. ]. " @@ -11528,7 +11524,7 @@ "open up the view modeless - positions the view (i.e. circumvents window managers positioning)" - ^ self openModelessAt:(self graphicsDevice centerOfMonitorHavingPointer - (self extent//2)). + ^ self openModelessAt:(device centerOfMonitorHavingPointer - (self extent//2)). " View new openModeless @@ -11545,7 +11541,7 @@ The view will be handled by its own process, effectively running in parallel (i.e. control is returned to the sender immediately)." - self openModelessAt:(self graphicsDevice pointerPosition) + self openModelessAt:(device pointerPosition) " (Button label:'hello') openModelessAtPointer @@ -11585,7 +11581,7 @@ n := 0. [self shown] whileFalse:[ - (self graphicsDevice notNil and:[self graphicsDevice isOpen not]) ifTrue:[^ self]. + (device notNil and:[device isOpen not]) ifTrue:[^ self]. "/ this was added to avoid a deadlock, when called from within "/ the event dispatch process (as when doing foo inspect there). diff -r d047c5fb149a -r c3b4c3c664d4 StandardSystemView.st --- a/StandardSystemView.st Sun Apr 03 16:05:41 2016 +0100 +++ b/StandardSystemView.st Sun Apr 03 17:09:29 2016 +0100 @@ -705,7 +705,7 @@ ]. (id := self drawableId) notNil ifTrue:[ - self graphicsDevice setWindowMinExtent:nil maxExtent:max in:id + device setWindowMinExtent:nil maxExtent:max in:id ]. "/ if my current extent is larger than the new @@ -735,7 +735,7 @@ minExtent ~= min ifTrue:[ minExtent := min. (id := self drawableId) notNil ifTrue:[ - self graphicsDevice setWindowMinExtent:min maxExtent:nil in:id + device setWindowMinExtent:min maxExtent:nil in:id ]. "/ if my current extent is smaller than the new @@ -767,12 +767,12 @@ iconValue := icon value. iconValue notNil ifTrue:[ self drawableId notNil ifTrue:[ - i := self graphicsDevice convertedIcon:iconValue. + i := device convertedIcon:iconValue. (i notNil and:[i id notNil]) ifTrue:[ (m := iconValue mask) notNil ifTrue:[ - m := self graphicsDevice convertedIconMask:m. + m := device convertedIconMask:m. ]. - self graphicsDevice setWindowIcon:i mask:m in:self drawableId + device setWindowIcon:i mask:m in:self drawableId ] ] ] @@ -794,7 +794,7 @@ (newLabel := aString string) ~= iconLabel ifTrue:[ iconLabel := newLabel. self drawableId notNil ifTrue:[ - self graphicsDevice setIconName:newLabel in:self drawableId. + device setIconName:newLabel in:self drawableId. " unbuffered - to make it visible right NOW " @@ -814,7 +814,7 @@ "/ only images possibly have iconMasks icon notNil ifTrue:[ (mask := icon value mask) notNil ifTrue:[ - ^ self graphicsDevice convertedIconMask:mask + ^ device convertedIconMask:mask ] ]. @@ -845,7 +845,7 @@ iconView := aView. self drawableId notNil ifTrue:[ aView create. - self graphicsDevice setWindowIconWindow:aView in:self drawableId. + device setWindowIconWindow:aView in:self drawableId. aView setRealized:true. ] @@ -1014,7 +1014,7 @@ "/ I only get a focus in. Could be a race, when the loosing view is already destroyed, "/ at the time the focus event arrives. "/ Anyway: it should not matter to take it again... - WindowGroup takeFocusFromDevice:self graphicsDevice. + WindowGroup takeFocusFromDevice:device. windowGroup isInModalLoop ifTrue:[ windowGroup allTopViewsDo:[:t | @@ -1169,7 +1169,7 @@ super initialize. "/ self setBorderWidth:2. "- notice: many window managers ignore this" - self graphicsDevice isWindowsPlatform ifTrue:[ + device isWindowsPlatform ifTrue:[ minExtent := 0 @ 0. ] ifFalse:[ minExtent := 10 @ 10. @@ -1184,7 +1184,7 @@ mapped super mapped. - self graphicsDevice isWindowsPlatform ifTrue:[ + device isWindowsPlatform ifTrue:[ "don't do this in X11 - switching between virtual desktops would change the window stacking all the time" self setForegroundWindow. @@ -1201,7 +1201,7 @@ |dX dY limitRight limitBottom graphicsDevice| - graphicsDevice := self graphicsDevice. + graphicsDevice := device. dX := (graphicsDevice horizontalPixelPerMillimeter * 20) rounded. dY := (graphicsDevice verticalPixelPerMillimeter * 20) rounded. @@ -1239,7 +1239,7 @@ self recreate. "if I was iconified (not realized), remap iconified" - self graphicsDevice + device mapView:self id:self drawableId iconified:(realized "shown" not) atX:left y:top width:width height:height minExtent:minExtent maxExtent:maxExtent. @@ -1301,7 +1301,7 @@ this means converting it to a format (typically: monochrome) which the device supports. Return a compatible version of the icon." - ^ self graphicsDevice convertedIcon:icon + ^ device convertedIcon:icon "Modified: / 30-10-2007 / 16:39:55 / cg" ! @@ -1311,7 +1311,7 @@ this means converting it to a format (typically: monochrome) which the device supports. Return a compatible version of the icon." - ^ self graphicsDevice convertedIcon:iconArg + ^ device convertedIcon:iconArg "Modified: / 30-10-2007 / 16:37:31 / cg" ! @@ -1322,7 +1322,7 @@ mask - future versions may add alpha channel masks, if the device supports them ..." - ^ self graphicsDevice convertedIconMask:aMask + ^ device convertedIconMask:aMask "Modified: / 30-10-2007 / 16:38:58 / cg" ! @@ -1429,7 +1429,7 @@ self unmap. "if it was iconified, try to remap iconified" - self graphicsDevice + device mapView:self id:self drawableId iconified:true atX:left y:top width:width height:height minExtent:minExtent maxExtent:maxExtent. @@ -1462,11 +1462,11 @@ iconView notNil ifTrue:[ iconView create. - self graphicsDevice setWindowIconWindow:iconView in:self drawableId. + device setWindowIconWindow:iconView in:self drawableId. iconView setRealized:true. ]. iconLabel notNil ifTrue:[ - self graphicsDevice setIconName:iconLabel string in:self drawableId + device setIconName:iconLabel string in:self drawableId ] "Modified: 10.6.1996 / 20:14:50 / cg" @@ -1479,7 +1479,7 @@ self unmap. "if it was iconified, try to remap non-iconified" - self graphicsDevice + device mapView:self id:self drawableId iconified:false atX:left y:top width:width height:height minExtent:minExtent maxExtent:maxExtent. @@ -1502,11 +1502,11 @@ physicalCreate "common code for create & recreate" - |dev lbl iconValue icn icnMask windowClassNameString org devBounds windowNameString| + |dev currentUserPrefs lbl iconValue icn icnMask windowClassNameString org devBounds windowNameString| - dev := self device. - - UserPreferences current forceWindowsIntoMonitorBounds ifTrue:[ + dev := device. + currentUserPrefs := UserPreferences current. + currentUserPrefs forceWindowsIntoMonitorBounds ifTrue:[ "/ MULTI SCREEN support devBounds := dev monitorBoundsAt:( left @ top ). "/ adjust origin, if too large @@ -1627,16 +1627,16 @@ iconView notNil ifTrue:[ iconView recreate. - self graphicsDevice setWindowIconWindow:iconView in:self drawableId. + device setWindowIconWindow:iconView in:self drawableId. iconView setRealized:true. ] ifFalse:[ icon notNil ifTrue:[ - self icon:(self graphicsDevice convertedIcon:icon). + self icon:(device convertedIcon:icon). ]. ]. iconLabel notNil ifTrue:[ - self graphicsDevice setIconName:iconLabel in:self drawableId + device setIconName:iconLabel in:self drawableId ] "Modified: / 30-10-2007 / 16:39:42 / cg" diff -r d047c5fb149a -r c3b4c3c664d4 SynchronousWindowSensor.st --- a/SynchronousWindowSensor.st Sun Apr 03 16:05:41 2016 +0100 +++ b/SynchronousWindowSensor.st Sun Apr 03 17:09:29 2016 +0100 @@ -1,5 +1,3 @@ -"{ Encoding: utf8 }" - " COPYRIGHT (c) 1995 by Claus Gittinger All Rights Reserved @@ -218,12 +216,12 @@ waitForExposeFor:aView "wait until a graphicsExpose or a noExpose arrives (after a bitblt)." - |device windowId stopPoll endPollTime| + |viewsDevice windowId stopPoll endPollTime| - device := aView graphicsDevice. + viewsDevice := aView graphicsDevice. "/ this is only needed for X ... - device scrollsAsynchronous ifTrue:[ + viewsDevice scrollsAsynchronous ifTrue:[ windowId := aView id. "/ @@ -234,8 +232,8 @@ stopPoll := false. [(gotExpose includes:aView) or:[stopPoll]] whileFalse:[ - (device exposeEventPendingFor:windowId withSync:true) ifTrue:[ - device dispatchExposeEventFor:windowId. + (viewsDevice exposeEventPendingFor:windowId withSync:true) ifTrue:[ + viewsDevice dispatchExposeEventFor:windowId. ]. stopPoll := Timestamp now > endPollTime. Processor yield. diff -r d047c5fb149a -r c3b4c3c664d4 TopView.st --- a/TopView.st Sun Apr 03 16:05:41 2016 +0100 +++ b/TopView.st Sun Apr 03 17:09:29 2016 +0100 @@ -552,10 +552,10 @@ "WIN32 only: add a tray icon for myself; may then receive tray*-events in the future." - self device - addTrayIconFor:self - icon:anImageOrForm iconMask:nil - toolTipMessage:toolTipMessage + device + addTrayIconFor:self + icon:anImageOrForm iconMask:nil + toolTipMessage:toolTipMessage " |v icon| @@ -665,13 +665,13 @@ |delta| CurrentWindowBeingMoved == self ifTrue:[ - delta := self graphicsDevice pointerPosition - CurrentWindowMoveStart. - (CurrentWindowMoveState notNil - or:[ delta r > 5 ]) ifTrue:[ - CurrentWindowMoveState := #inMove. - CurrentWindowMoveStart := self graphicsDevice pointerPosition. - self origin:(self origin + delta). - ]. + delta := device pointerPosition - CurrentWindowMoveStart. + (CurrentWindowMoveState notNil + or:[ delta r > 5 ]) ifTrue:[ + CurrentWindowMoveState := #inMove. + CurrentWindowMoveStart := device pointerPosition. + self origin:(self origin + delta). + ]. ]. "Created: / 03-03-2011 / 19:13:08 / cg" @@ -693,7 +693,7 @@ which want to be moved by click-motion on the background)" CurrentWindowBeingMoved := self. - CurrentWindowMoveStart := self graphicsDevice pointerPosition. + CurrentWindowMoveStart := device pointerPosition. CurrentWindowMoveState := nil. "Created: / 03-03-2011 / 19:09:39 / cg" @@ -780,7 +780,7 @@ |wg dev| wg := windowGroup. "/ have to fetch windowGroup before; - dev := self graphicsDevice. "/ and device ... + dev := device. "/ and device ... super destroy. "/ ... since destroy nils em "/ dev notNil ifTrue:[ @@ -801,10 +801,10 @@ |screenCenter| super initialize. - self graphicsDevice initializeTopViewHookFor:self. + device initializeTopViewHookFor:self. "/ MULTI SCREEN - screenCenter := self graphicsDevice centerOfMonitorHavingPointer. + screenCenter := device centerOfMonitorHavingPointer. left := screenCenter x - (width // 2). top := screenCenter y - (height // 2). @@ -817,10 +817,10 @@ super postRealize. keyboardProcessor isNil ifTrue:[ - keyboardProcessor := KeyboardProcessor new. + keyboardProcessor := KeyboardProcessor new. ]. - self graphicsDevice realizedTopViewHookFor:self + device realizedTopViewHookFor:self ! realize @@ -1129,7 +1129,7 @@ self create. id := self drawableId ]. - self graphicsDevice + device activateWindow:id; focusView:self @@ -1202,14 +1202,14 @@ In contrast to map, which does it non-iconified" realized ifFalse:[ - " - now, make the view visible - " - realized := true. - self graphicsDevice - mapView:self id:self drawableId iconified:true - atX:left y:top width:width height:height - minExtent:(self minExtent) maxExtent:(self maxExtent) + " + now, make the view visible + " + realized := true. + device + mapView:self id:self drawableId iconified:true + atX:left y:top width:width height:height + minExtent:(self minExtent) maxExtent:(self maxExtent) ] "Modified: 25.2.1997 / 22:44:33 / cg" @@ -1237,7 +1237,7 @@ Mark a TopView as #beScreenDialog, to send this on open." self drawableId isNil ifTrue:[self create]. - self graphicsDevice setForegroundWindow:self drawableId + device setForegroundWindow:self drawableId " Transcript topView raise @@ -1266,12 +1266,12 @@ self drawableId isNil ifTrue:[self create]. anotherView isNil ifTrue:[ - otherId := self drawableId. + otherId := self drawableId. ] ifFalse:[ - anotherView create. - otherId := anotherView id. + anotherView create. + otherId := anotherView id. ]. - self graphicsDevice setTransient:self drawableId for:otherId. + device setTransient:self drawableId for:otherId. self origin:aPosition. self open @@ -1417,7 +1417,7 @@ self getKeyboardFocus. ] ]. - self graphicsDevice isWindowsPlatform ifTrue:[ + device isWindowsPlatform ifTrue:[ self raise ]. false "self isScreenDialog" ifTrue:[ diff -r d047c5fb149a -r c3b4c3c664d4 WindowSensor.st --- a/WindowSensor.st Sun Apr 03 16:05:41 2016 +0100 +++ b/WindowSensor.st Sun Apr 03 17:09:29 2016 +0100 @@ -3247,12 +3247,12 @@ in future versions. (or the new device may simulate the arrival of such an event)" - |blocked lostExpose device stopPoll endPollTime pollDelay pollDelay2 + |blocked lostExpose viewsDevice stopPoll endPollTime pollDelay pollDelay2 exposeSema| - device := aView graphicsDevice. - - device scrollsAsynchronous ifFalse:[ + viewsDevice := aView graphicsDevice. + + viewsDevice scrollsAsynchronous ifFalse:[ gotExpose remove:aView ifAbsent:nil. catchExpose remove:aView ifAbsent:nil. ^ self @@ -3266,9 +3266,9 @@ blocked := true. [ - device flush. - - device isWindowsPlatform ifTrue:[ + viewsDevice flush. + + viewsDevice isWindowsPlatform ifTrue:[ "/ since this is definitely a local display, "/ there is no need for a long timeOut "/ (it should arrive fast) @@ -3288,8 +3288,8 @@ "/ must poll for the event "/ [(gotExpose includes:aView) or:[stopPoll]] whileFalse:[ - (device exposeEventPendingFor:aView id withSync:true) ifTrue:[ - device dispatchExposeEventFor:aView id. + (viewsDevice exposeEventPendingFor:aView id withSync:true) ifTrue:[ + viewsDevice dispatchExposeEventFor:aView id. ]. stopPoll := Timestamp now > endPollTime. Processor yield. @@ -3314,7 +3314,7 @@ lostExpose := 999. ]. (exposeSema waitWithTimeout:(pollDelay2 * lostExpose)) isNil ifTrue:[ - device flush. "/ we are paranoid + viewsDevice flush. "/ we are paranoid lostExpose := lostExpose + 1. ]. ].