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