DragRectangleController.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Fri, 26 Jan 2018 11:43:24 +0000
branchjv
changeset 6279 232954e959f7
parent 6039 5db22cb319e3
child 6087 0c7c2f8ebcb8
permissions -rw-r--r--
Fixed `PopUpList` widget to display correctly non-string objects ...using their `#displayOn:x:y:` / or `#displayString`. The popup menu shown the `#displayString` correctly however the "button" stubbornly used object's `#printString`, making the widget largely unusable with anything but strings. This commit removes this limitation.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6039
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 2017 by eXept Software AG
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
              All Rights Reserved
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
"{ Package: 'stx:libwidg' }"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
"{ NameSpace: Smalltalk }"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
ButtonController subclass:#DragRectangleController
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	instanceVariableNames:'action startPoint lastX lastY'
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	classVariableNames:''
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	poolDictionaries:''
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	category:'Interface-Support-Controllers'
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
!DragRectangleController class methodsFor:'documentation'!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
copyright
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
 COPYRIGHT (c) 2017 by eXept Software AG
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
              All Rights Reserved
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
 This software is furnished under a license and may be used
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
 only in accordance with the terms of that license and with the
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
 inclusion of the above copyright notice.   This software may not
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 be provided or otherwise made available to, or used by, any
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
 other person.  No title to or ownership of the software is
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
 hereby transferred.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
documentation
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    drags a rectangle
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
examples
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    |v c|
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
    v := View new openAndWait.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    c := DragRectangleController new.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
    c action:[:rect | Transcript showCR:rect ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
    v openAndWait.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
    
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
    v controller:c.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
! !
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
!DragRectangleController class methodsFor:'utilities'!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
dragRectangleIn:aView thenDo:action
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
    "drag a rectangle in aView"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
    
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
    |dragController oldController oldCursor|
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
    
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
    dragController := DragRectangleController new.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
    dragController view:aView.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
    oldController := aView controller.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
    oldCursor := aView cursor.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
    aView cursor:Cursor origin.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
    dragController action:[:rectOrNil |
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
        |image|
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
        aView controller:oldController.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
        aView cursor:oldCursor.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
        action value:rectOrNil.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
    ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
    
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
    aView controller:dragController.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
! !
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
!DragRectangleController methodsFor:'accessing'!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
action:aBlock
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
    "set the block which will be called when the rectangle drag is finished.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
     The block will be called with a nil arg, if escape is pressed"
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
     
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
    action := aBlock
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
lastMousePoint
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
    lastX isNil ifTrue:[^ nil].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
    ^ lastX @ lastY
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
startPoint
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
    ^ startPoint
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
! !
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
!DragRectangleController methodsFor:'event handling'!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
buttonMotion:buttonState x:x y:y
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
    (buttonState == 0 or:[startPoint isNil]) ifTrue:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
        super buttonMotion:buttonState x:x y:y.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
        ^ self
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
    ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
    
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
    lastX notNil ifTrue:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
        view xoring:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
            view displayRectangle:(startPoint corner:(lastX@lastY))
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
        ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
    ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
    
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
    lastX := x.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
    lastY := y.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
    startPoint ~= (x@y) ifTrue:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
        view xoring:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
            view displayRectangle:(startPoint corner:(lastX@lastY))
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
        ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
    ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
buttonPress:button x:x y:y
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
    startPoint := x@y.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
    view cursor:(Cursor corner).
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
buttonRelease:button x:x y:y
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
    |rect|
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
    
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
    startPoint isNil ifTrue:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
        super buttonRelease:button x:x y:y.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
        ^ self
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
    ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
    lastX notNil ifTrue:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
        view xoring:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
            view displayRectangle:(startPoint corner:(lastX@lastY))
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
        ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
    ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
    rect := startPoint corner:(lastX@lastY).
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
    startPoint := lastX := lastY := nil.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
    action value:rect.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
keyPress:key x:x y:y
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
    startPoint isNil ifTrue:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
        super keyPress:key x:x y:y.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
        ^ self
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
    ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
    lastX notNil ifTrue:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
        view xoring:[
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
            view displayRectangle:(startPoint corner:(lastX@lastY))
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
        ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
    ].
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
    startPoint := nil.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
    action value:nil.
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
! !
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
!DragRectangleController class methodsFor:'documentation'!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
version
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
    ^ '$Header$'
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
!
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
version_CVS
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
    ^ '$Header$'
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
! !
5db22cb319e3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172