ImageEditView.st
author Claus Gittinger <cg@exept.de>
Sat, 02 Nov 2002 19:31:49 +0100
changeset 2349 4cf7b4f1345e
parent 2338 ca7a34f082d5
child 2415 9645c5eae388
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
1763
7d6d64622ee4 change & updates fixed (monochrome bitmaps)
Claus Gittinger <cg@exept.de>
parents: 1706
diff changeset
    13
"{ Package: 'stx:libwidg2' }"
7d6d64622ee4 change & updates fixed (monochrome bitmaps)
Claus Gittinger <cg@exept.de>
parents: 1706
diff changeset
    14
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    15
ImageView subclass:#ImageEditView
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
    16
	instanceVariableNames:'magnification imageReaderClass resourceClass resourceSelector
2007
5d3af41241d9 no need for masterApp
Claus Gittinger <cg@exept.de>
parents: 2006
diff changeset
    17
		mouseKeyColorMode undoImages modified editMode lastPastePoint
5d3af41241d9 no need for masterApp
Claus Gittinger <cg@exept.de>
parents: 2006
diff changeset
    18
		imageInfoHolder activityInfoHolder pickedColorHolder
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
    19
		drawingColors drawingPixels drawingColorHolders
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
    20
		drawingPixelHolders clickInfoCallBack'
1035
5da83bdbd65e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1031
diff changeset
    21
	classVariableNames:'Clipboard LastMagnification ClipboardMagnification
1994
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
    22
		GridMagnificationLimit MaxUndos LastSaveDirectory LastSaveClass'
1035
5da83bdbd65e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1031
diff changeset
    23
	poolDictionaries:''
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    24
	category:'Views-Misc'
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    25
!
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
    26
636
d53428252193 revised version
tz
parents: 633
diff changeset
    27
!ImageEditView class methodsFor:'documentation'!
d53428252193 revised version
tz
parents: 633
diff changeset
    28
d53428252193 revised version
tz
parents: 633
diff changeset
    29
copyright
d53428252193 revised version
tz
parents: 633
diff changeset
    30
"
704
01140e14c065 Fix copyright.
Stefan Vogel <sv@exept.de>
parents: 694
diff changeset
    31
 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
    32
	      All Rights Reserved
636
d53428252193 revised version
tz
parents: 633
diff changeset
    33
d53428252193 revised version
tz
parents: 633
diff changeset
    34
 This software is furnished under a license and may be used
d53428252193 revised version
tz
parents: 633
diff changeset
    35
 only in accordance with the terms of that license and with the
d53428252193 revised version
tz
parents: 633
diff changeset
    36
 inclusion of the above copyright notice. This software may not
d53428252193 revised version
tz
parents: 633
diff changeset
    37
 be provided or otherwise made available to, or used by, any
d53428252193 revised version
tz
parents: 633
diff changeset
    38
 other person. No title to or ownership of the software is
d53428252193 revised version
tz
parents: 633
diff changeset
    39
 hereby transferred.
d53428252193 revised version
tz
parents: 633
diff changeset
    40
"
d53428252193 revised version
tz
parents: 633
diff changeset
    41
!
d53428252193 revised version
tz
parents: 633
diff changeset
    42
d53428252193 revised version
tz
parents: 633
diff changeset
    43
documentation
d53428252193 revised version
tz
parents: 633
diff changeset
    44
"
d53428252193 revised version
tz
parents: 633
diff changeset
    45
    The ImageEditView is a view class which can be used by applications
d53428252193 revised version
tz
parents: 633
diff changeset
    46
    like the Image Editor for modifying or inspecting images.
d53428252193 revised version
tz
parents: 633
diff changeset
    47
d53428252193 revised version
tz
parents: 633
diff changeset
    48
    [see also:]
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
    49
	ImageEditor Image
636
d53428252193 revised version
tz
parents: 633
diff changeset
    50
d53428252193 revised version
tz
parents: 633
diff changeset
    51
    [author:]
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
    52
	Thomas Zwick
636
d53428252193 revised version
tz
parents: 633
diff changeset
    53
"
d53428252193 revised version
tz
parents: 633
diff changeset
    54
! !
353
0442fc169b82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 322
diff changeset
    55
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
    56
!ImageEditView class methodsFor:'initialization'!
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
    57
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
    58
initialize
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
    59
    MaxUndos := 5.
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    60
    GridMagnificationLimit := 8 @ 8.
1245
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
     self initialize
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
    64
    "
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
    65
! !
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
    66
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    67
!ImageEditView class methodsFor:'accessing'!
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    68
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    69
gridMagnificationLimit
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    70
    ^ GridMagnificationLimit
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    71
!
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    72
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    73
gridMagnificationLimit:anInteger
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    74
    GridMagnificationLimit := anInteger
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    75
! !
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
    76
7
19b36b78ee01 *** empty log message ***
claus
parents: 5
diff changeset
    77
!ImageEditView methodsFor:'accessing'!
19b36b78ee01 *** empty log message ***
claus
parents: 5
diff changeset
    78
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
    79
activityInfoHolder
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
    80
    "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
    81
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
    82
    ^ activityInfoHolder
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
    83
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
    84
    "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
    85
!
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
activityInfoHolder:something
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
    88
    "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
    89
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
    90
    activityInfoHolder := something.
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
    91
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
    92
    "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
    93
!
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
    94
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
    95
clickInfoCallBack:aTwoArgBlock
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
    96
     clickInfoCallBack := aTwoArgBlock
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
    97
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
    98
    "Created: / 10.2.2000 / 23:07:14 / cg"
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
    99
!
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   100
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   101
drawingColors:anArrayTwoColors
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   102
    (drawingColorHolders at:1) value:(anArrayTwoColors at:1).
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   103
    (drawingColorHolders at:2) value:(anArrayTwoColors at:2).
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   104
!
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   105
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   106
imageInfoHolder
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   107
    "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
   108
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   109
    ^ imageInfoHolder
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   110
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   111
    "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
   112
!
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   113
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   114
imageInfoHolder:something
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   115
    "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
   116
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   117
    imageInfoHolder := something.
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   118
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   119
    "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
   120
!
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   121
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
   122
magnification
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
   123
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
   124
    ^magnification
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
   125
255
1dfa8deddaef checkin from browser
Claus Gittinger <cg@exept.de>
parents: 251
diff changeset
   126
!
1dfa8deddaef checkin from browser
Claus Gittinger <cg@exept.de>
parents: 251
diff changeset
   127
636
d53428252193 revised version
tz
parents: 633
diff changeset
   128
magnification: aPoint
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   129
    |oldOrg|
255
1dfa8deddaef checkin from browser
Claus Gittinger <cg@exept.de>
parents: 251
diff changeset
   130
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   131
    magnification ~= aPoint
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
   132
    ifTrue:
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
   133
    [
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   134
	oldOrg := self viewOrigin / magnification.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   135
	magnification := aPoint asPoint.
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   136
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   137
	self scrollTo:(oldOrg * magnification) rounded redraw:false.        
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   138
"/        self scrollToTopLeft.
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   139
	self contentsChanged.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   140
	self invalidate.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   141
	ClipboardMagnification := nil.
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
   142
    ]
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   143
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   144
    "Modified: / 31.7.1998 / 02:38:47 / cg"
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
   145
!
255
1dfa8deddaef checkin from browser
Claus Gittinger <cg@exept.de>
parents: 251
diff changeset
   146
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   147
resourceClass
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   148
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   149
    ^resourceClass
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   150
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   151
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   152
resourceClass: aClassOrSymbol
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   153
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
   154
    resourceClass := aClassOrSymbol isClass ifTrue: [aClassOrSymbol name] ifFalse: [aClassOrSymbol asSymbol]
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   155
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   156
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   157
resourceMessage
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   158
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   159
    ^resourceClass, ' ', resourceSelector
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   160
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   161
636
d53428252193 revised version
tz
parents: 633
diff changeset
   162
resourceMessage: aString
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   163
636
d53428252193 revised version
tz
parents: 633
diff changeset
   164
    (aString isString and: [aString trimBlanks size > 0])
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   165
    ifTrue:
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   166
    [
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   167
	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
   168
	resourceSelector := (aString copy reverse readStream upTo: Character space) reverse asSymbol
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   169
    ]
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   170
    ifFalse:
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   171
    [
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   172
	^nil
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
   173
    ]
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   174
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   175
   
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   176
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   177
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   178
resourceSelector
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   179
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   180
    ^resourceSelector
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   181
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   182
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   183
resourceSelector: aStringOrSymbol
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   184
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   185
    resourceSelector := aStringOrSymbol asSymbol
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   186
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   187
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   188
selectedColor
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   189
   ^ (drawingColorHolders at:mouseKeyColorMode) value
1246
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
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   192
selectedColor: aColor
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   193
    (drawingColorHolders at:mouseKeyColorMode) value:aColor
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   194
!
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
selectedColorIndex
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   197
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   198
   ^ (drawingPixelHolders at:mouseKeyColorMode) value
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   199
!
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
selectedColorIndex: aPixelIndex
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   202
    (drawingPixelHolders at:mouseKeyColorMode) value: aPixelIndex
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
   203
!
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
   204
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
   205
undoImages
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
   206
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
   207
   ^undoImages
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   208
! !
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   209
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   210
!ImageEditView methodsFor:'drawing'!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   211
1036
d860072f3b49 gridMag default.
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   212
drawFrame
d860072f3b49 gridMag default.
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   213
d860072f3b49 gridMag default.
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   214
    self paint:Color black.
d860072f3b49 gridMag default.
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   215
    self lineWidth: (magnification x//3 min: 3).
1104
a7101d656dab use margin in #drawFrame
tz
parents: 1103
diff changeset
   216
    self displayRectangle: ((0@0) extent:(image extent * magnification) + margin).
1036
d860072f3b49 gridMag default.
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   217
    self lineWidth:1.
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
d860072f3b49 gridMag default.
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   220
drawFramesIn: aRectangle
d860072f3b49 gridMag default.
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   221
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   222
    magnification >= GridMagnificationLimit
1036
d860072f3b49 gridMag default.
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   223
    ifTrue:
d860072f3b49 gridMag default.
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   224
    [   
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   225
        |origin lineStartingPoint lineEndingPoint oldColor|
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   226
        origin := aRectangle origin - 1.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   227
        lineStartingPoint := origin + (0@magnification y).
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   228
        lineEndingPoint   := lineStartingPoint + (aRectangle width@0).
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   229
        oldColor := self paint.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   230
        self xoring:
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   231
        [
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   232
            self displayLineFrom: lineStartingPoint to: lineEndingPoint.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   233
            lineStartingPoint x to: lineStartingPoint x + aRectangle width - magnification x by: magnification x do:
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   234
            [:x|   
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   235
                self displayLineFrom: x@(origin y) to: x@(origin y + magnification y)
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   236
            ].
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   237
        ].
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   238
        self paint: oldColor.
1036
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
!
d860072f3b49 gridMag default.
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   244
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   245
drawPasteRectangleAt: aPoint
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   246
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   247
    |currentPoint gridCorrection extent org|
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   248
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   249
    magnification >= GridMagnificationLimit ifFalse: [gridCorrection := 0] ifTrue: [gridCorrection := 1].
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   250
    currentPoint := aPoint // magnification*magnification + margin. 
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   251
2085
4cf52f994f0a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
   252
    self repairDamage.
4cf52f994f0a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
   253
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   254
    currentPoint ~= lastPastePoint ifTrue:[              
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   255
        ClipboardMagnification isNil ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   256
            ClipboardMagnification := (Clipboard magnifiedBy: magnification) onDevice: device
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   257
        ].   
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   258
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   259
        extent       := ClipboardMagnification extent.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   260
1967
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   261
        "/ currentPoint := currentPoint - self viewOrigin.
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   262
2085
4cf52f994f0a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
   263
        self redraw: (((lastPastePoint ? currentPoint)"-self viewOrigin") extent: extent).
4cf52f994f0a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
   264
        self repairDamage.
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   265
2085
4cf52f994f0a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
   266
false "        (extent x > 400 or: [extent y > 400])" ifTrue:[
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   267
            self xoring: [
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   268
                self fillRectangle: (currentPoint extent: extent)
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   269
            ]   
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   270
        ] ifFalse:[
2089
8c0aed9152c4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2086
diff changeset
   271
            ClipboardMagnification notNil ifTrue:[
8c0aed9152c4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2086
diff changeset
   272
                self displayDeviceForm: ClipboardMagnification 
8c0aed9152c4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2086
diff changeset
   273
                                     x: currentPoint x - self viewOrigin x 
8c0aed9152c4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2086
diff changeset
   274
                                     y: currentPoint y - self viewOrigin y.
8c0aed9152c4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2086
diff changeset
   275
            ].
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   276
            editMode == #pasteUnder ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   277
                self redrawImageX:currentPoint x y:currentPoint y width:extent x height:extent y unmaskedOnly:true
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   278
            ]
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   279
        ]  
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   280
    ]. 
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   281
    lastPastePoint := currentPoint.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   282
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   283
    "Modified: / 18.5.1999 / 20:23:33 / cg"
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   284
!
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   285
662
61b7601829ea with modal support
tz
parents: 636
diff changeset
   286
fillFramedRectangle: aRectangle
61b7601829ea with modal support
tz
parents: 636
diff changeset
   287
61b7601829ea with modal support
tz
parents: 636
diff changeset
   288
    self fillRectangle: aRectangle.
61b7601829ea with modal support
tz
parents: 636
diff changeset
   289
    self drawFramesIn: aRectangle
61b7601829ea with modal support
tz
parents: 636
diff changeset
   290
!
61b7601829ea with modal support
tz
parents: 636
diff changeset
   291
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   292
redraw:aRectangle
2053
5c19fe5b2db3 invalidate rather than redraw
Claus Gittinger <cg@exept.de>
parents: 2034
diff changeset
   293
    self invalidate:(aRectangle origin "+ self viewOrigin" extent:aRectangle extent). 
5c19fe5b2db3 invalidate rather than redraw
Claus Gittinger <cg@exept.de>
parents: 2034
diff changeset
   294
"/    super redraw:(aRectangle origin + self viewOrigin extent:aRectangle extent).
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   295
2053
5c19fe5b2db3 invalidate rather than redraw
Claus Gittinger <cg@exept.de>
parents: 2034
diff changeset
   296
    "Modified: / 15.11.2001 / 16:43:53 / cg"
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   297
!
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   298
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   299
redrawImageX:x y:y width:w height:h
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   300
    self redrawImageX:x y:y width:w height:h unmaskedOnly:false
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   301
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   302
    "Modified: / 18.5.1999 / 20:14:03 / cg"
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   303
!
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   304
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   305
redrawImageX:x y:y width:w height:h unmaskedOnly:unmaskedOnly
636
d53428252193 revised version
tz
parents: 633
diff changeset
   306
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   307
    |ih iw magX magY minX maxX minY maxY 
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   308
     color lastColor lastY runW x0 xI yI maskColor mask
1180
dcb9dede5128 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1160
diff changeset
   309
     sizeOfMaskPoint useNearestColor|
dcb9dede5128 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1160
diff changeset
   310
dcb9dede5128 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1160
diff changeset
   311
    useNearestColor := device visualType == #PseudoColor.
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   312
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   313
    mask := image mask.
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   314
    ih := image height.
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   315
    iw := image width.
662
61b7601829ea with modal support
tz
parents: 636
diff changeset
   316
    magX := magnification x.
61b7601829ea with modal support
tz
parents: 636
diff changeset
   317
    magY := magnification y.
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   318
662
61b7601829ea with modal support
tz
parents: 636
diff changeset
   319
    minX := (x // magX - 1) max: 0.
725
0e051202859d checkin from browser
tz
parents: 724
diff changeset
   320
    minX >= iw ifTrue:[minX := (iw - 1) max: 0].
662
61b7601829ea with modal support
tz
parents: 636
diff changeset
   321
    minY := (y // magY - 1) max: 0.
725
0e051202859d checkin from browser
tz
parents: 724
diff changeset
   322
    minY >= ih ifTrue:[minY := (ih - 1) max: 0].
662
61b7601829ea with modal support
tz
parents: 636
diff changeset
   323
    maxX := (x + w) // magX + 1.
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   324
    maxX > iw ifTrue:[maxX := iw].
662
61b7601829ea with modal support
tz
parents: 636
diff changeset
   325
    maxY := (y + h) // magY + 1.
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   326
    maxY > ih ifTrue:[maxY := ih].
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   327
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   328
    lastY := -1.
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   329
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   330
    x0 := minX.
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   331
    runW := 0.
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   332
    maskColor := false.
662
61b7601829ea with modal support
tz
parents: 636
diff changeset
   333
    sizeOfMaskPoint := magnification//3.
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   334
    image 
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   335
        colorsFromX:minX y:minY toX:maxX-1 y:maxY-1 
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   336
        do:[:xx :yy :color|
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   337
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   338
            shown ifFalse:[^ self].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   339
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   340
            yy ~~ lastY ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   341
                runW ~~ 0 ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   342
                    |origin|
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   343
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   344
                    origin := (x0 * magX + margin)@(lastY * magY + margin).
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   345
                    (unmaskedOnly not or:[maskColor not]) ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   346
                        self fillFramedRectangle: (origin extent: (runW@magY)).                    
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   347
                        maskColor ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   348
                            self xoring: [self fillRectangle: (origin + sizeOfMaskPoint extent: sizeOfMaskPoint)]
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   349
                        ]
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   350
                    ].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   351
                    runW := 0.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   352
                ]. 
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   353
                x0 := xx.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   354
                lastY := yy.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   355
            ]. 
1160
5d89296c4b04 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1158
diff changeset
   356
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   357
            color ~= lastColor ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   358
                runW ~~ 0 ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   359
                    |origin|
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   360
                    origin := (x0 * magX + margin)@(yy * magY + margin).
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   361
                    (unmaskedOnly not or:[maskColor not]) ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   362
                        self fillFramedRectangle: (origin extent: (runW@magY)).
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   363
                        maskColor ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   364
                            self xoring: [self fillRectangle: (origin + sizeOfMaskPoint extent: sizeOfMaskPoint)]
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   365
                        ].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   366
                    ].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   367
                    runW := 0.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   368
                ].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   369
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   370
                lastColor := color.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   371
                useNearestColor ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   372
                    lastColor := lastColor nearestOn:device
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   373
                ].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   374
                self paint:lastColor.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   375
                mask notNil ifTrue:[  
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   376
                    maskColor := false.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   377
                    (mask pixelAtX:xx y:yy) == 0 ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   378
                        unmaskedOnly ifFalse:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   379
                            self paint: (lastColor := self viewBackground).
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   380
                        ].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   381
                        maskColor := true.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   382
                    ].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   383
                    lastColor := nil.
1160
5d89296c4b04 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1158
diff changeset
   384
                ].
5d89296c4b04 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1158
diff changeset
   385
                runW := 0.
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   386
                x0 := xx.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   387
            ].  
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   388
            runW := runW + magX
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   389
        ].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   390
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   391
    runW ~~ 0 ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   392
        |origin|
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
   393
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   394
        origin := (x0 * magX + margin)@(lastY * magY + margin).
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   395
        (unmaskedOnly not or:[maskColor not]) ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   396
            self fillFramedRectangle: (origin extent: runW@magY).
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   397
            maskColor ifTrue:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   398
                self xoring:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   399
                    self fillRectangle: (origin + sizeOfMaskPoint extent: sizeOfMaskPoint)
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   400
                ]
1180
dcb9dede5128 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1160
diff changeset
   401
            ].
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   402
        ]
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   403
    ].
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   404
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   405
    "Created: / 18.5.1999 / 20:13:39 / cg"
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   406
    "Modified: / 18.5.1999 / 20:36:20 / cg"
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
redrawX:x y:y width:w height:h
636
d53428252193 revised version
tz
parents: 633
diff changeset
   410
1967
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   411
    |ih iw xI yI devImage imgWidth imgHeight|
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   412
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   413
    image isNil ifTrue:[^self].
662
61b7601829ea with modal support
tz
parents: 636
diff changeset
   414
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   415
    magnification = (1@1) ifTrue: [
1510
fd0cd6065dc6 catch image conversion errors.
Claus Gittinger <cg@exept.de>
parents: 1449
diff changeset
   416
        Object errorSignal handle:[:ex |
2092
36ef3048dbf4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2089
diff changeset
   417
            Transcript showCR:'cannot convert image: ', ex description.
1510
fd0cd6065dc6 catch image conversion errors.
Claus Gittinger <cg@exept.de>
parents: 1449
diff changeset
   418
        ] do:[
1763
7d6d64622ee4 change & updates fixed (monochrome bitmaps)
Claus Gittinger <cg@exept.de>
parents: 1706
diff changeset
   419
            devImage := image onDevice:device.
7d6d64622ee4 change & updates fixed (monochrome bitmaps)
Claus Gittinger <cg@exept.de>
parents: 1706
diff changeset
   420
            devImage ~~ image ifTrue:[
7d6d64622ee4 change & updates fixed (monochrome bitmaps)
Claus Gittinger <cg@exept.de>
parents: 1706
diff changeset
   421
                image := devImage.
1764
3dd553f8d9f0 oops - leftover halts
Claus Gittinger <cg@exept.de>
parents: 1763
diff changeset
   422
                self changed:#image.
1763
7d6d64622ee4 change & updates fixed (monochrome bitmaps)
Claus Gittinger <cg@exept.de>
parents: 1706
diff changeset
   423
            ].
1510
fd0cd6065dc6 catch image conversion errors.
Claus Gittinger <cg@exept.de>
parents: 1449
diff changeset
   424
        ].
fd0cd6065dc6 catch image conversion errors.
Claus Gittinger <cg@exept.de>
parents: 1449
diff changeset
   425
        image device == device ifTrue:[
fd0cd6065dc6 catch image conversion errors.
Claus Gittinger <cg@exept.de>
parents: 1449
diff changeset
   426
            ^ super redrawX:x y:y width:w height:h
fd0cd6065dc6 catch image conversion errors.
Claus Gittinger <cg@exept.de>
parents: 1449
diff changeset
   427
        ].
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   428
    ].
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   429
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   430
    self clippingRectangle: (x@y extent:w@h).
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   431
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   432
    self redrawImageX:x y:y width:w height:h.
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   433
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   434
    "/ right of image ?
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   435
    adjust == #center ifTrue:
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   436
    [
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   437
        xI := (width - ih) // 2 - margin.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   438
        yI := (height - iw) // 2 - margin.
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   439
    ]
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   440
    ifFalse:
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   441
    [
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   442
        xI := yI := margin
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   443
    ].
1967
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   444
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   445
    imgWidth := image width.
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   446
    imgHeight := image height.
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   447
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   448
    (x + w - 1) > (xI + (magnification x * imgWidth)) ifTrue:
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   449
    [
1967
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   450
        self clearRectangleX:(xI + (magnification x * imgWidth))
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   451
                           y:y
1967
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   452
                       width:(x + w - (magnification x * imgWidth) - xI)
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   453
                      height:h
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   454
    ].
1967
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   455
    (y + h - 1) > (yI + (magnification y * imgHeight)) ifTrue:
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   456
    [
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   457
        self clearRectangleX:margin
1967
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   458
                           y:(yI + (magnification y * imgHeight))
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   459
                       width:w
1967
1b4524f3105f checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1957
diff changeset
   460
                      height:(y + h - (magnification y * imgHeight) - yI)  
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   461
    ].
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   462
    self drawFrame.
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   463
    self clippingRectangle: nil.
1037
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   464
3735af6b5b24 remmeber scrollOffset
Claus Gittinger <cg@exept.de>
parents: 1036
diff changeset
   465
    "Modified: / 31.7.1998 / 02:22:45 / cg"
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   466
! !
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   467
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   468
!ImageEditView methodsFor:'edit modes'!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   469
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   470
editMode
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   471
1106
57c41df67ae5 support radio buttons of the ImageEditor
tz
parents: 1104
diff changeset
   472
    ^editMode
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   473
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   474
1106
57c41df67ae5 support radio buttons of the ImageEditor
tz
parents: 1104
diff changeset
   475
editMode: anEditMode
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   476
1106
57c41df67ae5 support radio buttons of the ImageEditor
tz
parents: 1104
diff changeset
   477
    editMode := anEditMode
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   478
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   479
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   480
mouseKeyColorMode
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   481
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   482
    ^mouseKeyColorMode printString
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   483
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   484
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   485
mouseKeyColorMode:aMode
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   486
1106
57c41df67ae5 support radio buttons of the ImageEditor
tz
parents: 1104
diff changeset
   487
    mouseKeyColorMode := aMode
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   488
! !
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   489
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   490
!ImageEditView methodsFor:'event handling'!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   491
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   492
buttonMotion:state x:x y:y
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   493
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   494
    |p|
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   495
2072
abd4e246f393 care for negative pos in buttonMotion (win32 klusge)
Claus Gittinger <cg@exept.de>
parents: 2053
diff changeset
   496
    (x < 0 or:[y < 0]) ifTrue:[
abd4e246f393 care for negative pos in buttonMotion (win32 klusge)
Claus Gittinger <cg@exept.de>
parents: 2053
diff changeset
   497
        ^ self
abd4e246f393 care for negative pos in buttonMotion (win32 klusge)
Claus Gittinger <cg@exept.de>
parents: 2053
diff changeset
   498
    ].
abd4e246f393 care for negative pos in buttonMotion (win32 klusge)
Claus Gittinger <cg@exept.de>
parents: 2053
diff changeset
   499
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   500
    p := x@y.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   501
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   502
    state ~~ 0 ifTrue:[
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   503
        ("self selectedColor notNil" true 
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   504
        and:[(self imageContainsPoint:p) 
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   505
        and:[editMode == #point]])
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   506
        ifTrue:[
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   507
            self pointAt:p.
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   508
            ^ self
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   509
        ].
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   510
        self drawCursorAt:p.
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
   511
    ] ifFalse:[
2092
36ef3048dbf4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2089
diff changeset
   512
"/ Transcript showCR:'m'.
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   513
        self drawCursorAt:p.
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
   514
        (editMode startsWith:#paste) ifTrue: [
2092
36ef3048dbf4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2089
diff changeset
   515
"/ Transcript show:'p '; showCR:(self imageContainsPastePoint:p).
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   516
            ("self selectedColor notNil" true and: [self imageContainsPastePoint:p]) 
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   517
                ifTrue:  [self drawPasteRectangleAt:p]
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   518
                ifFalse: [self cursor:Cursor stop. self releasePasteDrawing]
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   519
        ]
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
   520
    ]
1019
e68414752bc9 only change the cursor for myself.
Claus Gittinger <cg@exept.de>
parents: 1013
diff changeset
   521
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   522
    "Modified: / 10.2.2000 / 22:03:18 / cg"
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
   523
!
255
1dfa8deddaef checkin from browser
Claus Gittinger <cg@exept.de>
parents: 251
diff changeset
   524
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   525
buttonPress:button x:x y:y
2277
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
   526
    |p mouseButtonColorToolBar clr masked|
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   527
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   528
    p := x@y.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   529
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   530
    self drawCursorAt:p.
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
   531
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   532
    ("self selectedColor notNil" true 
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   533
    and: [self imageContainsPoint:p])
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   534
    ifTrue:[   
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   535
        self sensor shiftDown ifTrue:[
2277
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
   536
            (image maskAt:(p // magnification)) == 0 ifTrue:[
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
   537
                masked := true.
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
   538
            ] ifFalse:[
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
   539
                masked := false.
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
   540
                clr := image colorAt:(p // magnification).
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
   541
            ].
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   542
            pickedColorHolder notNil ifTrue:[
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   543
                "/ select the color under the cursor, place it into the
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   544
                "/ pickedColorHolder/
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   545
                pickedColorHolder value:clr.
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   546
            ].
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   547
            self selectedColor:clr.
2277
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
   548
            masked ifTrue:[self selectedColorIndex:nil].
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
   549
            self changed:#selectedColor with:clr.
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   550
        ] ifFalse:[
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   551
            mouseKeyColorMode := button.
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   552
            self makeUndo.
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   553
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   554
"/            "/ cg: what a kludge - please change to use a valueHolder,
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   555
"/            "/ which gets the information ...
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   556
"/            mouseButtonColorToolBar := masterApplication builder componentAt: #MouseButtonColorToolBar.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   557
"/            mouseButtonColorToolBar notNil ifTrue:[
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   558
"/                (mouseButtonColorToolBar itemAt: mouseKeyColorMode) toggleIndication.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   559
"/                mouseButtonColorToolBar do: [:i| i updateIndicators].
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   560
"/            ].
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   561
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   562
            clickInfoCallBack notNil ifTrue:[
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   563
                "/ still a kludge, but less ugly ...
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   564
                clickInfoCallBack value:button value:p
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   565
            ].
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   566
            "/ editMode is something like #point, #rectangle etc.
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   567
            self perform: (editMode, 'At:') asSymbol with:p
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   568
        ]
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
   569
    ]
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
   570
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   571
    "Modified: / 10.2.2000 / 23:11:33 / cg"
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   572
!
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   573
994
5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting
tz
parents: 877
diff changeset
   574
buttonRelease:button x:x y:y
5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting
tz
parents: 877
diff changeset
   575
5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting
tz
parents: 877
diff changeset
   576
    self drawCursorAt: x@y.
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   577
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   578
    ("self selectedColor notNil" true and: [self imageContainsPoint: x@y])
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   579
    ifTrue: [   
1763
7d6d64622ee4 change & updates fixed (monochrome bitmaps)
Claus Gittinger <cg@exept.de>
parents: 1706
diff changeset
   580
        image release.
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
   581
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   582
"/        "/ cg: what a kludge - please change to use a valueHolder,
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   583
"/        "/ which gets the information ...
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   584
"/        masterApplication imagePreView invalidate.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   585
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   586
        "/ cg: still a kludge - but less ugly
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   587
        self changed:#subImageIn with:(image bounds).
994
5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting
tz
parents: 877
diff changeset
   588
    ]
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   589
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   590
    "Modified: / 10.2.2000 / 23:41:41 / cg"
994
5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting
tz
parents: 877
diff changeset
   591
!
5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting
tz
parents: 877
diff changeset
   592
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
   593
pointerLeave:state
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
   594
688
e1c30adb37bf updates coord info label while defining boxes
tz
parents: 686
diff changeset
   595
    super pointerLeave: state.
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
   596
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   597
    self updateImageInfo: self imageInfoString.
1019
e68414752bc9 only change the cursor for myself.
Claus Gittinger <cg@exept.de>
parents: 1013
diff changeset
   598
    self cursor:Cursor normal.
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
   599
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   600
    (editMode == #paste or:[editMode == #pasteUnder]) ifTrue: [
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   601
        self releasePasteDrawing
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
   602
    ]
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
   603
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   604
    "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
   605
! !
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   606
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   607
!ImageEditView methodsFor:'image - dragging & info'!
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   608
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   609
dragRectangleStartingAt: aPointIn emphasis: emphasis
1084
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   610
    "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
   611
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   612
    |currentPoint currentExtent firstPoint lastCurrentPoint gridCorrection 
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   613
     mp lastMp p whichQuarter scrollX scrollY aPoint|
1084
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   614
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   615
    aPoint := aPointIn.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   616
    firstPoint := currentPoint := lastCurrentPoint :=  aPoint//magnification*magnification.
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
   617
    magnification >= GridMagnificationLimit ifFalse: [gridCorrection := 0] ifTrue: [gridCorrection := 1].
1084
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   618
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   619
    [device anyButtonPressed] whileTrue: [                                                  
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   620
        mp := self sensor mousePoint.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   621
        mp = lastMp ifTrue:[
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   622
            Delay waitForSeconds:0.05
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   623
        ] ifFalse:[
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   624
            lastMp := mp.
2021
fc2a3871b24b use new translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2009
diff changeset
   625
            mp := device translatePoint:mp fromView:nil toView:self.
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   626
            "/ mp is a device coordinate here ...
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   627
            scrollX := 0.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   628
            mp x > width ifTrue:[
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   629
                scrollX := mp x - width.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   630
            ] ifFalse:[
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   631
                mp x < 0 ifTrue:[
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   632
                    scrollX := mp x.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   633
                ]
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   634
            ].
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   635
            scrollY := 0.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   636
            mp y > height ifTrue:[
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   637
                scrollY := mp y - height.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   638
            ] ifFalse:[
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   639
                mp y < 0 ifTrue:[
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   640
                    scrollY := mp y.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   641
                ]
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   642
            ].
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   643
            (scrollX + scrollY) ~~ 0 ifTrue:[
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   644
                self scrollTo:(self viewOrigin + (scrollX @ scrollY)).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   645
                lastMp := nil.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   646
            ].
1084
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   647
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   648
            mp := mp + self viewOrigin.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   649
            "/ mp is now a logical coordinate.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   650
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   651
            currentPoint := (0@0) max: (image extent * magnification min: (p := mp)).
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   652
            currentPoint := currentPoint//magnification*magnification.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   653
            currentExtent := (firstPoint - currentPoint) abs.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   654
            whichQuarter := (firstPoint x - currentPoint x) > 0 
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   655
                 ifTrue:  [(firstPoint y - currentPoint y) > 0 ifTrue: ["4"1@1] ifFalse: ["3"1@0]]
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   656
                 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
   657
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   658
            self drawCursorAt: p withLabel: 
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   659
                ((firstPoint//magnification - whichQuarter + 1) printString, 
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   660
                ' to: ', 
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   661
                (currentPoint//magnification + whichQuarter) printString),
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   662
                ' (extent: ',
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   663
                (currentExtent//magnification) printString, ')'.
1084
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   664
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   665
            currentPoint ~= lastCurrentPoint ifTrue:[   
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   666
                emphasis = #inverseFilledBox ifTrue: [
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   667
                    self redraw: ((firstPoint min: lastCurrentPoint) - 1 extent: (firstPoint - lastCurrentPoint) abs + 2).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   668
                    self xoring: [self fillRectangle: ((firstPoint min: currentPoint) + margin extent: currentExtent - gridCorrection)]
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   669
                ].
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   670
                emphasis = #box
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   671
                ifTrue:[
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   672
                    |origin extent lineWidthY lineWidthX|
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   673
                    origin := (firstPoint min: lastCurrentPoint) - 1.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   674
                    extent := (firstPoint - lastCurrentPoint) abs + 2.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   675
                    lineWidthY := extent y min: (magnification y + 2).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   676
                    lineWidthX := extent x min: (magnification x + 2).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   677
                    self redraw: (origin extent: (extent x@lineWidthY)).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   678
                    self redraw: ((origin x@(origin y + extent y - lineWidthY)) extent: (extent x@lineWidthY)).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   679
                    self redraw: ((origin x@(origin y + lineWidthY)) extent: (lineWidthX@(0 max: (extent y - (lineWidthY * 2))))).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   680
                    self redraw: (((origin x + extent x - lineWidthX)@(origin y + lineWidthY)) extent: (lineWidthX@(extent y - (lineWidthY * 2)))).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   681
                    self selectedColor ~= Color noColor
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   682
                        ifTrue: [self paint: self selectedColor]
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   683
                        ifFalse: [self paint: self viewBackground]. 
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   684
                    origin := (firstPoint min: currentPoint) + margin.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   685
                    extent := currentExtent - gridCorrection.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   686
                    lineWidthY := extent y min: magnification y.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   687
                    lineWidthX := extent x min: magnification x.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   688
                    (lineWidthY > 0 and: [lineWidthX > 0])
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   689
                    ifTrue:[
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   690
                        self fillRectangle: (origin extent: (extent x@lineWidthY)).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   691
                        self fillRectangle: ((origin x@(origin y + extent y - lineWidthY)) extent: (extent x@lineWidthY)).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   692
                        self fillRectangle: ((origin x@(origin y + lineWidthY)) extent: (lineWidthX@(0 max: (extent y - (lineWidthY * 2))))).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   693
                        self fillRectangle: (((origin x + extent x - lineWidthX)@(origin y + lineWidthY)) extent: (lineWidthX@(extent y - (lineWidthY * 2)))).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   694
                    ]
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   695
                ].
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   696
                emphasis = #filledBox
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   697
                ifTrue:[
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   698
                    self redraw: ((firstPoint min: lastCurrentPoint) - 1 extent: (firstPoint - lastCurrentPoint) abs + 2).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   699
                    self selectedColor ~= Color noColor
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   700
                        ifTrue: [self paint: self selectedColor]
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   701
                        ifFalse: [self paint: self viewBackground].
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   702
                    self fillRectangle: ((firstPoint min: currentPoint) + margin extent: currentExtent - gridCorrection).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   703
                ].
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   704
            ]. 
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   705
            lastCurrentPoint := currentPoint.
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   706
        ].                  
1084
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   707
    ].                  
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   708
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   709
    ^((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
   710
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   711
    "Created: / 21.8.1998 / 20:17:07 / cg"
2021
fc2a3871b24b use new translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2009
diff changeset
   712
    "Modified: / 10.10.2001 / 14:13:08 / cg"
1084
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   713
!
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   714
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   715
drawCursorAt:aPoint
2006
99e13c98314c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1994
diff changeset
   716
    |clr imgPoint r g b|
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   717
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   718
    image isNil ifTrue: [
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   719
        self updateImageInfo: self imageInfoString. 
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   720
        self cursor:Cursor stop.
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   721
        ^ self
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   722
    ].
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   723
1991
fff8dc641cff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1987
diff changeset
   724
    imgPoint := aPoint // magnification.
fff8dc641cff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1987
diff changeset
   725
    ((imgPoint x between:0 and:(image width-1)) 
fff8dc641cff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1987
diff changeset
   726
    and:[imgPoint y between:0 and: (image height-1)])
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   727
    ifFalse:[
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   728
        self updateImageInfo: self imageInfoString. 
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   729
        self cursor:Cursor stop.
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   730
    ] ifTrue: [
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   731
        clr := image colorAt:imgPoint.
2006
99e13c98314c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1994
diff changeset
   732
        r := clr redByte.
99e13c98314c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1994
diff changeset
   733
        g := clr greenByte.
99e13c98314c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1994
diff changeset
   734
        b := clr blueByte.
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   735
        self updateImageInfo: imgPoint printString 
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   736
                        , ' (r:' 
2006
99e13c98314c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1994
diff changeset
   737
                        , r printString
99e13c98314c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1994
diff changeset
   738
                        , ' g:' , g printString
99e13c98314c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1994
diff changeset
   739
                        , ' b:' , b printString
99e13c98314c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1994
diff changeset
   740
                        , ' #' , (r hexPrintString:2) , (g hexPrintString:2) , (b hexPrintString:2)
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   741
                        , ' pixel:' , (image pixelAt:imgPoint) printString
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   742
                        , ')'.
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
   743
        self cursor:Cursor crossHair
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   744
    ].
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   745
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   746
    "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
   747
!
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   748
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   749
drawCursorAt: aPoint withLabel: aLabel
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   750
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   751
    ((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
   752
	 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
   753
	 ifTrue: [self cursor:Cursor crossHair].
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   754
     self updateImageInfo: aLabel.
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   755
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   756
    "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
   757
!
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   758
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   759
updateActivity: something
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   760
    |msg|
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   761
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   762
    msg := something printString.
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   763
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   764
    "/ cg: new code:
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   765
    activityInfoHolder notNil ifTrue:[
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   766
	activityInfoHolder value:msg.
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   767
    ].
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   768
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   769
    "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
   770
!
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   771
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   772
updateImageInfo: something
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   773
    |msg coordLabel|
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   774
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   775
    msg := something printString.
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   776
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   777
    "/ cg: new code:
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   778
    imageInfoHolder notNil ifTrue:[
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   779
	msg ~= imageInfoHolder value ifTrue:[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   780
	    imageInfoHolder value:msg.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   781
	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   782
	^ self
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   783
    ].
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   784
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   785
"/    "/ 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
   786
"/    "/ which gets the coordinate ...
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   787
"/
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   788
"/    (masterApplication respondsTo: #coordLabel)
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   789
"/    ifTrue:[  
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   790
"/        coordLabel := masterApplication coordLabel.
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   791
"/
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   792
"/        coordLabel label ~= msg
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   793
"/        ifTrue:[         
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   794
"/            coordLabel label: msg.
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   795
"/            "/ coordLabel redraw
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   796
"/        ]
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   797
"/    ]
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   798
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   799
    "Modified: / 29.7.1998 / 19:00:21 / cg"
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   800
! !
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   801
636
d53428252193 revised version
tz
parents: 633
diff changeset
   802
!ImageEditView methodsFor:'image editing'!
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   803
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   804
boxAt: aPoint
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   805
    "draw a rectangular outline with the currently selected color"
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   806
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   807
    |choosedBox imageBox clr|
1038
6c0bb03e88a1 no need to invalidate after assign of new image.
Claus Gittinger <cg@exept.de>
parents: 1037
diff changeset
   808
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   809
    (clr := self selectedColor) notNil ifTrue:[
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   810
        choosedBox := self dragRectangleStartingAt: aPoint emphasis: #box.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   811
        imageBox := choosedBox origin//magnification extent: (choosedBox extent//magnification).
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   812
        image rectangle:imageBox withColor:clr.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   813
        image restored.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   814
        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
   815
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   816
"/        "/ cg: what a kludge - please change to use a valueHolder,
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   817
"/        "/ which gets the information ...
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   818
"/        masterApplication imagePreView redraw: (imageBox expandedBy: 1).
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   819
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   820
        "/ cg: still a kludge - but less ugly
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   821
        self changed:#subImageIn with:(imageBox expandedBy: 1).
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   822
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   823
        modified := true
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   824
    ].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   825
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   826
    "Modified: / 10.2.2000 / 23:42:08 / cg"
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   827
!
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   828
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   829
copyAt: aPoint
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   830
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   831
    |choosenBox r|
1084
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   832
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   833
    choosenBox := self dragRectangleStartingAt: aPoint emphasis: #inverseFilledBox.
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
   834
    ClipboardMagnification := nil.
1449
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   835
    Clipboard := image subImageIn: (choosenBox origin//magnification extent: (choosenBox extent//magnification)).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   836
    r := (choosenBox expandedBy:1).
e5852c20c18a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1411
diff changeset
   837
    self redraw:r
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   838
1084
87c661e6c333 scroll when dragging out of the view in copy-mode.
Claus Gittinger <cg@exept.de>
parents: 1060
diff changeset
   839
    "Modified: / 21.8.1998 / 20:16:41 / cg"
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   840
!
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   841
1228
0aae4f7389ca renamed - crob -> crop
Claus Gittinger <cg@exept.de>
parents: 1184
diff changeset
   842
cropLeft:doLeft right:doRight top:doTop bottom:doBottom
1121
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   843
    |yMinNew yMaxNew xMinNew xMaxNew
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   844
     pix stillCrobbing xMax yMax x y|
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   845
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   846
    xMax := image width - 1.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   847
    yMax := image height - 1.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   848
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   849
    xMinNew := 0.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   850
    doLeft ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   851
        pix := image pixelAtX:xMinNew y:0.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   852
        stillCrobbing := true.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   853
        [stillCrobbing] whileTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   854
            0 to:yMax do:[:y |
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   855
                (image pixelAtX:xMinNew y:y) ~~ pix ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   856
                    stillCrobbing := false
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   857
                ]
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   858
            ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   859
            stillCrobbing ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   860
                xMinNew := xMinNew + 1.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   861
                xMinNew >= image width ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   862
                    self warn:'Image is all the same color - no crob.'.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   863
                    ^ self
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   864
                ]
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   865
            ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   866
        ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   867
    ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   868
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   869
    xMaxNew := xMax.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   870
    doRight ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   871
        stillCrobbing := true.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   872
        pix := image pixelAtX:xMaxNew y:0.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   873
        [stillCrobbing] whileTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   874
            0 to:yMax do:[:y |
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   875
                (image pixelAtX:xMaxNew y:y) ~~ pix ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   876
                    stillCrobbing := false
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   877
                ]
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   878
            ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   879
            stillCrobbing ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   880
                xMaxNew := xMaxNew - 1.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   881
            ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   882
        ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   883
    ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   884
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   885
    yMinNew := 0.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   886
    doTop ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   887
        pix := image pixelAtX:xMinNew y:yMinNew.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   888
        stillCrobbing := true.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   889
        [stillCrobbing] whileTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   890
            xMinNew to:xMaxNew do:[:x |
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   891
                (image pixelAtX:x y:yMinNew) ~~ pix ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   892
                    stillCrobbing := false
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   893
                ]
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   894
            ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   895
            stillCrobbing ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   896
                yMinNew := yMinNew + 1.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   897
            ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   898
        ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   899
    ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   900
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   901
    yMaxNew := yMax.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   902
    doRight ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   903
        stillCrobbing := true.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   904
        pix := image pixelAtX:xMaxNew y:yMaxNew.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   905
        [stillCrobbing] whileTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   906
            xMinNew to:xMaxNew do:[:x |
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   907
                (image pixelAtX:x y:yMaxNew) ~~ pix ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   908
                    stillCrobbing := false
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   909
                ]
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   910
            ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   911
            stillCrobbing ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   912
                yMaxNew := yMaxNew - 1.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   913
            ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   914
        ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   915
    ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   916
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   917
    (xMinNew == 0
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   918
    and:[xMaxNew == (image width - 1)
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   919
    and:[yMinNew == 0
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   920
    and:[yMaxNew == (image height - 1)]]]) ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   921
        self warn:'No border found - no crob.'.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   922
        ^ self
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   923
    ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   924
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   925
"/    self warn:'extract subImage ' 
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   926
"/              , (xMinNew @ yMinNew) printString
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   927
"/              , ' -> '
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   928
"/              , (xMaxNew @ yMaxNew) printString.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   929
2006
99e13c98314c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1994
diff changeset
   930
    self makeUndo.
1121
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   931
    self 
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   932
        makeSubImageX:xMinNew y:yMinNew 
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   933
        width:(xMaxNew - xMinNew + 1)
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   934
        height:(yMaxNew - yMinNew + 1)
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   935
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   936
    "Created: / 7.9.1998 / 14:25:52 / cg"
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   937
    "Modified: / 7.9.1998 / 16:35:35 / cg"
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   938
!
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
   939
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   940
fillAt: aPoint
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   941
    "perform a flood-fill with the currently selected color"
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
   942
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   943
    windowGroup withExecuteCursorDo:[
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   944
        |filledPoints clr|
1002
5d2e4c03a78e grid magnification can be changed
tz
parents: 996
diff changeset
   945
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   946
        (clr := self selectedColor) notNil ifTrue:[
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   947
            self updateActivity:'Flood filling - press CTRL-y to abort ...'.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   948
            [
2349
4cf7b4f1345e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2338
diff changeset
   949
                image floodFillAt: aPoint//magnification withColor:clr.
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   950
                image restored.
1038
6c0bb03e88a1 no need to invalidate after assign of new image.
Claus Gittinger <cg@exept.de>
parents: 1037
diff changeset
   951
2349
4cf7b4f1345e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2338
diff changeset
   952
                self invalidate.
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   953
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   954
"/                "/ cg: what a kludge - please change to use a valueHolder,
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   955
"/                "/ which gets the information ...
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   956
"/                masterApplication imagePreView invalidate.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   957
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   958
                "/ cg: still a kludge - but less ugly
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   959
                self changed:#subImageIn with:(image bounds).
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   960
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   961
                modified := true
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   962
            ] valueOnUnwindDo:[
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   963
                self updateActivity:'Flood fill aborted.'
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   964
            ].
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   965
        ].
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   966
        self updateActivity:''
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   967
    ]
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
   968
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   969
    "Modified: / 10.2.2000 / 23:40:58 / cg"
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   970
!
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   971
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   972
filledBoxAt: aPoint
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   973
    "fill a rectangular area with the currently selected color"
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   974
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   975
    |choosedBox imageBox clr|
1038
6c0bb03e88a1 no need to invalidate after assign of new image.
Claus Gittinger <cg@exept.de>
parents: 1037
diff changeset
   976
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   977
    (clr := self selectedColor) notNil ifTrue:[
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   978
        choosedBox := self dragRectangleStartingAt: aPoint emphasis: #filledBox.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   979
        imageBox := choosedBox origin//magnification extent: (choosedBox extent//magnification).
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   980
        image fillRectangle:imageBox withColor:clr.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   981
        image restored.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   982
        self redraw: (choosedBox expandedBy: 1).
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   983
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   984
"/        "/ cg: what a kludge - please change to use a valueHolder,
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   985
"/        "/ which gets the information ...
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   986
"/        masterApplication imagePreView redraw: (imageBox expandedBy: 1).
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   987
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   988
        "/ cg: still a kludge - but less ugly
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   989
        self changed:#subImageIn with:(imageBox expandedBy: 1).
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   990
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   991
        modified := true
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   992
    ]
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
   993
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
   994
    "Modified: / 10.2.2000 / 23:37:04 / cg"
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   995
!
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
   996
636
d53428252193 revised version
tz
parents: 633
diff changeset
   997
flipHorizontal
d53428252193 revised version
tz
parents: 633
diff changeset
   998
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
   999
    self makeUndo.
725
0e051202859d checkin from browser
tz
parents: 724
diff changeset
  1000
    self image: image copy flipHorizontal
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1001
d53428252193 revised version
tz
parents: 633
diff changeset
  1002
!
d53428252193 revised version
tz
parents: 633
diff changeset
  1003
d53428252193 revised version
tz
parents: 633
diff changeset
  1004
flipVertical
d53428252193 revised version
tz
parents: 633
diff changeset
  1005
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1006
    self makeUndo.
725
0e051202859d checkin from browser
tz
parents: 724
diff changeset
  1007
    self image: image copy flipVertical
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1008
d53428252193 revised version
tz
parents: 633
diff changeset
  1009
!
d53428252193 revised version
tz
parents: 633
diff changeset
  1010
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1011
magnifyImageTo:newSize
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1012
    self makeUndo.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1013
    self image: (image magnifiedBy: newSize/image extent)
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1014
!
d53428252193 revised version
tz
parents: 633
diff changeset
  1015
1992
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1016
makeBorderedImageX:newX y:newY width:newWidth height:newHeight
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1017
    |newImage oldWidth oldHeight|
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1018
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1019
    oldWidth := image width.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1020
    oldHeight := image height.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1021
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1022
    newImage := image class width:newWidth height:newHeight depth:image depth.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1023
    newImage photometric:image photometric.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1024
    newImage colorMap:image colorMap copy.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1025
    newImage bits:(ByteArray new:(newImage bytesPerRow * newHeight)).
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1026
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1027
    image mask notNil
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1028
    ifTrue:[
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1029
        |newMaskImage|
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1030
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1031
        newMaskImage := Depth1Image width:newWidth height:newHeight.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1032
        newMaskImage photometric: image mask photometric.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1033
        newMaskImage colorMap: image mask colorMap copy.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1034
        newMaskImage bits:(ByteArray new: newMaskImage bytesPerRow * newHeight).
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1035
        newImage mask: newMaskImage
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1036
    ].
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1037
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1038
    newImage copyFrom:image x:0 y:0 toX:newX y:newY width:oldWidth height:oldHeight.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1039
    self makeUndo.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1040
    self image:newImage.
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1041
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1042
    "Created: / 7.9.1998 / 13:00:16 / cg"
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1043
    "Modified: / 7.9.1998 / 14:15:32 / cg"
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1044
!
3aa650794ab4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1991
diff changeset
  1045
2168
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1046
makeBrighter
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1047
    ^ self makeNewColorMapByMapping:[:clr | clr lightened].
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1048
!
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1049
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1050
makeDarker
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1051
    ^ self makeNewColorMapByMapping:[:clr | clr darkened].
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1052
!
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1053
1886
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1054
makeGrayScale
2168
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1055
    ^ self makeNewColorMapByMapping:[:clr | Color brightness:(clr brightness)].
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1056
!
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1057
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1058
makeInverse
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1059
    ^ self makeNewColorMapByMapping:[:clr | 
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1060
        Color red:(100-clr red) green:(100-clr green) blue:(100-clr blue)].
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1061
!
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1062
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1063
makeNewColorMapByMapping:functionOfColor
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1064
    |xMax yMax clr pix map revMap n_clr n_pix anyChange
1886
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1065
     newColors newColorArray newImage|
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1066
2168
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1067
    image colorMap isNil ifTrue:[
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1068
        self error:'image has no colormap'.
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1069
        ^ false
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1070
    ].
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1071
1886
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1072
    anyChange := false.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1073
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1074
    xMax := image width - 1.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1075
    yMax := image height - 1.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1076
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1077
    newColors := Set new.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1078
    newColorArray := OrderedCollection new.
1903
b0c9fcf3155e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1901
diff changeset
  1079
    map := Array new:256.
1886
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1080
    revMap := OrderedCollection new.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1081
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1082
    newImage := image class width:image width height:image height depth:image depth.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1083
    newImage photometric:image photometric.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1084
    newImage colorMap:(image colorMap copy).
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1085
    newImage bits:(ByteArray new:(image bits size)).
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1086
    newImage mask:(image mask copy).
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1087
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1088
    0 to:yMax do:[:y |
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1089
        0 to:xMax do:[:x |
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1090
            pix := image pixelAtX:x y:y.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1091
            (n_pix := map at:pix+1) isNil ifTrue:[
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1092
                clr := image colorAtX:x y:y.
2168
d531fe16bae2 more colormap operations
Claus Gittinger <cg@exept.de>
parents: 2149
diff changeset
  1093
                n_clr := functionOfColor value:clr.
1886
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1094
                (newColors includes:n_clr) ifFalse:[
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1095
                    newColors add:n_clr.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1096
                    newColorArray add:n_clr.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1097
                    revMap add:pix.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1098
                    map at:pix+1 put:(n_pix := revMap size - 1).
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1099
                ] ifTrue:[
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1100
                    "/ mhmh - multiple pixels mapped to the same color
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1101
                    n_pix := (newColorArray indexOf:n_clr) - 1.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1102
                    map at:pix+1 put:n_pix.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1103
                ]
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1104
            ].
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1105
            newImage pixelAtX:x y:y put:n_pix.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1106
        ]
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1107
    ].
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1108
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1109
    newImage colorMap:(Colormap fromColors:newColorArray).
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1110
    self makeUndo.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1111
    self image:newImage.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1112
    ^ true
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1113
!
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1114
1121
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1115
makeSubImageX:oldX y:oldY width:newWidth height:newHeight
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1116
    |newImage|
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1117
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1118
    newImage := image class width:newWidth height:newHeight depth:image depth.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1119
    newImage photometric:image photometric.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1120
    newImage colorMap:image colorMap copy.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1121
    newImage bits:(ByteArray new:(newImage bytesPerRow * newHeight)).
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1122
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1123
    image mask notNil
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1124
    ifTrue:[
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1125
        |newMaskImage|
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1126
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1127
        newMaskImage := Depth1Image width:newWidth height:newHeight.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1128
        newMaskImage photometric: image mask photometric.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1129
        newMaskImage colorMap: image mask colorMap copy.
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1130
        newMaskImage bits:(ByteArray new: newMaskImage bytesPerRow * newHeight).
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1131
        newImage mask: newMaskImage
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1132
    ].
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1133
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1134
    newImage copyFrom:image x:oldX y:oldY toX:0 y:0 width:newWidth height:newHeight.
1886
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1135
    self image:newImage.
1121
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1136
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1137
    "Created: / 7.9.1998 / 13:00:16 / cg"
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1138
    "Modified: / 7.9.1998 / 14:15:32 / cg"
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1139
!
af09c616fb7b added crob operations.
Claus Gittinger <cg@exept.de>
parents: 1116
diff changeset
  1140
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1141
negativeImage
d53428252193 revised version
tz
parents: 633
diff changeset
  1142
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1143
    self makeUndo.
1411
05ffc8ae696e methode negativeImage ivert bits of image
tm
parents: 1380
diff changeset
  1144
    self image: (image copy bits:(image bits invert))
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1145
!
d53428252193 revised version
tz
parents: 633
diff changeset
  1146
d53428252193 revised version
tz
parents: 633
diff changeset
  1147
pasteAt: aPoint
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  1148
    "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
  1149
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1150
    self pasteAt:aPoint mode:nil.
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  1151
!
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  1152
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1153
pasteAt: aPoint mode:modeSymbol
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  1154
    "paste the image in the clipboard at aPoint"
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1155
1986
630db3277f10 support pasing 24bit rgb image into an 8-bit palette image
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
  1156
    |answer anyColorMissing choosedBox imagePoint imgX imgY copiedImage imageBox newColorMap
630db3277f10 support pasing 24bit rgb image into an 8-bit palette image
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
  1157
     existingColors newColors allColors currentColorMap newColormap|
1888
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1158
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1159
    ClipboardMagnification isNil ifTrue: [
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1160
        "/ ^self
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1161
    ].
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1162
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1163
    Object errorSignal handle:
d53428252193 revised version
tz
parents: 633
diff changeset
  1164
    [:ex|
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1165
        ex signal == Image unrepresentableColorSignal ifFalse:[
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1166
            ex reject
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1167
        ].
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1168
        self undo.
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1169
        self warn: 'Paste failed !!\Increasing the images depth might help.' withCRs. 
1823
d11286b90d3b paste mask
Claus Gittinger <cg@exept.de>
parents: 1781
diff changeset
  1170
    ] do: [   
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1171
        windowGroup withExecuteCursorDo:[
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1172
            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
  1173
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1174
            imagePoint := choosedBox origin//magnification.
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  1175
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1176
            copiedImage := Clipboard copy.
1987
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1177
1888
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1178
            true 
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1179
            "/ image photometric == #palette 
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1180
            ifTrue:[
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1181
                "/ for all colors in the pasted image,
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1182
                "/ check, if its in the colormap of the
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1183
                "/ target image.
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1184
1888
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1185
                anyColorMissing := false.
1957
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1186
                image colorMap notNil ifTrue:[
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1187
                    copiedImage usedValues do:[:pixel |
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1188
                        |pastedColor oldColorMap|
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1189
1957
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1190
                        pastedColor := copiedImage colorFromValue:pixel.
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1191
                        oldColorMap := image colorMap.
1028
4dfe1c6cbc48 fixed paste-drag display (when scrolled)
Claus Gittinger <cg@exept.de>
parents: 1027
diff changeset
  1192
1957
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1193
                        (oldColorMap detect: [:clr| clr = pastedColor] ifNone: nil) isNil
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1194
                        ifTrue:
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1195
                        [        
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1196
                            oldColorMap size < (1 bitShift:image depth) ifTrue:[
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1197
                                "/ add to colormap
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1198
                                newColorMap isNil ifTrue:[
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1199
                                    newColorMap := oldColorMap asOrderedCollection.
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1200
                                ].
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1201
                                newColorMap add:pastedColor.
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1202
        "/                        Transcript showCR:'adding color:' , pastedColor displayString , ' to targets colorMap'.
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1203
                            ] ifFalse:[
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1204
        "/                        Transcript showCR:'color:' , pastedColor displayString , ' not found in targets colorMap'.
1987
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1205
"/                                copiedImage colorMap notNil ifTrue:[
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1206
"/                                    copiedImage colorMap at: pixel+1 put: Color black.
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1207
"/                                ].
1957
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1208
                                anyColorMissing := true.
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1209
                            ]
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1210
                        ]
1957
9a4347986d96 paste with non-colormap image (i.e. truecolor).
Claus Gittinger <cg@exept.de>
parents: 1903
diff changeset
  1211
                    ].
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1212
                ].
1888
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1213
                anyColorMissing ifTrue:[
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1214
                    answer := Dialog
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1215
                                confirmWithCancel:'Some color(s) cannot be represented (colorMap full).\Use nearest or compute colorMap ?' withCRs 
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1216
                                labels:#( 'Cancel' 'New ColorMap' 'Use Nearest' )
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1217
                                values:#(  nil new nearest)
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1218
                                default:3.
1888
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1219
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1220
                    answer isNil ifTrue:[^ self].
1986
630db3277f10 support pasing 24bit rgb image into an 8-bit palette image
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
  1221
630db3277f10 support pasing 24bit rgb image into an 8-bit palette image
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
  1222
                    currentColorMap := image colorMap.
1987
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1223
                    imgX := imagePoint x.
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1224
                    imgY := imagePoint y.
1986
630db3277f10 support pasing 24bit rgb image into an 8-bit palette image
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
  1225
1888
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1226
                    answer == #nearest ifTrue:[
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1227
                        0 to:copiedImage height-1 do:[:y |
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1228
                            0 to:copiedImage width-1 do:[:x |
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1229
                                |clr n_clr|
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1230
1987
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1231
                                (copiedImage maskAtX:x y:y) == 0 ifTrue:[
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1232
                                    image mask isNil ifTrue:[
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1233
                                        image createMask.
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1234
                                    ].
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1235
                                    image maskAtX:imgX+x y:imgY+y put:0.
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1236
                                ] ifFalse:[
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1237
                                    clr := copiedImage atX:x y:y.
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1238
                                    n_clr := clr nearestIn:currentColorMap.
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1239
                                    image atX:imgX+x y:imgY+y put:n_clr
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1240
                                ]
1888
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1241
                            ]
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1242
                        ].
1987
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1243
                        image restored.
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1244
                        self redraw: (imageBox := (imagePoint * magnification extent: (Clipboard extent * magnification)) expandedBy: 1@1).
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1245
                        modified := true.
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1246
                        ^ self.
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1247
                    ].
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1248
                    answer == #new ifTrue:[
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1249
                        existingColors := image usedValues asIdentitySet.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1250
                        newColors := copiedImage usedValues.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1251
                        allColors := existingColors addAll:newColors.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1252
                        allColors size > (1 bitShift:image depth) ifTrue:[
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1253
                            self warn:'Sorry: too many colors - unimplemented function'.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1254
                            self undo.
1986
630db3277f10 support pasing 24bit rgb image into an 8-bit palette image
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
  1255
                            ^ self.
630db3277f10 support pasing 24bit rgb image into an 8-bit palette image
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
  1256
                        ].
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1257
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1258
                        newColormap := OrderedCollection new.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1259
                        newColormap addAll:image usedColors.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1260
                        newColormap addAll:copiedImage usedColors.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1261
                        "/ translate image to use new colorMap...
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1262
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1263
                        "/ translate image to use new colors ...
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1264
                        0 to:image height-1 do:[:y |
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1265
                            0 to:image width-1 do:[:x |
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1266
                                |clr n_idx|
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1267
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1268
                                (image maskAtX:x y:y) == 1 ifTrue:[
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1269
                                    clr := image atX:x y:y.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1270
                                    n_idx := newColormap indexOf:clr.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1271
                                    image pixelAtX:x y:y put:n_idx-1.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1272
                                ]
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1273
                            ]
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1274
                        ].
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1275
                        image colorMap:newColormap.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1276
                        currentColorMap := newColormap.    
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1277
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1278
                        "/ paste new image...    
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1279
                        0 to:copiedImage height-1 do:[:y |
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1280
                            0 to:copiedImage width-1 do:[:x |
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1281
                                |clr idx|
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1282
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1283
                                (copiedImage maskAtX:x y:y) == 1
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1284
                                ifTrue:[
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1285
                                    clr := copiedImage atX:x y:y.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1286
                                    idx := currentColorMap indexOf:clr.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1287
                                    idx == 0 ifTrue:[
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1288
                                        currentColorMap add:clr.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1289
                                        idx := currentColorMap size.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1290
                                        idx > (1 bitShift:image depth) ifTrue:[
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1291
                                            self warn:'Sorry: too many colors'.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1292
                                            self undo.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1293
                                            ^ self.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1294
                                        ].
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1295
                                    ].
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1296
                                    image pixelAtX:imgX+x y:imgY+y put:idx-1.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1297
                                    image maskAtX:imgX+x y:imgY+y put:1.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1298
                                ]
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1299
                            ]
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1300
                        ].
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1301
                        image restored.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1302
                        self redraw: (imageBox := (imagePoint * magnification extent: (Clipboard extent * magnification)) expandedBy: 1@1).
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1303
                        modified := true.
1888
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1304
                        ^ self.
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1305
                    ].
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1306
                    self warn:'Sorry: unimplemented function'.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1307
                    self undo.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1308
                    ^ self.
1888
ef622d292093 colormap conversion
Claus Gittinger <cg@exept.de>
parents: 1886
diff changeset
  1309
                ].
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1310
                newColorMap notNil ifTrue:[
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1311
                    image colorMap:(Colormap fromColors:newColorMap).
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1312
                ].
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1313
            ].
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  1314
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1315
            copiedImage := image class fromImage: copiedImage.
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1316
            (newColorMap isNil 
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1317
            and:[modeSymbol isNil
1987
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1318
            and:[copiedImage mask isNil] ]) ifTrue:[
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1319
                "/ use images copy functionality
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1320
                "/ however, this copies the mask as well,
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1321
                "/ which is not useful here
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1322
                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
  1323
            ] ifFalse:[
994
5727c2484ecd bugs fixed in undo/mask and point painting/preview and pasting
tz
parents: 877
diff changeset
  1324
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1325
                imgX := imagePoint x.
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1326
                imgY := imagePoint y.
1028
4dfe1c6cbc48 fixed paste-drag display (when scrolled)
Claus Gittinger <cg@exept.de>
parents: 1027
diff changeset
  1327
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1328
                0 to:copiedImage height-1 do:[:y |
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1329
                    0 to:copiedImage width-1 do:[:x |
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1330
                        |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
  1331
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1332
                        dstX := imgX + x.
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1333
                        dstY := imgY + y.
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1334
                        wasMasked := (image maskAtX:dstX y:dstY) == 0.
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1335
                        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
  1336
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1337
                        "/ with modeUnder, 
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1338
                        "/ only replace, if its either unmasked,
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1339
                        "/ or the current drawing color.
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1340
                        (modeSymbol isNil
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1341
                        or:[wasMasked
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1342
                        or:[modeSymbol == #withMask]])
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1343
                        ifTrue:[
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1344
                            newMasked ifFalse:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1345
                                image 
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1346
                                    colorAtX:dstX y:dstY put:(copiedImage colorAtX:x y:y).
1823
d11286b90d3b paste mask
Claus Gittinger <cg@exept.de>
parents: 1781
diff changeset
  1347
                                wasMasked ifTrue:[
1986
630db3277f10 support pasing 24bit rgb image into an 8-bit palette image
Claus Gittinger <cg@exept.de>
parents: 1980
diff changeset
  1348
                                    image maskAtX:dstX y:dstY put:1
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1349
                                ].
1823
d11286b90d3b paste mask
Claus Gittinger <cg@exept.de>
parents: 1781
diff changeset
  1350
                            ] ifTrue:[
d11286b90d3b paste mask
Claus Gittinger <cg@exept.de>
parents: 1781
diff changeset
  1351
                                wasMasked ifFalse:[
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1352
                                    modeSymbol == #withMask ifTrue:[
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1353
                                        image maskAtX:dstX y:dstY put:0
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1354
                                    ]
1823
d11286b90d3b paste mask
Claus Gittinger <cg@exept.de>
parents: 1781
diff changeset
  1355
                                ]
d11286b90d3b paste mask
Claus Gittinger <cg@exept.de>
parents: 1781
diff changeset
  1356
                            ].
1987
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1357
                        ].
eb9f2f7f1450 paste image
Claus Gittinger <cg@exept.de>
parents: 1986
diff changeset
  1358
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1359
                    ]
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1360
                ].
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1361
            ].
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1362
            image restored.
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1363
            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
  1364
"/            masterApplication imagePreView redraw: (imageBox expandedBy: 1).
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1365
            modified := true
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1366
        ]
1028
4dfe1c6cbc48 fixed paste-drag display (when scrolled)
Claus Gittinger <cg@exept.de>
parents: 1027
diff changeset
  1367
   ]
4dfe1c6cbc48 fixed paste-drag display (when scrolled)
Claus Gittinger <cg@exept.de>
parents: 1027
diff changeset
  1368
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1369
    "Modified: / 18.5.1999 / 20:40:37 / cg"
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1370
!
d53428252193 revised version
tz
parents: 633
diff changeset
  1371
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  1372
pasteUnderAt: aPoint
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  1373
    "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
  1374
     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
  1375
     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
  1376
2135
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1377
    self pasteAt:aPoint mode:#under.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1378
!
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1379
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1380
pasteWithMaskAt: aPoint
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1381
    "paste the image in the clipboard at aPoint.
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1382
     In this mode, both the mask and the image pixel are pasted"
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1383
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1384
09782f280a97 added "paste with mask"
Claus Gittinger <cg@exept.de>
parents: 2092
diff changeset
  1385
    self pasteAt:aPoint mode:#withMask.
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  1386
!
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  1387
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1388
performSpecialOperationOn:imageBox withColor:clr
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1389
    |operation x0 y0 x1 y1 grey pixelAction requiredColors missingColors answer|
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1390
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1391
    operation := Dialog 
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1392
           choose:'Which Operation:' 
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1393
           fromList:#(
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1394
                       'slightly brightened'
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1395
                       'slightly darkened'
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1396
                       'brightened'
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1397
                       'darkened'
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1398
                       '-'
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1399
                       'greyed'
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1400
                       'grey pattern'
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1401
                       '-'
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1402
                       'reversed'
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1403
                     ) 
2177
340ce04ccc78 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2172
diff changeset
  1404
           values:#(slightlyBrightened slightlyDarkened brightened darkened nil greyed greyPattern nil reversed) 
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1405
           lines:6
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1406
           cancel:nil.
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1407
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1408
    self invalidate.
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1409
    self windowGroup processExposeEvents.
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1410
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1411
    operation isNil ifTrue:[^ false].
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1412
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1413
    x0 := imageBox left.
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1414
    y0 := imageBox top.
1861
ba1f1a884ebc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1415
    x1 := imageBox right - 1.
ba1f1a884ebc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1416
    y1 := imageBox bottom -1 .
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1417
2177
340ce04ccc78 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2172
diff changeset
  1418
    operation == #slightlyBrightened ifTrue:[
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1419
        pixelAction := [:x :y :clr | clr slightlyLightened].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1420
    ].
2177
340ce04ccc78 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2172
diff changeset
  1421
    operation == #slightlyDarkened ifTrue:[
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1422
        pixelAction := [:x :y :clr | clr slightlyDarkened].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1423
    ].
2177
340ce04ccc78 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2172
diff changeset
  1424
    operation == #brightened ifTrue:[
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1425
        pixelAction := [:x :y :clr | clr lightened].
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1426
    ].
2177
340ce04ccc78 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2172
diff changeset
  1427
    operation == #darkened ifTrue:[
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1428
        pixelAction := [:x :y :clr | clr darkened].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1429
    ].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1430
    operation == #reversed ifTrue:[
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1431
        pixelAction := [:x :y :clr | Color red:(100-clr red) green:(100-clr green) blue:(100-clr blue) ].
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1432
    ].
2177
340ce04ccc78 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2172
diff changeset
  1433
    operation == #greyed ifTrue:[
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1434
        pixelAction := [:x :y :clr | clr blendWith:Color grey].
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1435
    ].
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1436
    operation == #greyPattern ifTrue:[
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1437
        pixelAction := [:x :y :clr | Color grey].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1438
    ].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1439
    pixelAction isNil ifTrue:[self halt. ^ false].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1440
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1441
    "/ compute required colors ...
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1442
    requiredColors := Set new.
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1443
    self image 
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1444
        colorsFromX:x0 y:y0 toX:x1 y:y1 
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1445
        do:[:x :y :clr | 
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1446
            requiredColors add:(pixelAction value:x value:y value:clr)
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1447
        ].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1448
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1449
    missingColors := requiredColors select:[:clr | (image colorMap includes:clr) not].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1450
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1451
    missingColors notEmpty ifTrue:[
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1452
        answer := Dialog
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1453
                    confirmWithCancel:'Some color(s) cannot be represented in the images colorMap.\Use nearest or compute colorMap ?' withCRs 
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1454
                    labels:#( 'Cancel' 'Add to ColorMap'  'Use Nearest')
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1455
                    values:#( nil add nearest)
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1456
                    default:3.
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1457
        answer isNil ifTrue:[^ self].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1458
        answer == #add ifTrue:[
2338
ca7a34f082d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2321
diff changeset
  1459
            self halt:'this function is not yet implemented'.
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1460
            missingColors do:[:eachColor |
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1461
            ].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1462
            ^ false.
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1463
        ].
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1464
    ].
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1465
2172
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1466
    "/ now, do it
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1467
    self image 
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1468
        colorsFromX:x0 y:y0 toX:x1 y:y1 
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1469
        do:[:x :y :clr |
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1470
            |newClr|
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1471
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1472
            newClr := pixelAction value:x value:y value:clr.
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1473
            answer == #nearest ifTrue:[
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1474
                newClr := newClr nearestIn:image colorMap
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1475
            ].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1476
            self image colorAtX:x y:y put:newClr
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1477
        ].
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1478
737d8733fb01 brightemed, darkened, reverse etc. added to operations.
Claus Gittinger <cg@exept.de>
parents: 2168
diff changeset
  1479
    ^ true.
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1480
!
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1481
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
  1482
pointAt:aPoint
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1483
    "draw a single pixel with the currently selected color"
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1484
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1485
    |imagePoint clr pix|
796
b68b09ddc62b preview redrawing
tz
parents: 783
diff changeset
  1486
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1487
    imagePoint := aPoint // magnification.
1277
8c74c9cc6e22 fixed point-drawing
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
  1488
    (clr := self selectedColor) isNil ifTrue:[
8c74c9cc6e22 fixed point-drawing
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
  1489
        pix := self selectedColorIndex
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1490
    ].
2277
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
  1491
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1492
    pix notNil ifTrue:[
1277
8c74c9cc6e22 fixed point-drawing
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
  1493
        image colorMap atImageAndMask:imagePoint putValue:pix.
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
  1494
        modified := true.
1277
8c74c9cc6e22 fixed point-drawing
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
  1495
    ] ifFalse:[     
2277
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
  1496
        "/ clr notNil ifTrue:[
1277
8c74c9cc6e22 fixed point-drawing
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
  1497
            image atImageAndMask:imagePoint put:clr.
8c74c9cc6e22 fixed point-drawing
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
  1498
            modified := true.
2277
012c57905267 allow pinging the mask
Claus Gittinger <cg@exept.de>
parents: 2240
diff changeset
  1499
        "/ ]
1246
0cd36bffc789 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1245
diff changeset
  1500
    ].
1277
8c74c9cc6e22 fixed point-drawing
Claus Gittinger <cg@exept.de>
parents: 1261
diff changeset
  1501
    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
  1502
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1503
    "Modified: / 5.9.1998 / 13:25:29 / cg"
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1504
!
d53428252193 revised version
tz
parents: 633
diff changeset
  1505
1374
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1506
reduceColorResolutionBy:numBits
1885
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1507
    |xMax yMax r g b n_r n_g n_b clr pix map revMap n_clr n_pix mask anyChange
1980
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1508
     newColors newColorArray newImage isPalette|
1374
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1509
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1510
    anyChange := false.
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1511
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1512
    xMax := image width - 1.
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1513
    yMax := image height - 1.
1885
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1514
    mask := (16rFF bitShift:numBits) bitAnd:16rFF.
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1515
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1516
    newColors := Set new.
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1517
    newColorArray := OrderedCollection new.
2034
232fc5aba8c4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2030
diff changeset
  1518
    map := Array new:256.
1885
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1519
    revMap := OrderedCollection new.
1374
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1520
1886
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1521
    newImage := image class width:image width height:image height depth:image depth.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1522
    newImage photometric:image photometric.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1523
    newImage colorMap:(image colorMap copy).
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1524
    newImage bits:(ByteArray new:(image bits size)).
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1525
    newImage mask:(image mask copy).
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1526
1980
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1527
    isPalette := image photometric == #palette.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1528
    isPalette ifFalse:[
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1529
        0 to:yMax do:[:y |
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1530
            0 to:xMax do:[:x |
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1531
                pix := image pixelAtX:x y:y.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1532
                r := image redBitsOf:pix.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1533
                g := image greenBitsOf:pix.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1534
                b := image blueBitsOf:pix.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1535
                n_r := r bitAnd:mask.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1536
                n_g := g bitAnd:mask.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1537
                n_b := b bitAnd:mask.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1538
                n_pix := image valueFromRedBits:n_r greenBits:n_g blueBits:n_b.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1539
                n_pix ~= pix ifTrue:[
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1540
                    newImage pixelAtX:x y:y put:n_pix.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1541
                    anyChange := true.
1885
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1542
                ]
1980
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1543
            ]
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1544
        ].
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1545
        anyChange ifFalse:[
1885
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1546
            ^ false
1980
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1547
        ].
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1548
    ] ifTrue:[
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1549
        0 to:yMax do:[:y |
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1550
            0 to:xMax do:[:x |
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1551
                pix := image pixelAtX:x y:y.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1552
                (n_pix := map at:pix+1) isNil ifTrue:[
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1553
                    clr := image colorAtX:x y:y.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1554
                    r := clr redByte.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1555
                    g := clr greenByte.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1556
                    b := clr blueByte.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1557
                    n_r := r bitAnd:mask.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1558
                    n_g := g bitAnd:mask.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1559
                    n_b := b bitAnd:mask.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1560
                    n_clr := Color redByte:n_r greenByte:n_g blueByte:n_b.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1561
                    (newColors includes:n_clr) ifFalse:[
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1562
                        newColors add:n_clr.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1563
                        newColorArray add:n_clr.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1564
                        revMap add:pix.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1565
                        map at:pix+1 put:(n_pix := revMap size - 1).
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1566
                    ] ifTrue:[
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1567
                        "/ mhmh - multiple pixels mapped to the same color
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1568
                        n_pix := (newColorArray indexOf:n_clr) - 1.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1569
                        map at:pix+1 put:n_pix.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1570
                    ]
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1571
                ].
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1572
                newImage pixelAtX:x y:y put:n_pix.
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1573
            ]
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1574
        ].
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1575
        revMap size == image colorMap size ifTrue:[
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1576
            revMap = (0 to:revMap size-1) ifTrue:[
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1577
                ^ false
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1578
            ]
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1579
        ].
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1580
bc32242dc2c3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1967
diff changeset
  1581
        newImage colorMap:(Colormap fromColors:newColorArray).
1885
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1582
    ].
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1583
1886
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1584
    self makeUndo.
e5b5a8850dc5 added make grayScale
Claus Gittinger <cg@exept.de>
parents: 1885
diff changeset
  1585
    self image:newImage.
1885
5f85501aaea9 reduce color-resolution fixed
Claus Gittinger <cg@exept.de>
parents: 1882
diff changeset
  1586
    ^ true
1374
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1587
!
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1588
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1589
resizeImageTo:newSize
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1590
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1591
    |newImage newMaskImage|
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1592
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1593
    newImage := image class width: newSize x height: newSize y depth: image depth.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1594
    newImage photometric:image photometric.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1595
    newImage colorMap:image colorMap copy.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1596
    newImage bits: (ByteArray new: newImage bytesPerRow * newSize y).
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1597
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1598
    image mask notNil ifTrue:[
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1599
        newMaskImage := Depth1Image width: newSize x height: newSize y.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1600
        newMaskImage photometric: image mask photometric.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1601
        newMaskImage colorMap: image mask colorMap copy.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1602
        newMaskImage bits:(ByteArray new: newMaskImage bytesPerRow * newSize y).
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1603
        newImage mask: newMaskImage
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1604
    ].
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1605
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1606
    newImage copyFrom:image x:0 y:0 toX:0 y:0 width: (image width min:newSize x) height: (image height min:newSize y).
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1607
    self makeUndo.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1608
    self image: newImage.
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1609
!
d53428252193 revised version
tz
parents: 633
diff changeset
  1610
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1611
rotateImageBy:rotation
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1612
    "rotate by (degrees)"
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1613
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1614
    Object errorSignal handle:[:ex|
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1615
        self warn: 'Image rotation failed!!\' withCRs, 'Increaing the image depth could help.'
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1616
    ] do:[   
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1617
        self makeUndo.
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1618
        self image: (image hardRotated: rotation)
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
  1619
    ]
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
  1620
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
  1621
    "Modified: / 29.7.1998 / 18:21:14 / cg"
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1622
!
d53428252193 revised version
tz
parents: 633
diff changeset
  1623
2086
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1624
shiftImageHorizontal:shiftH vertical:shiftV
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1625
    |w h srcX srcY dstX dstY newImage|
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1626
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1627
    w := image width.
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1628
    h := image height.
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1629
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1630
    newImage := image copy.
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1631
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1632
    srcX := srcY := dstX := dstY := 0.
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1633
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1634
    shiftH < 0 ifTrue:[
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1635
        srcX := shiftH negated
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1636
    ] ifFalse:[
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1637
        dstX := shiftH
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1638
    ].
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1639
    shiftV < 0 ifTrue:[
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1640
        srcY := shiftV negated
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1641
    ] ifFalse:[
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1642
        dstY := shiftV
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1643
    ].
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1644
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1645
    newImage copyFrom:image x:srcX y:srcY toX:dstX y:dstY width:w-shiftH abs height:h-shiftV abs.
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1646
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1647
    self image:newImage.
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1648
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1649
    "Created: / 7.9.1998 / 13:00:16 / cg"
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1650
    "Modified: / 7.9.1998 / 14:15:32 / cg"
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1651
!
3e32adf8adab added shift operation
Claus Gittinger <cg@exept.de>
parents: 2085
diff changeset
  1652
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1653
specialOperationAt: aPoint
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1654
    "special operation on a rectangular area"
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1655
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1656
    |choosedBox imageBox clr|
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1657
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1658
    choosedBox := self dragRectangleStartingAt: aPoint emphasis: #filledBox.
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1659
    imageBox := choosedBox origin//magnification extent: (choosedBox extent//magnification).
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1660
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1661
    (self performSpecialOperationOn:imageBox withColor:self selectedColor) ifFalse:[
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1662
        ^ self
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1663
    ].
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1664
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1665
    image restored.
1861
ba1f1a884ebc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1666
    self invalidate. "/ : (choosedBox expandedBy: 1).
ba1f1a884ebc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1667
ba1f1a884ebc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1859
diff changeset
  1668
    "/ self redraw: (choosedBox expandedBy: 1).
1858
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1669
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1670
"/        "/ cg: what a kludge - please change to use a valueHolder,
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1671
"/        "/ which gets the information ...
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1672
"/        masterApplication imagePreView redraw: (imageBox expandedBy: 1).
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1673
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1674
        "/ cg: still a kludge - but less ugly
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1675
    self changed:#subImageIn with:(imageBox expandedBy: 1).
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1676
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1677
    modified := true
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1678
!
54138b1b3efd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1855
diff changeset
  1679
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1680
undo
d53428252193 revised version
tz
parents: 633
diff changeset
  1681
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1682
    undoImages notEmpty ifTrue:[           
1374
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1683
        windowGroup withExecuteCursorDo:[
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1684
            modified := false. 
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1685
            self image: undoImages removeLast.
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1686
"/            "/ cg: what a kludge - please change to use a valueHolder,
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1687
"/            masterApplication notNil ifTrue:[
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1688
"/                masterApplication listOfColors contents: image colorMap.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1689
"/                masterApplication findColorMapMode.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1690
"/"/                undoImages isEmpty ifTrue: [
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1691
"/"/                    masterApplication valueOfCanUndo value: false
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1692
"/"/                ].
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1693
"/            ].
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1694
            self changed:#image.
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1695
1374
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1696
            "/ 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
  1697
"/            self invalidate
1374
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1698
        ]
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1699
    ]
1038
6c0bb03e88a1 no need to invalidate after assign of new image.
Claus Gittinger <cg@exept.de>
parents: 1037
diff changeset
  1700
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1701
    "Modified: / 10.2.2000 / 23:21:24 / cg"
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1702
! !
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1703
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1704
!ImageEditView methodsFor:'image setting'!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1705
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1706
image:anImage
1256
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1707
    |retVal fileName|
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1708
1256
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1709
    anImage isImage ifTrue:[           
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1710
        (image isNil or: [self checkModified]) ifTrue: [
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1711
"/ cg: that is too ugly ...
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1712
"/            masterApplication notNil ifTrue: [
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1713
"/"/                undoImages notEmpty ifTrue: [
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1714
"/"/                    masterApplication valueOfCanUndo value: true
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1715
"/"/                ].
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1716
"/                masterApplication imagePreView image: anImage
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1717
"/            ].
1256
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1718
            image notNil ifTrue: [
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1719
                fileName := image fileName.
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1720
                anImage fileName isNil ifTrue: [anImage fileName: fileName].
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1721
            ].
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1722
            super image: anImage.
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1723
            retVal := self.
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1724
        ].
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1725
    ] ifFalse: [
c4e0b9024475 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1246
diff changeset
  1726
        super image: nil.
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
  1727
    ].
1763
7d6d64622ee4 change & updates fixed (monochrome bitmaps)
Claus Gittinger <cg@exept.de>
parents: 1706
diff changeset
  1728
    "/cg: still a kludge, but less ugly
7d6d64622ee4 change & updates fixed (monochrome bitmaps)
Claus Gittinger <cg@exept.de>
parents: 1706
diff changeset
  1729
    self changed:#image.
1025
4470f3ad349f update the image label, when a new image is assigned.
Claus Gittinger <cg@exept.de>
parents: 1019
diff changeset
  1730
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
  1731
    self updateImageInfo: self imageInfoString. 
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
  1732
    ^ retVal
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
  1733
1693
5f8be1b4f856 de-uglified
Claus Gittinger <cg@exept.de>
parents: 1510
diff changeset
  1734
    "Modified: / 10.2.2000 / 23:33:12 / cg"
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1735
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1736
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1737
loadFromFile: aFileName
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1738
676
fd7918a3e6e6 load + preview redraw errors removed
tz
parents: 674
diff changeset
  1739
    aFileName isNil ifTrue: [^nil].
1774
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1740
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1741
    Object errorSignal handle:[:exeption|
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1742
        modified := false.
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1743
        self warn: exeption errorString.
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1744
        ^nil
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1745
    ] do:[ 
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1746
        |imageFromFile|
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1747
        (imageFromFile := Image fromFile: aFileName) notNil
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1748
        ifTrue:[
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1749
            self releaseUndos.
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1750
            self image: imageFromFile. 
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1751
            imageReaderClass := ImageReader allSubclasses
1865
49a47761ec76 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1861
diff changeset
  1752
                detect: [:cls| cls isValidImageFile: aFileName asFilename pathName]
1774
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1753
                ifNone: [self error: 'Unknown image file format!!']
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1754
        ] ifFalse:[
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1755
            self error: 'Not an image file (or unrecognized format) !!'
3e9f6af51746 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1764
diff changeset
  1756
        ]
676
fd7918a3e6e6 load + preview redraw errors removed
tz
parents: 674
diff changeset
  1757
    ]
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
  1758
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
  1759
    "Modified: / 29.7.1998 / 18:09:13 / cg"
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1760
!
255
1dfa8deddaef checkin from browser
Claus Gittinger <cg@exept.de>
parents: 251
diff changeset
  1761
633
594edef86630 revised version
tz
parents: 632
diff changeset
  1762
loadFromMessage: aMessage
594edef86630 revised version
tz
parents: 632
diff changeset
  1763
1781
b1078497810f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1774
diff changeset
  1764
    (self resourceMessage: aMessage) isNil ifTrue:[
b1078497810f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1774
diff changeset
  1765
        ^ nil
633
594edef86630 revised version
tz
parents: 632
diff changeset
  1766
    ].
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1767
633
594edef86630 revised version
tz
parents: 632
diff changeset
  1768
    ^self loadfromClass: resourceClass andSelector: resourceSelector
594edef86630 revised version
tz
parents: 632
diff changeset
  1769
594edef86630 revised version
tz
parents: 632
diff changeset
  1770
   
594edef86630 revised version
tz
parents: 632
diff changeset
  1771
!
594edef86630 revised version
tz
parents: 632
diff changeset
  1772
594edef86630 revised version
tz
parents: 632
diff changeset
  1773
loadfromClass: aClassOrSymbol andSelector: aStringOrSymbol
594edef86630 revised version
tz
parents: 632
diff changeset
  1774
678
9afa8810a8be image must not be nil after load failure
tz
parents: 676
diff changeset
  1775
    |aClass| 
9afa8810a8be image must not be nil after load failure
tz
parents: 676
diff changeset
  1776
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1777
    imageReaderClass := nil.
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1778
    self resourceClass: aClassOrSymbol.
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1779
    self resourceSelector: aStringOrSymbol.
678
9afa8810a8be image must not be nil after load failure
tz
parents: 676
diff changeset
  1780
2030
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1781
    (aClass := Smalltalk at: resourceClass) isClass ifTrue:[ 
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1782
        (aClass class implements: resourceSelector)
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1783
        ifTrue:
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1784
        [ 
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1785
            self releaseUndos.
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1786
            ^self image: (aClass perform: resourceSelector) copy
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1787
        ].
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1788
        (aClass implements: resourceSelector)
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1789
        ifTrue:
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1790
        [ 
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1791
            self releaseUndos.
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1792
            ^self image: (aClass basicNew perform: resourceSelector) copy
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1793
        ].
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1794
    ].
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1795
    modified := false.
3f5e2b7ec36a partial support for image-specs on the instance side
Claus Gittinger <cg@exept.de>
parents: 2021
diff changeset
  1796
    ^ nil
674
f24ca336b717 if none image found for loading clear image
tz
parents: 662
diff changeset
  1797
161
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  1798
! !
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  1799
1327
ab99aad206dc category change
Claus Gittinger <cg@exept.de>
parents: 1277
diff changeset
  1800
!ImageEditView methodsFor:'initialize / release'!
ab99aad206dc category change
Claus Gittinger <cg@exept.de>
parents: 1277
diff changeset
  1801
ab99aad206dc category change
Claus Gittinger <cg@exept.de>
parents: 1277
diff changeset
  1802
destroy
ab99aad206dc category change
Claus Gittinger <cg@exept.de>
parents: 1277
diff changeset
  1803
ab99aad206dc category change
Claus Gittinger <cg@exept.de>
parents: 1277
diff changeset
  1804
    ClipboardMagnification := Clipboard := nil.
ab99aad206dc category change
Claus Gittinger <cg@exept.de>
parents: 1277
diff changeset
  1805
    LastMagnification      := magnification.
ab99aad206dc category change
Claus Gittinger <cg@exept.de>
parents: 1277
diff changeset
  1806
ab99aad206dc category change
Claus Gittinger <cg@exept.de>
parents: 1277
diff changeset
  1807
    super destroy
ab99aad206dc category change
Claus Gittinger <cg@exept.de>
parents: 1277
diff changeset
  1808
ab99aad206dc category change
Claus Gittinger <cg@exept.de>
parents: 1277
diff changeset
  1809
!
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
  1810
161
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  1811
initialize
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1812
161
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  1813
    super initialize.
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1814
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
  1815
    self enableMotionEvents.
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1816
1374
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1817
    undoImages        := List new: MaxUndos.
1706
a954781f4440 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1693
diff changeset
  1818
    magnification     := LastMagnification ? (8@8).
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1819
    modified          := false.
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1820
    mouseKeyColorMode := 1.
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1821
    resourceClass     := resourceSelector := ''.
2009
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
  1822
    drawingColorHolders := Array with:(nil asValue) with:(nil asValue).   "/ left/right mouse colors
4f556ff9fec5 pick with SHIFT-click in the mag-view
Claus Gittinger <cg@exept.de>
parents: 2007
diff changeset
  1823
    drawingPixelHolders := Array with:(nil asValue) with:(nil asValue).   "/ left/right mouse colors
1106
57c41df67ae5 support radio buttons of the ImageEditor
tz
parents: 1104
diff changeset
  1824
    editMode          := #point.
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
  1825
! !
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
  1826
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1827
!ImageEditView methodsFor:'printing & storing'!
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
  1828
1994
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1829
askForFileNameToSave:msg
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1830
    "ask for a fileName"
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1831
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1832
    |lastFn fn filters|
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1833
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1834
    filters := FileSelectionBrowser saveImageFileNameFilters.
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1835
    lastFn := self image fileName.
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1836
    lastFn isNil ifTrue:[
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1837
        fn := FileSelectionBrowser
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1838
                request: msg
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1839
                inDirectory: LastSaveDirectory
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1840
                withFileFilters: filters
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1841
    ] ifFalse:[
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1842
        fn := FileSelectionBrowser
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1843
                request: msg
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1844
                fileName: lastFn
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1845
                withFileFilters: filters
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1846
    ].
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1847
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1848
    ^ fn
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1849
!
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1850
724
d6f4b89940ed undo disabling
tz
parents: 704
diff changeset
  1851
loadFromClass
404
322e32d8f099 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 398
diff changeset
  1852
676
fd7918a3e6e6 load + preview redraw errors removed
tz
parents: 674
diff changeset
  1853
    ^self loadFromMessage: 
1184
58e399d8c312 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1180
diff changeset
  1854
        (ResourceSelectionBrowser
58e399d8c312 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1180
diff changeset
  1855
            request: 'Load Image From Class'
58e399d8c312 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1180
diff changeset
  1856
            onSuperclass: nil
58e399d8c312 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1180
diff changeset
  1857
            andClass: self resourceClass
58e399d8c312 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1180
diff changeset
  1858
            andSelector: self resourceSelector
58e399d8c312 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1180
diff changeset
  1859
            withResourceTypes: #(image fileImage programImage))
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1860
            
477
37f12d35c359 added #resize.
Claus Gittinger <cg@exept.de>
parents: 430
diff changeset
  1861
161
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  1862
!
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  1863
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1864
makeUndo
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1865
1374
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1866
    image notNil ifTrue:[       
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1867
        undoImages size >= MaxUndos ifTrue:[
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1868
            undoImages removeFirst.
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1869
        ].
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  1870
        undoImages add: image copy
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1871
    ]
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1872
!
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  1873
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1874
print
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1875
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
  1876
    image notNil 
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
  1877
    ifTrue: 
636
d53428252193 revised version
tz
parents: 633
diff changeset
  1878
    [
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1879
	|stream|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1880
	Printer supportsPostscript ifFalse:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1881
	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1882
	    ^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
  1883
	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1884
	stream := Printer newNative.
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1885
	stream isNil ifTrue:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1886
	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1887
	    ^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
  1888
	].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1889
	self withWaitCursorDo:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1890
	[
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1891
	    |psgc|
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1892
	    psgc := PSGraphicsContext on:stream.  
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1893
	    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
  1894
	    psgc close
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  1895
	]
398
7b7255a4db0d show a wait cursor while printing
Claus Gittinger <cg@exept.de>
parents: 362
diff changeset
  1896
    ]
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1897
!
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1898
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1899
save
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1900
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  1901
    self saveImageOrMask: #image.
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  1902
624
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1903
!
d98fe4700fc2 checkin from browser
tz
parents: 606
diff changeset
  1904
2239
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  1905
save:image imageOrMask:what
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  1906
    "save the image or the mask only (if what == #mask)"
297
d733af1b0ffe better saving functions;
Claus Gittinger <cg@exept.de>
parents: 296
diff changeset
  1907
2239
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  1908
    image isNil ifTrue:[
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  1909
        Dialog warn: 'No image to save!!'.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  1910
        ^ self.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  1911
    ].
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  1912
    self save:image imageOrMask:what as:image fileName.
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  1913
!
297
d733af1b0ffe better saving functions;
Claus Gittinger <cg@exept.de>
parents: 296
diff changeset
  1914
2239
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  1915
save:image imageOrMask:what as:fileNameArg
1158
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1916
    "save the image or the mask only (if what == #mask)"
628
7f36d8a7735f popup menu starts image editor
tz
parents: 627
diff changeset
  1917
2240
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1918
    |fileName fileNameString|
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1919
2239
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  1920
    fileName := fileNameArg asFilename.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  1921
1158
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1922
    Object errorSignal handle:[:ex|
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1923
        |msg|
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1924
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1925
        ex signal == Image fileCreationErrorSignal ifTrue:[
1896
0f430b35c451 asText allBold -> allBold
Claus Gittinger <cg@exept.de>
parents: 1888
diff changeset
  1926
            msg := resources string:'Cannot create file: ''%1''' with:fileName asFilename pathName allBold
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1927
        ] ifFalse:[
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1928
            msg := ex errorString.
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1929
        ].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1930
        Dialog warn:msg.
1158
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1931
    ] do:[   
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1932
        Image informationLostQuerySignal handle:[:ex|
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1933
            "/ should make those warnings visible ...
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1934
            (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
  1935
                ex proceed.
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1936
            ]
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1937
        ] do:[   
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1938
            windowGroup withCursor:Cursor write do:[
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1939
                |suff fn|
1027
5bffbe90b8e2 show a wait-cursor while saving
Claus Gittinger <cg@exept.de>
parents: 1025
diff changeset
  1940
1158
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1941
                image isNil ifTrue:[
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1942
                    ^ self error: 'No image to save!!'
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1943
                ].
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  1944
1158
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1945
                what = #mask ifTrue:[   
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1946
                    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
  1947
                ].
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1948
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  1949
                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
  1950
                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
  1951
                imageReaderClass := nil.
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1952
                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
  1953
"/                (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
  1954
"/                    imageReaderClass := TIFFReader
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1955
"/                ] ifFalse:[
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1956
"/                    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
  1957
"/                        imageReaderClass := XPMReader
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1958
"/                    ] ifFalse:[
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1959
"/                        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
  1960
"/                            imageReaderClass := XBMReader
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1961
"/                        ] ifFalse:[
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1962
"/                            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
  1963
"/                                imageReaderClass := GIFReader
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1964
"/                            ] ifFalse:[
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1965
"/                                (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
  1966
"/                                    imageReaderClass := JPEGReader
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1967
"/                                ].
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1968
"/                            ]
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1969
"/                        ]
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1970
"/                    ]
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1971
"/                ].
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1972
1373
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1973
                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
  1974
                    imageReaderClass := XPMReader. 
2240
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1975
                    fileNameString := fileName, '.xpm'.
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1976
                    fileName := fileNameString asFilename.
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1977
                    image fileName:fileNameString.
1373
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1978
                    Dialog warn:(('Dont know how to write ''.' , suff , '''-files\\Saving in xpm format as ''%1''.') 
2240
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1979
                                withCRs bindWith:fileNameString allBold).
1373
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1980
                ].
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1981
                (imageReaderClass canRepresent:image) ifFalse:[
1991
fff8dc641cff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1987
diff changeset
  1982
                    imageReaderClass == XPMReader ifTrue:[
fff8dc641cff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1987
diff changeset
  1983
                        Dialog warn:('Saving in ''.' , suff , '''-format is not supported (or image cannot be represented in this format).\\Please try another format.') withCRs.
fff8dc641cff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1987
diff changeset
  1984
                        ^ self.
fff8dc641cff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1987
diff changeset
  1985
                    ].
1373
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1986
                    imageReaderClass := XPMReader. 
2240
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1987
                    fileNameString := fileName, '.xpm'.
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1988
                    fileName := fileNameString asFilename.
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1989
                    image fileName:fileNameString.
1991
fff8dc641cff *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1987
diff changeset
  1990
                    Dialog warn:(('Saving in ''.' , suff , '''-format is not supported (or image cannot be represented in this format).\\Saving in xpm format as ''%1''.') 
2240
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1991
                                withCRs bindWith:fileNameString allBold).
1373
c949e9f7757c give a warning, if saving in the given file-format is not
Claus Gittinger <cg@exept.de>
parents: 1327
diff changeset
  1992
                ].
2240
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1993
                Transcript showCR:('saving as:' , fileName pathName).
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1994
1994
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  1995
                what = #image ifTrue: [ image saveOn:fileName using: imageReaderClass. modified := false].
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1996
                what = #mask ifTrue: [image mask saveOn:fileName using: imageReaderClass].
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  1997
2240
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1998
                LastSaveDirectory := fileName directoryName.
2e9ad39f11c8 checkin from browser
ca
parents: 2239
diff changeset
  1999
                fileName exists ifFalse:[
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  2000
                    Dialog warn:'Oops image save failed.'
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  2001
                ]
1158
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  2002
            ]   
9b413954d34d issue a warning, if information (mask) is
Claus Gittinger <cg@exept.de>
parents: 1121
diff changeset
  2003
        ]
1027
5bffbe90b8e2 show a wait-cursor while saving
Claus Gittinger <cg@exept.de>
parents: 1025
diff changeset
  2004
    ]
5bffbe90b8e2 show a wait-cursor while saving
Claus Gittinger <cg@exept.de>
parents: 1025
diff changeset
  2005
1380
3b343d2e69ef fixed copy-paste with masked images.
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
  2006
    "Modified: / 18.5.1999 / 19:46:54 / cg"
633
594edef86630 revised version
tz
parents: 632
diff changeset
  2007
!
594edef86630 revised version
tz
parents: 632
diff changeset
  2008
2239
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2009
saveAs
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2010
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2011
    self saveImageFileAs
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2012
!
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2013
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2014
saveButtonImageToFileAs
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2015
    |fn|
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2016
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2017
    fn := self askForFileNameToSave:'Save Button Image to File'.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2018
    self saveButtonImageToFileAs:fn
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2019
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2020
    "Modified: / 30.9.1998 / 23:04:11 / cg"
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2021
!
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2022
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2023
saveButtonImageToFileAs: aFileName
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2024
    "save the image as if in a button in aFileName"
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2025
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2026
    |button grabbedImage|
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2027
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2028
    aFileName isNil ifTrue: [^nil].
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2029
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2030
    image isNil ifTrue:[
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2031
        self warn: 'No image or image mask detected!!'.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2032
        ^ self.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2033
    ].
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2034
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2035
    button := Button label:image.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2036
    button openAt:5@5.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2037
    button waitUntilVisible.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2038
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2039
    grabbedImage := Image fromView:button.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2040
    button destroy.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2041
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2042
    self save:grabbedImage imageOrMask:#image as:aFileName
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2043
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2044
    "/ self saveImageOrMask: #mask
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2045
!
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2046
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2047
saveImageFileAs
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2048
    "ask for a fileName and save the image"
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2049
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2050
    |fn|
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2051
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2052
    fn := self askForFileNameToSave:'Save Image To File'.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2053
    self saveImageFileAs:fn
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2054
!
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2055
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2056
saveImageFileAs: aFileName
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2057
    "save the image in aFileName"
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2058
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2059
    aFileName isNil ifTrue: [^nil].
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2060
    image notNil ifTrue:[
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2061
        self save:image imageOrMask:#image as:aFileName.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2062
    ] ifFalse:[
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2063
        self warn: 'No image for saving!!'
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2064
    ]
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2065
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2066
    "Modified: / 30.9.1998 / 23:04:55 / cg"
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2067
!
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2068
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2069
saveImageMaskFileAs
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2070
    "ask for a fileName and save the mask only"
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2071
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2072
    |fn|
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2073
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2074
    fn := self askForFileNameToSave:'Save Image Mask To File'.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2075
    self saveImageMaskFileAs:fn
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2076
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2077
    "Modified: / 30.9.1998 / 23:04:11 / cg"
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2078
!
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2079
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2080
saveImageMaskFileAs: aFileName
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2081
    "save the mask only in aFileName"
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2082
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2083
    aFileName isNil ifTrue: [^nil].
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2084
    (image notNil and:[image mask notNil]) ifTrue:[
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2085
        self save:image imageOrMask:#mask as:aFileName.
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2086
    ] ifFalse:[
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2087
        self warn: 'No image or image mask detected!!'
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2088
    ]
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2089
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2090
    "Modified: / 30.9.1998 / 23:06:24 / cg"
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2091
!
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2092
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2093
saveImageOrMask:what
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2094
    "save the image or the mask only (if what == #mask)"
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2095
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2096
    self save:image imageOrMask: what
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2097
!
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2098
633
594edef86630 revised version
tz
parents: 632
diff changeset
  2099
saveMethod
1994
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2100
    Object errorSignal handle:[:ex|
1882
fbb4a3a869f1 made image-method generator a class method (for reusability)
martin
parents: 1875
diff changeset
  2101
        self warn: ex errorString.
fbb4a3a869f1 made image-method generator a class method (for reusability)
martin
parents: 1875
diff changeset
  2102
        ^nil                                 
1994
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2103
    ] do: [   
1882
fbb4a3a869f1 made image-method generator a class method (for reusability)
martin
parents: 1875
diff changeset
  2104
        |category imageStoreStream cls sel mthd imageKey|
822
cace81f0a86b do not overwrite method categories + toggle between mouse button colors
tz
parents: 796
diff changeset
  2105
1882
fbb4a3a869f1 made image-method generator a class method (for reusability)
martin
parents: 1875
diff changeset
  2106
        windowGroup withExecuteCursorDo:[
2321
a35161597f7b saveMethod fixed
Michael Beyl <mb@exept.de>
parents: 2277
diff changeset
  2107
            (self resourceSelector trimBlanks size = 0) | (cls := Smalltalk at: self resourceClass asSymbol) isClass not 
1882
fbb4a3a869f1 made image-method generator a class method (for reusability)
martin
parents: 1875
diff changeset
  2108
                ifTrue: [^self saveMethodAs].
822
cace81f0a86b do not overwrite method categories + toggle between mouse button colors
tz
parents: 796
diff changeset
  2109
2149
04e8367eaf70 code generation moved to CodeGeneratorTool
Claus Gittinger <cg@exept.de>
parents: 2135
diff changeset
  2110
            CodeGeneratorTool
04e8367eaf70 code generation moved to CodeGeneratorTool
Claus Gittinger <cg@exept.de>
parents: 2135
diff changeset
  2111
                createImageSpecMethodFor:self image 
1882
fbb4a3a869f1 made image-method generator a class method (for reusability)
martin
parents: 1875
diff changeset
  2112
                comment:(ResourceSpecEditor codeGenerationCommentForClass: ImageEditor) 
2149
04e8367eaf70 code generation moved to CodeGeneratorTool
Claus Gittinger <cg@exept.de>
parents: 2135
diff changeset
  2113
                in:cls class 
1882
fbb4a3a869f1 made image-method generator a class method (for reusability)
martin
parents: 1875
diff changeset
  2114
                selector:self resourceSelector.
822
cace81f0a86b do not overwrite method categories + toggle between mouse button colors
tz
parents: 796
diff changeset
  2115
1901
b4b286ec221f flush cached icons, when defining a new image-method
Claus Gittinger <cg@exept.de>
parents: 1896
diff changeset
  2116
            "/ flush cache images in the Icon class (kludge)
b4b286ec221f flush cached icons, when defining a new image-method
Claus Gittinger <cg@exept.de>
parents: 1896
diff changeset
  2117
            Icon flushCachedIcons.
1994
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2118
            modified := false.
1901
b4b286ec221f flush cached icons, when defining a new image-method
Claus Gittinger <cg@exept.de>
parents: 1896
diff changeset
  2119
1994
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2120
            LastSaveClass := cls theNonMetaclass name.
1882
fbb4a3a869f1 made image-method generator a class method (for reusability)
martin
parents: 1875
diff changeset
  2121
        ]
633
594edef86630 revised version
tz
parents: 632
diff changeset
  2122
    ]
1027
5bffbe90b8e2 show a wait-cursor while saving
Claus Gittinger <cg@exept.de>
parents: 1025
diff changeset
  2123
1047
95f10ea8653d use #withExecuteCursorDo:
Claus Gittinger <cg@exept.de>
parents: 1038
diff changeset
  2124
    "Modified: / 31.7.1998 / 20:12:54 / cg"
633
594edef86630 revised version
tz
parents: 632
diff changeset
  2125
!
594edef86630 revised version
tz
parents: 632
diff changeset
  2126
594edef86630 revised version
tz
parents: 632
diff changeset
  2127
saveMethodAs
1994
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2128
    |className|
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2129
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2130
    className := self resourceClass.
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2131
    className size == 0 ifTrue:[
2177
340ce04ccc78 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2172
diff changeset
  2132
        className := LastSaveClass
1994
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2133
    ].
633
594edef86630 revised version
tz
parents: 632
diff changeset
  2134
636
d53428252193 revised version
tz
parents: 633
diff changeset
  2135
    (self resourceMessage:
1994
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2136
        (ResourceSelectionBrowser
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2137
            request: 'Save Image In Class'
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2138
            onSuperclass: #Object
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2139
            andClass: className
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2140
            andSelector: self resourceSelector
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2141
            withResourceTypes: #(image fileImage))) notNil
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2142
    ifTrue: [   
d2d9228d38ec *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1992
diff changeset
  2143
        ^ self saveMethod
674
f24ca336b717 if none image found for loading clear image
tz
parents: 662
diff changeset
  2144
    ].  
633
594edef86630 revised version
tz
parents: 632
diff changeset
  2145
    ^nil
1
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
  2146
! !
c6ca7bfedf31 Initial revision
claus
parents:
diff changeset
  2147
161
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  2148
!ImageEditView methodsFor:'queries'!
5
be72e6ba4822 *** empty log message ***
claus
parents: 1
diff changeset
  2149
161
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  2150
heightOfContents
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  2151
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
  2152
    image isNil ifTrue:[^0].
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
  2153
    ^(image height * magnification y) rounded
5
be72e6ba4822 *** empty log message ***
claus
parents: 1
diff changeset
  2154
!
be72e6ba4822 *** empty log message ***
claus
parents: 1
diff changeset
  2155
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2156
imageContainsPastePoint: aPoint
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2157
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2158
    ^image notNil and: 
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  2159
	[Clipboard notNil and:
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  2160
	[((0@0 corner:(image extent) "- 1" - Clipboard extent) containsPoint: (((aPoint - margin + 1) / magnification) floor))]]
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2161
!
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2162
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  2163
imageContainsPoint: aPoint
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2164
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2165
    ^image notNil and:
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  2166
	[((0@0 corner:(image extent) - 1) containsPoint: (((aPoint - margin + 1) / magnification) floor))]
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  2167
!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  2168
783
c81a097b84b8 revised version
tz
parents: 747
diff changeset
  2169
imageInfoString
c81a097b84b8 revised version
tz
parents: 747
diff changeset
  2170
c81a097b84b8 revised version
tz
parents: 747
diff changeset
  2171
    |imageInfoString usedColors|
1011
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  2172
325d334e93c8 added paste-under (only paste where pixel ~= current selected)
Claus Gittinger <cg@exept.de>
parents: 1006
diff changeset
  2173
    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
  2174
    ifFalse: [
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  2175
	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
  2176
	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
  2177
	    , image height printString, 'x'
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  2178
	    , (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
  2179
	    , (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
  2180
	    , usedColors printString
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  2181
	    , ' used colors)'].
783
c81a097b84b8 revised version
tz
parents: 747
diff changeset
  2182
c81a097b84b8 revised version
tz
parents: 747
diff changeset
  2183
    ^imageInfoString
c81a097b84b8 revised version
tz
parents: 747
diff changeset
  2184
!
c81a097b84b8 revised version
tz
parents: 747
diff changeset
  2185
161
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  2186
widthOfContents
5
be72e6ba4822 *** empty log message ***
claus
parents: 1
diff changeset
  2187
686
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
  2188
    image isNil ifTrue:[^0].
33833bcbb5cd some cleans
tz
parents: 678
diff changeset
  2189
    ^(image width * magnification x) rounded
5
be72e6ba4822 *** empty log message ***
claus
parents: 1
diff changeset
  2190
! !
be72e6ba4822 *** empty log message ***
claus
parents: 1
diff changeset
  2191
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  2192
!ImageEditView methodsFor:'release'!
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  2193
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2194
releasePasteDrawing
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2195
2085
4cf52f994f0a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2196
    self repairDamage.
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2197
    (lastPastePoint notNil and: [ClipboardMagnification notNil]) 
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2198
    ifTrue: 
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2199
    [ 
2085
4cf52f994f0a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2200
        self redraw: ((lastPastePoint"-self viewOrigin") extent: (ClipboardMagnification extent)). 
4cf52f994f0a checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  2201
        "/ self repairDamage.
995
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2202
    ].
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2203
    lastPastePoint := ClipboardMagnification := nil
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2204
!
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2205
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2206
releaseUndos
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2207
cd84d6f8c449 several undos
tz
parents: 994
diff changeset
  2208
    undoImages removeAll.
1038
6c0bb03e88a1 no need to invalidate after assign of new image.
Claus Gittinger <cg@exept.de>
parents: 1037
diff changeset
  2209
    "/ cg: what a kludge - please change to use a valueHolder,
1374
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  2210
"/    masterApplication notNil ifTrue:[
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  2211
"/        masterApplication valueOfCanUndo value: false.
44f511c341c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1373
diff changeset
  2212
"/    ].
1038
6c0bb03e88a1 no need to invalidate after assign of new image.
Claus Gittinger <cg@exept.de>
parents: 1037
diff changeset
  2213
6c0bb03e88a1 no need to invalidate after assign of new image.
Claus Gittinger <cg@exept.de>
parents: 1037
diff changeset
  2214
    "Modified: / 31.7.1998 / 02:47:21 / cg"
627
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  2215
! !
e0bf28f61361 many many fixes/enhancements
tz
parents: 624
diff changeset
  2216
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2217
!ImageEditView methodsFor:'testing'!
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2218
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2219
checkModified
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2220
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2221
    modified
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2222
    ifTrue:
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2223
    [
1116
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  2224
	((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
  2225
	    noText:(resources string:'Cancel');
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  2226
	    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
  2227
	    showAtPointer;
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  2228
	    accepted) ifFalse: [^false].
441ff42c1472 fixes to allow 24bit images to be (at least) displayed
Claus Gittinger <cg@exept.de>
parents: 1106
diff changeset
  2229
	modified := false
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2230
    ].
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2231
    ^true
1031
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
  2232
a5ab5869b2ba cleaned up the interface to the apps infoPanel
Claus Gittinger <cg@exept.de>
parents: 1030
diff changeset
  2233
    "Modified: / 29.7.1998 / 18:55:24 / cg"
632
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2234
! !
be1ac8ea33a7 checkin from browser
tz
parents: 628
diff changeset
  2235
255
1dfa8deddaef checkin from browser
Claus Gittinger <cg@exept.de>
parents: 251
diff changeset
  2236
!ImageEditView class methodsFor:'documentation'!
161
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  2237
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  2238
version
2349
4cf7b4f1345e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2338
diff changeset
  2239
    ^ '$Header: /cvs/stx/stx/libwidg2/ImageEditView.st,v 1.173 2002-11-02 18:31:49 cg Exp $'
161
5b6e284959a4 examples
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
  2240
! !
2239
d2f65f84f314 saveAsButtonImage added
ca
parents: 2177
diff changeset
  2241
1245
68581e6aaf23 code cleanup
Claus Gittinger <cg@exept.de>
parents: 1228
diff changeset
  2242
ImageEditView initialize!