--- a/ImgEditV.st Wed Apr 15 18:29:25 1998 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,843 +0,0 @@
-"
- COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-
-ImageView subclass:#ImageEditView
- instanceVariableNames:'magnification gridMagnification selectColors imageReaderClass
- resourceClass resourceSelector editMode mouseKeyColorMode
- undoImage modified coordInfoBlock'
- classVariableNames:'Clipboard'
- poolDictionaries:''
- category:'Views-Misc'
-!
-
-!ImageEditView class methodsFor:'documentation'!
-
-copyright
-"
- COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-!
-
-documentation
-"
- This View will eventually be able to edit bitmap images.
- For now, it is not.
-
- [author:]
- Claus Gittinger
-
- [see also:]
- Image Form
-
- [start with:]
- ImageEditView openOn:'bitmaps/gifImages/garfield.gif'
- ImageEditView openOnImage:(Image fromFile:'bitmaps/gifImages/garfield.gif')
-"
-! !
-
-!ImageEditView methodsFor:'accessing'!
-
-coordInfoBlock: aBlock
-
- coordInfoBlock := aBlock
-!
-
-gridMagnification: aPoint
-
- gridMagnification := aPoint
-!
-
-imageReaderClass
-
- ^imageReaderClass
-!
-
-magnification
-
- ^magnification
-
-!
-
-magnification:aPoint
-
- magnification ~= aPoint
- ifTrue:
- [
- magnification := aPoint asPoint.
- self scrollToTopLeft.
- self contentsChanged.
- self invalidate.
- ].
-!
-
-resourceClass
-
- ^resourceClass
-!
-
-resourceClass: aClassOrSymbol
-
- resourceClass := aClassOrSymbol isClass ifTrue: [aClassOrSymbol name] ifFalse: [aClassOrSymbol asSymbol].
-
-!
-
-resourceMessage
-
- ^resourceClass, ' ', resourceSelector
-!
-
-resourceMessage: aMessage
-
- (aMessage notNil and: [aMessage trimBlanks size > 0])
- ifTrue:
- [
- resourceClass := aMessage readStream nextWord asSymbol.
- resourceSelector := aMessage reversed readStream nextWord reverse asSymbol.
- ]
- ifFalse:
- [
- ^nil
- ].
-
- ^self resourceClass: resourceClass selector: resourceSelector
-
-
-!
-
-resourceSelector
-
- ^resourceSelector
-!
-
-resourceSelector: aStringOrSymbol
-
- resourceSelector := aStringOrSymbol asSymbol
-!
-
-selectedColor
-
- ^selectColors at: mouseKeyColorMode
-!
-
-selectedColor: aColor
-
- selectColors at: mouseKeyColorMode put: aColor
-! !
-
-!ImageEditView methodsFor:'drawing'!
-
-redrawImageX:x y:y width:w height:h
- |ih iw dotW dotH minX maxX minY maxY color last lastY runW x0 xI yI maskColor|
-
- ih := image height.
- iw := image width.
- dotW := magnification x.
- dotH := magnification y.
-
- minX := (x // dotW).
- minX >= iw ifTrue:[minX := iw - 1].
- minY := (y // dotH).
- minY >= ih ifTrue:[minY := ih - 1].
- maxX := (x + w) // dotW + 1.
- maxX > iw ifTrue:[maxX := iw].
- maxY := (y + h) // dotH + 1.
- maxY > ih ifTrue:[maxY := ih].
-
- lastY := -1.
-
- x0 := minX.
- runW := 0.
- maskColor := false.
- image colorsFromX:minX y:minY toX:maxX-1 y:maxY-1 do:
- [:xx :yy :color|
-
- yy ~~ lastY ifTrue:
- [
- runW ~~ 0 ifTrue:
- [
- |origin|
- origin := (x0 * dotW + margin)@(lastY * dotH + margin).
- self fillRectangle: (origin extent: (runW@dotH)).
- 0 to: runW by: dotW do: [:xxx| self drawFrameAt: ((origin x + xxx) @origin y)].
- maskColor ifTrue:
- [
- self drawMaskPointAt: origin
- ].
- runW := 0.
- ].
- x0 := xx.
- lastY := yy.
- ].
-
- color ~~ last ifTrue:
- [
- runW ~~ 0 ifTrue:
- [
- |origin|
- origin := (x0 * dotW + margin)@(yy * dotH + margin).
- self fillRectangle: (origin extent: (runW@dotH)).
- 0 to: runW by: dotW do: [:xxx| self drawFrameAt: ((origin x + xxx) @origin y)].
- maskColor ifTrue:
- [
- self drawMaskPointAt: origin
- ].
- runW := 0.
- ].
-
- self paint: (last := color).
- image mask notNil ifTrue:
- [
- maskColor := false.
- (image mask colorAt: xx@yy) = Color black ifTrue:
- [
- self paint: (last := self viewBackground).
- maskColor := true.
- ].
- last := nil.
- ].
- runW := 0.
- x0 := xx.
- ].
- runW := runW + dotW
- ].
- runW ~~ 0 ifTrue:
- [
- |origin|
- origin := (x0 * dotW + margin)@(lastY * dotH + margin).
- self fillRectangle: (origin extent: runW@dotH).
- 0 to: runW by: dotW do: [:xxx| self drawFrameAt: ((origin x + xxx) @origin y)].
- maskColor ifTrue:
- [
- self drawMaskPointAt: origin.
- ].
- runW := 0.
- ].
-!
-
-redrawX:x y:y width:w height:h
- |ih iw xI yI|
-
- image isNil ifTrue:[^self].
-
- magnification = (1@1) ifTrue:
- [
- super redrawX:x y:y width:w height:h.
- self drawFrame.
- ^ self
- ].
- self clippingRectangle: (x@y extent: w@h).
-
- self redrawImageX:x y:y width:w height:h.
-
- "/ right of image ?
- adjust == #center ifTrue:
- [
- xI := (width - (margin * 2) - ih) // 2.
- yI := (height - (margin * 2) - iw) // 2.
- ]
- ifFalse:
- [
- xI := yI := margin
- ].
- (x + w - 1) > (xI + (magnification x * image width)) ifTrue:
- [
- self clearRectangleX:(xI + (magnification x * image width))
- y:y
- width:(x + w - (magnification x * image width) - xI)
- height:h
- ].
- (y + h - 1) > (yI + (magnification y * image height)) ifTrue:
- [
- self clearRectangleX:margin
- y:(yI + (magnification y * image height))
- width:w
- height:(y + h - (magnification y * image height) - yI)
- ].
- self drawFrame.
- self clippingRectangle: nil.
-! !
-
-!ImageEditView methodsFor:'edit modes'!
-
-editMode
-
- editMode isNil ifTrue: [editMode := 'point'].
- ^editMode
-!
-
-editMode:aMode
-
- editMode := aMode
-!
-
-mouseKeyColorMode
-
- ^mouseKeyColorMode printString
-!
-
-mouseKeyColorMode:aMode
-
- mouseKeyColorMode := aMode asInteger
-! !
-
-!ImageEditView methodsFor:'event handling'!
-
-buttonMotion:state x:x y:y
-
- self selectedColor notNil & image notNil & (self imageContainsPoint: x@y) & (editMode = 'point')
- ifTrue: [^self pointAt: x@y].
-!
-
-buttonPress:button x:x y:y
-
- self selectedColor notNil & image notNil & (self imageContainsPoint: x@y)
- ifTrue:
- [
- undoImage := image copy.
- mouseKeyColorMode := button.
- (editMode = 'point') ifTrue: [self pointAt: x@y].
- (editMode = 'replace') ifTrue: [self replaceAt: x@y].
- (editMode = 'paste') ifTrue: [self pasteAt: x@y].
- (editMode = 'box') | (editMode = 'copy') ifTrue: [self boxAt: x@y].
- ^self
- ].
-! !
-
-!ImageEditView methodsFor:'image drawing'!
-
-boxAt: aPoint
-
- |firstPoint currentPoint lastCurrentPoint currentExtent imageFirstPoint imageExtent|
-
- firstPoint := lastCurrentPoint := aPoint//magnification*magnification.
- [Display anyButtonPressed]
- whileTrue:
- [
- currentPoint := (0@0) max: (image extent * magnification min: (self translation negated + (device translatePoint: self sensor mousePoint from:device rootView id to:self id))).
- currentPoint := currentPoint//magnification*magnification.
- currentExtent := (firstPoint - currentPoint) abs.
- currentPoint ~= lastCurrentPoint ifTrue:
- [
- self redraw: ((firstPoint min: lastCurrentPoint) - 1 extent: (firstPoint - lastCurrentPoint) abs + 2).
- editMode = 'copy'
- ifTrue:
- [
- self xoring: [self fillRectangle: ((firstPoint min: currentPoint) + 1 extent: currentExtent - 1)]
- ].
- editMode = 'box'
- ifTrue:
- [
- self selectedColor ~= Color noColor
- ifTrue: [self paint: self selectedColor]
- ifFalse: [self paint: self viewBackground].
- self fillRectangle: ((firstPoint min: currentPoint) + 1 extent: currentExtent - 1)
- ].
- ].
- self drawLabel: currentPoint//magnification.
- lastCurrentPoint := currentPoint.
- ].
-
- imageFirstPoint := (firstPoint min: currentPoint)//magnification.
- imageExtent := currentExtent//magnification.
- editMode = 'box'
- ifTrue:
- [
- self selectedColor ~= Color noColor
- ifTrue:
- [
- image mask notNil ifTrue: [image mask fillRectangleX: imageFirstPoint x y: imageFirstPoint y width: imageExtent x height: imageExtent y with:Color white].
- image fillRectangleX: imageFirstPoint x y: imageFirstPoint y width: imageExtent x height: imageExtent y with: self selectedColor.
- self paint: self selectedColor.
- ]
- ifFalse:
- [
- image fillRectangleX: imageFirstPoint x y: imageFirstPoint y width: imageExtent x height: imageExtent y with: ((image colorMap includes: Color black) ifTrue: [Color black] ifFalse: [image colorMap first]).
- image mask notNil ifTrue: [image mask fillRectangleX: imageFirstPoint x y: imageFirstPoint y width: imageExtent x height: imageExtent y with: Color black].
- self paint: self viewBackground.
- ].
- image restored.
- modified := true.
- ].
- editMode = 'copy'
- ifTrue:
- [
- Clipboard := image subImageIn: (imageFirstPoint extent: imageExtent)
- ].
- self redraw: ((firstPoint min: currentPoint) - 1 extent: (firstPoint - currentPoint) abs + 2).
-!
-
-pasteAt: aPoint
-
- Object errorSignal handle:
- [:ex|
- WarningBox warn: 'Pasting into this image failed!!'.
- ]
- do:
- [
- |imagePoint|
- imagePoint := aPoint//magnification.
- image copyFrom: Clipboard x:0 y:0 toX: imagePoint x y: imagePoint y width: Clipboard width height: Clipboard height.
- self redraw: (imagePoint * magnification extent: (Clipboard extent * magnification)).
- self drawLabel: imagePoint.
- image restored.
- modified := true.
- ]
-!
-
-pointAt: aPoint
-
- |imagePoint|
- imagePoint := aPoint//magnification.
- self selectedColor ~= Color noColor
- ifTrue:
- [
- image mask notNil ifTrue: [image mask colorAt: imagePoint put: Color white].
- image colorAt: imagePoint put: self selectedColor.
- self paint: self selectedColor.
- ]
- ifFalse:
- [
- image colorAt: imagePoint put: ((image colorMap includes: Color black) ifTrue: [Color black] ifFalse: [image colorMap first]).
- image mask notNil ifTrue: [image mask colorAt: imagePoint put: Color black].
- self paint:self viewBackground.
- ].
-
- self fillRectangle: (imagePoint * magnification + 1 extent: magnification).
- self selectedColor = Color noColor
- ifTrue:
- [
- self drawMaskPointAt: imagePoint * magnification + 1.
- ].
- self drawFrameAt: aPoint.
- self drawLabel: imagePoint.
- image restored.
- modified := true.
-!
-
-replaceAt: aPoint
-
- |imagePoint|
- imagePoint := aPoint//magnification.
- self selectedColor ~= Color noColor
- ifTrue:
- [
- image mask notNil ifTrue: [image mask fillAround: imagePoint withColor: Color white].
- image fillAround: imagePoint withColor: self selectedColor.
- self paint: self selectedColor.
- ]
- ifFalse:
- [
- image mask notNil ifTrue: [image mask fillAround: imagePoint withColor: Color black].
- self paint:self viewBackground.
- ].
- self drawLabel: imagePoint.
- self invalidate.
- image restored.
- modified := true.
-
-!
-
-undo
-
- undoImage notNil
- ifTrue:
- [
- modified := false.
- self image: undoImage.
- self invalidate
- ]
-! !
-
-!ImageEditView methodsFor:'image editing'!
-
-flipHorizontal
-
- self image: image flipHorizontal.
-
-!
-
-flipVertical
-
- self image: image flipVertical.
-
-!
-
-negativeImage
-
- self image: image negative.
-
-!
-
-resizeImage
-
- |b newSize|
-
- b := EnterBox new.
- b title:'resize image'.
- b okText:'apply'.
- b abortText:'abort'.
- b initialText:image extent printString.
- b showAtPointer.
- (newSize := Object readFromString: b contents onError:nil) notNil
- ifTrue:
- [
- self image: (image magnifiedBy: newSize/image extent)
- ].
-!
-
-rotateImage
-
- |b rotation|
-
- b := EnterBox new.
- b title:'rotate image'.
- b okText:'apply'.
- b abortText:'abort'.
- b initialText: '0'.
- b showAtPointer.
- (rotation := Object readFromString: b contents onError:nil) notNil
- ifTrue:
- [ Object errorSignal handle:
- [:ex|
- WarningBox warn: 'Image rotation failed.\' withCRs, 'An increase of image depth could help.'.
- ]
- do:
- [
- self image: (image hardRotated: rotation)
- ]
- ].
-! !
-
-!ImageEditView methodsFor:'image emphasis'!
-
-drawFrame
-
- self paint:Color black.
- "self lineWidth: (magnification x//3 min: 3). "
- self displayRectangle: ((0@0) extent:(image extent * magnification) + 2).
- self lineWidth:1.
-!
-
-drawFrameAt: aPoint
-
- magnification > gridMagnification
- ifTrue:
- [
- |lineStartingPoint lineEndingPoint oldColor|
- lineStartingPoint := aPoint//magnification*magnification.
- lineEndingPoint := aPoint//magnification*magnification + magnification.
- oldColor := self paint.
- self xoring:
- [
- self displayLineFrom: lineEndingPoint
- to: (lineEndingPoint x)@(lineStartingPoint y).
- self displayLineFrom: lineEndingPoint
- to: (lineStartingPoint x)@(lineEndingPoint y).
- ].
- self paint: oldColor.
- ]
-!
-
-drawLabel: aLabel
- coordInfoBlock notNil
- ifTrue:
- [
- coordInfoBlock value: aLabel printString
- ]
-!
-
-drawMaskPointAt: aPoint
-
- |sizeOfMaskPoint|
- sizeOfMaskPoint := magnification//3.
- self xoring: [self fillRectangle: (aPoint + sizeOfMaskPoint extent: sizeOfMaskPoint)].
-
-! !
-
-!ImageEditView methodsFor:'image setting'!
-
-image:anImage
-
- (anImage isImage and: [image isNil or: [self checkModified]])
- ifTrue:
- [
- super image: anImage.
- image photometric = #palette
- ifTrue:
- [
- (image usedColors includes: selectColors first) ifFalse: [selectColors at: 1 put: nil].
- (image usedColors includes: selectColors last) ifFalse: [selectColors at: 2 put: nil].
- ].
- ^self
- ].
- ^nil
-!
-
-loadFromFile: aFileName
-
- |fileName newImage|
- fileName := aFileName asFilename.
-
- Object errorSignal handle:
- [:exeption|
- WarningBox warn: exeption errorString.
- ^nil
- ]
- do:
- [
- newImage := Image fromFile: fileName name.
- ].
-
- (self image: newImage) notNil
- ifTrue:
- [
- imageReaderClass := ImageReader allSubclasses detect: [:cls| cls isValidImageFile:fileName name] ifNone:
- [WarningBox warn: 'Unknown image file format'. ^nil].
- ]
-!
-
-resourceClass: aClassOrSymbol selector: aStringOrSymbol
-
- |aClass|
- imageReaderClass := nil.
- self resourceClass: aClassOrSymbol.
- self resourceSelector: aStringOrSymbol.
- aClass := Smalltalk at: resourceClass.
- (aClass isClass and: [aClass class implements: resourceSelector])
- ifTrue:
- [
- ^self image: (aClass perform: resourceSelector) copy
- ].
- ^nil
-! !
-
-!ImageEditView methodsFor:'initialization'!
-
-initialize
-
- super initialize.
-
- magnification := 1@1.
- gridMagnification := 8@8.
- modified := false.
- mouseKeyColorMode := 1.
- resourceClass := resourceSelector := ''.
- selectColors := Array with: nil with: nil.
- self menuHolder:self; menuPerformer:self; menuMessage:#imageMenu.
-! !
-
-!ImageEditView methodsFor:'menu actions'!
-
-changeMagnification
- |b newMag|
-
- b := EnterBox new.
- b title:'magnification (magX @ magY)'.
- b okText:'apply'.
- b abortText:'abort'.
- b action:[:string | newMag := (Object readFromString:string onError:nil)].
- b initialText:(magnification printString).
- b showAtPointer.
-
- newMag notNil ifTrue:[
- self magnification:newMag.
- ].
-
- "Modified: 31.7.1997 / 11:43:12 / cg"
-!
-
-loadFromClass
-
- self resourceMessage: (ResourceSelectionBrowser
- openOnSuperclass: ApplicationModel
- class: self resourceClass
- selector: self resourceSelector
- resourceTypes: #(#image #fileImage))
-
-
-!
-
-loadFromUser
-
- self image:
- ((Image fromUser)
- asDitheredTrueColor8FormOn: Display)
-
-!
-
-print
- |stream psgc|
-
- image isNil ifTrue: [^nil].
-
- Printer supportsPostscript ifFalse:[
- self warn:'need a postscript printer'.
- ^ self
- ].
-
- stream := Printer newNative.
- stream isNil ifTrue:[
- self warn:'cannot open printer stream'.
- ^ nil
- ].
-
- self withWaitCursorDo:[
- psgc := PSGraphicsContext on:stream. "/ extent:(1.0 @ 1.0).
- psgc displayForm: (image magnifiedBy: magnification) x:0 y:0.
- psgc close.
- ]
-!
-
-save
-
- Object errorSignal handle:
- [:ex|
- WarningBox warn: ex errorString.
- ^nil
- ]
- do:
- [
- |fileName|
- image isNil ifTrue: [^self error: 'No image to save!!'].
- image fileName isNil ifTrue: [^self error: 'No file name for image detected!!'].
- fileName := image fileName asFilename.
- (fileName suffix = 'tiff') | (fileName suffix = 'tif') ifTrue: [imageReaderClass := TIFFReader].
- fileName suffix = 'xpm' ifTrue: [imageReaderClass := XPMReader].
- fileName suffix = 'xbm' ifTrue: [imageReaderClass := XBMReader].
- fileName suffix = 'gif' ifTrue: [imageReaderClass := GIFReader].
- (fileName suffix = 'jpg') | (fileName suffix = 'jpeg') ifTrue: [imageReaderClass := JPEGReader].
- imageReaderClass isNil ifTrue: [imageReaderClass := XPMReader. image fileName: image fileName, '.xpm'].
-
- image saveOn: image fileName using: imageReaderClass.
- modified := false.
- ]
-
-!
-
-saveAs
- "save contents into a file
- - ask user for filename using a fileSelectionBox."
-
- self saveImageFileAs
-!
-
-saveAsMethod
-
- Object errorSignal handle:
- [:ex|
- WarningBox warn: ex errorString.
- ^nil
- ]
- do:
- [
- |compileString stream aClass|
- stream := WriteStream on: ''.
- self resourceSelector trimBlanks size = 0 ifTrue: [^self error: 'No image selector detected'].
- (aClass := Smalltalk at: self resourceClass) isClass ifFalse: [^self error: 'No class for image selector detected'].
- self image storeOn: stream.
- compileString :=
- self resourceSelector,
- '\\' withCRs,
- ' <resource: #image>\' withCRs,
- ' ^',
- stream contents.
- ByteCodeCompiler compile: compileString forClass: aClass class inCategory: 'resources'.
- modified := false.
- ]
-!
-
-saveImageFileAs
-
- |aFileName|
-
- (aFileName := (FileBrowserView requestFileName: self image fileName fileFilters: #('*.xpm' '*.gif'))) notNil
- ifTrue:
- [
- self saveImageFileAs: aFileName
- ].
-!
-
-saveImageFileAs: aFileName
-
- image notNil
- ifTrue:
- [
- image fileName: aFileName.
- self save
- ]
- ifFalse:
- [
- WarningBox warn: 'No image detected'
- ]
-! !
-
-!ImageEditView methodsFor:'queries'!
-
-checkModified
-
- modified ifTrue:
- [
- |aBox|
- aBox := YesNoBox title:'Image was modified'.
- aBox noText:'abort'.
- aBox yesText:'ignore'.
- aBox showAtPointer.
- aBox accepted ifFalse: [^false].
- modified := false
- ].
- ^true
-!
-
-heightOfContents
- "return the images height"
-
- image isNil ifTrue:[^ 0].
- ^ (image height * magnification y) rounded
-!
-
-imageContainsPoint: aPoint
- |pi|
- image isNil ifTrue: [^false].
- pi := ((aPoint - margin + 1) / magnification) floor.
- ^((0@0 corner:(image extent) - 1) containsPoint:pi)
-!
-
-widthOfContents
- "return the images width"
-
- image isNil ifTrue:[^ 0].
- ^ (image width * magnification x) rounded
-! !
-
-!ImageEditView methodsFor:'release'!
-
-destroy
-
- undoImage := nil.
- Clipboard := nil.
- super destroy.
-
-! !
-
-!ImageEditView class methodsFor:'documentation'!
-
-version
- ^ '$Header$'
-! !