ImageSelectionBox.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Fri, 14 Jun 2019 12:46:37 +0100
branchjv
changeset 6069 bc60050be743
parent 4770 6634b540fea2
permissions -rw-r--r--
Add test for UTF-8 output in `TerminalView` on UNIX
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
64
claus
parents:
diff changeset
     1
"
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1995 by Claus Gittinger
claus
parents:
diff changeset
     3
	      All Rights Reserved
claus
parents:
diff changeset
     4
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
claus
parents:
diff changeset
    10
 hereby transferred.
claus
parents:
diff changeset
    11
"
4770
6634b540fea2 Added PluggableHierarchicalList to define ad-hoc tree models.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3150
diff changeset
    12
"{ Package: 'stx:libwidg2' }"
64
claus
parents:
diff changeset
    13
4770
6634b540fea2 Added PluggableHierarchicalList to define ad-hoc tree models.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3150
diff changeset
    14
"{ NameSpace: Smalltalk }"
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
    15
64
claus
parents:
diff changeset
    16
FileSelectionBox subclass:#ImageSelectionBox
202
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    17
	instanceVariableNames:'previewField preview info'
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    18
	classVariableNames:''
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    19
	poolDictionaries:''
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
    20
	category:'Views-DialogBoxes'
64
claus
parents:
diff changeset
    21
!
claus
parents:
diff changeset
    22
4770
6634b540fea2 Added PluggableHierarchicalList to define ad-hoc tree models.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3150
diff changeset
    23
!ImageSelectionBox class methodsFor:'documentation'!
64
claus
parents:
diff changeset
    24
claus
parents:
diff changeset
    25
copyright
claus
parents:
diff changeset
    26
"
claus
parents:
diff changeset
    27
 COPYRIGHT (c) 1995 by Claus Gittinger
claus
parents:
diff changeset
    28
	      All Rights Reserved
claus
parents:
diff changeset
    29
claus
parents:
diff changeset
    30
 This software is furnished under a license and may be used
claus
parents:
diff changeset
    31
 only in accordance with the terms of that license and with the
claus
parents:
diff changeset
    32
 inclusion of the above copyright notice.   This software may not
claus
parents:
diff changeset
    33
 be provided or otherwise made available to, or used by, any
claus
parents:
diff changeset
    34
 other person.  No title to or ownership of the software is
claus
parents:
diff changeset
    35
 hereby transferred.
claus
parents:
diff changeset
    36
"
claus
parents:
diff changeset
    37
!
claus
parents:
diff changeset
    38
claus
parents:
diff changeset
    39
documentation
claus
parents:
diff changeset
    40
"
claus
parents:
diff changeset
    41
    Like a fileSelectionBox, but adds a little preview field.
claus
parents:
diff changeset
    42
    Nice.
claus
parents:
diff changeset
    43
"
claus
parents:
diff changeset
    44
! !
claus
parents:
diff changeset
    45
claus
parents:
diff changeset
    46
!ImageSelectionBox methodsFor:'initialization'!
claus
parents:
diff changeset
    47
claus
parents:
diff changeset
    48
initialize
claus
parents:
diff changeset
    49
    |v check lw lh prefY frame previewSize|
claus
parents:
diff changeset
    50
claus
parents:
diff changeset
    51
    previewSize := 64@64.
claus
parents:
diff changeset
    52
claus
parents:
diff changeset
    53
    super initialize.
claus
parents:
diff changeset
    54
72
claus
parents: 64
diff changeset
    55
    label := (resources string:'Image dialog').
64
claus
parents:
diff changeset
    56
    labelField label:(resources string:'select an image file:').
claus
parents:
diff changeset
    57
claus
parents:
diff changeset
    58
    prefY := buttonPanel preferredExtent y.
claus
parents:
diff changeset
    59
claus
parents:
diff changeset
    60
    check := CheckBox label:(resources string:'preview') in:self.
claus
parents:
diff changeset
    61
    check model:(preview := false asValue).
claus
parents:
diff changeset
    62
    preview onChangeSend:#showPreview to:self.
claus
parents:
diff changeset
    63
    info := Label label:'' in:self.
claus
parents:
diff changeset
    64
    info adjust:#left.
claus
parents:
diff changeset
    65
claus
parents:
diff changeset
    66
    lh := check preferredExtent y.
claus
parents:
diff changeset
    67
    lw := check preferredExtent x.
claus
parents:
diff changeset
    68
claus
parents:
diff changeset
    69
    check
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
    70
	origin:(0.0 @ 1.0)
64
claus
parents:
diff changeset
    71
	corner:(0.0 @ 1.0).
claus
parents:
diff changeset
    72
    check
claus
parents:
diff changeset
    73
	topInset:(prefY + ViewSpacing + previewSize y) negated;
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
    74
	bottomInset:(prefY + ViewSpacing + (previewSize y - check preferredExtent y));
64
claus
parents:
diff changeset
    75
	rightInset:(ViewSpacing + lw) negated.
claus
parents:
diff changeset
    76
claus
parents:
diff changeset
    77
    info
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
    78
	origin:(0.0 @ 1.0)
64
claus
parents:
diff changeset
    79
	corner:(1.0 @ 1.0).
claus
parents:
diff changeset
    80
    info
claus
parents:
diff changeset
    81
	topInset:(prefY + ViewSpacing + info preferredExtent y + ViewSpacing) negated;
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
    82
	bottomInset:(prefY + ViewSpacing);
64
claus
parents:
diff changeset
    83
	leftInset:ViewSpacing;
claus
parents:
diff changeset
    84
	rightInset:(ViewSpacing + previewSize x + ViewSpacing) negated.
claus
parents:
diff changeset
    85
claus
parents:
diff changeset
    86
    StyleSheet is3D ifTrue:[
claus
parents:
diff changeset
    87
	v := View in:self.
claus
parents:
diff changeset
    88
	previewField := Label origin:0.0@0.0 corner:1.0@1.0 in:v.
claus
parents:
diff changeset
    89
	previewField allInset:ViewSpacing//2.
claus
parents:
diff changeset
    90
	frame := v.
claus
parents:
diff changeset
    91
	previewField level:-1.
claus
parents:
diff changeset
    92
	frame level:1.
claus
parents:
diff changeset
    93
    ] ifFalse:[
claus
parents:
diff changeset
    94
	previewField := frame := Label in:self.
claus
parents:
diff changeset
    95
    ].
claus
parents:
diff changeset
    96
    frame
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
    97
	origin:(1.0 @ 1.0)
64
claus
parents:
diff changeset
    98
	corner:(1.0 @ 1.0).
claus
parents:
diff changeset
    99
    frame
claus
parents:
diff changeset
   100
	topInset:(prefY + ViewSpacing + previewSize y + (frame borderWidth * 2)) negated;
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   101
	bottomInset:(prefY + frame borderWidth + ViewSpacing);
64
claus
parents:
diff changeset
   102
	leftInset:(ViewSpacing + previewSize x + ViewSpacing) negated;
claus
parents:
diff changeset
   103
	rightInset:ViewSpacing.
claus
parents:
diff changeset
   104
    previewField sizeFixed:true.
claus
parents:
diff changeset
   105
claus
parents:
diff changeset
   106
    selectionList superView
claus
parents:
diff changeset
   107
	bottomInset:(prefY + ViewSpacing + previewSize y + (frame borderWidth * 2) + ViewSpacing).
claus
parents:
diff changeset
   108
! !
claus
parents:
diff changeset
   109
202
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   110
!ImageSelectionBox methodsFor:'user actions'!
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   111
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   112
selectionChanged
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   113
    "selections in list show the image"
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   114
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   115
    super selectionChanged.
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   116
    self showPreview
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   117
!
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   118
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   119
showPreview
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   120
    "show the image as thumbNail"
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   121
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   122
    |fileNameString fileName image|
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   123
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   124
    previewField label:nil.
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   125
    info label:nil.
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   126
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   127
    preview value ifFalse:[
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   128
	^ self
202
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   129
    ].
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   130
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   131
    "
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   132
     show the image in the previewLabel
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   133
    "
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   134
    fileNameString := self contents.
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   135
    (fileNameString notNil and:[fileNameString notEmpty]) ifTrue:[
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   136
	fileName := fileNameString asFilename.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   137
	(fileName exists
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   138
	and:[fileName isDirectory not
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   139
	and:[fileName isReadable]]) ifTrue:[
202
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   140
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   141
	    self topView withWaitCursorDo:[
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   142
		image := Image fromFile:fileNameString.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   143
		image notNil ifTrue:[
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   144
		    info label:(resources string:'%1 x %2'
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   145
					  with:image width printString
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   146
					  with:image height printString),
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   147
			       (resources string:' Depth:%1'
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   148
					    with:image depth printString),
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   149
			       (resources string:' (%1)'
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   150
					    with:image photometric printString).
202
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   151
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   152
		    (image width <= 64 and:[image height <= 64]) ifFalse:[
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   153
			image := image magnifiedPreservingRatioTo:64@64.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   154
		    ].
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   155
		    "
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   156
		     for the thumbNail picture,
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   157
		     we can temporarily switch to a rough dither.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   158
		     (this speeds up the thing quite a bit
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   159
		    "
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   160
		    (image depth > 2
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   161
		    and:[device fixColors isNil]) ifTrue:[
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   162
			"temporarily go to a 3x3x2 colormap ..."
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   163
			Object errorSignal handle:[:ex |
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   164
			    'very low resolution colors' infoPrintNL.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   165
			    Object errorSignal handle:[:ex |
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   166
				'cannot allocate dither colors' infoPrintNL.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   167
				ex return
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   168
			    ] do:[
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   169
				Color getColorsRed:2 green:2 blue:2 on:device.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   170
			    ]
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   171
			] do:[
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   172
			    Color getColorsRed:5 green:5 blue:3 on:device.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   173
			].
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   174
			previewField label:image.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   175
			device releaseFixColors.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   176
		    ] ifFalse:[
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   177
			previewField label:image.
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   178
		    ]
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   179
		]
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   180
	    ]
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   181
	]
202
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   182
    ]
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   183
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   184
    "Modified: 7.6.1996 / 12:25:19 / cg"
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   185
! !
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   186
4770
6634b540fea2 Added PluggableHierarchicalList to define ad-hoc tree models.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3150
diff changeset
   187
!ImageSelectionBox class methodsFor:'documentation'!
202
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   188
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   189
version
3150
e3a55f15ef7e package information
Claus Gittinger <cg@exept.de>
parents: 233
diff changeset
   190
    ^ '$Header: /cvs/stx/stx/libwidg2/ImageSelectionBox.st,v 1.6 2006-11-13 16:11:30 cg Exp $'
202
e00b0bb1d439 show photometric
Claus Gittinger <cg@exept.de>
parents: 86
diff changeset
   191
! !
4770
6634b540fea2 Added PluggableHierarchicalList to define ad-hoc tree models.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 3150
diff changeset
   192