# HG changeset patch # User Claus Gittinger # Date 892735891 -7200 # Node ID d1f4401ae46747a817918fc9d60be65ecfc5dfbd # Parent 96270af95475d2f6a97ad578ccdd4aa7436490db *** empty log message *** diff -r 96270af95475 -r d1f4401ae467 ImgEditV.st --- 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, - ' \' 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$' -! !