hg/stx-libwidg2: ImageEditView.st@c949e9f7757c (annotated)

636 d53428252193 revised version tz parents: 633 diff changeset	1	"
704 01140e14c065 Fix copyright. Stefan Vogel <sv@exept.de> parents: 694 diff changeset	2	COPYRIGHT (c) 1997 by eXept Software AG
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	3	All Rights Reserved
636 d53428252193 revised version tz parents: 633 diff changeset	4
d53428252193 revised version tz parents: 633 diff changeset	5	This software is furnished under a license and may be used
d53428252193 revised version tz parents: 633 diff changeset	6	only in accordance with the terms of that license and with the
d53428252193 revised version tz parents: 633 diff changeset	7	inclusion of the above copyright notice. This software may not
d53428252193 revised version tz parents: 633 diff changeset	8	be provided or otherwise made available to, or used by, any
d53428252193 revised version tz parents: 633 diff changeset	9	other person. No title to or ownership of the software is
d53428252193 revised version tz parents: 633 diff changeset	10	hereby transferred.
d53428252193 revised version tz parents: 633 diff changeset	11	"
d53428252193 revised version tz parents: 633 diff changeset	12
1 c6ca7bfedf31 Initial revision claus parents: diff changeset	13	ImageView subclass:#ImageEditView
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	14	instanceVariableNames:'magnification imageReaderClass resourceClass resourceSelector
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	15	mouseKeyColorMode undoImages modified masterApplication editMode
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	16	lastPastePoint imageInfoHolder activityInfoHolder
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	17	pickedColorHolder drawingColors drawingPixels'
1035 5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	18	classVariableNames:'Clipboard LastMagnification ClipboardMagnification
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	19	GridMagnification MaxUndos'
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	20	poolDictionaries:''
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	21	category:'Views-Misc'
1 c6ca7bfedf31 Initial revision claus parents: diff changeset	22	!
c6ca7bfedf31 Initial revision claus parents: diff changeset	23
636 d53428252193 revised version tz parents: 633 diff changeset	24	!ImageEditView class methodsFor:'documentation'!
d53428252193 revised version tz parents: 633 diff changeset	25
d53428252193 revised version tz parents: 633 diff changeset	26	copyright
d53428252193 revised version tz parents: 633 diff changeset	27	"
704 01140e14c065 Fix copyright. Stefan Vogel <sv@exept.de> parents: 694 diff changeset	28	COPYRIGHT (c) 1997 by eXept Software AG
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	29	All Rights Reserved
636 d53428252193 revised version tz parents: 633 diff changeset	30
d53428252193 revised version tz parents: 633 diff changeset	31	This software is furnished under a license and may be used
d53428252193 revised version tz parents: 633 diff changeset	32	only in accordance with the terms of that license and with the
d53428252193 revised version tz parents: 633 diff changeset	33	inclusion of the above copyright notice. This software may not
d53428252193 revised version tz parents: 633 diff changeset	34	be provided or otherwise made available to, or used by, any
d53428252193 revised version tz parents: 633 diff changeset	35	other person. No title to or ownership of the software is
d53428252193 revised version tz parents: 633 diff changeset	36	hereby transferred.
d53428252193 revised version tz parents: 633 diff changeset	37	"
d53428252193 revised version tz parents: 633 diff changeset	38	!
d53428252193 revised version tz parents: 633 diff changeset	39
d53428252193 revised version tz parents: 633 diff changeset	40	documentation
d53428252193 revised version tz parents: 633 diff changeset	41	"
d53428252193 revised version tz parents: 633 diff changeset	42	The ImageEditView is a view class which can be used by applications
d53428252193 revised version tz parents: 633 diff changeset	43	like the Image Editor for modifying or inspecting images.
d53428252193 revised version tz parents: 633 diff changeset	44
d53428252193 revised version tz parents: 633 diff changeset	45	[see also:]
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	46	ImageEditor Image
636 d53428252193 revised version tz parents: 633 diff changeset	47
d53428252193 revised version tz parents: 633 diff changeset	48	[author:]
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	49	Thomas Zwick
636 d53428252193 revised version tz parents: 633 diff changeset	50	"
d53428252193 revised version tz parents: 633 diff changeset	51	! !
353 0442fc169b82 * empty log message * Claus Gittinger <cg@exept.de> parents: 322 diff changeset	52
1245 68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	53	!ImageEditView class methodsFor:'initialization'!
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	54
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	55	initialize
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	56	MaxUndos := 5.
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	57	GridMagnification := 8 @ 8.
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	58
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	59	"
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	60	self initialize
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	61	"
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	62	! !
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	63
7 19b36b78ee01 * empty log message * claus parents: 5 diff changeset	64	!ImageEditView methodsFor:'accessing'!
19b36b78ee01 * empty log message * claus parents: 5 diff changeset	65
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	66	activityInfoHolder
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	67	"return the value of the instance variable 'activityInfoHolder' (automatically generated)"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	68
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	69	^ activityInfoHolder
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	70
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	71	"Created: / 29.7.1998 / 18:49:39 / cg"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	72	!
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	73
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	74	activityInfoHolder:something
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	75	"set the value of the instance variable 'activityInfoHolder' (automatically generated)"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	76
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	77	activityInfoHolder := something.
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	78
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	79	"Created: / 29.7.1998 / 18:49:39 / cg"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	80	!
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	81
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	82	imageInfoHolder
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	83	"return the value of the instance variable 'imageInfoHolder' (automatically generated)"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	84
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	85	^ imageInfoHolder
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	86
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	87	"Created: / 29.7.1998 / 18:29:50 / cg"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	88	!
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	89
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	90	imageInfoHolder:something
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	91	"set the value of the instance variable 'imageInfoHolder' (automatically generated)"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	92
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	93	imageInfoHolder := something.
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	94
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	95	"Created: / 29.7.1998 / 18:29:50 / cg"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	96	!
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	97
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	98	magnification
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	99
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	100	^magnification
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	101
255 1dfa8deddaef checkin from browser Claus Gittinger <cg@exept.de> parents: 251 diff changeset	102	!
1dfa8deddaef checkin from browser Claus Gittinger <cg@exept.de> parents: 251 diff changeset	103
636 d53428252193 revised version tz parents: 633 diff changeset	104	magnification: aPoint
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	105	\|oldOrg\|
255 1dfa8deddaef checkin from browser Claus Gittinger <cg@exept.de> parents: 251 diff changeset	106
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	107	magnification ~= aPoint
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	108	ifTrue:
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	109	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	110	oldOrg := self viewOrigin / magnification.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	111	magnification := aPoint asPoint.
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	112
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	113	self scrollTo:(oldOrg * magnification) rounded redraw:false.
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	114	"/ self scrollToTopLeft.
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	115	self contentsChanged.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	116	self invalidate.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	117	ClipboardMagnification := nil.
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	118	]
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	119
3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	120	"Modified: / 31.7.1998 / 02:38:47 / cg"
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	121	!
255 1dfa8deddaef checkin from browser Claus Gittinger <cg@exept.de> parents: 251 diff changeset	122
662 61b7601829ea with modal support tz parents: 636 diff changeset	123	masterApplication
61b7601829ea with modal support tz parents: 636 diff changeset	124
61b7601829ea with modal support tz parents: 636 diff changeset	125	^masterApplication
61b7601829ea with modal support tz parents: 636 diff changeset	126	!
61b7601829ea with modal support tz parents: 636 diff changeset	127
61b7601829ea with modal support tz parents: 636 diff changeset	128	masterApplication: anApplicationModel
61b7601829ea with modal support tz parents: 636 diff changeset	129
61b7601829ea with modal support tz parents: 636 diff changeset	130	masterApplication := anApplicationModel
61b7601829ea with modal support tz parents: 636 diff changeset	131	!
61b7601829ea with modal support tz parents: 636 diff changeset	132
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	133	resourceClass
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	134
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	135	^resourceClass
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	136	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	137
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	138	resourceClass: aClassOrSymbol
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	139
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	140	resourceClass := aClassOrSymbol isClass ifTrue: [aClassOrSymbol name] ifFalse: [aClassOrSymbol asSymbol]
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	141	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	142
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	143	resourceMessage
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	144
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	145	^resourceClass, ' ', resourceSelector
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	146	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	147
636 d53428252193 revised version tz parents: 633 diff changeset	148	resourceMessage: aString
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	149
636 d53428252193 revised version tz parents: 633 diff changeset	150	(aString isString and: [aString trimBlanks size > 0])
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	151	ifTrue:
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	152	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	153	resourceClass := (aString readStream upTo: Character space) asSymbol.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	154	resourceSelector := (aString copy reverse readStream upTo: Character space) reverse asSymbol
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	155	]
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	156	ifFalse:
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	157	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	158	^nil
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	159	]
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	160
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	161
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	162	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	163
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	164	resourceSelector
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	165
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	166	^resourceSelector
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	167	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	168
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	169	resourceSelector: aStringOrSymbol
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	170
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	171	resourceSelector := aStringOrSymbol asSymbol
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	172	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	173
840 93f209fc0f7a selectColors tz parents: 839 diff changeset	174	selectColors
93f209fc0f7a selectColors tz parents: 839 diff changeset	175
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	176	^drawingColors
840 93f209fc0f7a selectColors tz parents: 839 diff changeset	177	!
93f209fc0f7a selectColors tz parents: 839 diff changeset	178
93f209fc0f7a selectColors tz parents: 839 diff changeset	179	selectColors: anArrayTwoColors
633 594edef86630 revised version tz parents: 632 diff changeset	180
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	181	drawingColors := anArrayTwoColors
633 594edef86630 revised version tz parents: 632 diff changeset	182	!
594edef86630 revised version tz parents: 632 diff changeset	183
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	184	selectedColor
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	185
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	186	^drawingColors at: mouseKeyColorMode
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	187	!
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	188
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	189	selectedColor: aColor
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	190
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	191	drawingColors at: mouseKeyColorMode put: aColor
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	192	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	193
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	194	selectedColorIndex
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	195
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	196	^ drawingPixels at: mouseKeyColorMode
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	197	!
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	198
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	199	selectedColorIndex: aPixelIndex
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	200
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	201	drawingPixels at: mouseKeyColorMode put: aPixelIndex
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	202	!
cd84d6f8c449 several undos tz parents: 994 diff changeset	203
cd84d6f8c449 several undos tz parents: 994 diff changeset	204	undoImages
cd84d6f8c449 several undos tz parents: 994 diff changeset	205
cd84d6f8c449 several undos tz parents: 994 diff changeset	206	^undoImages
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	207	! !
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	208
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	209	!ImageEditView methodsFor:'drawing'!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	210
1036 d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	211	drawFrame
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	212
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	213	self paint:Color black.
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	214	self lineWidth: (magnification x//3 min: 3).
1104 a7101d656dab use margin in #drawFrame tz parents: 1103 diff changeset	215	self displayRectangle: ((0@0) extent:(image extent * magnification) + margin).
1036 d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	216	self lineWidth:1.
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	217	!
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	218
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	219	drawFramesIn: aRectangle
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	220
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	221	magnification >= GridMagnification
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	222	ifTrue:
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	223	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	224	\|origin lineStartingPoint lineEndingPoint oldColor\|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	225	origin := aRectangle origin - 1.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	226	lineStartingPoint := origin + (0@magnification y).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	227	lineEndingPoint := lineStartingPoint + (aRectangle width@0).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	228	oldColor := self paint.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	229	self xoring:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	230	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	231	self displayLineFrom: lineStartingPoint to: lineEndingPoint.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	232	lineStartingPoint x to: lineStartingPoint x + aRectangle width - magnification x by: magnification x do:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	233	[:x\|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	234	self displayLineFrom: x@(origin y) to: x@(origin y + magnification y)
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	235	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	236	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	237	self paint: oldColor.
1036 d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	238	]
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	239
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	240
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	241
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	242	!
d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	243
662 61b7601829ea with modal support tz parents: 636 diff changeset	244	fillFramedRectangle: aRectangle
61b7601829ea with modal support tz parents: 636 diff changeset	245
61b7601829ea with modal support tz parents: 636 diff changeset	246	self fillRectangle: aRectangle.
61b7601829ea with modal support tz parents: 636 diff changeset	247	self drawFramesIn: aRectangle
61b7601829ea with modal support tz parents: 636 diff changeset	248	!
61b7601829ea with modal support tz parents: 636 diff changeset	249
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	250	redrawImageX:x y:y width:w height:h
636 d53428252193 revised version tz parents: 633 diff changeset	251
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	252	\|ih iw magX magY minX maxX minY maxY
3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	253	color lastColor lastY runW x0 xI yI maskColor mask
1180 dcb9dede5128 checkin from browser Claus Gittinger <cg@exept.de> parents: 1160 diff changeset	254	sizeOfMaskPoint useNearestColor\|
dcb9dede5128 checkin from browser Claus Gittinger <cg@exept.de> parents: 1160 diff changeset	255
dcb9dede5128 checkin from browser Claus Gittinger <cg@exept.de> parents: 1160 diff changeset	256	useNearestColor := device visualType == #PseudoColor.
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	257
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	258	mask := image mask.
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	259	ih := image height.
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	260	iw := image width.
662 61b7601829ea with modal support tz parents: 636 diff changeset	261	magX := magnification x.
61b7601829ea with modal support tz parents: 636 diff changeset	262	magY := magnification y.
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	263
662 61b7601829ea with modal support tz parents: 636 diff changeset	264	minX := (x // magX - 1) max: 0.
725 0e051202859d checkin from browser tz parents: 724 diff changeset	265	minX >= iw ifTrue:[minX := (iw - 1) max: 0].
662 61b7601829ea with modal support tz parents: 636 diff changeset	266	minY := (y // magY - 1) max: 0.
725 0e051202859d checkin from browser tz parents: 724 diff changeset	267	minY >= ih ifTrue:[minY := (ih - 1) max: 0].
662 61b7601829ea with modal support tz parents: 636 diff changeset	268	maxX := (x + w) // magX + 1.
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	269	maxX > iw ifTrue:[maxX := iw].
662 61b7601829ea with modal support tz parents: 636 diff changeset	270	maxY := (y + h) // magY + 1.
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	271	maxY > ih ifTrue:[maxY := ih].
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	272
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	273	lastY := -1.
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	274
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	275	x0 := minX.
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	276	runW := 0.
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	277	maskColor := false.
662 61b7601829ea with modal support tz parents: 636 diff changeset	278	sizeOfMaskPoint := magnification//3.
61b7601829ea with modal support tz parents: 636 diff changeset	279	image colorsFromX: minX y: minY toX: maxX-1 y: maxY-1 do:
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	280	[:xx :yy :color\|
1160 5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	281	shown ifFalse:[^ self].
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	282
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	283	yy ~~ lastY
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	284	ifTrue:
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	285	[
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	286	runW ~~ 0
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	287	ifTrue:
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	288	[
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	289	\|origin\|
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	290	origin := (x0 * magX + margin)@(lastY * magY + margin).
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	291	self fillFramedRectangle: (origin extent: (runW@magY)).
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	292	maskColor ifTrue:
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	293	[
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	294	self xoring: [self fillRectangle: (origin + sizeOfMaskPoint extent: sizeOfMaskPoint)]
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	295	].
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	296	runW := 0.
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	297	].
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	298	x0 := xx.
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	299	lastY := yy.
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	300	].
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	301
1180 dcb9dede5128 checkin from browser Claus Gittinger <cg@exept.de> parents: 1160 diff changeset	302	color ~= lastColor
1160 5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	303	ifTrue:
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	304	[
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	305	runW ~~ 0
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	306	ifTrue:
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	307	[
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	308	\|origin\|
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	309	origin := (x0 * magX + margin)@(yy * magY + margin).
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	310	self fillFramedRectangle: (origin extent: (runW@magY)).
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	311	maskColor ifTrue:
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	312	[
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	313	self xoring: [self fillRectangle: (origin + sizeOfMaskPoint extent: sizeOfMaskPoint)]
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	314	].
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	315	runW := 0.
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	316	].
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	317
1180 dcb9dede5128 checkin from browser Claus Gittinger <cg@exept.de> parents: 1160 diff changeset	318	lastColor := color.
dcb9dede5128 checkin from browser Claus Gittinger <cg@exept.de> parents: 1160 diff changeset	319	useNearestColor ifTrue:[
dcb9dede5128 checkin from browser Claus Gittinger <cg@exept.de> parents: 1160 diff changeset	320	lastColor := lastColor nearestOn:device
dcb9dede5128 checkin from browser Claus Gittinger <cg@exept.de> parents: 1160 diff changeset	321	].
dcb9dede5128 checkin from browser Claus Gittinger <cg@exept.de> parents: 1160 diff changeset	322	self paint:lastColor.
1160 5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	323	mask notNil ifTrue:
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	324	[
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	325	maskColor := false.
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	326	(mask colorAtX:xx y:yy) = Color black ifTrue:
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	327	[
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	328	self paint: (lastColor := self viewBackground).
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	329	maskColor := true.
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	330	].
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	331	lastColor := nil.
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	332	].
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	333	runW := 0.
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	334	x0 := xx.
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	335	].
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	336	runW := runW + magX
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	337	].
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	338	runW ~~ 0 ifTrue:
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	339	[
1160 5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	340	\|origin\|
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	341	origin := (x0 * magX + margin)@(lastY * magY + margin).
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	342	self fillFramedRectangle: (origin extent: runW@magY).
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	343	maskColor ifTrue:
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	344	[
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	345	self xoring: [self fillRectangle: (origin + sizeOfMaskPoint extent: sizeOfMaskPoint)]
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	346	].
5d89296c4b04 * empty log message * Claus Gittinger <cg@exept.de> parents: 1158 diff changeset	347	runW := 0.
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	348	].
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	349
1180 dcb9dede5128 checkin from browser Claus Gittinger <cg@exept.de> parents: 1160 diff changeset	350	"Modified: / 8.1.1999 / 22:30:50 / cg"
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	351	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	352
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	353	redrawX:x y:y width:w height:h
636 d53428252193 revised version tz parents: 633 diff changeset	354
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	355	\|ih iw xI yI\|
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	356
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	357	image isNil ifTrue:[^self].
662 61b7601829ea with modal support tz parents: 636 diff changeset	358
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	359	magnification = (1@1) ifTrue: [
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	360	^ super redrawX:x y:y width:w height:h
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	361	].
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	362
662 61b7601829ea with modal support tz parents: 636 diff changeset	363	self clippingRectangle: (x@y extent: w@h).
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	364
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	365	self redrawImageX:x y:y width:w height:h.
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	366
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	367	"/ right of image ?
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	368	adjust == #center ifTrue:
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	369	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	370	xI := (width - ih) // 2 - margin.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	371	yI := (height - iw) // 2 - margin.
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	372	]
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	373	ifFalse:
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	374	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	375	xI := yI := margin
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	376	].
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	377	(x + w - 1) > (xI + (magnification x * image width)) ifTrue:
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	378	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	379	self clearRectangleX:(xI + (magnification x * image width))
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	380	y:y
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	381	width:(x + w - (magnification x * image width) - xI)
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	382	height:h
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	383	].
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	384	(y + h - 1) > (yI + (magnification y * image height)) ifTrue:
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	385	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	386	self clearRectangleX:margin
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	387	y:(yI + (magnification y * image height))
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	388	width:w
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	389	height:(y + h - (magnification y * image height) - yI)
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	390	].
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	391	self drawFrame.
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	392	self clippingRectangle: nil.
1037 3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	393
3735af6b5b24 remmeber scrollOffset Claus Gittinger <cg@exept.de> parents: 1036 diff changeset	394	"Modified: / 31.7.1998 / 02:22:45 / cg"
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	395	! !
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	396
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	397	!ImageEditView methodsFor:'edit modes'!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	398
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	399	editMode
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	400
1106 57c41df67ae5 support radio buttons of the ImageEditor tz parents: 1104 diff changeset	401	^editMode
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	402	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	403
1106 57c41df67ae5 support radio buttons of the ImageEditor tz parents: 1104 diff changeset	404	editMode: anEditMode
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	405
1106 57c41df67ae5 support radio buttons of the ImageEditor tz parents: 1104 diff changeset	406	editMode := anEditMode
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	407	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	408
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	409	mouseKeyColorMode
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	410
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	411	^mouseKeyColorMode printString
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	412	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	413
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	414	mouseKeyColorMode:aMode
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	415
1106 57c41df67ae5 support radio buttons of the ImageEditor tz parents: 1104 diff changeset	416	mouseKeyColorMode := aMode
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	417	! !
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	418
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	419	!ImageEditView methodsFor:'event handling'!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	420
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	421	buttonMotion:state x:x y:y
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	422
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	423	state ~~ 0 ifTrue: [
1245 68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	424	("self selectedColor notNil" true
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	425	and: [(self imageContainsPoint: x@y)
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	426	and: [editMode == #point]])
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	427	ifTrue: [
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	428	self pointAt: x@y.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	429	^ self
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	430	].
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	431	self drawCursorAt: x@y.
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	432	] ifFalse:[
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	433	self drawCursorAt: x@y.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	434	(editMode == #paste or:[editMode == #pasteUnder]) ifTrue: [
1245 68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	435	("self selectedColor notNil" true and: [self imageContainsPastePoint: x@y])
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	436	ifTrue: [self drawPasteRectangleAt: x@y]
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	437	ifFalse: [self cursor:Cursor stop. self releasePasteDrawing]
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	438	]
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	439	]
1019 e68414752bc9 only change the cursor for myself. Claus Gittinger <cg@exept.de> parents: 1013 diff changeset	440
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	441	"Modified: / 5.9.1998 / 13:28:15 / cg"
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	442	!
255 1dfa8deddaef checkin from browser Claus Gittinger <cg@exept.de> parents: 251 diff changeset	443
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	444	buttonPress:button x:x y:y
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	445	\|mouseButtonColorToolBar clr\|
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	446
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	447	self drawCursorAt: x@y.
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	448
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	449	("self selectedColor notNil" true
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	450	and: [self imageContainsPoint: x@y])
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	451	ifTrue:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	452	self sensor shiftDown ifTrue:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	453	pickedColorHolder notNil ifTrue:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	454	"/ select the color under the cursor, place it into the
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	455	"/ pickedColorHolder/
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	456	clr := image colorAt:((x@y)//magnification).
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	457	pickedColorHolder value:clr
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	458	].
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	459	] ifFalse:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	460	"/ cg: what a kludge - please change to use a valueHolder,
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	461	"/ which gets the information ...
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	462	mouseKeyColorMode := button.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	463	mouseButtonColorToolBar := masterApplication builder componentAt: #MouseButtonColorToolBar.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	464	self makeUndo.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	465	masterApplication valueOfCanUndo value: true.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	466	(mouseButtonColorToolBar itemAt: mouseKeyColorMode) toggleIndication.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	467	mouseButtonColorToolBar do: [:i\| i updateIndicators].
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	468
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	469	"/ editMode is something like #point, #rectangle etc.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	470	self perform: (editMode, 'At:') asSymbol with: x@y
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	471	]
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	472	]
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	473
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	474	"Modified: / 5.9.1998 / 13:28:02 / cg"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	475	!
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	476
994 5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting tz parents: 877 diff changeset	477	buttonRelease:button x:x y:y
5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting tz parents: 877 diff changeset	478
5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting tz parents: 877 diff changeset	479	self drawCursorAt: x@y.
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	480
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	481	("self selectedColor notNil" true and: [self imageContainsPoint: x@y])
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	482	ifTrue: [
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	483	image restored.
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	484
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	485	"/ cg: what a kludge - please change to use a valueHolder,
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	486	"/ which gets the information ...
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	487	masterApplication imagePreView invalidate
994 5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting tz parents: 877 diff changeset	488	]
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	489
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	490	"Modified: / 5.9.1998 / 13:20:12 / cg"
994 5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting tz parents: 877 diff changeset	491	!
5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting tz parents: 877 diff changeset	492
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	493	pointerLeave:state
33833bcbb5cd some cleans tz parents: 678 diff changeset	494
688 e1c30adb37bf updates coord info label while defining boxes tz parents: 686 diff changeset	495	super pointerLeave: state.
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	496
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	497	self updateImageInfo: self imageInfoString.
1019 e68414752bc9 only change the cursor for myself. Claus Gittinger <cg@exept.de> parents: 1013 diff changeset	498	self cursor:Cursor normal.
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	499
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	500	(editMode == #paste or:[editMode == #pasteUnder]) ifTrue: [
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	501	self releasePasteDrawing
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	502	]
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	503
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	504	"Modified: / 29.7.1998 / 18:27:42 / cg"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	505	! !
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	506
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	507	!ImageEditView methodsFor:'image - dragging & info'!
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	508
1084 87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	509	dragRectangleStartingAt: aPoint emphasis: emphasis
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	510	"drag a rectangle (filled or unfilled)"
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	511
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	512	\|currentPoint currentExtent firstPoint lastCurrentPoint gridCorrection
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	513	mp lastMp p whichQuarter scrollX scrollY\|
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	514
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	515	firstPoint := currentPoint := lastCurrentPoint := aPoint//magnification*magnification.
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	516	magnification >= GridMagnification ifFalse: [gridCorrection := 0] ifTrue: [gridCorrection := 1].
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	517
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	518	[device anyButtonPressed] whileTrue: [
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	519	mp := self sensor mousePoint.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	520	mp = lastMp ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	521	Delay waitForSeconds:0.05
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	522	] ifFalse:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	523	lastMp := mp.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	524	mp := device translatePoint:mp from:device rootView id to:self id.
1084 87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	525
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	526	scrollX := 0.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	527	mp x > width ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	528	scrollX := mp x - width.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	529	] ifFalse:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	530	mp x < 0 ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	531	scrollX := mp x.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	532	]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	533	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	534	scrollY := 0.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	535	mp y > height ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	536	scrollY := mp y - height.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	537	] ifFalse:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	538	mp y < 0 ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	539	scrollY := mp y.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	540	]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	541	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	542	(scrollX + scrollY) ~~ 0 ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	543	self scrollTo:(self viewOrigin + (scrollX @ scrollY)).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	544	lastMp := nil.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	545	].
1084 87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	546
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	547	currentPoint := (0@0) max: (image extent * magnification min: (p := self translation negated + mp)).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	548	currentPoint := currentPoint//magnification*magnification.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	549	currentExtent := (firstPoint - currentPoint) abs.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	550	whichQuarter := (firstPoint x - currentPoint x) > 0
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	551	ifTrue: [(firstPoint y - currentPoint y) > 0 ifTrue: ["4"1@1] ifFalse: ["3"1@0]]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	552	ifFalse: [(firstPoint y - currentPoint y) > 0 ifTrue: ["1"0@1] ifFalse: ["2"0@0]].
1084 87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	553
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	554	self drawCursorAt: p withLabel:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	555	((firstPoint//magnification - whichQuarter + 1) printString,
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	556	' to: ',
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	557	(currentPoint//magnification + whichQuarter) printString),
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	558	' (extent: ',
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	559	(currentExtent//magnification) printString, ')'.
1084 87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	560
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	561	currentPoint ~= lastCurrentPoint ifTrue:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	562	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	563	emphasis = #inverseFilledBox
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	564	ifTrue:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	565	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	566	self redraw: ((firstPoint min: lastCurrentPoint) - 1 extent: (firstPoint - lastCurrentPoint) abs + 2).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	567	self xoring: [self fillRectangle: ((firstPoint min: currentPoint) + margin extent: currentExtent - gridCorrection)]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	568	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	569	emphasis = #box
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	570	ifTrue:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	571	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	572	\|origin extent lineWidthY lineWidthX\|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	573	origin := (firstPoint min: lastCurrentPoint) - 1.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	574	extent := (firstPoint - lastCurrentPoint) abs + 2.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	575	lineWidthY := extent y min: (magnification y + 2).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	576	lineWidthX := extent x min: (magnification x + 2).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	577	self redraw: (origin extent: (extent x@lineWidthY)).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	578	self redraw: ((origin x@(origin y + extent y - lineWidthY)) extent: (extent x@lineWidthY)).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	579	self redraw: ((origin x@(origin y + lineWidthY)) extent: (lineWidthX@(0 max: (extent y - (lineWidthY * 2))))).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	580	self redraw: (((origin x + extent x - lineWidthX)@(origin y + lineWidthY)) extent: (lineWidthX@(extent y - (lineWidthY * 2)))).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	581	self selectedColor ~= Color noColor
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	582	ifTrue: [self paint: self selectedColor]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	583	ifFalse: [self paint: self viewBackground].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	584	origin := (firstPoint min: currentPoint) + margin.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	585	extent := currentExtent - gridCorrection.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	586	lineWidthY := extent y min: magnification y.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	587	lineWidthX := extent x min: magnification x.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	588	(lineWidthY > 0 and: [lineWidthX > 0])
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	589	ifTrue:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	590	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	591	self fillRectangle: (origin extent: (extent x@lineWidthY)).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	592	self fillRectangle: ((origin x@(origin y + extent y - lineWidthY)) extent: (extent x@lineWidthY)).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	593	self fillRectangle: ((origin x@(origin y + lineWidthY)) extent: (lineWidthX@(0 max: (extent y - (lineWidthY * 2))))).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	594	self fillRectangle: (((origin x + extent x - lineWidthX)@(origin y + lineWidthY)) extent: (lineWidthX@(extent y - (lineWidthY * 2)))).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	595	]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	596	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	597	emphasis = #filledBox
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	598	ifTrue:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	599	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	600	self redraw: ((firstPoint min: lastCurrentPoint) - 1 extent: (firstPoint - lastCurrentPoint) abs + 2).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	601	self selectedColor ~= Color noColor
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	602	ifTrue: [self paint: self selectedColor]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	603	ifFalse: [self paint: self viewBackground].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	604	self fillRectangle: ((firstPoint min: currentPoint) + margin extent: currentExtent - gridCorrection).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	605	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	606	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	607	lastCurrentPoint := currentPoint.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	608	].
1084 87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	609	].
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	610
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	611	^((0@0) max: (firstPoint min: currentPoint)) extent: (firstPoint - currentPoint) abs
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	612
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	613	"Created: / 21.8.1998 / 20:17:07 / cg"
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	614	"Modified: / 21.8.1998 / 20:34:42 / cg"
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	615	!
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	616
1245 68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	617	drawCursorAt:aPoint
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	618	\|clr imgPoint\|
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	619
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	620	image isNil ifTrue: [
1245 68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	621	self updateImageInfo: self imageInfoString.
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	622	self cursor:Cursor stop.
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	623	^ self
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	624	].
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	625
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	626	(aPoint x < (image width * magnification)
1060 690045fd9032 drag rect with bad point tz parents: 1053 diff changeset	627	and:[aPoint y < (image height * magnification)
690045fd9032 drag rect with bad point tz parents: 1053 diff changeset	628	and:[aPoint x >= 0
690045fd9032 drag rect with bad point tz parents: 1053 diff changeset	629	and:[aPoint y >= 0]]])
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	630	ifFalse:[
1245 68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	631	self updateImageInfo: self imageInfoString.
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	632	self cursor:Cursor stop.
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	633	] ifTrue: [
1245 68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	634	imgPoint := aPoint // magnification.
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	635	clr := image colorAt:imgPoint.
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	636	self updateImageInfo: imgPoint printString
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	637	, ' (r:'
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	638	, clr redByte printString
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	639	, ' g:' , clr greenByte printString
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	640	, ' b:' , clr blueByte printString
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	641	, ' pixel:' , (image pixelAt:imgPoint) printString
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	642	, ')'.
68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	643	self cursor:Cursor crossHair
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	644	].
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	645
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	646	"Modified: / 29.7.1998 / 18:26:01 / cg"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	647	!
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	648
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	649	drawCursorAt: aPoint withLabel: aLabel
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	650
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	651	((0@0 extent: image extent * magnification) containsPoint: aPoint)
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	652	ifFalse:[self cursor:Cursor stop]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	653	ifTrue: [self cursor:Cursor crossHair].
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	654	self updateImageInfo: aLabel.
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	655
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	656	"Modified: / 29.7.1998 / 18:26:04 / cg"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	657	!
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	658
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	659	updateActivity: something
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	660	\|msg\|
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	661
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	662	msg := something printString.
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	663
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	664	"/ cg: new code:
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	665	activityInfoHolder notNil ifTrue:[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	666	activityInfoHolder value:msg.
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	667	].
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	668
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	669	"Modified: / 29.7.1998 / 18:41:47 / cg"
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	670	!
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	671
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	672	updateImageInfo: something
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	673	\|msg coordLabel\|
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	674
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	675	msg := something printString.
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	676
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	677	"/ cg: new code:
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	678	imageInfoHolder notNil ifTrue:[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	679	msg ~= imageInfoHolder value ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	680	imageInfoHolder value:msg.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	681	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	682	^ self
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	683	].
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	684
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	685	"/ "/ cg: what a kludge - please change to use a valueHolder,
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	686	"/ "/ which gets the coordinate ...
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	687	"/
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	688	"/ (masterApplication respondsTo: #coordLabel)
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	689	"/ ifTrue:[
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	690	"/ coordLabel := masterApplication coordLabel.
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	691	"/
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	692	"/ coordLabel label ~= msg
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	693	"/ ifTrue:[
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	694	"/ coordLabel label: msg.
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	695	"/ "/ coordLabel redraw
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	696	"/ ]
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	697	"/ ]
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	698
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	699	"Modified: / 29.7.1998 / 19:00:21 / cg"
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	700	! !
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	701
636 d53428252193 revised version tz parents: 633 diff changeset	702	!ImageEditView methodsFor:'image editing'!
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	703
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	704	boxAt: aPoint
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	705	"draw a rectangular outline with the currently selected color"
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	706
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	707	\|choosedBox imageBox clr\|
1038 6c0bb03e88a1 no need to invalidate after assign of new image. Claus Gittinger <cg@exept.de> parents: 1037 diff changeset	708
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	709	(clr := self selectedColor) notNil ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	710	choosedBox := self dragRectangleStartingAt: aPoint emphasis: #box.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	711	imageBox := choosedBox origin//magnification extent: (choosedBox extent//magnification).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	712	image rectangle:imageBox withColor:clr.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	713	image restored.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	714	self redraw: (choosedBox expandedBy: 1).
1038 6c0bb03e88a1 no need to invalidate after assign of new image. Claus Gittinger <cg@exept.de> parents: 1037 diff changeset	715
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	716	"/ cg: what a kludge - please change to use a valueHolder,
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	717	"/ which gets the information ...
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	718	masterApplication imagePreView redraw: (imageBox expandedBy: 1).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	719	modified := true
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	720	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	721
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	722	"Modified: / 5.9.1998 / 13:29:55 / cg"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	723	!
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	724
1002 5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	725	changeGridMagnification
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	726
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	727	\|box newGridMagnification\|
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	728	box := EnterBox new.
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	729	box title:'Grid Magnification:'.
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	730	box okText:'OK'.
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	731	box abortText:'Cancel'.
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	732	box initialText:GridMagnification x printString.
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	733	box showAtPointer.
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	734	(box accepted and: [(newGridMagnification := Number readFromString: box contents onError:[2]) notNil])
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	735	ifTrue:
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	736	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	737	GridMagnification := (99 min: (2 max: newGridMagnification)) asPoint.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	738	self invalidate
1002 5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	739	]
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	740	!
5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	741
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	742	copyAt: aPoint
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	743
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	744	\|choosedBox\|
1084 87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	745
87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	746	choosedBox := self dragRectangleStartingAt: aPoint emphasis: #inverseFilledBox.
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	747	ClipboardMagnification := nil.
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	748	Clipboard := image subImageIn: (choosedBox origin//magnification extent: (choosedBox extent//magnification)).
1084 87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	749	self redraw: (choosedBox expandedBy: 1)
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	750
1084 87c661e6c333 scroll when dragging out of the view in copy-mode. Claus Gittinger <cg@exept.de> parents: 1060 diff changeset	751	"Modified: / 21.8.1998 / 20:16:41 / cg"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	752	!
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	753
1228 0aae4f7389ca renamed - crob -> crop Claus Gittinger <cg@exept.de> parents: 1184 diff changeset	754	cropLeft:doLeft right:doRight top:doTop bottom:doBottom
1121 af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	755	\|yMinNew yMaxNew xMinNew xMaxNew
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	756	pix stillCrobbing xMax yMax x y\|
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	757
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	758	xMax := image width - 1.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	759	yMax := image height - 1.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	760
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	761	xMinNew := 0.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	762	doLeft ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	763	pix := image pixelAtX:xMinNew y:0.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	764	stillCrobbing := true.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	765	[stillCrobbing] whileTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	766	0 to:yMax do:[:y \|
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	767	(image pixelAtX:xMinNew y:y) ~~ pix ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	768	stillCrobbing := false
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	769	]
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	770	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	771	stillCrobbing ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	772	xMinNew := xMinNew + 1.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	773	xMinNew >= image width ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	774	self warn:'Image is all the same color - no crob.'.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	775	^ self
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	776	]
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	777	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	778	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	779	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	780
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	781	xMaxNew := xMax.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	782	doRight ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	783	stillCrobbing := true.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	784	pix := image pixelAtX:xMaxNew y:0.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	785	[stillCrobbing] whileTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	786	0 to:yMax do:[:y \|
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	787	(image pixelAtX:xMaxNew y:y) ~~ pix ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	788	stillCrobbing := false
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	789	]
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	790	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	791	stillCrobbing ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	792	xMaxNew := xMaxNew - 1.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	793	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	794	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	795	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	796
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	797	yMinNew := 0.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	798	doTop ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	799	pix := image pixelAtX:xMinNew y:yMinNew.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	800	stillCrobbing := true.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	801	[stillCrobbing] whileTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	802	xMinNew to:xMaxNew do:[:x \|
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	803	(image pixelAtX:x y:yMinNew) ~~ pix ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	804	stillCrobbing := false
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	805	]
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	806	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	807	stillCrobbing ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	808	yMinNew := yMinNew + 1.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	809	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	810	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	811	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	812
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	813	yMaxNew := yMax.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	814	doRight ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	815	stillCrobbing := true.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	816	pix := image pixelAtX:xMaxNew y:yMaxNew.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	817	[stillCrobbing] whileTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	818	xMinNew to:xMaxNew do:[:x \|
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	819	(image pixelAtX:x y:yMaxNew) ~~ pix ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	820	stillCrobbing := false
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	821	]
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	822	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	823	stillCrobbing ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	824	yMaxNew := yMaxNew - 1.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	825	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	826	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	827	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	828
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	829	(xMinNew == 0
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	830	and:[xMaxNew == (image width - 1)
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	831	and:[yMinNew == 0
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	832	and:[yMaxNew == (image height - 1)]]]) ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	833	self warn:'No border found - no crob.'.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	834	^ self
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	835	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	836
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	837	"/ self warn:'extract subImage '
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	838	"/ , (xMinNew @ yMinNew) printString
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	839	"/ , ' -> '
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	840	"/ , (xMaxNew @ yMaxNew) printString.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	841
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	842	self
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	843	makeSubImageX:xMinNew y:yMinNew
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	844	width:(xMaxNew - xMinNew + 1)
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	845	height:(yMaxNew - yMinNew + 1)
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	846
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	847	"Created: / 7.9.1998 / 14:25:52 / cg"
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	848	"Modified: / 7.9.1998 / 16:35:35 / cg"
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	849	!
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	850
1035 5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	851	drawPasteRectangleAt: aPoint
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	852
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	853	\|currentPoint gridCorrection extent\|
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	854
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	855	magnification >= GridMagnification ifFalse: [gridCorrection := 0] ifTrue: [gridCorrection := 1].
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	856	currentPoint := aPoint//magnification*magnification + margin.
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	857
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	858	currentPoint ~= lastPastePoint
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	859	ifTrue:
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	860	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	861	ClipboardMagnification isNil ifTrue: [ClipboardMagnification := (Clipboard magnifiedBy: magnification) onDevice: device].
1035 5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	862
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	863	extent := ClipboardMagnification extent.
1035 5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	864
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	865	currentPoint := currentPoint - self viewOrigin.
1035 5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	866
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	867	self redraw: ((lastPastePoint ? currentPoint) extent: extent).
1035 5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	868
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	869	(extent x > 200 or: [extent y > 200])
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	870	ifTrue:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	871	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	872	self xoring: [self fillRectangle: (currentPoint extent: extent)]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	873	]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	874	ifFalse:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	875	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	876	self displayDeviceForm: ClipboardMagnification x: currentPoint x y: currentPoint y
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	877	]
1035 5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	878	].
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	879	lastPastePoint := currentPoint.
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	880
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	881	"Modified: / 29.7.1998 / 02:18:11 / cg"
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	882	!
5da83bdbd65e checkin from browser Claus Gittinger <cg@exept.de> parents: 1031 diff changeset	883
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	884	fillAt: aPoint
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	885	"perform a flood-fill with the currently selected color"
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	886
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	887	windowGroup withExecuteCursorDo:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	888	\|filledPoints clr\|
1002 5d2e4c03a78e grid magnification can be changed tz parents: 996 diff changeset	889
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	890	(clr := self selectedColor) notNil ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	891	self updateActivity:'Flood filling - press CTRL-y to abort ...'.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	892	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	893	filledPoints := image floodFillAt: aPoint//magnification withColor:clr.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	894	image restored.
1038 6c0bb03e88a1 no need to invalidate after assign of new image. Claus Gittinger <cg@exept.de> parents: 1037 diff changeset	895
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	896	"/ animation effect ...
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	897	filledPoints size < 300
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	898	ifTrue: [
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	899	filledPoints do: [:p\| self redraw: ((p * magnification extent: magnification) expandedBy: 1)]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	900	] ifFalse: [
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	901	self invalidate
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	902	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	903	"/ cg: what a kludge - please change to use a valueHolder,
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	904	"/ which gets the information ...
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	905	masterApplication imagePreView invalidate.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	906	modified := true
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	907	] valueOnUnwindDo:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	908	self updateActivity:'Flood fill aborted.'
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	909	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	910	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	911	self updateActivity:''
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	912	]
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	913
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	914	"Modified: / 5.9.1998 / 13:28:24 / cg"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	915	!
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	916
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	917	filledBoxAt: aPoint
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	918	"fill a rectangular area with the currently selected color"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	919
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	920	\|choosedBox imageBox clr\|
1038 6c0bb03e88a1 no need to invalidate after assign of new image. Claus Gittinger <cg@exept.de> parents: 1037 diff changeset	921
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	922	(clr := self selectedColor) notNil ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	923	choosedBox := self dragRectangleStartingAt: aPoint emphasis: #filledBox.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	924	imageBox := choosedBox origin//magnification extent: (choosedBox extent//magnification).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	925	image fillRectangle:imageBox withColor:clr.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	926	image restored.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	927	self redraw: (choosedBox expandedBy: 1).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	928	"/ cg: what a kludge - please change to use a valueHolder,
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	929	"/ which gets the information ...
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	930	masterApplication imagePreView redraw: (imageBox expandedBy: 1).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	931	modified := true
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	932	]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	933
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	934	"Modified: / 5.9.1998 / 13:25:44 / cg"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	935	!
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	936
636 d53428252193 revised version tz parents: 633 diff changeset	937	flipHorizontal
d53428252193 revised version tz parents: 633 diff changeset	938
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	939	self makeUndo.
725 0e051202859d checkin from browser tz parents: 724 diff changeset	940	self image: image copy flipHorizontal
636 d53428252193 revised version tz parents: 633 diff changeset	941
d53428252193 revised version tz parents: 633 diff changeset	942	!
d53428252193 revised version tz parents: 633 diff changeset	943
d53428252193 revised version tz parents: 633 diff changeset	944	flipVertical
d53428252193 revised version tz parents: 633 diff changeset	945
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	946	self makeUndo.
725 0e051202859d checkin from browser tz parents: 724 diff changeset	947	self image: image copy flipVertical
636 d53428252193 revised version tz parents: 633 diff changeset	948
d53428252193 revised version tz parents: 633 diff changeset	949	!
d53428252193 revised version tz parents: 633 diff changeset	950
d53428252193 revised version tz parents: 633 diff changeset	951	magnifyImage
d53428252193 revised version tz parents: 633 diff changeset	952
d53428252193 revised version tz parents: 633 diff changeset	953	\|box newSize\|
d53428252193 revised version tz parents: 633 diff changeset	954	box := EnterBox new.
d53428252193 revised version tz parents: 633 diff changeset	955	box title:'Image new size:'.
d53428252193 revised version tz parents: 633 diff changeset	956	box okText:'OK'.
d53428252193 revised version tz parents: 633 diff changeset	957	box abortText:'Cancel'.
d53428252193 revised version tz parents: 633 diff changeset	958	box initialText:image extent printString.
d53428252193 revised version tz parents: 633 diff changeset	959	box showAtPointer.
d53428252193 revised version tz parents: 633 diff changeset	960	(box accepted and: [(newSize := Object readFromString: box contents onError:nil) notNil])
d53428252193 revised version tz parents: 633 diff changeset	961	ifTrue:
d53428252193 revised version tz parents: 633 diff changeset	962	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	963	self makeUndo.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	964	self image: (image magnifiedBy: newSize/image extent)
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	965	]
636 d53428252193 revised version tz parents: 633 diff changeset	966	!
d53428252193 revised version tz parents: 633 diff changeset	967
1121 af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	968	makeSubImageX:oldX y:oldY width:newWidth height:newHeight
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	969	\|newImage\|
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	970
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	971	newImage := image class width:newWidth height:newHeight depth:image depth.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	972	newImage photometric:image photometric.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	973	newImage colorMap:image colorMap copy.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	974	newImage bits:(ByteArray new:(newImage bytesPerRow * newHeight)).
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	975
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	976	image mask notNil
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	977	ifTrue:[
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	978	\|newMaskImage\|
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	979
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	980	newMaskImage := Depth1Image width:newWidth height:newHeight.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	981	newMaskImage photometric: image mask photometric.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	982	newMaskImage colorMap: image mask colorMap copy.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	983	newMaskImage bits:(ByteArray new: newMaskImage bytesPerRow * newHeight).
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	984	newImage mask: newMaskImage
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	985	].
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	986
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	987	newImage copyFrom:image x:oldX y:oldY toX:0 y:0 width:newWidth height:newHeight.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	988	self makeUndo.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	989	self image: newImage.
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	990
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	991	"Created: / 7.9.1998 / 13:00:16 / cg"
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	992	"Modified: / 7.9.1998 / 14:15:32 / cg"
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	993	!
af09c616fb7b added crob operations. Claus Gittinger <cg@exept.de> parents: 1116 diff changeset	994
636 d53428252193 revised version tz parents: 633 diff changeset	995	negativeImage
d53428252193 revised version tz parents: 633 diff changeset	996
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	997	self makeUndo.
725 0e051202859d checkin from browser tz parents: 724 diff changeset	998	self image: image copy negative
636 d53428252193 revised version tz parents: 633 diff changeset	999	!
d53428252193 revised version tz parents: 633 diff changeset	1000
d53428252193 revised version tz parents: 633 diff changeset	1001	pasteAt: aPoint
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1002	"paste the image in the clipboard at aPoint"
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1003
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1004	self pasteAt:aPoint modeUnder:false.
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1005	!
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1006
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1007	pasteAt: aPoint modeUnder:modeUnder
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1008	"paste the image in the clipboard at aPoint"
636 d53428252193 revised version tz parents: 633 diff changeset	1009
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1010	ClipboardMagnification isNil ifTrue: [^self].
cd84d6f8c449 several undos tz parents: 994 diff changeset	1011
636 d53428252193 revised version tz parents: 633 diff changeset	1012	Object errorSignal handle:
d53428252193 revised version tz parents: 633 diff changeset	1013	[:ex\|
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1014	ex signal == Image unrepresentableColorSignal ifFalse:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1015	ex reject
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1016	].
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1017	self undo.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1018	self warn: 'Paste failed !!\Increasing the images depth might help.' withCRs.
636 d53428252193 revised version tz parents: 633 diff changeset	1019	]
d53428252193 revised version tz parents: 633 diff changeset	1020	do:
d53428252193 revised version tz parents: 633 diff changeset	1021	[
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1022	windowGroup withExecuteCursorDo:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1023	\|choosedBox imagePoint imgX imgY copiedImage imageBox presentClr newColorMap\|
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1024
cd84d6f8c449 several undos tz parents: 994 diff changeset	1025
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1026	choosedBox := self dragRectangleStartingAt: aPoint emphasis: #inverseFilledBox.
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1027
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1028	imagePoint := choosedBox origin//magnification.
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1029
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1030	copiedImage := Clipboard copy.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1031	image photometric == #palette ifTrue:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1032	"/ for all colors in the pasted image,
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1033	"/ check, if its in the colormap of the
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1034	"/ target image.
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1035
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1036	copiedImage usedValues do:[:pixel \|
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1037	\|pastedColor oldColorMap\|
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1038
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1039	pastedColor := copiedImage colorFromValue:pixel.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1040	oldColorMap := image colorMap.
1028 4dfe1c6cbc48 fixed paste-drag display (when scrolled) Claus Gittinger <cg@exept.de> parents: 1027 diff changeset	1041
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1042	(oldColorMap detect: [:clr\| clr = pastedColor] ifNone: nil) isNil
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1043	ifTrue:
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1044	[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1045	oldColorMap size < (1 bitShift:image depth) ifTrue:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1046	"/ add to colormap
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1047	newColorMap isNil ifTrue:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1048	newColorMap := oldColorMap asOrderedCollection.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1049	].
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1050	newColorMap add:pastedColor.
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1051	"/ Transcript showCR:'adding color:' , pastedColor displayString , ' to targets colorMap'.
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1052	] ifFalse:[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1053	"/ Transcript showCR:'color:' , pastedColor displayString , ' not found in targets colorMap'.
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1054	copiedImage colorMap at: pixel+1 put: Color black
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1055	]
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1056	]
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1057	].
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1058
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1059	newColorMap notNil ifTrue:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1060	image colorMap:(Colormap fromColors:newColorMap).
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1061	].
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1062	].
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1063
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1064	copiedImage := image class fromImage: copiedImage.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1065	(newColorMap isNil and:[modeUnder not]) ifTrue:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1066	image copyFrom: copiedImage x:0 y:0 toX: imagePoint x y: imagePoint y width: copiedImage width height: copiedImage height.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1067	] ifFalse:[
994 5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting tz parents: 877 diff changeset	1068
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1069	imgX := imagePoint x.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1070	imgY := imagePoint y.
1028 4dfe1c6cbc48 fixed paste-drag display (when scrolled) Claus Gittinger <cg@exept.de> parents: 1027 diff changeset	1071
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1072	0 to:copiedImage height-1 do:[:y \|
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1073	0 to:copiedImage width-1 do:[:x \|
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1074	\|wasMasked newMasked dstX dstY oldColor\|
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1075
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1076	dstX := imgX + x.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1077	dstY := imgY + y.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1078	wasMasked := (image maskAtX:dstX y:dstY) == 0.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1079	newMasked := (copiedImage maskAtX:x y:y) == 0.
994 5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting tz parents: 877 diff changeset	1080
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1081	"/ with modeUnder,
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1082	"/ only replace, if its either unmasked,
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1083	"/ or the current drawing color.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1084	(modeUnder not
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1085	or:[wasMasked
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1086	or:[(oldColor := image colorAtX:dstX y:dstY) = (drawingColors at:1)]])
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1087	ifTrue:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1088	image
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1089	colorAtX:dstX
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1090	y:dstY
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1091	put:(copiedImage colorAtX:x y:y).
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1092	(wasMasked and:[newMasked not]) ifTrue:[
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1093	image mask pixelAtX:dstX y:dstY put:1
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1094	].
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1095	]
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1096	]
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1097	].
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1098	].
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1099	image restored.
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1100	self redraw: (imageBox := (imagePoint * magnification extent: (Clipboard extent * magnification)) expandedBy: 1@1).
1028 4dfe1c6cbc48 fixed paste-drag display (when scrolled) Claus Gittinger <cg@exept.de> parents: 1027 diff changeset	1101	"/ masterApplication imagePreView redraw: (imageBox expandedBy: 1).
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1102	modified := true
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1103	]
1028 4dfe1c6cbc48 fixed paste-drag display (when scrolled) Claus Gittinger <cg@exept.de> parents: 1027 diff changeset	1104	]
4dfe1c6cbc48 fixed paste-drag display (when scrolled) Claus Gittinger <cg@exept.de> parents: 1027 diff changeset	1105
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1106	"Modified: / 5.9.1998 / 13:36:58 / cg"
636 d53428252193 revised version tz parents: 633 diff changeset	1107	!
d53428252193 revised version tz parents: 633 diff changeset	1108
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1109	pasteUnderAt: aPoint
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1110	"pasteUnder the image in the clipboard at aPoint.
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1111	In this mode, only pixels which are not equal to
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1112	the current color or masked are pasted."
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1113
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1114	self pasteAt:aPoint modeUnder:true.
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1115	!
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1116
636 d53428252193 revised version tz parents: 633 diff changeset	1117	pointAt: aPoint
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1118	"draw a single pixel with the currently selected color"
636 d53428252193 revised version tz parents: 633 diff changeset	1119
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1120	\|imagePoint clr pix\|
796 b68b09ddc62b preview redrawing tz parents: 783 diff changeset	1121
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1122	imagePoint := aPoint // magnification.
1277 8c74c9cc6e22 fixed point-drawing Claus Gittinger <cg@exept.de> parents: 1261 diff changeset	1123	(clr := self selectedColor) isNil ifTrue:[
8c74c9cc6e22 fixed point-drawing Claus Gittinger <cg@exept.de> parents: 1261 diff changeset	1124	pix := self selectedColorIndex
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1125	].
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1126	pix notNil ifTrue:[
1277 8c74c9cc6e22 fixed point-drawing Claus Gittinger <cg@exept.de> parents: 1261 diff changeset	1127	image colorMap atImageAndMask:imagePoint putValue:pix.
1245 68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	1128	modified := true.
1277 8c74c9cc6e22 fixed point-drawing Claus Gittinger <cg@exept.de> parents: 1261 diff changeset	1129	] ifFalse:[
8c74c9cc6e22 fixed point-drawing Claus Gittinger <cg@exept.de> parents: 1261 diff changeset	1130	clr notNil ifTrue:[
8c74c9cc6e22 fixed point-drawing Claus Gittinger <cg@exept.de> parents: 1261 diff changeset	1131	image atImageAndMask:imagePoint put:clr.
8c74c9cc6e22 fixed point-drawing Claus Gittinger <cg@exept.de> parents: 1261 diff changeset	1132	modified := true.
8c74c9cc6e22 fixed point-drawing Claus Gittinger <cg@exept.de> parents: 1261 diff changeset	1133	].
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1134	].
1277 8c74c9cc6e22 fixed point-drawing Claus Gittinger <cg@exept.de> parents: 1261 diff changeset	1135	self invalidate:((imagePoint * magnification extent: magnification) expandedBy: 1).
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1136
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1137	"Modified: / 5.9.1998 / 13:25:29 / cg"
636 d53428252193 revised version tz parents: 633 diff changeset	1138	!
d53428252193 revised version tz parents: 633 diff changeset	1139
d53428252193 revised version tz parents: 633 diff changeset	1140	resizeImage
d53428252193 revised version tz parents: 633 diff changeset	1141
d53428252193 revised version tz parents: 633 diff changeset	1142	\|box newSize\|
d53428252193 revised version tz parents: 633 diff changeset	1143	box := EnterBox new.
d53428252193 revised version tz parents: 633 diff changeset	1144	box title:'Image new size:'.
d53428252193 revised version tz parents: 633 diff changeset	1145	box okText:'OK'.
d53428252193 revised version tz parents: 633 diff changeset	1146	box abortText:'Cancel'.
d53428252193 revised version tz parents: 633 diff changeset	1147	box initialText:image extent printString.
d53428252193 revised version tz parents: 633 diff changeset	1148	box showAtPointer.
d53428252193 revised version tz parents: 633 diff changeset	1149	(box accepted and: [(newSize := Object readFromString: box contents onError:nil) notNil])
d53428252193 revised version tz parents: 633 diff changeset	1150	ifTrue:
d53428252193 revised version tz parents: 633 diff changeset	1151	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1152	\|newImage\|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1153	newImage := image class width: newSize x height: newSize y depth: image depth.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1154	newImage photometric:image photometric.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1155	newImage colorMap:image colorMap copy.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1156	newImage bits: (ByteArray new: newImage bytesPerRow * newSize y).
636 d53428252193 revised version tz parents: 633 diff changeset	1157
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1158	image mask notNil
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1159	ifTrue:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1160	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1161	\|newMaskImage\|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1162	newMaskImage := Depth1Image width: newSize x height: newSize y.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1163	newMaskImage photometric: image mask photometric.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1164	newMaskImage colorMap: image mask colorMap copy.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1165	newMaskImage bits:(ByteArray new: newMaskImage bytesPerRow * newSize y).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1166	newImage mask: newMaskImage
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1167	].
636 d53428252193 revised version tz parents: 633 diff changeset	1168
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1169	newImage copyFrom:image x:0 y:0 toX:0 y:0 width: (image width min:newSize x) height: (image height min:newSize y).
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1170	self makeUndo.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1171	self image: newImage.
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	1172	]
636 d53428252193 revised version tz parents: 633 diff changeset	1173	!
d53428252193 revised version tz parents: 633 diff changeset	1174
d53428252193 revised version tz parents: 633 diff changeset	1175	rotateImage
d53428252193 revised version tz parents: 633 diff changeset	1176
d53428252193 revised version tz parents: 633 diff changeset	1177	\|box rotation\|
d53428252193 revised version tz parents: 633 diff changeset	1178	box := EnterBox new.
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1179	box title:'Rotate by (degrees, clockwise):'.
636 d53428252193 revised version tz parents: 633 diff changeset	1180	box okText:'OK'.
d53428252193 revised version tz parents: 633 diff changeset	1181	box abortText:'Cancel'.
d53428252193 revised version tz parents: 633 diff changeset	1182	box initialText: '0'.
d53428252193 revised version tz parents: 633 diff changeset	1183	box showAtPointer.
d53428252193 revised version tz parents: 633 diff changeset	1184	(box accepted and: [(rotation := Object readFromString: box contents onError:nil) notNil])
d53428252193 revised version tz parents: 633 diff changeset	1185	ifTrue:
d53428252193 revised version tz parents: 633 diff changeset	1186	[ Object errorSignal handle:
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1187	[:ex\|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1188	self warn: 'Image rotation failed!!\' withCRs, 'Increaing the image depth could help.'
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1189	]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1190	do:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1191	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1192	self makeUndo.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1193	self image: (image hardRotated: rotation)
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1194	]
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	1195	]
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1196
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1197	"Modified: / 29.7.1998 / 18:21:14 / cg"
636 d53428252193 revised version tz parents: 633 diff changeset	1198	!
d53428252193 revised version tz parents: 633 diff changeset	1199
d53428252193 revised version tz parents: 633 diff changeset	1200	undo
d53428252193 revised version tz parents: 633 diff changeset	1201
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1202	undoImages notEmpty
636 d53428252193 revised version tz parents: 633 diff changeset	1203	ifTrue:
725 0e051202859d checkin from browser tz parents: 724 diff changeset	1204	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1205	windowGroup withExecuteCursorDo:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1206	modified := false.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1207	self image: undoImages removeLast.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1208	"/ cg: what a kludge - please change to use a valueHolder,
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1209	masterApplication notNil ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1210	masterApplication listOfColors contents: image colorMap.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1211	masterApplication findColorMapMode.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1212	undoImages isEmpty ifTrue: [masterApplication valueOfCanUndo value: false].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1213	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1214	"/ cg: not needed - image: already does it.
1038 6c0bb03e88a1 no need to invalidate after assign of new image. Claus Gittinger <cg@exept.de> parents: 1037 diff changeset	1215	"/ self invalidate
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1216	]
636 d53428252193 revised version tz parents: 633 diff changeset	1217	]
1038 6c0bb03e88a1 no need to invalidate after assign of new image. Claus Gittinger <cg@exept.de> parents: 1037 diff changeset	1218
1047 95f10ea8653d use #withExecuteCursorDo: Claus Gittinger <cg@exept.de> parents: 1038 diff changeset	1219	"Modified: / 31.7.1998 / 20:12:58 / cg"
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1220	! !
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1221
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1222	!ImageEditView methodsFor:'image setting'!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1223
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1224	image:anImage
1256 c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1225	\|retVal fileName\|
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1226
1256 c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1227	anImage isImage ifTrue:[
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1228	(image isNil or: [self checkModified]) ifTrue: [
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1229	masterApplication notNil ifTrue: [
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1230	undoImages notEmpty ifTrue: [masterApplication valueOfCanUndo value: true].
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1231	masterApplication imagePreView image: anImage
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1232	].
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1233	image notNil ifTrue: [
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1234	fileName := image fileName.
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1235	anImage fileName isNil ifTrue: [anImage fileName: fileName].
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1236	].
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1237	super image: anImage.
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1238	retVal := self.
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1239	].
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1240	] ifFalse: [
c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1241	super image: nil.
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1242	].
1025 4470f3ad349f update the image label, when a new image is assigned. Claus Gittinger <cg@exept.de> parents: 1019 diff changeset	1243
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1244	self updateImageInfo: self imageInfoString.
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1245	^ retVal
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1246
1256 c4e0b9024475 checkin from browser Claus Gittinger <cg@exept.de> parents: 1246 diff changeset	1247	"Modified: / 16.3.1999 / 21:45:13 / cg"
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1248	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1249
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1250	loadFromFile: aFileName
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1251
676 fd7918a3e6e6 load + preview redraw errors removed tz parents: 674 diff changeset	1252	aFileName isNil ifTrue: [^nil].
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1253	Object errorSignal handle:
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1254	[:exeption\|
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1255	modified := false.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1256	self warn: exeption errorString.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1257	^nil
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1258	]
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1259	do:
676 fd7918a3e6e6 load + preview redraw errors removed tz parents: 674 diff changeset	1260	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1261	\|imageFromFile\|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1262	(imageFromFile := Image fromFile: aFileName) notNil
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1263	ifTrue:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1264	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1265	self releaseUndos.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1266	self image: imageFromFile.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1267	imageReaderClass := ImageReader allSubclasses
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1268	detect: [:cls\| cls isValidImageFile: aFileName]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1269	ifNone: [self error: 'Unknown image file format!!']
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1270	]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1271	ifFalse:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1272	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1273	self error: 'Not an image file (or unrecognized format) !!'
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1274	]
676 fd7918a3e6e6 load + preview redraw errors removed tz parents: 674 diff changeset	1275	]
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1276
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1277	"Modified: / 29.7.1998 / 18:09:13 / cg"
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1278	!
255 1dfa8deddaef checkin from browser Claus Gittinger <cg@exept.de> parents: 251 diff changeset	1279
633 594edef86630 revised version tz parents: 632 diff changeset	1280	loadFromMessage: aMessage
594edef86630 revised version tz parents: 632 diff changeset	1281
594edef86630 revised version tz parents: 632 diff changeset	1282	(self resourceMessage: aMessage) isNil
594edef86630 revised version tz parents: 632 diff changeset	1283	ifTrue:
594edef86630 revised version tz parents: 632 diff changeset	1284	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1285	^nil
633 594edef86630 revised version tz parents: 632 diff changeset	1286	].
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1287
633 594edef86630 revised version tz parents: 632 diff changeset	1288	^self loadfromClass: resourceClass andSelector: resourceSelector
594edef86630 revised version tz parents: 632 diff changeset	1289
594edef86630 revised version tz parents: 632 diff changeset	1290
594edef86630 revised version tz parents: 632 diff changeset	1291	!
594edef86630 revised version tz parents: 632 diff changeset	1292
594edef86630 revised version tz parents: 632 diff changeset	1293	loadfromClass: aClassOrSymbol andSelector: aStringOrSymbol
594edef86630 revised version tz parents: 632 diff changeset	1294
678 9afa8810a8be image must not be nil after load failure tz parents: 676 diff changeset	1295	\|aClass\|
9afa8810a8be image must not be nil after load failure tz parents: 676 diff changeset	1296
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1297	imageReaderClass := nil.
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1298	self resourceClass: aClassOrSymbol.
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1299	self resourceSelector: aStringOrSymbol.
678 9afa8810a8be image must not be nil after load failure tz parents: 676 diff changeset	1300
9afa8810a8be image must not be nil after load failure tz parents: 676 diff changeset	1301	((aClass := Smalltalk at: resourceClass) isClass and:
9afa8810a8be image must not be nil after load failure tz parents: 676 diff changeset	1302	[aClass class implements: resourceSelector])
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1303	ifTrue:
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1304	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1305	self releaseUndos.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1306	^self image: (aClass perform: resourceSelector) copy
674 f24ca336b717 if none image found for loading clear image tz parents: 662 diff changeset	1307	]
f24ca336b717 if none image found for loading clear image tz parents: 662 diff changeset	1308	ifFalse:
f24ca336b717 if none image found for loading clear image tz parents: 662 diff changeset	1309	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1310	modified := false.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1311	^nil
674 f24ca336b717 if none image found for loading clear image tz parents: 662 diff changeset	1312	]
f24ca336b717 if none image found for loading clear image tz parents: 662 diff changeset	1313
161 5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1314	! !
5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1315
1327 ab99aad206dc category change Claus Gittinger <cg@exept.de> parents: 1277 diff changeset	1316	!ImageEditView methodsFor:'initialize / release'!
ab99aad206dc category change Claus Gittinger <cg@exept.de> parents: 1277 diff changeset	1317
ab99aad206dc category change Claus Gittinger <cg@exept.de> parents: 1277 diff changeset	1318	destroy
ab99aad206dc category change Claus Gittinger <cg@exept.de> parents: 1277 diff changeset	1319
ab99aad206dc category change Claus Gittinger <cg@exept.de> parents: 1277 diff changeset	1320	ClipboardMagnification := Clipboard := nil.
ab99aad206dc category change Claus Gittinger <cg@exept.de> parents: 1277 diff changeset	1321	LastMagnification := magnification.
ab99aad206dc category change Claus Gittinger <cg@exept.de> parents: 1277 diff changeset	1322
ab99aad206dc category change Claus Gittinger <cg@exept.de> parents: 1277 diff changeset	1323	super destroy
ab99aad206dc category change Claus Gittinger <cg@exept.de> parents: 1277 diff changeset	1324
ab99aad206dc category change Claus Gittinger <cg@exept.de> parents: 1277 diff changeset	1325	!
1 c6ca7bfedf31 Initial revision claus parents: diff changeset	1326
161 5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1327	initialize
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1328
161 5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1329	super initialize.
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1330
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	1331	self enableMotionEvents.
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1332
cd84d6f8c449 several undos tz parents: 994 diff changeset	1333	undoImages := OrderedCollection new: MaxUndos.
1003 c0958fda9993 remember the old magnification tz parents: 1002 diff changeset	1334	magnification := LastMagnification ? GridMagnification.
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1335	modified := false.
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1336	mouseKeyColorMode := 1.
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1337	resourceClass := resourceSelector := ''.
1246 0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1338	drawingColors := Array with: nil with: nil. "/ left/right mouse colors
0cd36bffc789 checkin from browser Claus Gittinger <cg@exept.de> parents: 1245 diff changeset	1339	drawingPixels := Array with: nil with: nil. "/ left/right mouse colors
1106 57c41df67ae5 support radio buttons of the ImageEditor tz parents: 1104 diff changeset	1340	editMode := #point.
1036 d860072f3b49 gridMag default. Claus Gittinger <cg@exept.de> parents: 1035 diff changeset	1341
1 c6ca7bfedf31 Initial revision claus parents: diff changeset	1342	! !
c6ca7bfedf31 Initial revision claus parents: diff changeset	1343
636 d53428252193 revised version tz parents: 633 diff changeset	1344	!ImageEditView methodsFor:'printing & storing'!
1 c6ca7bfedf31 Initial revision claus parents: diff changeset	1345
724 d6f4b89940ed undo disabling tz parents: 704 diff changeset	1346	loadFromClass
404 322e32d8f099 checkin from browser Claus Gittinger <cg@exept.de> parents: 398 diff changeset	1347
676 fd7918a3e6e6 load + preview redraw errors removed tz parents: 674 diff changeset	1348	^self loadFromMessage:
1184 58e399d8c312 checkin from browser Claus Gittinger <cg@exept.de> parents: 1180 diff changeset	1349	(ResourceSelectionBrowser
58e399d8c312 checkin from browser Claus Gittinger <cg@exept.de> parents: 1180 diff changeset	1350	request: 'Load Image From Class'
58e399d8c312 checkin from browser Claus Gittinger <cg@exept.de> parents: 1180 diff changeset	1351	onSuperclass: nil
58e399d8c312 checkin from browser Claus Gittinger <cg@exept.de> parents: 1180 diff changeset	1352	andClass: self resourceClass
58e399d8c312 checkin from browser Claus Gittinger <cg@exept.de> parents: 1180 diff changeset	1353	andSelector: self resourceSelector
58e399d8c312 checkin from browser Claus Gittinger <cg@exept.de> parents: 1180 diff changeset	1354	withResourceTypes: #(image fileImage programImage))
636 d53428252193 revised version tz parents: 633 diff changeset	1355
477 37f12d35c359 added #resize. Claus Gittinger <cg@exept.de> parents: 430 diff changeset	1356
161 5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1357	!
5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1358
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1359	makeUndo
cd84d6f8c449 several undos tz parents: 994 diff changeset	1360
cd84d6f8c449 several undos tz parents: 994 diff changeset	1361	image notNil
cd84d6f8c449 several undos tz parents: 994 diff changeset	1362	ifTrue:
cd84d6f8c449 several undos tz parents: 994 diff changeset	1363	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1364	MaxUndos <= undoImages size
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1365	ifTrue: [undoImages contents: (undoImages copyFrom: 2 to: MaxUndos)].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1366	undoImages add: image copy
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1367	]
cd84d6f8c449 several undos tz parents: 994 diff changeset	1368	!
cd84d6f8c449 several undos tz parents: 994 diff changeset	1369
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1370	print
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1371
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	1372	image notNil
33833bcbb5cd some cleans tz parents: 678 diff changeset	1373	ifTrue:
636 d53428252193 revised version tz parents: 633 diff changeset	1374	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1375	\|stream\|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1376	Printer supportsPostscript ifFalse:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1377	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1378	^self warn:'No postscript printer detected!!'
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1379	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1380	stream := Printer newNative.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1381	stream isNil ifTrue:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1382	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1383	^self warn:'Cannot open printer stream!!'
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1384	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1385	self withWaitCursorDo:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1386	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1387	\|psgc\|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1388	psgc := PSGraphicsContext on:stream.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1389	psgc displayForm: (image magnifiedBy: magnification) x:0 y:0.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1390	psgc close
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1391	]
398 7b7255a4db0d show a wait cursor while printing Claus Gittinger <cg@exept.de> parents: 362 diff changeset	1392	]
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1393	!
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1394
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1395	save
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1396
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1397	self saveImageOrMask: #image.
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1398
624 d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1399	!
d98fe4700fc2 checkin from browser tz parents: 606 diff changeset	1400
297 d733af1b0ffe better saving functions; Claus Gittinger <cg@exept.de> parents: 296 diff changeset	1401	saveAs
d733af1b0ffe better saving functions; Claus Gittinger <cg@exept.de> parents: 296 diff changeset	1402
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1403	self saveImageFileAs
297 d733af1b0ffe better saving functions; Claus Gittinger <cg@exept.de> parents: 296 diff changeset	1404	!
d733af1b0ffe better saving functions; Claus Gittinger <cg@exept.de> parents: 296 diff changeset	1405
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1406	saveImageFileAs
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1407	"ask for a fileName and save the image"
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1408
633 594edef86630 revised version tz parents: 632 diff changeset	1409	self saveImageFileAs:
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1410	(FileSelectionBrowser
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1411	request: 'Save Image To File'
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1412	fileName: self image fileName
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1413	withFileFilters: FileSelectionBrowser saveImageFileNameFilters)
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1414
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1415	"Modified: / 30.9.1998 / 23:05:19 / cg"
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1416	!
297 d733af1b0ffe better saving functions; Claus Gittinger <cg@exept.de> parents: 296 diff changeset	1417
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1418	saveImageFileAs: aFileName
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1419	"save the image in aFileName"
297 d733af1b0ffe better saving functions; Claus Gittinger <cg@exept.de> parents: 296 diff changeset	1420
633 594edef86630 revised version tz parents: 632 diff changeset	1421	aFileName isNil ifTrue: [^nil].
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1422	image notNil ifTrue:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1423	image fileName: aFileName.
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1424	self saveImageOrMask: #image
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1425	] ifFalse:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1426	self warn: 'No image or file name for saving detected!!'
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1427	]
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1428
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1429	"Modified: / 30.9.1998 / 23:04:55 / cg"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1430	!
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1431
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1432	saveImageMaskFileAs
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1433	"ask for a fileName and save the mask only"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1434
633 594edef86630 revised version tz parents: 632 diff changeset	1435	self saveImageMaskFileAs:
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1436	(FileSelectionBrowser
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1437	request: 'Save Image Mask To File'
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1438	fileName: self image fileName
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1439	withFileFilters: FileSelectionBrowser saveImageFileNameFilters)
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1440
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1441	"Modified: / 30.9.1998 / 23:04:11 / cg"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1442	!
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1443
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1444	saveImageMaskFileAs: aFileName
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1445	"save the mask only in aFileName"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1446
633 594edef86630 revised version tz parents: 632 diff changeset	1447	aFileName isNil ifTrue: [^nil].
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1448	(image notNil and:[image mask notNil]) ifTrue:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1449	image mask fileName:aFileName.
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1450	self saveImageOrMask: #mask
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1451	] ifFalse:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1452	self warn: 'No image or image mask detected!!'
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1453	]
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1454
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1455	"Modified: / 30.9.1998 / 23:06:24 / cg"
628 7f36d8a7735f popup menu starts image editor tz parents: 627 diff changeset	1456	!
7f36d8a7735f popup menu starts image editor tz parents: 627 diff changeset	1457
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1458	saveImageOrMask: what
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1459	"save the image or the mask only (if what == #mask)"
628 7f36d8a7735f popup menu starts image editor tz parents: 627 diff changeset	1460
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1461	Object errorSignal handle:[:ex\|
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1462	self warn: ex errorString.
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1463	] do:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1464	Image informationLostQuerySignal handle:[:ex\|
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1465	"/ should make those warnings visible ...
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1466	(self confirm:(ex errorString , '\\Save anyway ?') withCRs) ifTrue:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1467	ex proceed.
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1468	]
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1469	] do:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1470	windowGroup withCursor:Cursor write do:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1471	\|fileName suff\|
1027 5bffbe90b8e2 show a wait-cursor while saving Claus Gittinger <cg@exept.de> parents: 1025 diff changeset	1472
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1473	image isNil ifTrue:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1474	^ self error: 'No image to save!!'
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1475	].
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1476
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1477	what = #image ifTrue:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1478	(fileName := image fileName) isNil ifTrue: [^self error: 'No file name for image detected!!'].
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1479	].
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1480	what = #mask ifTrue:[
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1481	image mask isNil ifTrue: [^self error: 'No image mask to save!!'].
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1482	(fileName := image mask fileName) isNil ifTrue: [^self error: 'No file name for image mask detected!!'].
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1483	].
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1484	fileName := fileName asFilename.
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1485
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1486	fileName name size = 0 ifTrue: [^self error: 'No file name detected!!'].
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1487	suff := fileName suffix asLowercase.
1373 c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1488	imageReaderClass := nil.
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1489	imageReaderClass := MIMETypes imageReaderForSuffix:suff.
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1490	"/ (suff = 'tiff' or:[suff = 'tif']) ifTrue: [
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1491	"/ imageReaderClass := TIFFReader
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1492	"/ ] ifFalse:[
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1493	"/ suff = 'xpm' ifTrue: [
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1494	"/ imageReaderClass := XPMReader
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1495	"/ ] ifFalse:[
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1496	"/ suff = 'xbm' ifTrue: [
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1497	"/ imageReaderClass := XBMReader
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1498	"/ ] ifFalse:[
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1499	"/ suff = 'gif' ifTrue: [
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1500	"/ imageReaderClass := GIFReader
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1501	"/ ] ifFalse:[
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1502	"/ (suff = 'jpg' or:[suff = 'jpeg']) ifTrue: [
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1503	"/ imageReaderClass := JPEGReader
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1504	"/ ].
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1505	"/ ]
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1506	"/ ]
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1507	"/ ]
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1508	"/ ].
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1509	imageReaderClass isNil ifTrue: [
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1510	imageReaderClass := XPMReader.
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1511	image fileName:(image fileName, '.xpm').
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1512	Dialog warn:(('Dont know how to write ''.' , suff , '''-files\\Saving in xpm format as ''%1''.')
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1513	withCRs bindWith:image fileName asText allBold).
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1514	].
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1515	(imageReaderClass canRepresent:image) ifFalse:[
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1516	imageReaderClass := XPMReader.
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1517	image fileName:(image fileName, '.xpm').
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1518	Dialog warn:(('Saving in ''.' , suff , '''-format is not supported\\Saving in xpm format as ''%1''.')
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1519	withCRs bindWith:image fileName asText allBold).
c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1520	].
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1521	what = #image ifTrue: [image saveOn: image fileName using: imageReaderClass. modified := false].
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1522	what = #mask ifTrue: [image mask saveOn: image mask fileName using: imageReaderClass].
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1523	]
9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1524	]
1027 5bffbe90b8e2 show a wait-cursor while saving Claus Gittinger <cg@exept.de> parents: 1025 diff changeset	1525	]
5bffbe90b8e2 show a wait-cursor while saving Claus Gittinger <cg@exept.de> parents: 1025 diff changeset	1526
1158 9b413954d34d issue a warning, if information (mask) is Claus Gittinger <cg@exept.de> parents: 1121 diff changeset	1527	"Modified: / 30.9.1998 / 23:19:39 / cg"
633 594edef86630 revised version tz parents: 632 diff changeset	1528	!
594edef86630 revised version tz parents: 632 diff changeset	1529
594edef86630 revised version tz parents: 632 diff changeset	1530	saveMethod
594edef86630 revised version tz parents: 632 diff changeset	1531
594edef86630 revised version tz parents: 632 diff changeset	1532	Object errorSignal handle:
594edef86630 revised version tz parents: 632 diff changeset	1533	[:ex\|
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1534	self warn: ex errorString.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1535	^nil
633 594edef86630 revised version tz parents: 632 diff changeset	1536	]
594edef86630 revised version tz parents: 632 diff changeset	1537	do:
594edef86630 revised version tz parents: 632 diff changeset	1538	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1539	\|category imageStoreStream cls sel mthd imageKey\|
822 cace81f0a86b do not overwrite method categories + toggle between mouse button colors tz parents: 796 diff changeset	1540
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1541	windowGroup withExecuteCursorDo:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1542	(self resourceSelector trimBlanks size = 0) \| (cls := Smalltalk at: self resourceClass) isClass not
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1543	ifTrue: [^self saveMethodAs].
822 cace81f0a86b do not overwrite method categories + toggle between mouse button colors tz parents: 796 diff changeset	1544
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1545	self image storeOn: (imageStoreStream := WriteStream on: '').
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1546	sel := self resourceSelector.
1027 5bffbe90b8e2 show a wait-cursor while saving Claus Gittinger <cg@exept.de> parents: 1025 diff changeset	1547
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1548	"/ if that method already exists, do not overwrite the category
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1549	category := 'image specs'.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1550	(mthd := cls class compiledMethodAt:sel) notNil ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1551	category := mthd category.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1552	].
822 cace81f0a86b do not overwrite method categories + toggle between mouse button colors tz parents: 796 diff changeset	1553
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1554	imageKey := (cls name, ' ', sel) asSymbol.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1555	Icon constantNamed: imageKey put:nil.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1556	ByteCodeCompiler
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1557	compile: ((sel,
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1558	'\', (ResourceSpecEditor codeGenerationCommentForClass: ImageEditor),
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1559	'\\' ,
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1560	' "\',
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1561	' self ' , self resourceSelector , ' inspect\',
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1562	' ImageEditor openOnClass:self andSelector:#', self resourceSelector,
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1563	'\ "',
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1564	'\\',
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1565	' <resource: #image>',
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1566	'\\',
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1567	' ^Icon\') withCRs,
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1568	' constantNamed:#''', imageKey, '''\' withCRs,
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1569	' ifAbsentPut:[', imageStoreStream contents, ']')
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1570	forClass: cls class inCategory: category.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1571	modified := false.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1572	]
633 594edef86630 revised version tz parents: 632 diff changeset	1573	]
1027 5bffbe90b8e2 show a wait-cursor while saving Claus Gittinger <cg@exept.de> parents: 1025 diff changeset	1574
1047 95f10ea8653d use #withExecuteCursorDo: Claus Gittinger <cg@exept.de> parents: 1038 diff changeset	1575	"Modified: / 31.7.1998 / 20:12:54 / cg"
633 594edef86630 revised version tz parents: 632 diff changeset	1576	!
594edef86630 revised version tz parents: 632 diff changeset	1577
594edef86630 revised version tz parents: 632 diff changeset	1578	saveMethodAs
594edef86630 revised version tz parents: 632 diff changeset	1579
636 d53428252193 revised version tz parents: 633 diff changeset	1580	(self resourceMessage:
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1581	(ResourceSelectionBrowser
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1582	request: 'Save Image In Class'
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1583	onSuperclass: #Object
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1584	andClass: self resourceClass
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1585	andSelector: self resourceSelector
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1586	withResourceTypes: #(image fileImage))) notNil
633 594edef86630 revised version tz parents: 632 diff changeset	1587	ifTrue:
674 f24ca336b717 if none image found for loading clear image tz parents: 662 diff changeset	1588	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1589	^self saveMethod
674 f24ca336b717 if none image found for loading clear image tz parents: 662 diff changeset	1590	].
633 594edef86630 revised version tz parents: 632 diff changeset	1591	^nil
1 c6ca7bfedf31 Initial revision claus parents: diff changeset	1592	! !
c6ca7bfedf31 Initial revision claus parents: diff changeset	1593
161 5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1594	!ImageEditView methodsFor:'queries'!
5 be72e6ba4822 * empty log message * claus parents: 1 diff changeset	1595
161 5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1596	heightOfContents
5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1597
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	1598	image isNil ifTrue:[^0].
33833bcbb5cd some cleans tz parents: 678 diff changeset	1599	^(image height * magnification y) rounded
5 be72e6ba4822 * empty log message * claus parents: 1 diff changeset	1600	!
be72e6ba4822 * empty log message * claus parents: 1 diff changeset	1601
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1602	imageContainsPastePoint: aPoint
cd84d6f8c449 several undos tz parents: 994 diff changeset	1603
cd84d6f8c449 several undos tz parents: 994 diff changeset	1604	^image notNil and:
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1605	[Clipboard notNil and:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1606	[((0@0 corner:(image extent) "- 1" - Clipboard extent) containsPoint: (((aPoint - margin + 1) / magnification) floor))]]
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1607	!
cd84d6f8c449 several undos tz parents: 994 diff changeset	1608
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1609	imageContainsPoint: aPoint
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1610
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1611	^image notNil and:
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1612	[((0@0 corner:(image extent) - 1) containsPoint: (((aPoint - margin + 1) / magnification) floor))]
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1613	!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1614
783 c81a097b84b8 revised version tz parents: 747 diff changeset	1615	imageInfoString
c81a097b84b8 revised version tz parents: 747 diff changeset	1616
c81a097b84b8 revised version tz parents: 747 diff changeset	1617	\|imageInfoString usedColors\|
1011 325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1618
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1619	image isNil ifTrue: [imageInfoString := 'No image loaded.']
325d334e93c8 added paste-under (only paste where pixel ~= current selected) Claus Gittinger <cg@exept.de> parents: 1006 diff changeset	1620	ifFalse: [
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1621	image colorMap isNil ifTrue: [usedColors := '?'] ifFalse: [usedColors := image usedColors size].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1622	imageInfoString := image width printString, 'x'
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1623	, image height printString, 'x'
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1624	, (2 raisedTo: image depth) printString
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1625	, (image mask notNil ifTrue: [' (mask + '] ifFalse: ['('])
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1626	, usedColors printString
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1627	, ' used colors)'].
783 c81a097b84b8 revised version tz parents: 747 diff changeset	1628
c81a097b84b8 revised version tz parents: 747 diff changeset	1629	^imageInfoString
c81a097b84b8 revised version tz parents: 747 diff changeset	1630	!
c81a097b84b8 revised version tz parents: 747 diff changeset	1631
161 5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1632	widthOfContents
5 be72e6ba4822 * empty log message * claus parents: 1 diff changeset	1633
686 33833bcbb5cd some cleans tz parents: 678 diff changeset	1634	image isNil ifTrue:[^0].
33833bcbb5cd some cleans tz parents: 678 diff changeset	1635	^(image width * magnification x) rounded
5 be72e6ba4822 * empty log message * claus parents: 1 diff changeset	1636	! !
be72e6ba4822 * empty log message * claus parents: 1 diff changeset	1637
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1638	!ImageEditView methodsFor:'release'!
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1639
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1640	releasePasteDrawing
cd84d6f8c449 several undos tz parents: 994 diff changeset	1641
cd84d6f8c449 several undos tz parents: 994 diff changeset	1642	(lastPastePoint notNil and: [ClipboardMagnification notNil])
cd84d6f8c449 several undos tz parents: 994 diff changeset	1643	ifTrue:
cd84d6f8c449 several undos tz parents: 994 diff changeset	1644	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1645	self redraw: (lastPastePoint extent: (ClipboardMagnification extent)).
995 cd84d6f8c449 several undos tz parents: 994 diff changeset	1646	].
cd84d6f8c449 several undos tz parents: 994 diff changeset	1647	lastPastePoint := ClipboardMagnification := nil
cd84d6f8c449 several undos tz parents: 994 diff changeset	1648	!
cd84d6f8c449 several undos tz parents: 994 diff changeset	1649
cd84d6f8c449 several undos tz parents: 994 diff changeset	1650	releaseUndos
cd84d6f8c449 several undos tz parents: 994 diff changeset	1651
cd84d6f8c449 several undos tz parents: 994 diff changeset	1652	undoImages removeAll.
1038 6c0bb03e88a1 no need to invalidate after assign of new image. Claus Gittinger <cg@exept.de> parents: 1037 diff changeset	1653	"/ cg: what a kludge - please change to use a valueHolder,
1261 3117f31a73c5 checkin from browser Claus Gittinger <cg@exept.de> parents: 1256 diff changeset	1654	masterApplication notNil ifTrue:[
3117f31a73c5 checkin from browser Claus Gittinger <cg@exept.de> parents: 1256 diff changeset	1655	masterApplication valueOfCanUndo value: false.
3117f31a73c5 checkin from browser Claus Gittinger <cg@exept.de> parents: 1256 diff changeset	1656	].
1038 6c0bb03e88a1 no need to invalidate after assign of new image. Claus Gittinger <cg@exept.de> parents: 1037 diff changeset	1657
6c0bb03e88a1 no need to invalidate after assign of new image. Claus Gittinger <cg@exept.de> parents: 1037 diff changeset	1658	"Modified: / 31.7.1998 / 02:47:21 / cg"
627 e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1659	! !
e0bf28f61361 many many fixes/enhancements tz parents: 624 diff changeset	1660
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1661	!ImageEditView methodsFor:'testing'!
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1662
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1663	checkModified
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1664
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1665	modified
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1666	ifTrue:
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1667	[
1116 441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1668	((YesNoBox title:(resources string:'Image was modified !!'))
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1669	noText:(resources string:'Cancel');
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1670	yesText:(resources string:'Forget it and proceed');
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1671	showAtPointer;
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1672	accepted) ifFalse: [^false].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed Claus Gittinger <cg@exept.de> parents: 1106 diff changeset	1673	modified := false
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1674	].
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1675	^true
1031 a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1676
a5ab5869b2ba cleaned up the interface to the apps infoPanel Claus Gittinger <cg@exept.de> parents: 1030 diff changeset	1677	"Modified: / 29.7.1998 / 18:55:24 / cg"
632 be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1678	! !
be1ac8ea33a7 checkin from browser tz parents: 628 diff changeset	1679
255 1dfa8deddaef checkin from browser Claus Gittinger <cg@exept.de> parents: 251 diff changeset	1680	!ImageEditView class methodsFor:'documentation'!
161 5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1681
5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1682	version
1373 c949e9f7757c give a warning, if saving in the given file-format is not Claus Gittinger <cg@exept.de> parents: 1327 diff changeset	1683	^ '$Header: /cvs/stx/stx/libwidg2/ImageEditView.st,v 1.117 1999-05-09 14:02:46 cg Exp $'
161 5b6e284959a4 examples Claus Gittinger <cg@exept.de> parents: 86 diff changeset	1684	! !
1245 68581e6aaf23 code cleanup Claus Gittinger <cg@exept.de> parents: 1228 diff changeset	1685	ImageEditView initialize!

author	Claus Gittinger <cg@exept.de>
	Sun, 09 May 1999 16:02:46 +0200
changeset 1373	c949e9f7757c
parent 1327	ab99aad206dc
child 1374	44f511c341c0
permissions	-rw-r--r--