ObjectView.st
author Claus Gittinger <cg@exept.de>
Fri, 24 Apr 2020 12:05:44 +0200
changeset 6847 22dc78cb5436
parent 6551 a82593975b92
permissions -rw-r--r--
#FEATURE by cg class: TextView changed: #editMenu
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6551
a82593975b92 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6303
diff changeset
     1
"{ Encoding: utf8 }"
a82593975b92 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6303
diff changeset
     2
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     3
"
5
claus
parents: 3
diff changeset
     4
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
     5
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     6
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     7
 This software is furnished under a license and may be used
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     8
 only in accordance with the terms of that license and with the
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     9
 inclusion of the above copyright notice.   This software may not
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    10
 be provided or otherwise made available to, or used by, any
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    11
 other person.  No title to or ownership of the software is
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    12
 hereby transferred.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    13
"
2227
58426f7611f2 category changes
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
    14
"{ Package: 'stx:libwidg' }"
58426f7611f2 category changes
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
    15
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
    16
"{ NameSpace: Smalltalk }"
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
    17
121
claus
parents: 119
diff changeset
    18
View subclass:#ObjectView
256
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
    19
	instanceVariableNames:'contents sorted lastButt pressAction releaseAction
3002
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
    20
		shiftPressAction ctrlPressAction doublePressAction motionAction
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
    21
		keyPressAction selection gridShown gridPixmap scaleMetric
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
    22
		dragObject leftHandCursor oldCursor movedObject moveStartPoint
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
    23
		moveDelta documentFormat canDragOutOfView rootMotion rootView
3199
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
    24
		aligning gridAlign aligningMove inMotion buttonPressTime'
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
    25
	classVariableNames:'MIN_DELTA_FOR_MOVE TIME_DELTA_FOR_MOVE'
256
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
    26
	poolDictionaries:''
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
    27
	category:'Views-Basic'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    28
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    29
961
1b65b39c5079 aligningMove was undefined.
Claus Gittinger <cg@exept.de>
parents: 839
diff changeset
    30
!ObjectView class methodsFor:'documentation'!
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    31
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    32
copyright
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    33
"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    34
 COPYRIGHT (c) 1989 by Claus Gittinger
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    35
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    36
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    37
 This software is furnished under a license and may be used
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    38
 only in accordance with the terms of that license and with the
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    39
 inclusion of the above copyright notice.   This software may not
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    40
 be provided or otherwise made available to, or used by, any
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    41
 other person.  No title to or ownership of the software is
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    42
 hereby transferred.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    43
"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    44
!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    45
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    46
documentation
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    47
"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    48
    a View which can hold DisplayObjects, can make selections, move them around etc.
5193
d583e6cc6b0f class: ObjectView
Claus Gittinger <cg@exept.de>
parents: 4981
diff changeset
    49
    ObjectView is an abstract class providing common mechanisms 
d583e6cc6b0f class: ObjectView
Claus Gittinger <cg@exept.de>
parents: 4981
diff changeset
    50
    (i.e. a whiteBox framework, to be used by concrete subclasses).
2653
441d15cf7fba comment
Claus Gittinger <cg@exept.de>
parents: 2635
diff changeset
    51
    Actual instances are DrawView, DirectoryView, LogicView or DocumentView.
441d15cf7fba comment
Claus Gittinger <cg@exept.de>
parents: 2635
diff changeset
    52
441d15cf7fba comment
Claus Gittinger <cg@exept.de>
parents: 2635
diff changeset
    53
    If you want to use this class, have a special look at the pluggable behavior, especially,
441d15cf7fba comment
Claus Gittinger <cg@exept.de>
parents: 2635
diff changeset
    54
    pressAction, releaseAction etc.:
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    55
584
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    56
    [Instance variables:]
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    57
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    58
        contents        <Collection>            the objects. The order in which
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    59
                                                these are in that collection defines
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    60
                                                their appearance in the z-plane:
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    61
                                                an object located after another one
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    62
                                                here will be drawn ABOVE the other.
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    63
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    64
        sorted          <Boolean>               if set, redraw and picking methods
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    65
                                                assume that the objects are sorted by 
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    66
                                                >= y-coordinates. These operations are
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    67
                                                a bit faster then, since a binary search
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    68
                                                can be done. (use with care).
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    69
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    70
        lastButt        <Point>                 last pointer press position
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    71
                                                (internal)
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    72
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    73
        pressAction     <Block>                 action to perform when mouse pointer
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    74
                                                is pressed. Can be set to something like
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    75
                                                [self startCreate], [self startSelectOrMove]
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    76
                                                etc.
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    77
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    78
        releaseAction   <Block>                 action to perform when mouse pointer is
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    79
                                                released. Typically set in one of the
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    80
                                                startXXX methods.
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    81
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    82
        shiftPressAction        <Block>         like pressAction, if shift key is
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    83
                                                pressed.
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    84
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    85
        doublePressAction       <Block>         same for double-clicks
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    86
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    87
        motionAction            <Block>         action to perform on mouse-pointer
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    88
                                                motion.
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    89
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    90
        keyPressAction          <Block>         action for keyboard events
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    91
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    92
        selection               <any>           the current selection; either a single
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    93
                                                object or a collection of objects.
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    94
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    95
        gridShown               <Boolean>       internal
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    96
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    97
        gridPixmap              <Form>          internal
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    98
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
    99
        scaleMetric             <Symbol>        either #mm or #inch; used to
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   100
                                                decide how the grid is defined
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   101
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   102
        dragObject                              internal
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   103
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   104
        leftHandCursor                          cursor shown while dragging a rectangle
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   105
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   106
        oldCursor                               saved original cursor while dragging a rectangle
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   107
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   108
        movedObject                             internal
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   109
        moveStartPoint                          internal
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   110
        moveDelta                               internal
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   111
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   112
        documentFormat          <Symbol>        defines the size and layout of the
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   113
                                                document. Can be any of
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   114
                                                #letter, #a4, #a3 etc.
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   115
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   116
        canDragOutOfView        <Boolean>       if true, objects can be dragged out of the
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   117
                                                view. If false, dragging is restricted to within
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   118
                                                this view.
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   119
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   120
        rootMotion                              internal
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   121
        rootView                                internal
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   122
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   123
        aligning                <Boolean>       if true, pointer positions are
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   124
                                                aligned (snapped) to the point
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   125
                                                specified in gridAlign
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   126
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   127
        gridAlign               <Point>         if aligning is true, this point
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   128
                                                defines the snapping. For example,
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   129
                                                12@12 defines snap to the nearest
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   130
                                                12-point grid.
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   131
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   132
    written spring/summer 89 by claus
584
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   133
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   134
    [author:]
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   135
        Claus Gittinger
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   136
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   137
    [see also:]
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   138
        DrawTool LogicTool
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   139
        DrawObject
e3b11115fc18 documentation
Claus Gittinger <cg@exept.de>
parents: 531
diff changeset
   140
        DisplayObject
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   141
"
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   142
!
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   143
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   144
examples
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   145
"
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   146
    typically, ObjectViews are not used on their own, but instead
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   147
    subclassed and thereby provide the common functionality for
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   148
    views which show (possibly overlapping) objects.
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   149
    The methods here provide all mechanisms to handle redraws, picking
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   150
    (i.e. finding an object by position), gridding, moving objects with
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   151
    minimum redraw etc.
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   152
    Also, zooming and scrolling is handled.
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   153
    All objects which respond to the DisplayObject protocol can be handled
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   154
    by ObjectView - therefore, you can add almost any object and have it
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   155
    displayed and handled here. (as an example, try to copy a LogicGate
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   156
    from a LogicView and paste it into a DrawTool - it will work).
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   157
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   158
    Reminder: ObjectViews are not to be used as below, but instead to be
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   159
    subclassed. Therefore, the examples below are somewhat untypical.
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   160
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   161
    simple example:
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   162
                                                                        [exBegin]
531
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   163
        |v o|
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   164
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   165
        v := ObjectView new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   166
        v extent:200@200.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   167
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   168
        o := DrawRectangle new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   169
        o origin:10@10 corner:100@100.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   170
        v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   171
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   172
        o := DrawText new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   173
        o text:'hello there'; origin:50@50; foreground:Color red.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   174
        v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   175
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   176
        v open
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   177
                                                                        [exEnd]
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   178
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   179
    add scrolling:
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   180
                                                                        [exBegin]
531
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   181
        |v top o|
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   182
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   183
        top := HVScrollableView for:ObjectView.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   184
        top extent:200@200.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   185
        v := top scrolledView.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   186
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   187
        o := DrawRectangle new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   188
        o origin:10@10 corner:100@100.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   189
        v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   190
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   191
        o := DrawText new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   192
        o text:'hello there'; origin:50@50; foreground:Color red.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   193
        v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   194
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   195
        top open
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   196
                                                                        [exEnd]
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   197
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   198
    or, using miniscrollers:
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   199
                                                                        [exBegin]
531
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   200
        |v top o|
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   201
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   202
        top := HVScrollableView for:ObjectView 
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   203
                                miniScrollerH:true miniScrollerV:true.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   204
        top extent:200@200.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   205
        v := top scrolledView.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   206
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   207
        o := DrawRectangle new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   208
        o origin:10@10 corner:100@100.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   209
        v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   210
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   211
        o := DrawText new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   212
        o text:'hello there'; origin:50@50; foreground:Color red.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   213
        v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   214
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   215
        top open
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   216
                                                                        [exEnd]
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   217
2678
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   218
    mix views and displayObjects:
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   219
                                                                        [exBegin]
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   220
        |v top o|
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   221
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   222
        top := HVScrollableView for:ObjectView.
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   223
        top extent:200@200.
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   224
        v := top scrolledView.
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   225
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   226
        o := DrawLine new.
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   227
        o origin:10@10 corner:50@50.
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   228
        v add:o.
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   229
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   230
        o := ClockView in:top.
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   231
        o origin:50@50 corner:100@100.
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   232
        v add:o.
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   233
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   234
        top open
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   235
                                                                        [exEnd]
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
   236
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   237
    grid:
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   238
                                                                        [exBegin]
531
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   239
        |v top o|
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   240
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   241
        top := HVScrollableView for:ObjectView 
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   242
                                miniScrollerH:true miniScrollerV:true.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   243
        top extent:200@200.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   244
        v := top scrolledView.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   245
        v showGrid.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   246
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   247
        o := DrawRectangle new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   248
        o origin:10@10 corner:100@100.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   249
        v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   250
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   251
        o := DrawText new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   252
        o text:'hello there'; origin:50@50; foreground:Color red.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   253
        v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   254
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   255
        top open
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   256
                                                                        [exEnd]
531
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   257
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   258
    zoom:
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   259
                                                                        [exBegin]
531
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   260
        |v top o|
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   261
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   262
        top := HVScrollableView for:ObjectView 
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   263
                                miniScrollerH:true miniScrollerV:true.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   264
        top extent:200@200.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   265
        v := top scrolledView.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   266
        v showGrid.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   267
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   268
        o := DrawRectangle new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   269
        o origin:10@10 corner:100@100.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   270
        v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   271
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   272
        o := DrawText new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   273
        o text:'hello there'; origin:50@50; foreground:Color red.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   274
        v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   275
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   276
        top open.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   277
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   278
        Delay waitForSeconds:5.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   279
        v zoom:2.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   280
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   281
        Delay waitForSeconds:5.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   282
        v zoom:0.35.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   283
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   284
        Delay waitForSeconds:5.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   285
        v zoom:1.
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   286
                                                                        [exEnd]
531
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   287
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   288
   private benchmark: display 10000 objects ...
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   289
                                                                        [exBegin]
531
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   290
        |v top o rnd|
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   291
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   292
        top := HVScrollableView for:ObjectView 
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   293
                                miniScrollerH:true miniScrollerV:true.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   294
        top extent:200@200.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   295
        v := top scrolledView.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   296
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   297
        rnd := Random new.
1164
5cf2b5fcb5f1 example
Claus Gittinger <cg@exept.de>
parents: 1002
diff changeset
   298
        10000 timesRepeat:[
531
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   299
            o := DrawLine new.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   300
            o origin:(rnd nextIntegerBetween:0 and:700) @ (rnd nextIntegerBetween:0 and:700)
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   301
              corner:(rnd nextIntegerBetween:0 and:700) @ (rnd nextIntegerBetween:0 and:700).
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   302
            v add:o.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   303
        ].
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   304
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   305
        top openAndWait.
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   306
655
acad3ef3a46c showCr: -> showCR:
Claus Gittinger <cg@exept.de>
parents: 619
diff changeset
   307
        Transcript showCR:(
531
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   308
            Time millisecondsToRun:[
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   309
                v redraw              
a2ceb2c8e853 commentary
Claus Gittinger <cg@exept.de>
parents: 262
diff changeset
   310
            ])
592
ace25772463d examples
Claus Gittinger <cg@exept.de>
parents: 588
diff changeset
   311
                                                                        [exEnd]
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   312
"
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   313
! !
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   314
961
1b65b39c5079 aligningMove was undefined.
Claus Gittinger <cg@exept.de>
parents: 839
diff changeset
   315
!ObjectView class methodsFor:'defaults'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   316
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
   317
handleSize
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
   318
    "size of blob drawn for handles"
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
   319
2289
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
   320
    ^ (Screen current horizontalPixelPerMillimeter * 1.2) rounded asInteger
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
   321
!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
   322
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   323
hitDelta
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   324
    "when clicking an object, allow for hitDelta pixels around object;
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   325
     0 is exact; 1*pixelPerMillimeter is good for draw programs"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   326
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   327
    ^ 0
3199
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
   328
!
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
   329
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
   330
mouseMotionDeltaForMove
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
   331
    ^ MIN_DELTA_FOR_MOVE ? 10
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
   332
!
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
   333
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
   334
mouseMotionTimeDeltaForMove
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
   335
    ^ TIME_DELTA_FOR_MOVE ? 500
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   336
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   337
996
c4d8f29f3567 *** empty log message ***
ca
parents: 984
diff changeset
   338
!ObjectView methodsFor:'accessing'!
c4d8f29f3567 *** empty log message ***
ca
parents: 984
diff changeset
   339
2782
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   340
aligning
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   341
    ^ aligning
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   342
!
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   343
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   344
aligningMove
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   345
    ^ aligningMove
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   346
!
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   347
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   348
aligningMove:aBoolean
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   349
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   350
    aligningMove == aBoolean ifTrue:[ ^ self ].
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   351
    aBoolean ifTrue:[
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   352
        aligning == true ifFalse:[ ^ self ].
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   353
        gridAlign isNil ifTrue:[ ^ self ].
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   354
    ].
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   355
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   356
    aligningMove := aBoolean
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   357
!
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   358
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   359
contents
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   360
    ^ contents
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   361
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   362
    "Created: / 4.7.1999 / 15:15:15 / cg"
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   363
!
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   364
996
c4d8f29f3567 *** empty log message ***
ca
parents: 984
diff changeset
   365
gridShown
c4d8f29f3567 *** empty log message ***
ca
parents: 984
diff changeset
   366
    ^ gridShown
c4d8f29f3567 *** empty log message ***
ca
parents: 984
diff changeset
   367
! !
c4d8f29f3567 *** empty log message ***
ca
parents: 984
diff changeset
   368
2227
58426f7611f2 category changes
Claus Gittinger <cg@exept.de>
parents: 2144
diff changeset
   369
!ObjectView methodsFor:'accessing-behavior'!
1943
c5e77664abac category change
Claus Gittinger <cg@exept.de>
parents: 1942
diff changeset
   370
3419
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   371
ctrlPressAction:aBlock
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   372
    ctrlPressAction := aBlock
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   373
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   374
    "Created: / 27-10-2006 / 14:06:41 / cg"
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   375
!
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   376
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   377
doublePressAction:aBlock
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   378
    doublePressAction := aBlock
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   379
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   380
    "Created: / 27-10-2006 / 14:06:49 / cg"
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   381
!
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   382
2381
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   383
keyPressAction:aBlock
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   384
    keyPressAction := aBlock
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   385
!
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   386
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   387
motionAction:aBlock
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   388
    motionAction := aBlock
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   389
!
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   390
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   391
pressAction:aBlock
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   392
    pressAction := aBlock
3419
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   393
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   394
    "Modified: / 27-10-2006 / 14:06:34 / cg"
2381
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   395
!
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   396
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   397
releaseAction:aBlock
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   398
    releaseAction := aBlock
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   399
!
ba992e7f3929 action accessors
Claus Gittinger <cg@exept.de>
parents: 2311
diff changeset
   400
1943
c5e77664abac category change
Claus Gittinger <cg@exept.de>
parents: 1942
diff changeset
   401
setDefaultActions
c5e77664abac category change
Claus Gittinger <cg@exept.de>
parents: 1942
diff changeset
   402
    "setup actions for default behavior (do - nothing)"
c5e77664abac category change
Claus Gittinger <cg@exept.de>
parents: 1942
diff changeset
   403
3199
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
   404
    movedObject := nil.
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
   405
    inMotion := false.
1943
c5e77664abac category change
Claus Gittinger <cg@exept.de>
parents: 1942
diff changeset
   406
    motionAction := [:movePoint | nil].
c5e77664abac category change
Claus Gittinger <cg@exept.de>
parents: 1942
diff changeset
   407
    releaseAction := [nil]
c5e77664abac category change
Claus Gittinger <cg@exept.de>
parents: 1942
diff changeset
   408
c5e77664abac category change
Claus Gittinger <cg@exept.de>
parents: 1942
diff changeset
   409
    "Modified: / 4.7.1999 / 18:55:01 / cg"
3419
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   410
!
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   411
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   412
shiftPressAction:aBlock
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   413
    shiftPressAction := aBlock
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   414
35a817eabae0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3354
diff changeset
   415
    "Created: / 27-10-2006 / 14:06:30 / cg"
1943
c5e77664abac category change
Claus Gittinger <cg@exept.de>
parents: 1942
diff changeset
   416
! !
c5e77664abac category change
Claus Gittinger <cg@exept.de>
parents: 1942
diff changeset
   417
2144
8cfc21c91319 category rename
Claus Gittinger <cg@exept.de>
parents: 2134
diff changeset
   418
!ObjectView methodsFor:'adding & removing'!
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   419
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   420
add:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   421
    "add something, anObject or a collection of objects to the contents
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   422
     with redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   423
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   424
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   425
        self addObject:anObject
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   426
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   427
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   428
    "Modified: / 11-04-2018 / 18:09:37 / stefan"
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   429
!
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   430
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   431
addObject:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   432
    "add the argument, anObject to the contents - with redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   433
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   434
    anObject notNil ifTrue:[
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   435
        contents addLast:anObject.
2783
ea9bf46c39d9 *** empty log message ***
tm
parents: 2782
diff changeset
   436
        self changed:#addObject with:anObject.
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   437
        "its on top - only draw this one"
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   438
        shown "realized" ifTrue:[
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   439
            self showUnselected:anObject
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   440
        ]
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   441
    ]
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   442
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   443
    "Modified: / 4.7.1999 / 16:50:24 / cg"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   444
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   445
1741
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   446
addObjectFirst:anObject
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   447
    "add the argument, anObject to the beginning of the contents - with redraw"
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   448
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   449
    anObject notNil ifTrue:[
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   450
        contents addFirst:anObject.
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   451
        self changed:#addObject.
1741
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   452
        "its on top - only draw this one"
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   453
        shown "realized" ifTrue:[
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   454
            self showUnselected:anObject
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   455
        ]
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   456
    ]
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   457
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   458
    "Modified: / 4.7.1999 / 16:50:22 / cg"
1741
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   459
!
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   460
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   461
addObjectFirstWithoutRedraw:anObject
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   462
    "add the argument, anObject to the start of the contents - no redraw"
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   463
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   464
    anObject notNil ifTrue:[
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   465
        contents addFirst:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   466
        self changed:#addObject.
1741
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   467
    ]
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   468
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   469
    "Modified: / 4.7.1999 / 16:50:19 / cg"
1741
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   470
!
082f3849e5af + #addObjectFirst:
Claus Gittinger <cg@exept.de>
parents: 1622
diff changeset
   471
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   472
addObjectWithoutRedraw:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   473
    "add the argument, anObject to the contents - no redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   474
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   475
    anObject notNil ifTrue:[
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   476
        contents addLast:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   477
        self changed:#addObject.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   478
    ]
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   479
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   480
    "Modified: / 4.7.1999 / 16:50:16 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   481
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   482
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   483
addSelected:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   484
    "add something, anObject or a collection of objects to the contents
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   485
     and select it"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   486
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   487
    self add:something.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   488
    self select:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   489
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   490
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   491
addWithoutRedraw:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   492
    "add something, anObject or a collection of objects to the contents
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   493
     do not redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   494
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   495
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   496
        self addObjectWithoutRedraw:anObject
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   497
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   498
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   499
    "Modified: / 11-04-2018 / 18:09:51 / stefan"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   500
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   501
3288
10c909bd8ca8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3209
diff changeset
   502
contents:aCollectionOfObjects
10c909bd8ca8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3209
diff changeset
   503
    contents := aCollectionOfObjects.
10c909bd8ca8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3209
diff changeset
   504
    self invalidate.
10c909bd8ca8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3209
diff changeset
   505
!
10c909bd8ca8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3209
diff changeset
   506
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   507
remove:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   508
    "remove something, anObject or a collection of objects from the contents
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   509
     do redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   510
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   511
    something size > (contents size / 4) ifTrue:[
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   512
        "
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   513
         better to remove first, then redraw rest
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   514
        "
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   515
        something doIfNotNil:[:anObject |
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   516
            self removeFromSelection:anObject.
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   517
            contents remove:anObject.
2783
ea9bf46c39d9 *** empty log message ***
tm
parents: 2782
diff changeset
   518
            self changed:#removeObject with:anObject.
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   519
        ].
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   520
        self invalidate.
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   521
        ^ self
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   522
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   523
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   524
    something doIfNotNil:[:anObject |
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   525
        self removeObject:anObject
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   526
    ]
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   527
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   528
    "Modified: / 04-07-1999 / 16:50:09 / cg"
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   529
    "Modified: / 11-04-2018 / 18:15:56 / stefan"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   530
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   531
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   532
removeAll
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   533
    "remove all - redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   534
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   535
    self removeAllWithoutRedraw.
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   536
    self invalidate
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   537
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   538
    "Modified: 29.5.1996 / 16:20:28 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   539
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   540
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   541
removeAllWithoutRedraw
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   542
    "remove all - no redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   543
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   544
    contents := OrderedCollection new.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   545
    self changed:#removeObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   546
    selection notNil ifTrue:[
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   547
        selection := nil.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   548
        self changed:#selection.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   549
    ].
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   550
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   551
    "Modified: / 4.7.1999 / 16:50:43 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   552
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   553
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   554
removeObject:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   555
    "remove the argument, anObject from the contents - no redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   556
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   557
    anObject notNil ifTrue:[
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   558
        self removeFromSelection:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   559
        contents remove:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   560
        shown "realized" ifTrue:[
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   561
            self redrawObjectsIn:(anObject frame)
2053
c947a9ba6036 checkin from browser
ps
parents: 2051
diff changeset
   562
        ].
c947a9ba6036 checkin from browser
ps
parents: 2051
diff changeset
   563
        self changed:#removeObject with:anObject.
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   564
    ]
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   565
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   566
    "Modified: / 4.7.1999 / 16:50:49 / cg"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   567
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   568
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   569
removeObjectWithoutRedraw:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   570
    "remove the argument, anObject from the contents - no redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   571
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   572
    anObject notNil ifTrue:[
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   573
        self removeFromSelection:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   574
        contents remove:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   575
        self changed:#removeObject.
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   576
    ]
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   577
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   578
    "Modified: / 4.7.1999 / 16:50:58 / cg"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   579
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   580
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   581
removeWithoutRedraw:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   582
    "remove something, anObject or a collection of objects from the contents
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   583
     do not redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   584
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   585
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   586
        self removeObjectWithoutRedraw:anObject
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   587
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   588
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
   589
    "Modified: / 11-04-2018 / 18:16:03 / stefan"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   590
! !
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   591
2449
b9bf97bf089d category included a space
Claus Gittinger <cg@exept.de>
parents: 2435
diff changeset
   592
!ObjectView methodsFor:'cut & paste'!
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   593
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   594
convertForPaste:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   595
    "return a converted version of anObject to be pasted, or nil if
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   596
     the object is not compatible with me.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   597
     Return nil here; concrete subclasses should try to convert.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   598
     Notice: anObject may be a collection of to-be-pasted objects."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   599
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   600
    "in concrete subclasses, you can use:"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   601
"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   602
    |s|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   603
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   604
    (anObject respondsTo:#asDisplayObject) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   605
	^ anObject asDisplayObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   606
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   607
    (anObject isString or:[anObject isMemberOf:Text]) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   608
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   609
    anObject size > 0 ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   610
	(anObject inject:true into:[:okSoFar :element |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   611
	    okSoFar and:[element respondsTo:#asDisplayObject]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   612
	]) ifFalse:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   613
	    self warn:'selection not convertable to DisplayObject'.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   614
	    ^ nil
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   615
	].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   616
	^ anObject collect:[:element | element asDisplayObject].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   617
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   618
"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   619
    ^ nil.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   620
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   621
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   622
copySelection
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   623
    "copy the selection into the cut&paste-buffer"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   624
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   625
    |tmp|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   626
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   627
    tmp := OrderedCollection new.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   628
    self selectionDo:[:object |
3042
fb0853b6b762 set selection interface changed
ca
parents: 3039
diff changeset
   629
        tmp add:(object copy)
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   630
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   631
"/    self forEach:tmp do:[:anObject |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   632
"/        anObject moveTo:(anObject origin + (8 @ 8))
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   633
"/    ].
3042
fb0853b6b762 set selection interface changed
ca
parents: 3039
diff changeset
   634
    self setClipboardObject:tmp
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   635
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   636
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   637
cutSelection
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   638
    "cut the selection into the cut&paste buffer"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   639
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   640
    |tmp|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   641
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   642
    tmp := selection.
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   643
    tmp notNil ifTrue:[
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   644
        self unselect.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   645
        self remove:tmp.
3042
fb0853b6b762 set selection interface changed
ca
parents: 3039
diff changeset
   646
        self setClipboardObject:tmp
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   647
    ]
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   648
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   649
    "Created: / 4.7.1999 / 15:07:59 / cg"
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   650
    "Modified: / 4.7.1999 / 15:29:50 / cg"
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   651
!
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   652
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   653
deleteSelection
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   654
    "delete the selection"
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   655
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   656
    |tmp|
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   657
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   658
    tmp := selection.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   659
    tmp notNil ifTrue:[
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   660
        self unselect.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   661
        self remove:tmp.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   662
    ].
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   663
2782
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   664
    ^ tmp
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   665
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   666
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   667
paste:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   668
    "add the objects in the cut&paste-buffer"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   669
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   670
    |s|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   671
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   672
    s := self convertForPaste:something .
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   673
    s isNil ifTrue:[
4625
ff8daa46e92f class: ObjectView
Claus Gittinger <cg@exept.de>
parents: 4439
diff changeset
   674
        self warn:(resources string:'selection not convertable').
1186
56b5d99d0265 checkin from browser
ah
parents: 1164
diff changeset
   675
        ^ self
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   676
    ].
1186
56b5d99d0265 checkin from browser
ah
parents: 1164
diff changeset
   677
    self unselect.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   678
    self addSelected:s 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   679
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   680
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   681
pasteBuffer
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   682
    "add the objects in the paste-buffer"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   683
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   684
    |sel|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   685
3044
f8419843f748 get selection interface changed
ca
parents: 3042
diff changeset
   686
    sel := self getClipboardObject.
5942
828121e0baf0 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5941
diff changeset
   687
    ((device isX11Platform)
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
   688
     or:[(device getSelectionOwnerOf:#CLIPBOARD) == self drawableId])
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   689
    ifTrue:[
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   690
        "
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   691
         a local selection - paste with some offset
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   692
        "
6551
a82593975b92 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6303
diff changeset
   693
        sel size ~~ 0 ifTrue:[
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   694
            sel := sel collect:[:element |
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   695
                element copy moveTo:(element origin + (8 @ 8))
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   696
            ]
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   697
        ] ifFalse:[
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   698
            sel := sel copy moveTo:(sel origin + (8 @ 8))
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   699
        ]
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   700
    ].
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   701
    self paste:sel
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
   702
6551
a82593975b92 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6303
diff changeset
   703
    "Modified: / 04-07-1999 / 15:10:46 / cg"
a82593975b92 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6303
diff changeset
   704
    "Modified: / 01-03-2019 / 16:05:57 / Claus Gittinger"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   705
! !
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   706
2615
e5ff9323b909 categories
Claus Gittinger <cg@exept.de>
parents: 2449
diff changeset
   707
!ObjectView methodsFor:'dragging-line'!
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   708
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   709
doLineDrag:aPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   710
    "do drag a line"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   711
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   712
    self invertDragLine.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   713
    dragObject corner:aPoint.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   714
    self invertDragLine.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   715
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   716
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   717
endLineDrag
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   718
    "cleanup after line drag; select them. Find the origin and destination
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   719
     views and relative offsets, then dispatch to one of the endLineDrag methods.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   720
     These can be redefined in subclasses to allow connect between views."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   721
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   722
    |rootPoint viewId offs transformation2
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   723
     lastViewId destinationId destinationView destinationPoint 
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   724
     inMySelf dragOrigin|
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   725
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   726
    self invertDragLine.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   727
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   728
    self cursor:oldCursor.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   729
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   730
    "check if line drag is into another view"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   731
    rootMotion ifTrue:[
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   732
        |currentTransformation|
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   733
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   734
        rootPoint := lastButt.
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   735
        "
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   736
         get device coordinates
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   737
        "
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   738
        currentTransformation := gc transformation.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   739
        currentTransformation notNil ifTrue:[
5234
9d85f8e1e20c class: ObjectView
Claus Gittinger <cg@exept.de>
parents: 5193
diff changeset
   740
            rootPoint := currentTransformation transformPoint:rootPoint.
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   741
        ].
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   742
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   743
        "
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   744
         translate to screen
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   745
        "
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
   746
        offs := device translatePoint:0@0 fromView:self toView:rootView.
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   747
        rootPoint := rootPoint + offs.
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   748
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   749
        "search view the drop is in"
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   750
        viewId := rootView id.
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   751
        [viewId notNil] whileTrue:[
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
   752
            destinationId := device viewIdFromPoint:rootPoint in:viewId.
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   753
            lastViewId := viewId.
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   754
            viewId := destinationId
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   755
        ].
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
   756
        destinationView := device viewFromId:lastViewId.
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   757
        destinationId := lastViewId.
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   758
        inMySelf := (destinationView == self).
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   759
        rootMotion := false
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   760
    ] ifFalse:[
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   761
        inMySelf := true
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   762
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   763
2658
1d3f90424bcf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   764
    dragObject isNil ifTrue:[^ self].
1d3f90424bcf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   765
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   766
    dragOrigin := dragObject origin.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   767
    inMySelf ifTrue:[
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   768
        "a simple line within myself"
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   769
        self lineDragFrom:dragOrigin to:dragObject corner
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   770
    ] ifFalse:[
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   771
        "into another one"
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   772
        destinationView notNil ifTrue:[
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
   773
            destinationPoint := device translatePoint:rootPoint fromView:rootView toView:destinationView.
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   774
            (transformation2 := destinationView transformation) notNil ifTrue:[
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   775
                destinationPoint := transformation2 applyInverseTo:destinationPoint
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   776
            ].
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   777
            "
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   778
             move into another smalltalk view
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   779
            "
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   780
            self lineDragFrom:dragOrigin to:destinationPoint in:destinationView
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   781
        ] ifFalse:[
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   782
            "
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   783
             not one of my views
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   784
            "
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   785
            self lineDragFrom:dragOrigin to:destinationPoint inAlienViewId:destinationId
2311
9746fb5dd8e0 use rootWindowId (save a message send)
Claus Gittinger <cg@exept.de>
parents: 2289
diff changeset
   786
        ] 
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   787
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   788
    self setDefaultActions.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   789
    dragObject := nil
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   790
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   791
    "Modified: / 10.10.2001 / 14:41:52 / cg"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   792
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   793
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   794
invertDragLine
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   795
    "helper for line dragging - invert the dragged line.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   796
     Extracted for easier redefinition in subclasses
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   797
     (different line width etc.)"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   798
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   799
    |dragger offs p1 p2|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   800
2658
1d3f90424bcf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   801
    dragObject isNil ifTrue:[^ self].
1d3f90424bcf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2653
diff changeset
   802
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   803
    p1 := dragObject origin.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   804
    p2 := dragObject corner.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   805
    rootMotion ifTrue:[
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   806
        |currentTransformation|
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   807
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   808
        dragger := rootView.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   809
        "
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   810
         get device coordinates
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   811
        "
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   812
        currentTransformation := gc transformation.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   813
        currentTransformation notNil ifTrue:[
5234
9d85f8e1e20c class: ObjectView
Claus Gittinger <cg@exept.de>
parents: 5193
diff changeset
   814
            p1 := currentTransformation transformPoint:p1.
9d85f8e1e20c class: ObjectView
Claus Gittinger <cg@exept.de>
parents: 5193
diff changeset
   815
            p2 := currentTransformation transformPoint:p2.
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   816
        ].
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   817
        "
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   818
         translate to screen
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   819
        "
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
   820
        offs := device translatePoint:0@0 fromView:self toView:rootView.
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   821
        p1 := p1 + offs.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   822
        p2 := p2 + offs.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   823
    ] ifFalse:[
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   824
        dragger := self.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   825
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   826
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   827
    dragger xoring:[
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   828
        dragger lineWidth:0. 
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   829
        dragger displayLineFrom:p1 to:p2.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   830
        dragger flush
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   831
    ].
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
   832
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   833
    "Modified: / 10.10.2001 / 13:59:05 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   834
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   835
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   836
lineDragFrom:startPoint to:endPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   837
    "this is called after a line-drag. Nothing is done here.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   838
     - should be redefined in subclasses"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   839
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   840
    ^ self
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   841
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   842
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   843
lineDragFrom:startPoint to:endPoint in:destinationView
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   844
    "this is called after a line-drag crossing view boundaries.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   845
     - should be redefined in subclasses"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   846
5958
138b25592837 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5942
diff changeset
   847
    ^ self notify:'don''t know how to connect to external views'
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   848
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   849
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   850
lineDragFrom:startPoint to:endPoint inAlienViewId:destinationId
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   851
    "this is called after a line-drag with rootmotion set
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   852
     to true, IFF the endpoint is in an alien view
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   853
     - should be redefined in subclasses"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   854
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   855
    self notify:'cannot connect object in alien view'
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   856
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   857
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   858
setLineDragActions
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   859
    "setup to drag a line. Call this (for example) from your buttonPress
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   860
     method, to make the view start to drag a line.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   861
     See startLineDrag and startRootLineDrag."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   862
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   863
    motionAction := [:movePoint | self doLineDrag:movePoint].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   864
    releaseAction := [self endLineDrag]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   865
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   866
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   867
startLineDrag:startPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   868
    "start a line drag within the view"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   869
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   870
    self setLineDragActions.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   871
    dragObject := Rectangle origin:startPoint corner:startPoint.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   872
    self invertDragLine.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   873
    oldCursor := cursor.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   874
    self cursor:leftHandCursor
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   875
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   876
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   877
startRootLineDrag:startPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   878
    "start a line drag possibly crossing my view boundaries"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   879
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   880
    self setLineDragActions.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   881
    rootMotion := true.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   882
    dragObject := Rectangle origin:startPoint corner:startPoint.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   883
    self invertDragLine.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   884
    oldCursor := cursor.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
   885
    self cursor:leftHandCursor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   886
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   887
2615
e5ff9323b909 categories
Claus Gittinger <cg@exept.de>
parents: 2449
diff changeset
   888
!ObjectView methodsFor:'dragging-object'!
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   889
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   890
doObjectMove:aPoint
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   891
    "do an object move - this is called for every motion
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   892
     when moving objects."
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   893
102
f600526404e6 *** empty log message ***
claus
parents: 95
diff changeset
   894
    |d org nOrg|
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   895
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   896
    movedObject isNil ifTrue:[
2782
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   897
        movedObject := selection.
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   898
        "
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   899
         draw first outline
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   900
        "
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   901
        movedObject notNil ifTrue:[
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   902
            moveDelta := 0@0.
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   903
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   904
            "tricky, the moved object may not currently be aligned.
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   905
             if so, simulate a frame move of the delta"
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   906
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   907
            aligningMove ifTrue:[
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   908
                org := movedObject origin.
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   909
                d := org - (self alignToGrid:(org)).
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   910
                moveDelta := d negated.
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   911
            ].
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   912
            self invertDragObject:movedObject delta:moveDelta    
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   913
        ]
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   914
    ].
2782
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   915
    moveStartPoint notNil ifTrue:[
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   916
        movedObject notNil ifTrue:[
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   917
            d := aPoint - moveStartPoint.
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   918
            aligningMove ifTrue:[
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   919
                org := movedObject origin.
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   920
                nOrg := org + d.
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   921
                d :=  (self alignToGrid:(nOrg)) - org.
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   922
            ].
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   923
            d ~= moveDelta ifTrue:[
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   924
                "
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   925
                 clear prev outline,
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   926
                 draw new outline
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   927
                "
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   928
                self invertDragObject:movedObject delta:moveDelta.    
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   929
                moveDelta :=  d.
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   930
                self invertDragObject:movedObject delta:moveDelta    
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   931
            ]
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   932
        ]
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
   933
    ].
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   934
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   935
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   936
endObjectMove
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   937
    "cleanup after object move - called when the object move ends.
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   938
     Find the destination view and position and dispatch to
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   939
     one of the moveObjectXXX-methods which should do the real move. 
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   940
     These can be redefined in subclasses."
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
   941
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   942
    |inMySelf rootPoint destinationPoint p transformation2
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   943
     viewId destinationView destinationId lastViewId|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   944
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   945
    movedObject notNil ifTrue:[
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   946
        self invertDragObject:movedObject delta:moveDelta.    
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   947
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   948
        "check if object is to be put into another view"
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   949
        rootMotion ifTrue:[
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   950
            |currentTransformation|
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   951
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   952
            p := lastButt.
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   953
            "
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   954
             get device coordinates
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   955
            "
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   956
            currentTransformation := gc transformation.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
   957
            currentTransformation notNil ifTrue:[
5234
9d85f8e1e20c class: ObjectView
Claus Gittinger <cg@exept.de>
parents: 5193
diff changeset
   958
                p := currentTransformation transformPoint:p.
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   959
            ].
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   960
            "
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   961
             translate to screen
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   962
            "
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
   963
            rootPoint := p + (device translatePoint:0@0 fromView:self toView:rootView).
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   964
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   965
            "search view the drop is in"
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   966
            viewId := rootView id.
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   967
            [viewId notNil] whileTrue:[
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
   968
                destinationId := device viewIdFromPoint:rootPoint in:viewId.
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   969
                lastViewId := viewId.
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   970
                viewId := destinationId
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   971
            ].
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
   972
            destinationView := device viewFromId:lastViewId.
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   973
            destinationId := lastViewId.
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   974
            inMySelf := (destinationView == self).
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   975
            rootMotion := false
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   976
        ] ifFalse:[
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   977
            inMySelf := true
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   978
        ].
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   979
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   980
        inMySelf ifTrue:[
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   981
            "simple move"
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   982
            self move:movedObject by:moveDelta
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   983
        ] ifFalse:[
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
   984
            destinationPoint := device translatePoint:rootPoint        "/ use id here - could be alian view
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   985
                                                 from:(rootView id) 
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   986
                                                   to:destinationId.
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   987
            destinationView notNil ifTrue:[
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   988
                (transformation2 := destinationView transformation) notNil ifTrue:[
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   989
                    destinationPoint := transformation2 applyInverseTo:destinationPoint
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   990
                ].
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   991
                "
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   992
                 move into another smalltalk view
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   993
                "
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   994
                self move:movedObject to:destinationPoint in:destinationView
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   995
            ] ifFalse:[
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   996
                "
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   997
                 not one of my views
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   998
                "
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
   999
                self move:movedObject to:destinationPoint inAlienViewId:destinationId
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
  1000
            ] 
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
  1001
        ].
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
  1002
        self setDefaultActions.
3530
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1003
        movedObject := nil.
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1004
    ]
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
  1005
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
  1006
    "Modified: / 10.10.2001 / 14:43:09 / cg"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1007
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1008
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1009
invertDragObject:movedObject delta:moveDelta
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1010
    "draw inverting for an object move"
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1011
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1012
    |dragger offs p d scale oldTrans|
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1013
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1014
    rootMotion ifTrue:[
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1015
        |currentTransformation|
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1016
        p := movedObject origin + moveDelta.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1017
        dragger := rootView.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1018
        "
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1019
         get device coordinates
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1020
        "
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1021
        currentTransformation := gc transformation.
4958
cae3c8b75f94 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4912
diff changeset
  1022
        currentTransformation notNil ifTrue:[
cae3c8b75f94 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4912
diff changeset
  1023
            scale := currentTransformation scale.
5234
9d85f8e1e20c class: ObjectView
Claus Gittinger <cg@exept.de>
parents: 5193
diff changeset
  1024
            p := currentTransformation transformPoint:p.
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1025
        ].
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1026
        "
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1027
         translate to screen
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1028
        "
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  1029
        offs := device translatePoint:0@0 fromView:self toView:rootView.
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1030
        p := p + offs.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1031
        "
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1032
         p is where we want it ...
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1033
         have to adust slightly, since showDragging shows the object
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1034
         at its origin plus some offset; here we want it to be drawn
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1035
         at absolute p.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1036
         To do so, we set the draggers translation to p and
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1037
         draw the object scaled at 0@0 (by setting offset to its negative org)
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1038
        "
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1039
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1040
        oldTrans := dragger transformation.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1041
        dragger transformation:(WindowingTransformation 
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1042
                                        scale:scale
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1043
                                        translation:p).
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1044
        d := movedObject origin negated.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1045
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1046
        dragger xoring:[
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1047
            self showDragging:movedObject offset:d.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1048
        ].
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1049
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1050
        dragger transformation:oldTrans.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1051
        dragger flush.
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1052
    ] ifFalse:[
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1053
        self xoring:[
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1054
            self showDragging:movedObject offset:moveDelta.
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1055
        ].
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1056
        self flush
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1057
    ].
262
d2c946b6a5b4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 256
diff changeset
  1058
2435
a47df77ac405 use new #translatePoint:fromView:toView:
Claus Gittinger <cg@exept.de>
parents: 2381
diff changeset
  1059
    "Modified: / 10.10.2001 / 13:59:19 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1060
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1061
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1062
setMoveActions
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1063
    "setup to drag an object. Call this (for example) from your buttonPress
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1064
     method, to make the view start to drag some object.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1065
     See startObjectMove and startRootObjectMove."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1066
3199
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1067
    |didStartMove|
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1068
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1069
    didStartMove := false.
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1070
    motionAction := [:movePoint | 
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1071
                        didStartMove := true. 
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1072
                        self doObjectMove:movePoint
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1073
                    ].
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1074
    releaseAction := [ didStartMove 
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1075
                        ifTrue:[ self endObjectMove ] 
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1076
                        ifFalse:[self setDefaultActions]
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1077
                     ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1078
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1079
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1080
startObjectMove:something at:aPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1081
    "start an object move"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1082
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1083
    self startObjectMove:something at:aPoint inRoot:canDragOutOfView 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1084
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1085
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1086
startObjectMove:something at:aPoint inRoot:inRoot
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1087
    "start an object move; if inRoot is true, view
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1088
     boundaries may be crossed."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1089
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1090
    something notNil ifTrue:[
1944
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1091
        (self canSelect:something) ifTrue:[
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1092
            self select:something.
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1093
            (self canMove:something) ifTrue:[
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1094
                self setMoveActions.
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1095
                moveStartPoint := aPoint.
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1096
                rootMotion := inRoot.
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1097
            ] ifFalse:[
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1098
                self setDefaultActions
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1099
            ]
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1100
        ] ifFalse:[
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1101
            self setDefaultActions
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1102
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1103
    ]
1944
378857db4611 care for unselectable objects in startMove
Claus Gittinger <cg@exept.de>
parents: 1943
diff changeset
  1104
3420
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  1105
    "Modified: / 27-10-2006 / 14:32:12 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1106
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1107
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1108
startRootObjectMove:something at:aPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1109
    "start an object move, possibly crossing view boundaries"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1110
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1111
    self startObjectMove:something at:aPoint inRoot:true 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1112
! !
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1113
2615
e5ff9323b909 categories
Claus Gittinger <cg@exept.de>
parents: 2449
diff changeset
  1114
!ObjectView methodsFor:'dragging-rectangle'!
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1115
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1116
doRectangleDrag:aPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1117
    "do drag a rectangle"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1118
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1119
    self invertDragRectangle.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1120
    dragObject corner:aPoint.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1121
    self invertDragRectangle.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1122
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1123
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1124
endRectangleDrag
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1125
    "cleanup after rectangle drag; select them"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1126
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1127
    self invertDragRectangle.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1128
    self cursor:oldCursor.
3530
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1129
    dragObject width < 0 ifTrue:[
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1130
        dragObject 
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1131
                origin:(dragObject origin + (dragObject width@0))
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1132
                corner:(dragObject corner - (dragObject width@0))
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1133
    ].
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1134
    dragObject height < 0 ifTrue:[
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1135
        dragObject 
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1136
                origin:(dragObject origin + (0@dragObject height))
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1137
                corner:(dragObject corner - (0@dragObject height))
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  1138
    ].
3420
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  1139
    self selectAllIn:dragObject.
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  1140
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  1141
    releaseAction := nil.
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  1142
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  1143
    "Modified: / 27-10-2006 / 14:21:11 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1144
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1145
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1146
invertDragRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1147
    "helper for rectangle drag - invert the dragRectangle.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1148
     Extracted into a separate method to allow easier redefinition
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1149
     (different lineWidth etc)"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1150
6056
da66f10bc24d #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  1151
    gc clippedByChildren:false.
da66f10bc24d #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  1152
da66f10bc24d #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  1153
    gc xoring:[
da66f10bc24d #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  1154
        gc lineWidth:0. 
743
c2aafc876d49 dashed rectangle drag does not work on some Xservers
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
  1155
"/        self lineStyle:#dashed.
6056
da66f10bc24d #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  1156
        gc displayRectangle:dragObject.
743
c2aafc876d49 dashed rectangle drag does not work on some Xservers
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
  1157
"/        self lineStyle:#solid.
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  1158
    ].
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  1159
6056
da66f10bc24d #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  1160
    gc clippedByChildren:true.
3889
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1161
743
c2aafc876d49 dashed rectangle drag does not work on some Xservers
Claus Gittinger <cg@exept.de>
parents: 736
diff changeset
  1162
    "Modified: 3.6.1996 / 10:02:22 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1163
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1164
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1165
setRectangleDragActions
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1166
    "setup to drag a rectangle. Call this (for example) from your buttonPress
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1167
     method, to make the view start the drag.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1168
     See startRectangleDrag:."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1169
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1170
    motionAction := [:movePoint | self doRectangleDrag:movePoint].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1171
    releaseAction := [self endRectangleDrag]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1172
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1173
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1174
startRectangleDrag:startPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1175
    "start a rectangle drag"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1176
3302
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1177
    lastButt := startPoint.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1178
    self setRectangleDragActions.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1179
    dragObject := Rectangle origin:startPoint corner:startPoint.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1180
    self invertDragRectangle.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1181
    oldCursor := cursor.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1182
    self cursor:leftHandCursor
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1183
! !
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1184
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1185
!ObjectView methodsFor:'drawing'!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1186
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1187
redraw
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1188
    "redraw complete View"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1189
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1190
    shown ifTrue:[
2924
65b0b26ff549 clear -> clearView
Claus Gittinger <cg@exept.de>
parents: 2913
diff changeset
  1191
        self clearView.
65b0b26ff549 clear -> clearView
Claus Gittinger <cg@exept.de>
parents: 2913
diff changeset
  1192
        self redrawObjects
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1193
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1194
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1195
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1196
redrawObjects
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1197
    "redraw all objects"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1198
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1199
    self redrawObjectsOn:self
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1200
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1201
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1202
redrawObjectsAbove:anObject in:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1203
    "redraw all objects which have part of themselfes in aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1204
     and are above (in front of) anObject.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1205
     draw only in (i.e. clip output to) aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1206
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1207
    |vis oldClip|
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1208
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1209
    shown ifTrue:[
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1210
        vis := aRectangle.
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1211
        oldClip := self clippingBoundsOrNil.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1212
        oldClip notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1213
            vis := vis intersect:oldClip
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1214
        ].
6033
92b2ad926234 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5958
diff changeset
  1215
        self clippingBounds:vis.
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1216
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1217
        self redrawObjectsAbove:anObject intersecting:vis.
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1218
6033
92b2ad926234 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5958
diff changeset
  1219
        self clippingBounds:oldClip
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1220
    ]
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1221
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1222
    "Modified: 28.5.1996 / 19:57:06 / cg"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1223
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1224
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1225
redrawObjectsAbove:anObject inVisible:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1226
    "redraw all objects which have part of themselfes in a vis rectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1227
     and are above (in front of) anObject.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1228
     draw only in (i.e. clip output to) aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1229
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1230
    |vis oldClip|
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1231
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1232
    shown ifTrue:[
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1233
        vis := aRectangle.
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1234
        oldClip := self clippingBoundsOrNil.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1235
        oldClip notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1236
            vis := vis intersect:oldClip
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1237
        ].
6033
92b2ad926234 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5958
diff changeset
  1238
        self clippingBounds:vis.
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1239
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1240
        self redrawObjectsAbove:anObject intersectingVisible:vis.
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1241
6033
92b2ad926234 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5958
diff changeset
  1242
        self clippingBounds:oldClip
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1243
    ]
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1244
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1245
    "Modified: 28.5.1996 / 19:56:44 / cg"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1246
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1247
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1248
redrawObjectsAbove:anObject intersecting:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1249
    "redraw all objects which have part of themself in aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1250
     and are above (in front of) anObject"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1251
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1252
    self objectsAbove:anObject intersecting:aRectangle do:[:theObject |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1253
	self show:theObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1254
    ]
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1255
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1256
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1257
redrawObjectsAbove:anObject intersectingVisible:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1258
    "redraw all objects which have part of themself in a vis rectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1259
     and are above (in front of) anObject"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1260
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1261
    self objectsAbove:anObject intersectingVisible:aRectangle do:[:theObject |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1262
	self show:theObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1263
    ]
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1264
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1265
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1266
redrawObjectsIn:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1267
    "redraw all objects which have part of themselfes in aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1268
     draw only in (i.e. clip output to) aRectangle"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1269
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1270
    |visRect oldClip|
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1271
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1272
    shown ifTrue:[
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1273
        visRect := Rectangle origin:(aRectangle origin)
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1274
                             extent:(aRectangle extent).
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1275
"/        transformation notNil ifTrue:[
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1276
            visRect := visRect origin truncated
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1277
                       corner:(visRect corner + (1@1)) truncated.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1278
"/        ].
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1279
        oldClip := self clippingBoundsOrNil.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1280
        oldClip notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1281
            visRect := visRect intersect:oldClip
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1282
        ].
6033
92b2ad926234 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5958
diff changeset
  1283
        self clippingBounds:visRect.
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1284
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1285
        self clearRectangle:visRect.
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1286
        self redrawObjectsIntersecting:visRect.
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1287
6033
92b2ad926234 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5958
diff changeset
  1288
        self clippingBounds:oldClip
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1289
    ]
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1290
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1291
    "Modified: 28.5.1996 / 19:56:20 / cg"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1292
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1293
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1294
redrawObjectsInVisible:visRect
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1295
    "redraw all objects which have part of themselfes in a vis rectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1296
     draw only in (i.e. clip output to) aRectangle"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1297
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1298
    |vis oldClip|
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1299
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1300
    shown ifTrue:[
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1301
        vis := visRect.
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1302
        oldClip := self clippingBoundsOrNil.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1303
        oldClip notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1304
            vis := vis intersect:oldClip
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1305
        ].
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1306
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1307
        gc transformation notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1308
"/            gc transformation scale ~~ 1 ifTrue:[
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1309
                vis := vis origin truncated
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1310
                           corner:(vis corner + (1@1)) truncated.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1311
"/            ]
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1312
        ].
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1313
6033
92b2ad926234 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5958
diff changeset
  1314
        self clippingBounds:vis.
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1315
2985
22ab9531ab4f redrawObjectsInVisible: donot clear background; already done in redrawX:y:width:height:
ca
parents: 2924
diff changeset
  1316
        "/ no clear background; already done in redrawX:y:width:height:
22ab9531ab4f redrawObjectsInVisible: donot clear background; already done in redrawX:y:width:height:
ca
parents: 2924
diff changeset
  1317
        "/ self clearRectangle:vis.
22ab9531ab4f redrawObjectsInVisible: donot clear background; already done in redrawX:y:width:height:
ca
parents: 2924
diff changeset
  1318
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1319
        self redrawObjectsIntersecting:vis.
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1320
6033
92b2ad926234 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5958
diff changeset
  1321
        self clippingBounds:oldClip
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1322
    ]
700
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1323
962bcd86ac8b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 696
diff changeset
  1324
    "Modified: 28.5.1996 / 19:55:47 / cg"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1325
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1326
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1327
redrawObjectsIntersecting:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1328
    "redraw all objects which have part of themself in aRectangle"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1329
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1330
    self objectsIntersecting:aRectangle do:[:theObject |
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1331
	self show:theObject
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1332
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1333
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1334
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1335
redrawObjectsIntersectingVisible:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1336
    "redraw all objects which have part of themself in a vis rectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1337
     This is a leftOver from times when scrolling was not transparent.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1338
     Please use redrawObjectsIntersecting:, since this will vanish."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1339
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1340
    self redrawObjectsIntersecting:aRectangle
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1341
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1342
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1343
redrawObjectsOn:aGC
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1344
    "redraw all objects on a graphic context"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1345
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1346
    |vFrame|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1347
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1348
    (aGC == self) ifTrue:[
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1349
        |currentTransformation|
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1350
619
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1351
        shown ifFalse:[^ self].
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1352
        vFrame := Rectangle left:0 top:0 width:width height:height.
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1353
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1354
        currentTransformation := gc transformation.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1355
        currentTransformation notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1356
            vFrame := currentTransformation applyInverseTo:vFrame.
619
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1357
        ].
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1358
        self redrawObjectsIntersecting:vFrame
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1359
    ] ifFalse:[
619
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1360
        "should loop over pages"
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1361
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1362
        vFrame := Rectangle left:0 top:0 width:9999 height:9999.
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1363
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1364
        self objectsIntersecting:vFrame do:[:theObject |
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1365
            theObject drawIn:aGC
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1366
        ]
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1367
    ]
619
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1368
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1369
    "Modified: 8.5.1996 / 21:01:27 / cg"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1370
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1371
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1372
redrawScale
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1373
    "redraw the scales"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1374
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1375
    self redrawHorizontalScale.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1376
    self redrawVerticalScale
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1377
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1378
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1379
show:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1380
    "show the object, either selected or not"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1381
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1382
    (self isSelected:anObject) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1383
	self showSelected:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1384
    ] ifFalse:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1385
	self showUnselected:anObject
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1386
    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1387
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1388
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1389
showDragging:something offset:anOffset
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1390
    "show an object while dragging"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1391
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1392
    |drawer|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1393
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1394
    rootMotion ifTrue:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1395
        "drag in root-window"
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1396
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1397
        drawer := rootView
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1398
    ] ifFalse:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1399
        drawer := self
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1400
    ].
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1401
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1402
        anObject drawDragIn:drawer offset:anOffset
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1403
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1404
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1405
    "Modified: / 11-04-2018 / 18:16:59 / stefan"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1406
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1407
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1408
showSelected:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1409
    "show an object as selected"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1410
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1411
    anObject drawSelectedIn:self
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1412
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1413
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1414
showUnselected:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1415
    "show an object as unselected"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1416
2678
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
  1417
    anObject isView ifFalse:[
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
  1418
        anObject drawIn:self
873a631b1f1d only send drawOn to displayObjects
Michael Beyl <mb@exept.de>
parents: 2658
diff changeset
  1419
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1420
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1421
3889
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1422
!ObjectView methodsFor:'enumerating'!
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1423
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1424
contentsDo:aBlock
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1425
    contents do:aBlock
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1426
! !
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1427
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1428
!ObjectView methodsFor:'event handling'!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1429
3002
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
  1430
buttonCtrlPress:button x:x y:y
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
  1431
    "user pressed left button with ctrl"
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
  1432
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
  1433
    ctrlPressAction notNil ifTrue:[
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
  1434
        ctrlPressAction value:lastButt.
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
  1435
    ]
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
  1436
!
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
  1437
3039
c346a6cdcf73 buttonState handling sensor bug workaround
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1438
buttonMotion:buttonState x:buttX y:buttY
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1439
    "user moved mouse while button pressed"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1440
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1441
    |xpos ypos movePoint limitW limitH minDeltaForMotion currentTransformation|
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1442
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1443
    "is it the select or 1-button ?"
3039
c346a6cdcf73 buttonState handling sensor bug workaround
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1444
    buttonState == 0 ifTrue:[^ self].
1622
50dd1ee1604a use another left-button-down test in #buttonMotion.
Claus Gittinger <cg@exept.de>
parents: 1490
diff changeset
  1445
    self sensor leftButtonPressed ifFalse:[^ self].
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1446
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1447
    lastButt notNil ifTrue:[
732
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1448
        xpos := buttX.
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1449
        ypos := buttY.
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1450
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1451
        "check against visible limits if move outside is not allowed"
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1452
        rootMotion ifFalse:[
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1453
            limitW := width.
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1454
            limitH := height.
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1455
            currentTransformation := gc transformation.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1456
            currentTransformation notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1457
                limitW := currentTransformation applyInverseToX:width.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1458
                limitH := currentTransformation applyInverseToY:height.
732
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1459
            ].
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1460
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1461
            (xpos < 0) ifTrue:[                    
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1462
                xpos := 0
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1463
            ] ifFalse: [
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1464
                (xpos > limitW) ifTrue:[xpos := limitW]
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1465
            ].
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1466
            (ypos < 0) ifTrue:[                    
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1467
                ypos := 0
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1468
            ] ifFalse: [
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1469
                (ypos > limitH) ifTrue:[ypos := limitH]
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1470
            ]
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1471
        ].
3199
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1472
732
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1473
        movePoint := xpos @ ypos.
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1474
3199
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1475
        "/ if the motion is more than mouseMotionDeltaForMove
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1476
        "/ or the time-delta is longer than timeDeltaForMove
3302
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1477
        buttonPressTime notNil ifTrue:[
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1478
            (Timestamp now millisecondDeltaFrom:buttonPressTime) > self class mouseMotionTimeDeltaForMove ifFalse:[
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1479
                inMotion == true ifTrue:[
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1480
                    minDeltaForMotion := 1
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1481
                ] ifFalse:[
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1482
                    minDeltaForMotion := self class mouseMotionDeltaForMove
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1483
                ].
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1484
                currentTransformation := gc transformation.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1485
                currentTransformation notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1486
                    minDeltaForMotion := currentTransformation applyInverseToX:minDeltaForMotion.
3302
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1487
                ].
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1488
                ((xpos - (lastButt x)) abs < minDeltaForMotion
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1489
                and:[ (ypos - (lastButt y)) abs < minDeltaForMotion]) ifTrue:[
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1490
                    ^ self      "no (ignored) move"
0a541907ce79 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3301
diff changeset
  1491
                ].
3199
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1492
            ].
732
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1493
        ].
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1494
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1495
        motionAction notNil ifTrue:[
3889
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1496
            self sensor motionEventPending ifFalse:[
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1497
                inMotion := true.
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1498
                motionAction value:movePoint.
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1499
                lastButt := movePoint.
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  1500
            ].
732
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1501
            ^ self
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1502
        ].
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1503
        lastButt := movePoint
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1504
    ].
3039
c346a6cdcf73 buttonState handling sensor bug workaround
Claus Gittinger <cg@exept.de>
parents: 3002
diff changeset
  1505
    super buttonMotion:buttonState x:buttX y:buttY
732
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1506
1622
50dd1ee1604a use another left-button-down test in #buttonMotion.
Claus Gittinger <cg@exept.de>
parents: 1490
diff changeset
  1507
    "Modified: / 28.7.1998 / 16:01:31 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1508
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1509
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1510
buttonMultiPress:button x:x y:y
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1511
    "user pressed left button twice (or more)"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1512
3916
73162fbd69c1 preps for right-menu on buttonRelease
Claus Gittinger <cg@exept.de>
parents: 3889
diff changeset
  1513
    (button == 1) ifTrue:[
732
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1514
        doublePressAction notNil ifTrue:[
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1515
            doublePressAction value:(x @ y).
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1516
            ^ self
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1517
        ]
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1518
    ].
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1519
    super buttonMultiPress:button x:x y:y
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1520
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1521
    "Modified: 30.5.1996 / 17:57:36 / cg"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1522
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1523
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1524
buttonPress:button x:x y:y
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1525
    "user pressed left button"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1526
3878
b329263f6d98 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3845
diff changeset
  1527
    |sensor|
b329263f6d98 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3845
diff changeset
  1528
3916
73162fbd69c1 preps for right-menu on buttonRelease
Claus Gittinger <cg@exept.de>
parents: 3889
diff changeset
  1529
    (button == 1) ifTrue:[
3199
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1530
        lastButt := x @ y.
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1531
        buttonPressTime := Timestamp now.
3878
b329263f6d98 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3845
diff changeset
  1532
        sensor := self sensor.
b329263f6d98 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3845
diff changeset
  1533
        sensor shiftDown ifTrue:[
815
38082a0ff5c9 more on buttonShiftPress
Claus Gittinger <cg@exept.de>
parents: 810
diff changeset
  1534
            ^ self buttonShiftPress:button x:x y:y
38082a0ff5c9 more on buttonShiftPress
Claus Gittinger <cg@exept.de>
parents: 810
diff changeset
  1535
        ].
3878
b329263f6d98 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3845
diff changeset
  1536
        sensor ctrlDown ifTrue:[
3002
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
  1537
            ^ self buttonCtrlPress:button x:x y:y
7f11f0dc6b0f ctrl-action
ca
parents: 3000
diff changeset
  1538
        ].
815
38082a0ff5c9 more on buttonShiftPress
Claus Gittinger <cg@exept.de>
parents: 810
diff changeset
  1539
732
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1540
        pressAction notNil ifTrue:[
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1541
            pressAction value:lastButt.
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1542
            ^ self
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1543
        ]
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1544
    ].
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1545
    super buttonPress:button x:x y:y
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1546
815
38082a0ff5c9 more on buttonShiftPress
Claus Gittinger <cg@exept.de>
parents: 810
diff changeset
  1547
    "Modified: 1.8.1996 / 19:13:01 / cg"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1548
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1549
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1550
buttonRelease:button x:x y:y
3199
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1551
    inMotion := false.
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1552
3916
73162fbd69c1 preps for right-menu on buttonRelease
Claus Gittinger <cg@exept.de>
parents: 3889
diff changeset
  1553
    (button == 1) ifTrue:[
732
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1554
        releaseAction notNil ifTrue:[
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1555
            releaseAction value.
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1556
            ^ self
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1557
        ]
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1558
    ].
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1559
    super buttonRelease:button x:x y:y
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1560
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1561
    "Modified: 30.5.1996 / 17:57:13 / cg"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1562
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1563
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1564
buttonShiftPress:button x:x y:y
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1565
    "user pressed left button with shift"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1566
815
38082a0ff5c9 more on buttonShiftPress
Claus Gittinger <cg@exept.de>
parents: 810
diff changeset
  1567
    shiftPressAction notNil ifTrue:[
38082a0ff5c9 more on buttonShiftPress
Claus Gittinger <cg@exept.de>
parents: 810
diff changeset
  1568
        shiftPressAction value:lastButt.
38082a0ff5c9 more on buttonShiftPress
Claus Gittinger <cg@exept.de>
parents: 810
diff changeset
  1569
    ]
38082a0ff5c9 more on buttonShiftPress
Claus Gittinger <cg@exept.de>
parents: 810
diff changeset
  1570
38082a0ff5c9 more on buttonShiftPress
Claus Gittinger <cg@exept.de>
parents: 810
diff changeset
  1571
    "Modified: 1.8.1996 / 19:13:19 / cg"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1572
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1573
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1574
keyPress:key x:x y:y
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1575
    keyPressAction notNil ifTrue:[
732
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1576
        selection notNil ifTrue:[
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1577
            self selectionDo: [:obj |
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1578
                obj keyInput:key .
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1579
            ]
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1580
        ].
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1581
        ^ self.
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1582
    ].
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1583
    super keyPress:key x:x y:y
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1584
1b1520ba6c56 perform default event actions, if no corresponding action was set (keyPress/release; buttonPress/release)
Claus Gittinger <cg@exept.de>
parents: 721
diff changeset
  1585
    "Modified: 30.5.1996 / 17:57:54 / cg"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1586
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1587
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1588
redrawX:x y:y width:w height:h
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1589
    |redrawFrame |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1590
3878
b329263f6d98 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3845
diff changeset
  1591
"/    self clearRectangle:redrawFrame.
b329263f6d98 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3845
diff changeset
  1592
    super redrawX:x y:y width:w height:h.
b329263f6d98 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3845
diff changeset
  1593
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1594
    ((contents size ~~ 0) or:[gridShown]) ifTrue:[
3878
b329263f6d98 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3845
diff changeset
  1595
        redrawFrame := Rectangle left:x top:y width:w height:h.
619
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1596
        self redrawObjectsInVisible:redrawFrame
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1597
    ]
619
ea9172634006 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 592
diff changeset
  1598
749
19b1792b9506 clear area before doing a redraw
Claus Gittinger <cg@exept.de>
parents: 747
diff changeset
  1599
    "Modified: 5.6.1996 / 10:42:19 / cg"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1600
! !
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1601
1918
3ac07b97b4f7 use extra query: #wantsFocusWithPointerEnter;
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
  1602
!ObjectView methodsFor:'focus control'!
3ac07b97b4f7 use extra query: #wantsFocusWithPointerEnter;
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
  1603
3ac07b97b4f7 use extra query: #wantsFocusWithPointerEnter;
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
  1604
wantsFocusWithPointerEnter
3ac07b97b4f7 use extra query: #wantsFocusWithPointerEnter;
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
  1605
    ^ UserPreferences current focusFollowsMouse ~~ false
3ac07b97b4f7 use extra query: #wantsFocusWithPointerEnter;
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
  1606
3ac07b97b4f7 use extra query: #wantsFocusWithPointerEnter;
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
  1607
3ac07b97b4f7 use extra query: #wantsFocusWithPointerEnter;
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
  1608
! !
3ac07b97b4f7 use extra query: #wantsFocusWithPointerEnter;
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
  1609
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1610
!ObjectView methodsFor:'grid manipulation'!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1611
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1612
alignOff
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1613
    "do no align point to grid"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1614
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1615
    aligning := false
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1616
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1617
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1618
alignOn
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1619
    "align points to grid"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1620
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1621
    aligning := true.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1622
    self getAlignParameters
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1623
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1624
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1625
defineGrid
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1626
    "define the grid pattern - this creates the gridPixmap, which is
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1627
     used as viewBackground when a grid is to be shown.
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1628
     The grid is specified by the value returned from gridParameters,
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1629
     which can be redefined in subclasses. See the comment there on how
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  1630
     the numbers are interpreted."
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1631
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1632
    |mmH mmV params showDocumentBoundary gridW gridH 
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1633
     bigStepH bigStepV littleStepH littleStepV hires 
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1634
     devPixmap colorMap fg bg currentTransformation|
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1635
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1636
    mmH := self horizontalPixelPerMillimeter.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1637
    mmV := self verticalPixelPerMillimeter.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1638
    hires := self horizontalPixelPerInch > 120.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1639
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1640
    params := self gridParameters.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1641
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1642
    bigStepH := params at:1.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1643
    bigStepV := params at:2.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1644
    littleStepH := params at:3.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1645
    littleStepV := params at:4.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1646
    showDocumentBoundary := params at:7.
4912
bdd1ec48fe80 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4902
diff changeset
  1647
    fg := self blackColor.
bdd1ec48fe80 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4902
diff changeset
  1648
    bg := self whiteColor.
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1649
    params size >= 8 ifTrue:[
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1650
        bg := params at:8.
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1651
        params size >= 9 ifTrue:[
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1652
            fg := params at:9.
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1653
        ].
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1654
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1655
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1656
    currentTransformation := gc transformation.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1657
    currentTransformation notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1658
        mmH := mmH * currentTransformation scale x.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1659
        mmV := mmV * currentTransformation scale y.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1660
        bigStepH := bigStepH * currentTransformation scale x.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1661
        bigStepV := bigStepV * currentTransformation scale y.
256
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1662
        littleStepH notNil ifTrue:[
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1663
            littleStepH := littleStepH * currentTransformation scale x.
256
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1664
        ].
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1665
        littleStepV notNil ifTrue:[
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1666
            littleStepV := littleStepV * currentTransformation scale y.
256
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1667
        ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1668
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1669
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1670
    bigStepH isNil ifTrue:[^ self].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1671
1490
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1672
    gridW := (self widthOfContentsInMM * mmH).
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1673
    gridH := (self heightOfContentsInMM * mmV).
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1674
256
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1675
    self withWaitCursorDo:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1676
        |xp yp y x|
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1677
5941
c38ea1820a2d #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5662
diff changeset
  1678
        (bigStepH isInteger 
c38ea1820a2d #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5662
diff changeset
  1679
            and:[ (littleStepH isNil or:[littleStepH isInteger])
c38ea1820a2d #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5662
diff changeset
  1680
            and:[ bigStepV isInteger 
c38ea1820a2d #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5662
diff changeset
  1681
            and:[ littleStepV isNil or:[littleStepV isInteger]]]]
c38ea1820a2d #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 5662
diff changeset
  1682
        ) ifTrue:[
1490
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1683
            gridW := bigStepH.
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1684
            littleStepH notNil ifTrue:[gridW := gridW max:littleStepH].
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1685
            gridH := bigStepV.
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1686
            littleStepV notNil ifTrue:[gridH := gridH max:littleStepV].
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1687
        ] ifFalse:[
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1688
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1689
            "
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1690
             up to next full unit
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1691
            "
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  1692
            gridW := (((gridW // bigStepH) + 1) * bigStepH) asInteger.
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  1693
            gridH := (((gridH // bigStepV) + 1) * bigStepV) asInteger.
1490
757c7f49de8e tuned for small integer-sized grid-backgrounds
tz
parents: 1435
diff changeset
  1694
        ].
256
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1695
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1696
        gridPixmap := Form width:gridW height:gridH depth:1.
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1697
        gridPixmap colorMap:(Array with:bg with:fg).
256
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1698
        gridPixmap clear.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1699
        gridPixmap paint:(Color colorId:1).
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1700
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1701
        "draw first row point-by-point"
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1702
        yp := 0.0.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1703
        xp := 0.0.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1704
        y := yp asInteger.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1705
        [xp <= gridW] whileTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1706
            x := xp rounded.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1707
            hires ifTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1708
                gridPixmap displayPointX:(x + 1) y:y.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1709
                gridPixmap displayPointX:(x + 2) y:y
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1710
            ].
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1711
            gridPixmap displayPointX:x y:y.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1712
            littleStepH notNil ifTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1713
                xp := xp + littleStepH
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1714
            ] ifFalse:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1715
                xp := xp + bigStepH
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1716
            ]
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1717
        ].
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1718
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1719
        "copy rest from what has been drawn already"
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1720
        yp := yp + bigStepV.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1721
        [yp <= gridH] whileTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1722
            y := yp rounded.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1723
            hires ifTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1724
                gridPixmap copyFrom:gridPixmap x:0 y:0 
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1725
                                             toX:0 y:(y + 1)
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1726
                                           width:gridW height:1.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1727
                gridPixmap copyFrom:gridPixmap x:0 y:0 
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1728
                                             toX:0 y:(y + 2)
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1729
                                           width:gridW height:1
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1730
            ].
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1731
            gridPixmap copyFrom:gridPixmap x:0 y:0 
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1732
                                         toX:0 y:y
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1733
                                       width:gridW height:1.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1734
            yp := yp + bigStepV
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1735
        ].
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1736
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1737
        "draw first col point-by-point"
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1738
        xp := 0.0.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1739
        yp := 0.0.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1740
        x := xp asInteger.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1741
        [yp <= gridH] whileTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1742
            y := yp rounded.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1743
            hires ifTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1744
                gridPixmap displayPointX:x y:(y + 1).
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1745
                gridPixmap displayPointX:x y:(y + 2)
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1746
            ].
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1747
            gridPixmap displayPointX:x y:y.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1748
            littleStepV notNil ifTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1749
                yp := yp + littleStepV
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1750
            ] ifFalse:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1751
                yp := yp + bigStepV
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1752
            ]
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1753
        ].
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1754
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1755
        "copy rest from what has been drawn already"
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1756
        xp := xp + bigStepH.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1757
        [xp <= gridW] whileTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1758
            x := xp rounded.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1759
            hires ifTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1760
                gridPixmap copyFrom:gridPixmap x:0 y:0 
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1761
                                             toX:(x + 1) y:0
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1762
                                           width:1 height:gridH.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1763
                gridPixmap copyFrom:gridPixmap x:0 y:0 
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1764
                                             toX:(x + 2) y:0
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1765
                                           width:1 height:gridH
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1766
            ].
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1767
            gridPixmap copyFrom:gridPixmap x:0 y:0 
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1768
                                         toX:x y:0
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1769
                                       width:1 height:gridH.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1770
            xp := xp + bigStepH
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1771
        ].
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1772
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1773
        showDocumentBoundary ifTrue:[
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1774
             "
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1775
             mark the right-end and bottom of the document
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1776
            "
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1777
            gridPixmap displayLineFromX:gridW-1 y:0 toX:gridW-1 y:gridH-1.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1778
            gridPixmap displayLineFromX:0 y:gridH-1 toX:gridW-1 y:gridH-1.
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1779
        ].
1920
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1780
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  1781
        device isWindowsPlatform ifTrue:[
1920
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1782
            "/ kludge - needs a deep form
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1783
            colorMap := gridPixmap colorMap.
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  1784
            devPixmap := Form width:gridW height:gridH depth:device depth onDevice:device.
1920
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1785
            devPixmap notNil ifTrue:[
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1786
                devPixmap paint:(colorMap at:1).
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1787
                devPixmap fillRectangleX:0 y:0 width:gridW height:gridH.
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1788
                devPixmap foreground:(colorMap at:2) background:(colorMap at:1).
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1789
                devPixmap copyPlaneFrom:gridPixmap x:0 y:0 toX:0 y:0 width:gridW height:gridH.
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1790
                gridPixmap := devPixmap.
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1791
            ]
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1792
        ].
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1793
    ]
256
c55a4f8d8a70 use withWaitCursorDo: / withReadCursorDo:
Claus Gittinger <cg@exept.de>
parents: 216
diff changeset
  1794
1920
0693ba9568f9 kludge for grid
Claus Gittinger <cg@exept.de>
parents: 1918
diff changeset
  1795
    "Modified: / 6.6.1999 / 01:00:16 / cg"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1796
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1797
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1798
getAlignParameters
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1799
    |params|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1800
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1801
    params := self gridParameters.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1802
    gridAlign := (params at:5) @ (params at:6)
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1803
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1804
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1805
gridParameters
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1806
    "used by defineGrid, and in a separate method for
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1807
     easier redefinition in subclasses. 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1808
     Returns the grid parameters in an array of 7 elements,
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1809
     which control the appearance of the grid-pattern.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1810
     the elements are:
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1811
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1812
        bigStepH        number of pixels horizontally between 2 major steps
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1813
        bigStepV        number of pixels vertically between 2 major steps
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1814
        littleStepH     number of pixels horizontally between 2 minor steps
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1815
        littleStepV     number of pixels vertically between 2 minor steps
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1816
        gridAlignH      number of pixels for horizontal grid align (pointer snap)
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1817
        gridAlignV      number of pixels for vertical grid align (pointer snap)
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1818
        docBounds       true, if document boundary should be shown
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1819
        bgColor         grid bg-color [optional]
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1820
        fgColor         grid fg-color [optional]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1821
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1822
     if littleStepH/V are nil, only bigSteps are drawn.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1823
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1824
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1825
    |mmH mmV bigStepH bigStepV littleStepH littleStepV arr currentTransformation|
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1826
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1827
    "example: 12grid & 12snapIn"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1828
"/    ^ #(12 12 nil nil 12 12 false).
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1829
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1830
    "example: 12grid & 24snapIn"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1831
"/    ^ #(12 12 nil nil 24 24 false).
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1832
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1833
    "default: cm/mm grid & mm snapIn for metric,
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1834
     1inch , 1/8inch grid & 1/8 inch snapIn"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1835
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1836
    mmH := self horizontalPixelPerMillimeter.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1837
    mmV := self verticalPixelPerMillimeter.
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1838
    currentTransformation := gc transformation.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1839
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1840
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1841
     metric grid: small steps every millimeter, big step every
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1842
     centimeter. If the transformation is shrinking, turn off little
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1843
     steps.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1844
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1845
    (scaleMetric == #mm) ifTrue:[
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1846
        "dots every mm; lines every cm"
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1847
        bigStepH := mmH * 10.0.
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1848
        bigStepV := mmV * 10.0.
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1849
        (currentTransformation notNil
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1850
        and:[currentTransformation scale <= 0.5]) ifFalse:[
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1851
            littleStepH := mmH.
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1852
            littleStepV := mmV
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1853
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1854
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1855
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1856
     inch grid: small steps every 1/8th inch, big step every half inch
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1857
     If the transformation is shrinking, change little steps to 1/th inch
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1858
     or even turn them off completely.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1859
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1860
    (scaleMetric == #inch) ifTrue:[
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1861
        "dots every eights inch; lines every half inch"
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1862
        bigStepH := mmH * (25.4 / 2).
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1863
        bigStepV := mmV * (25.4 / 2).
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1864
        (currentTransformation notNil
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1865
        and:[currentTransformation scale <= 0.5]) ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  1866
            currentTransformation scale > 0.2 ifTrue:[
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1867
                littleStepH := mmH * (25.4 / 4).
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1868
                littleStepV := mmV * (25.4 / 4)
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1869
            ]
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1870
        ] ifFalse:[
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1871
            littleStepH := mmH * (25.4 / 8).
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1872
            littleStepV := mmV * (25.4 / 8)
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1873
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1874
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1875
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1876
    arr := Array new:9.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1877
    arr at:1 put:bigStepH.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1878
    arr at:2 put:bigStepV.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1879
    arr at:3 put:littleStepH.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1880
    arr at:4 put:littleStepV.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1881
    arr at:5 put:littleStepH.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1882
    arr at:6 put:littleStepV.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1883
    arr at:7 put:false.
4912
bdd1ec48fe80 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4902
diff changeset
  1884
    arr at:8 put:self whiteColor.
bdd1ec48fe80 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4902
diff changeset
  1885
    arr at:9 put:self blackColor.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1886
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1887
    ^ arr
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1888
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1889
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1890
hideGrid
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1891
    "hide the grid"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1892
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1893
    gridShown := false.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1894
    self newGrid
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1895
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1896
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1897
newGrid
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1898
    "define a new grid - this is a private helper which has to be
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1899
     called after any change in the grid. It (re)creates the gridPixmap,
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1900
     clears the view and redraws all visible objects."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1901
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1902
    |params bg|
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1903
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1904
    gridPixmap := nil.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1905
    shown ifTrue:[
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1906
        params := self gridParameters.
4912
bdd1ec48fe80 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4902
diff changeset
  1907
        bg := self whiteColor.
3000
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1908
        params size >= 8 ifTrue:[
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1909
            bg := params at:8.
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1910
        ].
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1911
e6a548a2ca0c bad hack: allow for gridParameters to specify fg & bg
ca
parents: 2985
diff changeset
  1912
        self viewBackground:bg.
2924
65b0b26ff549 clear -> clearView
Claus Gittinger <cg@exept.de>
parents: 2913
diff changeset
  1913
        self clearView.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1914
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1915
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1916
    gridShown ifTrue:[
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1917
        self defineGrid.
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1918
        self viewBackground:gridPixmap.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1919
    ].
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1920
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1921
    self invalidate
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1922
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  1923
    "Modified: 29.5.1996 / 16:20:11 / cg"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1924
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1925
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1926
showGrid
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1927
    "show the grid. The grid is defined by the return value of
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1928
     gridParameters, which can be redefined in concrete subclasses."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1929
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1930
    gridShown := true.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1931
    self newGrid
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1932
! !
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1933
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1934
!ObjectView methodsFor:'initialization'!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1935
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1936
initEvents
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1937
"/    self backingStore:true.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1938
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1939
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1940
initialize
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1941
    super initialize.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1942
4912
bdd1ec48fe80 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4902
diff changeset
  1943
    viewBackground := self whiteColor.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1944
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1945
    bitGravity := #NorthWest.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1946
    contents := OrderedCollection new.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1947
    gridShown := false.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1948
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1949
    canDragOutOfView := false.
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  1950
    rootView := device rootView.
1220
9bc6add9aa54 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1186
diff changeset
  1951
    rootView clippedByChildren:false.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1952
    rootMotion := false.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1953
    self setInitialDocumentFormat.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1954
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1955
    leftHandCursor := Cursor leftHand.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1956
    sorted := false.
961
1b65b39c5079 aligningMove was undefined.
Claus Gittinger <cg@exept.de>
parents: 839
diff changeset
  1957
    aligning := false.
1b65b39c5079 aligningMove was undefined.
Claus Gittinger <cg@exept.de>
parents: 839
diff changeset
  1958
    aligningMove := false.
3199
893814d511ff better start-motion behavior
Claus Gittinger <cg@exept.de>
parents: 3162
diff changeset
  1959
    inMotion := false.
961
1b65b39c5079 aligningMove was undefined.
Claus Gittinger <cg@exept.de>
parents: 839
diff changeset
  1960
1b65b39c5079 aligningMove was undefined.
Claus Gittinger <cg@exept.de>
parents: 839
diff changeset
  1961
    "Modified: 20.1.1997 / 20:41:10 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1962
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1963
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1964
setInitialDocumentFormat
3951
1726c8891c34 changed: #setInitialDocumentFormat
Claus Gittinger <cg@exept.de>
parents: 3916
diff changeset
  1965
    (UserPreferences current languageTerritory == #us) ifTrue:[
1726c8891c34 changed: #setInitialDocumentFormat
Claus Gittinger <cg@exept.de>
parents: 3916
diff changeset
  1966
        documentFormat := 'letter'.
1726c8891c34 changed: #setInitialDocumentFormat
Claus Gittinger <cg@exept.de>
parents: 3916
diff changeset
  1967
        scaleMetric := #inch
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1968
    ] ifFalse:[
3951
1726c8891c34 changed: #setInitialDocumentFormat
Claus Gittinger <cg@exept.de>
parents: 3916
diff changeset
  1969
        documentFormat := 'a4'.
1726c8891c34 changed: #setInitialDocumentFormat
Claus Gittinger <cg@exept.de>
parents: 3916
diff changeset
  1970
        scaleMetric := #mm
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1971
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1972
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1973
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1974
!ObjectView methodsFor:'layout manipulation'!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1975
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1976
alignBottom:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1977
    |botMost|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1978
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1979
    botMost := -999999.
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1980
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1981
        botMost := botMost max:(anObject frame bottom)
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1982
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1983
    self withSelectionHiddenDo:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1984
        something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1985
            self moveObject:anObject to:(anObject frame left)
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1986
                                        @
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1987
                                        (botMost - (anObject frame height))
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1988
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1989
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1990
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  1991
    "Modified: / 11-04-2018 / 18:10:14 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1992
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  1993
747
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1994
alignHorizontal:something
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1995
    "align selection along their center horizontally"
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1996
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1997
    |topMost bottomMost h|
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1998
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  1999
    topMost := 999999.
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2000
    bottomMost := -999999.
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2001
    something doIfNotNil:[:anObject |
747
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2002
        |f|
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2003
        f := anObject frame.
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2004
        topMost := topMost min:(f top).
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2005
        bottomMost := bottomMost max:(f bottom).
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2006
    ].
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2007
    h := bottomMost - topMost.
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2008
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2009
    self withSelectionHiddenDo:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2010
        something doIfNotNil:[:anObject |
747
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2011
            self moveObject:anObject 
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2012
                         to:(anObject frame left)
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2013
                            @
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2014
                            (topMost + ((h - anObject frame height) // 2))
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2015
        ]
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2016
    ]
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2017
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2018
    "Created: / 04-06-1996 / 20:01:19 / cg"
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2019
    "Modified: / 04-06-1996 / 21:19:48 / cg"
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2020
    "Modified: / 11-04-2018 / 18:10:39 / stefan"
747
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2021
!
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2022
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2023
alignLeft:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2024
    |leftMost|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2025
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2026
    leftMost := 999999.
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2027
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2028
        leftMost := leftMost min:(anObject frame left)
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2029
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2030
    self withSelectionHiddenDo:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2031
        something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2032
            self moveObject:anObject to:(leftMost @ (anObject frame top))
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2033
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2034
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2035
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2036
    "Modified: / 11-04-2018 / 18:11:26 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2037
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2038
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2039
alignRight:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2040
    |rightMost|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2041
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2042
    rightMost := -999999.
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2043
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2044
        rightMost := rightMost max:(anObject frame right)
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2045
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2046
    self withSelectionHiddenDo:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2047
        something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2048
            self moveObject:anObject to:(rightMost - (anObject frame width))
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2049
                                         @ (anObject frame top)
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2050
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2051
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2052
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2053
    "Modified: / 11-04-2018 / 18:11:39 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2054
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2055
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2056
alignTop:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2057
    |topMost|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2058
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2059
    topMost := 999999.
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2060
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2061
        topMost := topMost min:(anObject frame top)
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2062
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2063
    self withSelectionHiddenDo:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2064
        something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2065
            self moveObject:anObject to:((anObject frame left) @ topMost)
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2066
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2067
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2068
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2069
    "Modified: / 11-04-2018 / 18:11:50 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2070
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2071
747
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2072
alignVertical:something
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2073
    "align selection along their center vertically"
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2074
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2075
    |leftMost rightMost w|
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2076
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2077
    leftMost := 999999.
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2078
    rightMost := -999999.
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2079
    something doIfNotNil:[:anObject |
747
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2080
        |f|
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2081
        f := anObject frame.
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2082
        rightMost := rightMost max:(f right).
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2083
        leftMost := leftMost min:(f left).
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2084
    ].
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2085
    w := rightMost - leftMost.
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2086
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2087
    self withSelectionHiddenDo:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2088
        something doIfNotNil:[:anObject |
747
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2089
            self moveObject:anObject 
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2090
                         to:(leftMost + ((w - anObject frame width) // 2))
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2091
                            @
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2092
                            (anObject frame top)
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2093
        ]
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2094
    ]
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2095
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2096
    "Created: / 04-06-1996 / 19:59:16 / cg"
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2097
    "Modified: / 04-06-1996 / 21:19:58 / cg"
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2098
    "Modified: / 11-04-2018 / 18:12:01 / stefan"
747
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2099
!
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2100
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2101
move:something by:delta
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2102
    "change the position of something, an Object or Collection 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2103
     by delta, aPoint"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2104
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2105
    (delta x == 0) ifTrue:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2106
        (delta y == 0) ifTrue:[^ self]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2107
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2108
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2109
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2110
        self moveObject:anObject by:delta
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2111
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2112
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2113
    "Modified: / 11-04-2018 / 18:15:21 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2114
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2115
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2116
move:something to:aPoint in:aView
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2117
    "can only happen when dragOutOfView is true
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2118
     - should be redefined in subclasses"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2119
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2120
    self notify:'cannot move object(s) out of view'
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2121
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2122
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2123
move:something to:aPoint inAlienViewId:aViewId
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2124
    "can only happen when dragOutOfView is true
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2125
     - should be redefined in subclasses"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2126
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2127
    self notify:'cannot move object(s) to alien views'
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2128
!
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2129
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2130
moveObject:anObject by:delta
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2131
    "change the position of anObject by delta, aPoint"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2132
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2133
    self moveObject:anObject to:(anObject origin + delta)
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2134
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2135
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2136
moveObject:anObject to:newOrigin
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2137
    "move anObject to newOrigin, aPoint"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2138
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2139
    |oldOrigin oldFrame newFrame 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2140
     objectsIntersectingOldFrame objectsIntersectingNewFrame 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2141
     wasObscured isObscured intersects
701
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2142
     oldLeft oldTop w h newLeft newTop griddedNewOrigin clip|
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2143
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2144
    anObject isNil ifTrue:[^ self].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2145
    anObject canBeMoved ifFalse:[^ self].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2146
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2147
    griddedNewOrigin := self alignToGrid:newOrigin.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2148
    oldOrigin := anObject origin.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2149
    (oldOrigin = griddedNewOrigin) ifTrue:[^ self].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2150
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2151
    oldFrame := self frameOf:anObject.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2152
    objectsIntersectingOldFrame := self objectsIntersecting:oldFrame.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2153
    wasObscured := self isObscured:anObject.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2154
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2155
    anObject moveTo:griddedNewOrigin.
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2156
    self changed:#objectLayout.
782
f963155637e3 dont redraw in moveObject: when not visible
ca
parents: 749
diff changeset
  2157
    shown ifFalse:[^ self].
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2158
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2159
    newFrame := self frameOf:anObject.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2160
    objectsIntersectingNewFrame := self objectsIntersecting:newFrame.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2161
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2162
    "try to redraw the minimum possible"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2163
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2164
    "if no other object intersects both frames we can do a copy:"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2165
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2166
    intersects := oldFrame intersects:newFrame.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2167
    intersects ifFalse:[
2045
4796486fc00a checkin from browser
ps
parents: 1947
diff changeset
  2168
        self hasSolidBackground ifTrue:[
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  2169
            gc transformation isNil ifTrue:[
701
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2170
                (objectsIntersectingOldFrame size == 1) ifTrue:[
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2171
                    (objectsIntersectingNewFrame size == 1) ifTrue:[
6142
6b283d1e3597 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6056
diff changeset
  2172
                        clip := self clippingBoundsOrNil.
701
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2173
                        (clip isNil or:[oldFrame isContainedIn:clip]) ifTrue:[
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2174
                            oldLeft := oldFrame left.
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2175
                            oldTop := oldFrame top.
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2176
                            newLeft := newFrame left.
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2177
                            newTop := newFrame top.
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2178
                            w := oldFrame width.
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2179
                            h := oldFrame height.
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2180
                            ((newLeft < width) and:[newTop < height]) ifTrue:[
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2181
                                ((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2182
                                    self catchExpose.
984
dbd60475b3f5 explicit async bitBlt
Claus Gittinger <cg@exept.de>
parents: 961
diff changeset
  2183
                                    self 
dbd60475b3f5 explicit async bitBlt
Claus Gittinger <cg@exept.de>
parents: 961
diff changeset
  2184
                                        copyFrom:self 
dbd60475b3f5 explicit async bitBlt
Claus Gittinger <cg@exept.de>
parents: 961
diff changeset
  2185
                                        x:oldLeft y:oldTop
dbd60475b3f5 explicit async bitBlt
Claus Gittinger <cg@exept.de>
parents: 961
diff changeset
  2186
                                        toX:newLeft y:newTop
dbd60475b3f5 explicit async bitBlt
Claus Gittinger <cg@exept.de>
parents: 961
diff changeset
  2187
                                        width:w height:h
dbd60475b3f5 explicit async bitBlt
Claus Gittinger <cg@exept.de>
parents: 961
diff changeset
  2188
                                        async:true.
701
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2189
                                    self waitForExpose
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2190
                                ]
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2191
                            ].
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2192
                            ((oldLeft < width) and:[oldTop < height]) ifTrue:[
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2193
                                ((oldLeft >= 0) and:[oldTop >= 0]) ifTrue:[
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2194
                                  self clearRectangleX:oldLeft y:oldTop width:w height:h.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2195
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2196
"/                                self fillRectangleX:oldLeft y:oldTop width:w height:h
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2197
"/                                               with:viewBackground
701
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2198
                                ]
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2199
                            ].
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2200
                            ^ self
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2201
                        ]
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2202
                    ]
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2203
                ]
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2204
            ]
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2205
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2206
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2207
    isObscured := self isObscured:anObject.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2208
    (oldFrame intersects:newFrame) ifTrue:[
701
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2209
        isObscured ifFalse:[
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2210
            self redrawObjectsIn:oldFrame.
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2211
            self show: anObject
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2212
        ] ifTrue:[
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2213
            self redrawObjectsIn:(oldFrame merge:newFrame)
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2214
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2215
    ] ifFalse:[
701
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2216
        self redrawObjectsIn:oldFrame.
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2217
        isObscured ifFalse:[
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2218
            self show: anObject
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2219
        ] ifTrue:[
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2220
            self redrawObjectsIn:newFrame
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2221
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2222
    ]
701
8079d5ac8637 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 700
diff changeset
  2223
6142
6b283d1e3597 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6056
diff changeset
  2224
    "Modified: / 04-07-1999 / 16:52:17 / cg"
6b283d1e3597 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6056
diff changeset
  2225
    "Modified: / 31-03-2017 / 17:51:04 / stefan"
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2226
!
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2227
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2228
objectToBack:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2229
    "bring the argument, anObject to back"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2230
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2231
    anObject notNil ifTrue:[
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2232
        contents remove:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2233
        contents addFirst:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2234
        (self isObscured:anObject) ifTrue:[
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2235
            self redrawObjectsIn:(anObject frame)
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2236
        ].
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2237
        self changed:#objectLayout.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2238
    ]
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2239
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2240
    "Modified: / 4.7.1999 / 16:52:39 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2241
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2242
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2243
objectToFront:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2244
    "bring the argument, anObject to front"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2245
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2246
    |wasObscured|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2247
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2248
    anObject notNil ifTrue:[
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2249
        wasObscured := self isObscured:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2250
        contents remove:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2251
        contents addLast:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2252
        wasObscured ifTrue:[
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2253
"old:
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2254
            self redrawObjectsIn:(anObject frame)
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2255
"
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2256
            self hideSelection.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2257
            self show:anObject.
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2258
            self showSelection
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2259
        ].
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2260
        self changed:#objectLayout.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2261
    ]
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2262
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2263
    "Modified: / 4.7.1999 / 16:52:49 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2264
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2265
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2266
selectionAlignBottom
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2267
    "align selected objects at bottom"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2268
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2269
    self alignBottom:selection
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2270
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2271
747
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2272
selectionAlignHorizontal
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2273
    "align selected objects horizontally"
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2274
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2275
    self alignHorizontal:selection
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2276
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2277
    "Created: 4.6.1996 / 19:58:46 / cg"
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2278
    "Modified: 4.6.1996 / 19:59:10 / cg"
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2279
!
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2280
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2281
selectionAlignLeft
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2282
    "align selected objects left"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2283
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2284
    self alignLeft:selection
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2285
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2286
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2287
selectionAlignRight
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2288
    "align selected objects right"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2289
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2290
    self alignRight:selection
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2291
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2292
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2293
selectionAlignTop
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2294
    "align selected objects at top"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2295
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2296
    self alignTop:selection
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2297
!
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2298
747
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2299
selectionAlignVertical
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2300
    "align selected objects vertically"
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2301
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2302
    self alignVertical:selection
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2303
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2304
    "Created: 4.6.1996 / 19:59:00 / cg"
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2305
!
54cd4d5f9e66 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 743
diff changeset
  2306
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2307
selectionToBack
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2308
    "bring the selection to back"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2309
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2310
    self toBack:selection
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2311
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2312
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2313
selectionToFront
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2314
    "bring the selection to front"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2315
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2316
    self toFront:selection
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2317
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2318
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2319
toBack:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2320
    "bring the argument, anObject or a collection of objects to back"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2321
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2322
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2323
        self objectToBack:anObject
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2324
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2325
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2326
    "Modified: / 11-04-2018 / 18:17:33 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2327
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2328
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2329
toFront:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2330
    "bring the argument, anObject or a collection of objects to front"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2331
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2332
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2333
        self objectToFront:anObject
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2334
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2335
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2336
    "Modified: / 11-04-2018 / 18:17:41 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2337
! !
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2338
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2339
!ObjectView methodsFor:'misc'!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2340
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2341
documentFormat:aFormatString
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2342
    "set the document format (mostly used by scrollbars).
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2343
     The argument should be a string such as 'a4', 'a5'
736
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2344
     or 'letter'. 
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2345
     See the UnitConverter class for supported formats."
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2346
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2347
    aFormatString ~= documentFormat ifTrue:[
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2348
        documentFormat := aFormatString.
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2349
        self contentsChanged.
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2350
        self defineGrid.
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2351
        gridShown ifTrue:[
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2352
            self invalidate "/ clear; redraw
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2353
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2354
    ]
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  2355
736
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2356
    "Modified: 31.5.1996 / 19:44:08 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2357
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2358
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2359
hitDelta
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2360
    "when clicking an object, allow for hitDelta pixels around object.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2361
     We compensate for any scaling here, to get a constant physical
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2362
     hitDelta (i.e. the value returned here is inverse scaled)."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2363
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  2364
    |delta currentTransformation|
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2365
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2366
    delta := self class hitDelta.
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  2367
    currentTransformation := gc transformation.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  2368
    currentTransformation notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  2369
        delta := delta / currentTransformation scale x
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2370
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2371
    ^ delta
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2372
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2373
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2374
numberOfObjectsIntersecting:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2375
    "answer the number of objects intersecting the argument, aRectangle"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2376
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2377
    |tally|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2378
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2379
    tally := 0.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2380
    contents do:[:theObject |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2381
	(theObject frame intersects:aRectangle) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2382
	    tally := tally + 1
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2383
	]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2384
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2385
    ^ tally
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2386
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2387
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2388
numberOfObjectsIntersectingVisible:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2389
    "answer the number of objects intersecting the argument, aRectangle.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2390
     This is a leftOver from times when scrolling was not transparent.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2391
     Please use numberOfObjectsIntersecting:, since this will vanish."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2392
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2393
    ^ self numberOfObjectsIntersecting:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2394
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2395
3889
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2396
object:anObject isContainedIn:aRectangle
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2397
    "true, if anObject is completely inside aRectangle (for rectangle drag)"
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2398
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2399
    ^ anObject isContainedIn:aRectangle
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2400
!
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2401
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2402
objectsAbove:objectToBeTested do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2403
    "do something to every object above objectToBeTested
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2404
     (does not mean obscured - simply above in hierarchy)"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2405
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2406
    |startIndex|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2407
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2408
    startIndex := contents identityIndexOf:objectToBeTested
2289
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  2409
                                  ifAbsent:[self error:'nonexisting object'].
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2410
    contents from:startIndex to:(contents size) do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2411
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2412
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2413
objectsAbove:anObject intersecting:aRectangle do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2414
    "do something to every object above objectToBeTested
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2415
     and intersecting aRectangle"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2416
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2417
    self objectsAbove:anObject do:[:theObject |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2418
	(theObject frame intersects:aRectangle) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2419
	    aBlock value:theObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2420
	]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2421
    ]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2422
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2423
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2424
objectsBelow:objectToBeTested do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2425
    "do something to every object below objectToBeTested
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2426
     (does not mean obscured by - simply below in hierarchy)"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2427
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2428
    |endIndex|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2429
2289
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  2430
    endIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error:'nonexisting object'].
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2431
    contents from:1 to:(endIndex - 1) do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2432
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2433
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2434
objectsIn:aRectangle do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2435
    "do something to every object which is completely in a rectangle"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2436
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2437
    |bot|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2438
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2439
    sorted ifTrue:[
3889
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2440
        bot := aRectangle bottom.
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2441
        self contentsDo:[:theObject |
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2442
            (self object:theObject isContainedIn:aRectangle) ifTrue:[
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2443
                aBlock value:theObject
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2444
            ] ifFalse:[
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2445
                theObject frame top > bot ifTrue:[^ self]
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2446
            ]
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2447
        ].
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2448
        ^ self
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2449
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2450
3889
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2451
    self contentsDo:[:theObject |
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2452
        (self object:theObject isContainedIn:aRectangle) ifTrue:[
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2453
            aBlock value:theObject
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  2454
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2455
    ]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2456
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2457
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2458
objectsInVisible:aRectangle do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2459
    "do something to every object which is completely in a 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2460
     visible rectangle.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2461
     This is a leftOver from times when scrolling was not transparent.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2462
     Please use objectsIn:do:, since this will vanish."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2463
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2464
    self objectsIn:aRectangle do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2465
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2466
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2467
objectsIntersecting:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2468
    "answer a Collection of objects intersecting the argument, aRectangle"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2469
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2470
    |newCollection|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2471
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2472
    newCollection := OrderedCollection new.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2473
    self objectsIntersecting:aRectangle do:[:theObject |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2474
	newCollection add:theObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2475
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2476
    (newCollection size == 0) ifTrue:[^ nil].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2477
    ^ newCollection
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2478
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2479
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2480
objectsIntersecting:aRectangle do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2481
    "do something to every object which intersects a rectangle"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2482
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2483
    |f top bot
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2484
     firstIndex "{ Class: SmallInteger }"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2485
     delta      "{ Class: SmallInteger }"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2486
     theObject 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2487
     nObjects   "{ Class: SmallInteger }"|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2488
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2489
    nObjects := contents size.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2490
    (nObjects == 0) ifTrue:[^ self].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2491
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2492
    sorted ifFalse:[
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2493
	"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2494
	 have to check every object
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2495
	"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2496
	contents do:[:theObject |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2497
	    (theObject frame intersects:aRectangle) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2498
		aBlock value:theObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2499
	    ]
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2500
	].
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2501
	^ self
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2502
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2503
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2504
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2505
     contents is sorted by y; can do a fast (binary) search for the first
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2506
     object which intersects aRectangle and 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2507
     break from the draw loop, when the 1st object below aRectangle is reached.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2508
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2509
    bot := aRectangle bottom.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2510
    top := aRectangle top.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2511
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2512
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2513
     binary search for an object in aRectangle ...
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2514
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2515
    delta := nObjects // 2.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2516
    firstIndex := delta.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2517
    (firstIndex == 0) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2518
       firstIndex := 1
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2519
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2520
    theObject := contents at:firstIndex.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2521
    (theObject frame bottom < top) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2522
	[theObject frame bottom < top and:[delta > 1]] whileTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2523
	    delta := delta // 2.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2524
	    firstIndex := firstIndex + delta.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2525
	    theObject := contents at:firstIndex
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2526
	]
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2527
    ] ifFalse:[
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2528
	[theObject frame top > bot and:[delta > 1]] whileTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2529
	    delta := delta // 2.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2530
	    firstIndex := firstIndex - delta.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2531
	    theObject := contents at:firstIndex
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2532
	]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2533
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2534
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2535
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2536
     now, theObject at:firstIndex is in aRectangle; go backward to the object
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2537
     following first non-visible
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2538
    "
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2539
    [theObject frame bottom > top and:[firstIndex > 1]] whileTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2540
	firstIndex := firstIndex - 1.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2541
	theObject := contents at:firstIndex
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2542
    ].
87
2c6ab478466a *** empty log message ***
claus
parents: 83
diff changeset
  2543
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2544
    firstIndex to:nObjects do:[:index |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2545
	theObject := contents at:index.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2546
	f := theObject frame.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2547
	(f intersects:aRectangle) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2548
	    aBlock value:theObject
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2549
	] ifFalse:[
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2550
	    (f top > bot) ifTrue:[^ self]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2551
	]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2552
    ]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2553
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2554
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2555
objectsIntersectingVisible:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2556
    "answer a Collection of objects intersecting a visible aRectangle.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2557
     This is a leftOver from times when scrolling was not transparent.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2558
     Please use objectsIntersecting:, since this will vanish."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2559
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2560
    ^ self objectsIntersecting:aRectangle
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2561
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2562
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2563
objectsIntersectingVisible:aRectangle do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2564
    "do something to every object which intersects a visible rectangle.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2565
     This is a leftOver from times when scrolling was not transparent.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2566
     Please use objectsIntersecting:do:, since this will vanish."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2567
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2568
    self objectsIntersecting:aRectangle do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2569
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2570
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2571
rectangleForScroll
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2572
    "find the area occupied by visible objects"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2573
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2574
    |left right top bottom frame oLeft oRight oTop oBottom|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2575
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2576
    left := 9999.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2577
    right := 0.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2578
    top := 9999.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2579
    bottom := 0.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2580
    self visibleObjectsDo:[:anObject |
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2581
	frame := anObject frame.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2582
	oLeft := frame left.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2583
	oRight := frame right.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2584
	oTop := frame top.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2585
	oBottom := frame bottom.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2586
	(oLeft < left) ifTrue:[left := oLeft].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2587
	(oRight > right) ifTrue:[right := oRight].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2588
	(oTop < top) ifTrue:[top := oTop].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2589
	(oBottom > bottom) ifTrue:[bottom := oBottom]
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2590
    ].
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2591
    (left < margin) ifTrue:[left := margin].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2592
    (top < margin) ifTrue:[top := margin].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2593
    (right > (width - margin)) ifTrue:[right := width - margin].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2594
    (bottom > (height - margin)) ifTrue:[bottom := height - margin].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2595
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2596
    ((left > right) or:[top > bottom]) ifTrue:[^ nil].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2597
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2598
    ^ Rectangle left:left right:right top:top bottom:bottom
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2599
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2600
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2601
visibleObjectsDo:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2602
    "do something to every visible object"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2603
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2604
    |absRect|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2605
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2606
    absRect := Rectangle left:0 top:0 width:width height:height.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2607
    self objectsIntersecting:absRect do:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2608
! !
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2609
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2610
!ObjectView methodsFor:'queries'!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2611
2045
4796486fc00a checkin from browser
ps
parents: 1947
diff changeset
  2612
hasSolidBackground
4796486fc00a checkin from browser
ps
parents: 1947
diff changeset
  2613
    "return true, if I have a solid color background, which can be pixel-copied
4796486fc00a checkin from browser
ps
parents: 1947
diff changeset
  2614
     for optimized redraw in moveObject."
4796486fc00a checkin from browser
ps
parents: 1947
diff changeset
  2615
4796486fc00a checkin from browser
ps
parents: 1947
diff changeset
  2616
    ^ gridShown not
4796486fc00a checkin from browser
ps
parents: 1947
diff changeset
  2617
!
4796486fc00a checkin from browser
ps
parents: 1947
diff changeset
  2618
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2619
heightOfContents
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2620
    "answer the height of the document in pixels"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2621
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2622
    |h|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2623
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2624
    h := self heightOfContentsInMM * (self verticalPixelPerMillimeter:1).
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2625
    ^ h rounded
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2626
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2627
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2628
heightOfContentsInMM
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2629
    "answer the height of the document in millimeters"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2630
736
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2631
    |unit value|
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2632
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2633
    "landscape"
736
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2634
    unit := (documentFormat , 'H') asSymbolIfInterned.
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2635
    unit isNil ifTrue:[
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2636
        "/ certainly unknown
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2637
    ] ifFalse:[
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2638
        value := UnitConverter convert:1 from:unit to:#millimeter
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2639
    ].
736
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2640
    value isNil ifTrue:[
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2641
        "/ assuming window size is document size
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2642
        value := (height / self verticalPixelPerMillimeter:1) asInteger
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2643
    ].
736
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2644
    ^ value
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2645
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2646
    "Modified: 31.5.1996 / 19:38:51 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2647
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2648
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2649
widthOfContents
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2650
    "answer the width of the document in pixels"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2651
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2652
    |w|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2653
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2654
    w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2655
    ^ w rounded
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2656
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2657
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2658
widthOfContentsInMM
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2659
    "answer the width of the document in millimeters"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2660
736
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2661
    |unit value|
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2662
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2663
    "landscape"
736
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2664
    unit := (documentFormat , 'W') asSymbolIfInterned.
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2665
    unit isNil ifTrue:[
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2666
        "/ certainly unknown
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2667
    ] ifFalse:[
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2668
        value := UnitConverter convert:1 from:unit to:#millimeter
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2669
    ].
736
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2670
    value isNil ifTrue:[
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2671
        "/ assuming window size is document size
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2672
        value := (width / self horizontalPixelPerMillimeter:1) asInteger
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2673
    ].
736
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2674
    ^ value
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2675
53d23f1eb6af use UnitConverter for page sizes
Claus Gittinger <cg@exept.de>
parents: 733
diff changeset
  2676
    "Modified: 31.5.1996 / 19:38:22 / cg"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2677
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2678
2747
6fd2aa4c9300 method category rename
Claus Gittinger <cg@exept.de>
parents: 2736
diff changeset
  2679
!ObjectView methodsFor:'saving & restoring'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2680
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2681
fileInContentsFrom:aStream
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2682
    "remove all objects, load new contents from aStream and redraw"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2683
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2684
    self fileInContentsFrom:aStream redraw:true new:true binary:false
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2685
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2686
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2687
fileInContentsFrom:aStream redraw:redraw
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2688
    "remove all objects, load new contents from aStream 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2689
     and redraw if the redraw argument is true"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2690
77
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2691
    self fileInContentsFrom:aStream redraw:redraw new:true binary:false
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2692
!
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2693
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2694
fileInContentsFrom:aStream redraw:redraw new:new 
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2695
    "remove all objects, load new contents from aStream 
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2696
     and redraw if the redraw argument is true"
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2697
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2698
    self fileInContentsFrom:aStream redraw:redraw new:new binary:false
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2699
!
565b052f5277 *** empty log message ***
claus
parents: 71
diff changeset
  2700
3354
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2701
fileInContentsFrom:aStream redraw:redraw new:new binary:binary
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2702
    "if the new argument is true, remove all objects.
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2703
     Then load objects from aStream. If redraw is false, no redraw
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2704
     is done
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2705
     (allows fileIn of multiple files doing a single redraw at the end)."
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2706
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2707
    binary ifTrue:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2708
        aStream binary
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2709
    ].
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2710
    self topView withReadCursorDo:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2711
        |newObject chunk individualRedraw|
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2712
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2713
        self unselect.
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2714
        individualRedraw := redraw.
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2715
        new ifTrue:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2716
            self removeAll.
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2717
            individualRedraw := false.
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2718
        ].
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2719
        [aStream atEnd] whileFalse:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2720
            binary ifTrue:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2721
                newObject := Object readBinaryFrom:aStream
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2722
            ] ifFalse:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2723
                chunk := aStream nextChunk.
6551
a82593975b92 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6303
diff changeset
  2724
                (chunk size ~~ 0) ifTrue:[
3354
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2725
                    newObject := Compiler evaluate:chunk compile:false.
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2726
                ] ifFalse:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2727
                    newObject := nil
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2728
                ]
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2729
            ].
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2730
            newObject notNil ifTrue:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2731
                self initializeFileInObject:newObject.
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2732
                individualRedraw ifFalse:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2733
                    self addObjectWithoutRedraw:newObject
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2734
                ] ifTrue:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2735
                    self addObject:newObject
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2736
                ]
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2737
            ]
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2738
        ].
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2739
        (new and:[redraw]) ifTrue:[
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2740
            self invalidate
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2741
        ]
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2742
    ]
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2743
6551
a82593975b92 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6303
diff changeset
  2744
    "Modified: / 30-01-1998 / 01:02:16 / cg"
a82593975b92 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 6303
diff changeset
  2745
    "Modified: / 01-03-2019 / 16:05:51 / Claus Gittinger"
3354
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2746
!
98ef31b9f367 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3353
diff changeset
  2747
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2748
initializeFileInObject:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2749
    "each object may be processed here after its being filed-in
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2750
     - subclasses may do whatever they want here ...
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2751
     (see LogicView for example)"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2752
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2753
    ^ self
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2754
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2755
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2756
storeBinaryContentsOn:aStream
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2757
    "store the contents in binary representation on aStream."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2758
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2759
    aStream binary.
4439
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2760
    self topView withWriteCursorDo:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2761
        contents doIfNotNil:[:theObject |
4439
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2762
            theObject storeBinaryOn:aStream.
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2763
        ].
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2764
    ]
4439
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2765
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2766
    "Modified: / 27-07-2012 / 09:45:31 / cg"
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2767
    "Modified: / 11-04-2018 / 18:17:09 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2768
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2769
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2770
storeContentsOn:aStream
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2771
    "store the contents in textual representation on aStream.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2772
     Notice, that for huge objects (such as DrawImages) this ascii output
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2773
     can become quite large, and the time to save and reload can become
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2774
     long."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2775
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2776
    |excla|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2777
4439
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2778
    self topView withWriteCursorDo:[
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2779
        excla := aStream class chunkSeparator.
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2780
        contents doIfNotNil:[:theObject |
4439
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2781
            theObject storeOn:aStream.
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2782
            aStream nextPut:excla.
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2783
            aStream cr
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2784
        ].
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2785
        aStream nextPut:excla
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2786
    ]
4439
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2787
df2d2f707795 withWriteCursorDo
Claus Gittinger <cg@exept.de>
parents: 3952
diff changeset
  2788
    "Modified: / 27-07-2012 / 09:45:23 / cg"
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2789
    "Modified: / 11-04-2018 / 18:17:20 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2790
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2791
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2792
withoutRedrawFileInContentsFrom:aStream
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2793
    "remove all objects, load new contents from aStream without any redraw"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2794
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2795
    self fileInContentsFrom:aStream redraw:false new:true binary:false
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2796
! !
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2797
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2798
!ObjectView methodsFor:'scrolling'!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2799
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2800
horizontalScrollStep
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2801
    "return the amount to scroll when stepping left/right.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2802
     Redefined to scroll by inches or centimeters."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2803
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2804
    scaleMetric == #inch ifTrue:[
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  2805
        ^ (device horizontalPixelPerInch * (1/2)) asInteger
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2806
    ].
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  2807
    ^ (device horizontalPixelPerMillimeter * 20) asInteger
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2808
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2809
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2810
verticalScrollStep
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2811
    "return the amount to scroll when stepping left/right.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2812
     Redefined to scroll by inches or centimeters."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2813
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2814
    scaleMetric == #inch ifTrue:[
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  2815
        ^ (device verticalPixelPerInch * (1/2)) asInteger
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2816
    ].
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  2817
    ^ (device verticalPixelPerMillimeter * 20) asInteger
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2818
! !
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2819
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2820
!ObjectView methodsFor:'selection & handles'!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2821
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2822
drawHandle:aPoint
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2823
    |hsize halfSize|
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2824
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2825
    hsize := self handleSize.
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2826
    halfSize := hsize // 2.
6056
da66f10bc24d #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  2827
    gc fillRectangleX:(aPoint x - halfSize) y:(aPoint y - halfSize)
da66f10bc24d #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  2828
       width:hsize height:hsize
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2829
!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2830
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2831
drawHandlesFor:anObject
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2832
    |hsize halfSize|
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2833
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2834
    hsize := self handleSize.
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2835
    halfSize := hsize // 2.
2049
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2836
    self handlesOf:anObject do:[:handlePoint |
6056
da66f10bc24d #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  2837
        gc fillRectangleX:(handlePoint x - halfSize) y:(handlePoint y - halfSize)
da66f10bc24d #TUNING by cg
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  2838
           width:hsize height:hsize
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2839
    ]
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2840
!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2841
2782
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2842
findAllObjectsHandleAt:aPoint
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2843
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2844
    ^ contents select:[:object|
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2845
        (self object:object hasHandleAt:aPoint) 
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2846
    ] 
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2847
!
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2848
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2849
findAllObjectsHandleAt:aPoint suchThat:aBlock
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2850
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2851
    ^ contents select:[:object|
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2852
        (aBlock value:object) 
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2853
        and:[(self object:object hasHandleAt:aPoint)]
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2854
    ] 
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2855
!
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2856
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2857
findLastObjectHandleAt:aPoint
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2858
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2859
    ^ contents detectLast:[:object|
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2860
        (self object:object hasHandleAt:aPoint) 
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2861
    ] ifNone:nil
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2862
!
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2863
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2864
findLastObjectHandleAt:aPoint suchThat:aBlock
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2865
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2866
    contents reverseDo:[:object |
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2867
        (self object:object hasHandleAt:aPoint) ifTrue:[
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2868
            (aBlock value:object) ifTrue:[ ^ object ]
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2869
        ]
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2870
    ].
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2871
    ^ nil
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2872
!
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2873
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2874
findObjectHandleAt:aPoint
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2875
    |objectFound|
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2876
    contents do:[:object |
2782
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2877
        (self object:object hasHandleAt:aPoint) ifTrue:[
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2878
            objectFound := object
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  2879
        ]
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2880
    ].
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2881
    ^ objectFound
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2882
!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2883
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2884
handle:handlePoint isHitBy:aPoint
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2885
    ^ (self handleFor:handlePoint) containsPoint:aPoint
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2886
!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2887
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2888
handleFor:aPoint
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2889
    "return the handle-rectangle for a handle at aPoint"
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2890
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2891
    |hsize centerX centerY|
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2892
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2893
    hsize := self handleSize.
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2894
    centerX := aPoint x.
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2895
    centerY := aPoint y.
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2896
    ^ Rectangle left:(centerX - hsize)
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2897
		 top:(centerY - hsize)
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2898
	       right:(centerX + hsize)
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2899
	      bottom:(centerY + hsize)
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2900
!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2901
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2902
handleSize
2289
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  2903
    "return the size of the handles - since handles should be
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2904
     the same size regardless of scaling, inverse-scale from
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2905
     what the default is."
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2906
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  2907
    |hs currentTransformation|
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2908
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2909
    hs := self class handleSize.
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  2910
    currentTransformation := gc transformation.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  2911
    currentTransformation notNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  2912
        ^ currentTransformation applyInverseScaleX:hs
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2913
    ].
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2914
    ^ hs
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2915
!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2916
2049
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2917
handlesOf:anObject do:aBlock
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2918
    anObject handlesDo:aBlock
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2919
!
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2920
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2921
invertHandle:aHandle
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2922
    self xoring:[self drawHandle:aHandle]
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2923
!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2924
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2925
invertHandlesOf:aSelection
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2926
    aSelection notNil ifTrue:[
2049
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2927
        self clippedTo:nil do:[
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2928
            self xoring:[
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2929
                aSelection doIfNotNil:[:anObject |
2049
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2930
                    (anObject respondsTo:#handlesDo:) ifTrue:[
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2931
                        self drawHandlesFor:anObject
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2932
                    ] ifFalse:[
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2933
                        anObject drawOutlineIn:self
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2934
                    ]
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2935
                ]
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2936
            ]
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2937
        ]
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2938
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2939
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2940
    "Modified: / 11-04-2018 / 18:14:50 / stefan"
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2941
!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2942
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2943
object:anObject hasHandleAt:aPoint
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2944
    |found|
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2945
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2946
    found := false.
2049
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2947
    self handlesOf:anObject do:[:handlePoint |
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2948
        (self handle:handlePoint isHitBy:aPoint) ifTrue:[
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2949
            found := true
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2950
        ]
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2951
    ].
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2952
    ^ found
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2953
!
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2954
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2955
selectionHandlesDo:aBlock
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2956
    selection doIfNotNil:[:theObject |
2049
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2957
        (theObject respondsTo:#handlesDo:) ifTrue:[
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2958
            self handlesOf:theObject do:[:handlePoint |
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2959
                aBlock value:theObject value:handlePoint
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2960
            ]
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  2961
        ]
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2962
    ]
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2963
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  2964
    "Modified: / 11-04-2018 / 18:16:50 / stefan"
1752
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2965
! !
f1e400f163ad moved some handle stuff from DrawView to here,
Claus Gittinger <cg@exept.de>
parents: 1746
diff changeset
  2966
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2967
!ObjectView methodsFor:'selections'!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2968
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2969
addToSelection:anObject
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  2970
    "add anObject to the selection; redraw it selected"
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  2971
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2972
    selection isCollection ifFalse:[
1002
62b2636d0923 care for nil selection
ca
parents: 996
diff changeset
  2973
        selection isNil ifTrue:[
3420
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  2974
            selection := OrderedCollection new
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  2975
        ] ifFalse:[
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  2976
            selection := OrderedCollection with:selection
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  2977
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2978
    ].
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  2979
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  2980
    (selection includes:anObject) ifFalse:[
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  2981
        (self frameIncludesSelectionHandlesOn:anObject) ifFalse:[
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  2982
            self hideSelection.
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  2983
            selection add:anObject.
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  2984
            self showSelection.
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  2985
        ] ifTrue:[
3209
fd62099cbe4f addToSelection fix
Claus Gittinger <cg@exept.de>
parents: 3204
diff changeset
  2986
            selection add:anObject.
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  2987
            self showSelected:anObject
3209
fd62099cbe4f addToSelection fix
Claus Gittinger <cg@exept.de>
parents: 3204
diff changeset
  2988
        ].
fd62099cbe4f addToSelection fix
Claus Gittinger <cg@exept.de>
parents: 3204
diff changeset
  2989
        self changed:#selection with:selection.
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  2990
    ].
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  2991
3420
d1d2631c48a6 clear releaseAction after a motion
Claus Gittinger <cg@exept.de>
parents: 3419
diff changeset
  2992
    "Modified: / 27-10-2006 / 14:16:04 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2993
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2994
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2995
hideSelection
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2996
    "hide the selection - undraw hilights - whatever that is"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  2997
3783
54e58a968f32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3775
diff changeset
  2998
    shown ifFalse:[^ self].
54e58a968f32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3775
diff changeset
  2999
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3000
    self selectionDo:[:object |
3783
54e58a968f32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3775
diff changeset
  3001
        self showUnselected:object
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3002
    ]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3003
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3004
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3005
removeFromSelection:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3006
    "remove anObject from the selection"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3007
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3008
    |wasSelected didHide|
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3009
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3010
    didHide := false.
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3011
    wasSelected := true.
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3012
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3013
    (self frameIncludesSelectionHandlesOn:anObject) ifFalse:[
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3014
        "/ must hide any selection-handles first
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3015
        self hideSelection.
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3016
        didHide := true.
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3017
    ].
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3018
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3019
    selection isCollection ifTrue:[
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3020
        (selection remove:anObject ifAbsent:[nil]) isNil ifTrue:[
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3021
            wasSelected := false
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3022
        ].
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3023
        (selection size == 1) ifTrue:[
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3024
            selection := selection first
1002
62b2636d0923 care for nil selection
ca
parents: 996
diff changeset
  3025
        ] ifFalse:[
4655
aa2214d7012a class: ObjectView
Claus Gittinger <cg@exept.de>
parents: 4625
diff changeset
  3026
            selection := selection asNilIfEmpty
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3027
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3028
    ] ifFalse:[
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3029
        (selection == anObject) ifTrue:[
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3030
            selection := nil
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3031
        ] ifFalse:[
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3032
            wasSelected := false
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3033
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3034
    ].
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3035
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3036
    didHide ifTrue:[
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3037
        self showSelection.
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3038
    ] ifFalse:[
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3039
        wasSelected ifTrue:[
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3040
            self showUnselected:anObject
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3041
        ].
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3042
    ].
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3043
3209
fd62099cbe4f addToSelection fix
Claus Gittinger <cg@exept.de>
parents: 3204
diff changeset
  3044
    self changed:#selection with:selection.
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3045
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3046
    "Modified: / 4.7.1999 / 15:22:28 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3047
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3048
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3049
select:something
3952
35fa38e8cf5b comment/format in: #select:
Claus Gittinger <cg@exept.de>
parents: 3951
diff changeset
  3050
    "select something - hide previous selection, set to something and hilight"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3051
3775
4bf735abb3ec care for same selection
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
  3052
    |newSelection|
4bf735abb3ec care for same selection
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
  3053
4bf735abb3ec care for same selection
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
  3054
    newSelection :=
4bf735abb3ec care for same selection
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
  3055
        (something isCollection and:[something size == 0]) 
4bf735abb3ec care for same selection
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
  3056
            ifTrue:[ nil ]
4bf735abb3ec care for same selection
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
  3057
            ifFalse:[ something ].
4bf735abb3ec care for same selection
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
  3058
4bf735abb3ec care for same selection
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
  3059
    (selection = newSelection) ifFalse:[
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3060
        self hideSelection.
3775
4bf735abb3ec care for same selection
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
  3061
        selection := newSelection.
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3062
        self showSelection.
2051
56ebae1cfdbe pass the selection as argument with the selectionChange notification
Claus Gittinger <cg@exept.de>
parents: 2049
diff changeset
  3063
        self changed:#selection with:selection.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3064
    ]
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3065
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3066
    "Modified: / 4.7.1999 / 15:22:39 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3067
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3068
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3069
selectAll
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3070
    "select all objects"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3071
3162
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3072
    self select:contents copy.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3073
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3074
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3075
selectAllIn:aRectangle
3162
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3076
    "select all objects which are fully contained in aRectangle"
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3077
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3078
    |newSelection|
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3079
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3080
    newSelection := OrderedCollection new.
3889
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  3081
    self 
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  3082
        objectsIn:aRectangle 
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  3083
        do:[:theObject |
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  3084
            newSelection add:theObject
da959fe6f990 refactored selectAll to allow for rectangle-drag in UIObjectView
Claus Gittinger <cg@exept.de>
parents: 3878
diff changeset
  3085
        ].
3162
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3086
    self select:newSelection.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3087
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3088
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3089
selectAllIntersecting:aRectangle
3162
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3090
    "select all objects which are touched by aRectangle"
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3091
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3092
    |newSelection|
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3093
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3094
    newSelection := OrderedCollection new.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3095
    self objectsIntersecting:aRectangle do:[:theObject |
3162
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3096
        newSelection add:theObject
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3097
    ].
3162
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3098
    self select:newSelection.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3099
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3100
1940
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3101
selection
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3102
    "return the selection as a collection or nil"
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3103
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3104
    selection isNil ifTrue:[^ nil].
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3105
    selection isCollection ifTrue:[^ selection].
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3106
    ^ Array with:selection
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3107
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3108
    "Created: / 4.7.1999 / 14:33:16 / cg"
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3109
    "Modified: / 4.7.1999 / 14:34:20 / cg"
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3110
!
3a4ac6539647 added: #selection
Claus Gittinger <cg@exept.de>
parents: 1920
diff changeset
  3111
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3112
selectionDo:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3113
    "apply block to every object in selection"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3114
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3115
    selection doIfNotNil:aBlock
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3116
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3117
    "Modified: / 11-04-2018 / 18:16:30 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3118
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3119
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3120
showSelection
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3121
    "show the selection - draw hilights - whatever that is"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3122
3783
54e58a968f32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3775
diff changeset
  3123
    shown ifFalse:[^ self].
54e58a968f32 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3775
diff changeset
  3124
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3125
    self selectionDo:[:object |
3162
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3126
        self showSelected:object
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3127
    ]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3128
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3129
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3130
unselect
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3131
    "unselect - hide selection; clear selection"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3132
2049
e59deb5f1de8 allow for handle-enumeration to be redefined.
Claus Gittinger <cg@exept.de>
parents: 2047
diff changeset
  3133
    selection notNil ifTrue:[
3162
db595b51e766 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3044
diff changeset
  3134
        self select:nil.
1941
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3135
    ]
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3136
928af17c7344 send self changed:#addObject after adding,
Claus Gittinger <cg@exept.de>
parents: 1940
diff changeset
  3137
    "Modified: / 4.7.1999 / 15:30:36 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3138
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3139
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3140
withSelectionHiddenDo:aBlock
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3141
    "evaluate aBlock while selection is hidden"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3142
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3143
    |sel|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3144
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3145
    sel := selection.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3146
    sel notNil ifTrue:[self unselect].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3147
    aBlock value.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3148
    sel notNil ifTrue:[self select:sel]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3149
! !
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3150
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3151
!ObjectView methodsFor:'testing objects'!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3152
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3153
allObjectsHitAt:aPoint do:aBlock
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3154
    "for all objects (by enumerating from back to front) which are hit by
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3155
     the argument, aPoint, evaluate aBlock"
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3156
3530
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3157
    self allObjectsHitAt:aPoint withDelta:(self hitDelta / self scale x) do:aBlock
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3158
!
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3159
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3160
allObjectsHitAt:aPoint withDelta:hDelta do:aBlock
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3161
    "for all objects (by enumerating from back to front) which are hit by
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3162
     the argument, aPoint, evaluate aBlock"
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3163
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3164
    contents notEmptyOrNil ifTrue:[
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3165
        contents reverseDo:[:object |
3530
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3166
            (object isHitBy:aPoint withDelta:hDelta) ifTrue:[
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3167
                aBlock value:object
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3168
            ]
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3169
        ]
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3170
    ].
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3171
    ^ nil
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3172
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3173
    "Created: / 27-10-2006 / 16:58:34 / cg"
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3174
!
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3175
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3176
canMove:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3177
    "return true, if the argument, anObject or a collection can be moved"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3178
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3179
    something doIfNotNil:[:theObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3180
        (theObject perform:#canBeMoved ifNotUnderstood:true) ifFalse:[^ false]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3181
    ].
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3182
    ^ true
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3183
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3184
    "Modified: / 11-04-2018 / 18:13:04 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3185
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3186
1942
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3187
canSelect:something
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3188
    "return true, if the argument, anObject or a collection can be selected"
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3189
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3190
    something doIfNotNil:[:theObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3191
        theObject isView ifFalse:[
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3192
            (theObject perform:#canBeSelected ifNotUnderstood:true) ifFalse:[^ false]
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3193
        ]
1942
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3194
    ].
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3195
    ^ true
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3196
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3197
    "Created: / 04-07-1999 / 18:51:29 / cg"
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3198
    "Modified: / 11-04-2018 / 18:14:02 / stefan"
1942
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3199
!
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3200
3530
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3201
findNearestObjectAt:aPoint
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3202
    "find the nearest object (by looking from back to front) which is hit by
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3203
     the argument, aPoint - this is the topmost object hit"
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3204
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3205
    0 to:(self hitDelta) by:(1 / 2) do:[:hdelta |
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3206
        self allObjectsHitAt:aPoint withDelta:(hdelta " / self scale x") do:[:object | ^ object].
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3207
    ].
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3208
    ^ nil
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3209
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3210
    "Modified: / 27-10-2006 / 16:58:54 / cg"
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3211
!
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3212
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3213
findObjectAt:aPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3214
    "find the last object (by looking from back to front) which is hit by
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3215
     the argument, aPoint - this is the topmost object hit"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3216
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3217
    self allObjectsHitAt:aPoint do:[:object | ^ object].
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3218
    ^ nil
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3219
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3220
    "Modified: / 27-10-2006 / 16:58:54 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3221
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3222
3300
146dacf3c7c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3297
diff changeset
  3223
findObjectAt:aPoint forWhich:aBlock
146dacf3c7c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3297
diff changeset
  3224
    "find the last object (by looking from back to front) which is hit by
146dacf3c7c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3297
diff changeset
  3225
     the argument, aPoint - this is the topmost object hit"
146dacf3c7c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3297
diff changeset
  3226
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3227
    self allObjectsHitAt:aPoint do:[:object | (aBlock value:object) ifTrue:[^ object]].
3300
146dacf3c7c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3297
diff changeset
  3228
    ^ nil
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3229
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3230
    "Modified: / 27-10-2006 / 16:59:26 / cg"
3300
146dacf3c7c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3297
diff changeset
  3231
!
146dacf3c7c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3297
diff changeset
  3232
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3233
findObjectAt:aPoint suchThat:aBlock
3845
fada56873a83 Mark obsolete methods
Stefan Vogel <sv@exept.de>
parents: 3783
diff changeset
  3234
    <resource: #obsolete>
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3235
    "find the last object (back to front ) which is hit by
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3236
     the argument, aPoint and for which the testBlock, aBlock evaluates to true.
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3237
     This is a leftOver from times when scrolling was not transparent.
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3238
     Please use findObjectAt:forWhich:, since this will vanish."
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3239
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3240
    self obsoleteMethodWarning:'use findObjectAt:forWhich:'.
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3241
    ^ self findObjectAt:aPoint forWhich:aBlock
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3242
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3243
    "Modified: / 27-10-2006 / 17:01:42 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3244
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3245
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3246
findObjectAtVisible:aPoint
3845
fada56873a83 Mark obsolete methods
Stefan Vogel <sv@exept.de>
parents: 3783
diff changeset
  3247
    <resource: #obsolete>
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3248
    "find the last object (by looking from back to front) which is hit by
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3249
     a visible point - this is the topmost object hit.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3250
     This is a leftOver from times when scrolling was not transparent.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3251
     Please use findObjectAt:, since this will vanish."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3252
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3253
    self obsoleteMethodWarning:'use findObjectAt:'.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3254
    ^ self findObjectAt:aPoint
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3255
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3256
    "Modified: / 27-10-2006 / 17:02:08 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3257
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3258
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3259
findObjectAtVisible:aPoint suchThat:aBlock
3845
fada56873a83 Mark obsolete methods
Stefan Vogel <sv@exept.de>
parents: 3783
diff changeset
  3260
    <resource: #obsolete>
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3261
    "find the last object (back to front ) which is hit by
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3262
     the argument, aPoint and for which the testBlock, aBlock evaluates to
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3263
     true.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3264
     This is a leftOver from times when scrolling was not transparent.
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3265
     Please use findObjectAt:forWhich:, since this will vanish."
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3266
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3267
    self obsoleteMethodWarning:'use findObjectAt:forWhich:'.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3268
    ^ self findObjectAt:aPoint suchThat:aBlock
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3269
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3270
    "Modified: / 27-10-2006 / 17:01:47 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3271
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3272
3530
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3273
findObjectForSelectAt:aPoint
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3274
    "find the object for a select"
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3275
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3276
    ^ self findObjectAt:aPoint
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3277
!
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3278
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3279
frameIncludesSelectionHandlesOn:anObject
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3280
    "return true, if anObjects frame includes any selection
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3281
     handles, false if not or if we do not know.
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3282
     This can be used to optimize the redraw, in removeObjectFromSelection.
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3283
     Subclasses which know how selections are highlighted may redefine this."
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3284
5958
138b25592837 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5942
diff changeset
  3285
    ^ false     "/ i.e. don't know.
839
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3286
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3287
    "Created: 1.10.1996 / 12:06:51 / cg"
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3288
!
53a5344288e6 redrawing when removing/adding from/to the selection
Claus Gittinger <cg@exept.de>
parents: 815
diff changeset
  3289
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3290
frameOf:anObjectOrCollection
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3291
    "answer the maximum extent defined by the argument, anObject or a
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3292
     collection of objects"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3293
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3294
    |first frameAll|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3295
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3296
    anObjectOrCollection isNil ifTrue:[^ nil ].
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3297
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3298
    first := true.
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3299
    anObjectOrCollection doIfNotNil:[:theObject |
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3300
        first ifTrue:[
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3301
            frameAll := theObject frame.
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3302
            first := false
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3303
        ] ifFalse:[
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3304
            frameAll := frameAll merge:(theObject frame)
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3305
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3306
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3307
    ^ frameAll
3421
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3308
ed1db967fa82 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3420
diff changeset
  3309
    "Modified: / 27-10-2006 / 17:02:16 / cg"
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3310
    "Modified: / 11-04-2018 / 18:14:35 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3311
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3312
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3313
isObscured:something
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3314
    "return true, if the argument something, anObject or a collection of
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3315
     objects is obscured (partially or whole) by any other object"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3316
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3317
    something doIfNotNil:[:anObject |
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3318
        (self objectIsObscured:anObject) ifTrue:[
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3319
            ^ true
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3320
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3321
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3322
    ^ false
6303
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3323
8ae931b8a84e #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 6142
diff changeset
  3324
    "Modified: / 11-04-2018 / 18:15:07 / stefan"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3325
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3326
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3327
isSelected:anObject
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3328
    "return true, if the argument, anObject is in the selection"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3329
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3330
    selection isNil ifTrue:[^ false].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3331
    (selection == anObject) ifTrue:[^ true].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3332
    selection isCollection ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3333
	^ (selection identityIndexOf:anObject startingAt:1) ~~ 0
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3334
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3335
    ^ false
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3336
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3337
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3338
objectIsObscured:objectToBeTested
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3339
    "return true, if the argument, anObject is obscured (partially or whole)
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3340
     by any other object"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3341
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3342
    |frameToBeTested frameleft frameright frametop framebot
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3343
     objectsFrame startIndex|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3344
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3345
    (objectToBeTested == (contents last)) ifTrue:[
2289
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3346
        "quick return if object is on top"
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3347
        ^ false
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3348
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3349
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3350
    frameToBeTested := self frameOf:objectToBeTested.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3351
    frameleft := frameToBeTested left.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3352
    frameright := frameToBeTested right.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3353
    frametop := frameToBeTested top.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3354
    framebot := frameToBeTested bottom.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3355
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3356
    "check objects after the one to check"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3357
2289
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3358
    startIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error:'nonexisting object'].
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3359
    contents from:(startIndex + 1) to:(contents size) do:[:object |
2289
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3360
        objectsFrame := self frameOf:object.
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3361
        (objectsFrame right < frameleft) ifFalse:[
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3362
            (objectsFrame left > frameright) ifFalse:[
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3363
                (objectsFrame bottom < frametop) ifFalse:[
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3364
                    (objectsFrame top > framebot) ifFalse:[
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3365
                        ^ true
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3366
                    ]
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3367
                ]
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3368
            ]
64be0d7d2e84 Selection stuff
Stefan Vogel <sv@exept.de>
parents: 2227
diff changeset
  3369
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3370
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3371
    ^ false
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3372
! !
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3373
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3374
!ObjectView methodsFor:'user interface'!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3375
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3376
alignToGrid:aPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3377
    "round aPoint to the next nearest point on the grid"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3378
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3379
    aligning ifFalse:[
2782
efccf22db49d settings about grid
tm
parents: 2747
diff changeset
  3380
        ^ aPoint
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3381
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3382
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3383
    ^ (aPoint grid:gridAlign) rounded
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3384
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3385
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3386
selectMore:aPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3387
    "add/remove an object from the selection"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3388
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3389
    |anObject|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3390
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3391
    anObject := self findObjectAt:aPoint.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3392
    anObject notNil ifTrue:[
1942
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3393
        (self isSelected:anObject) ifTrue:[
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3394
            "remove from selection"
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3395
            self removeFromSelection:anObject
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3396
        ] ifFalse:[
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3397
            "add to selection"
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3398
            (self canSelect:anObject) ifTrue:[
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3399
                self addToSelection:anObject
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3400
            ]
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3401
        ]
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3402
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3403
    ^ self
1942
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3404
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3405
    "Modified: / 4.7.1999 / 18:52:13 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3406
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3407
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3408
startSelectMoreOrMove:aPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3409
    "add/remove object hit by aPoint, then start a rectangleDrag or move 
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3410
     - if aPoint hits an object, a move is started, otherwise a rectangleDrag.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3411
     This is typically the button shiftPressAction."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3412
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3413
    |anObject|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3414
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3415
    anObject := self findObjectAt:aPoint.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3416
    anObject notNil ifTrue:[
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3417
        (self isSelected:anObject) ifTrue:[
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3418
            "remove from selection"
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3419
            self removeFromSelection:anObject
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3420
        ] ifFalse:[
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3421
            "add to selection"
1942
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3422
            (self canSelect:anObject) ifTrue:[
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3423
                self addToSelection:anObject
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3424
            ]
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3425
        ].
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3426
        self startObjectMove:selection at:aPoint.
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3427
        ^ self
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3428
    ].
733
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3429
"/    self unselect.
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3430
"/    self startRectangleDrag:aPoint
f67b1c728316 fixed shift-select & move
Claus Gittinger <cg@exept.de>
parents: 732
diff changeset
  3431
1942
9d3fdaf53967 added #canBeSelected query
Claus Gittinger <cg@exept.de>
parents: 1941
diff changeset
  3432
    "Modified: / 4.7.1999 / 18:51:52 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3433
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3434
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3435
startSelectOrMove:aPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3436
    "start a rectangleDrag or objectMove - if aPoint hits an object,
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3437
     an object move is started, otherwise a rectangleDrag.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3438
     This is typically the button pressAction."
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3439
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3440
    |anObject|
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3441
3530
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3442
    anObject := self findObjectForSelectAt:aPoint.
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3443
    anObject notNil ifTrue:[
3530
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3444
        (self isSelected:anObject) ifFalse:[
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3445
            self unselect.
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3446
            self startObjectMove:anObject at:aPoint.
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3447
        ] ifTrue:[
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3448
            self startObjectMove:selection at:aPoint.
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3449
        ].
2cac95ddc118 drag and findObject fixes
Claus Gittinger <cg@exept.de>
parents: 3489
diff changeset
  3450
        ^ self
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3451
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3452
    "nothing was hit by this click - this starts a group select"
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3453
    self unselect.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3454
    self startRectangleDrag:aPoint
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3455
! !
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3456
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3457
!ObjectView methodsFor:'view manipulation'!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3458
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3459
inchMetric
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3460
    (scaleMetric ~~ #inch) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3461
	scaleMetric := #inch.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3462
	self newGrid
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3463
    ]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3464
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3465
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3466
millimeterMetric
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3467
    (scaleMetric ~~ #mm) ifTrue:[
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3468
	scaleMetric := #mm.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3469
	self newGrid
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3470
    ]
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3471
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3472
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3473
zoom:factor
2736
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3474
    "set a zoom factor; smaller than 1 is shrink; larger than 1 is magnify. 
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3475
     I.e. 1 is identity; 2 is magnify by 2; 0.5 is shrink by 2"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3476
3301
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3477
    |currentScale currentTranslation newScale|
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3478
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3479
    currentScale := self scale.
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3480
    currentTranslation := self translation.
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3481
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3482
    newScale := factor.
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3483
    newScale isNil ifTrue:[
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3484
        newScale := 1 @ 1
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3485
    ].
3301
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3486
    newScale := newScale asPoint.
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3487
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3488
    newScale = currentScale ifTrue:[
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  3489
        ^ self
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3490
    ].
3297
fa28c86a74cf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3290
diff changeset
  3491
3301
af1a7ca0488c preserve relative translation, when zoom changes
Claus Gittinger <cg@exept.de>
parents: 3300
diff changeset
  3492
    (newScale = 1) ifTrue:[
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3493
        gc transformation:nil
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3494
    ] ifFalse:[
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3495
        gc transformation:(WindowingTransformation 
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3496
                            scale:newScale 
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3497
                            translation:(currentTranslation / currentScale x * newScale x ) rounded).
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3498
    ].
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3499
    self contentsChanged.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3500
    self setInnerClip.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3501
    gridShown ifTrue:[
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  3502
        self newGrid
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3503
    ].
3297
fa28c86a74cf *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3290
diff changeset
  3504
    self invalidate 
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  3505
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  3506
    "Modified: 29.5.1996 / 16:20:41 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3507
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3508
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3509
zoomIn
2736
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3510
    "zoom in - multiply the zoom factor by 1.5"
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3511
2134
1bb04fefce04 zoomIn/Out confusion fixed
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  3512
    self zoomIn:1.5
1bb04fefce04 zoomIn/Out confusion fixed
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  3513
1bb04fefce04 zoomIn/Out confusion fixed
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  3514
    "Modified: / 10.2.2000 / 21:14:41 / cg"
588
2d6fc80017df checkin from browser
Claus Gittinger <cg@exept.de>
parents: 584
diff changeset
  3515
!
2d6fc80017df checkin from browser
Claus Gittinger <cg@exept.de>
parents: 584
diff changeset
  3516
2d6fc80017df checkin from browser
Claus Gittinger <cg@exept.de>
parents: 584
diff changeset
  3517
zoomIn:factor
2736
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3518
    "zoom in by multiplying the zoom factor by the argument"
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3519
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3520
    |currentTransformation|
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3521
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3522
    currentTransformation := gc transformation.
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3523
    currentTransformation isNil ifTrue:[
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3524
        currentTransformation := WindowingTransformation scale:1 translation:0
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3525
    ].
4902
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3526
    gc transformation:(WindowingTransformation 
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3527
                        scale:(currentTransformation scale * factor)
3cd9b17d6e45 class: ObjectView
Stefan Vogel <sv@exept.de>
parents: 4655
diff changeset
  3528
                        translation:(currentTransformation translation * factor) rounded).
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3529
    self contentsChanged.
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3530
    self setInnerClip.
721
4a01084cf643 use #invalidate instead of #redraw
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
  3531
    self invalidate.
588
2d6fc80017df checkin from browser
Claus Gittinger <cg@exept.de>
parents: 584
diff changeset
  3532
2134
1bb04fefce04 zoomIn/Out confusion fixed
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  3533
    "Created: / 27.4.1996 / 10:08:39 / cg"
1bb04fefce04 zoomIn/Out confusion fixed
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  3534
    "Modified: / 10.2.2000 / 21:11:11 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3535
!
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3536
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3537
zoomOut
2736
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3538
    "zoom in - divide the zoom factor by 1.5"
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3539
2134
1bb04fefce04 zoomIn/Out confusion fixed
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  3540
    self zoomOut:1.5
1bb04fefce04 zoomIn/Out confusion fixed
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  3541
1bb04fefce04 zoomIn/Out confusion fixed
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  3542
    "Modified: / 10.2.2000 / 21:14:46 / cg"
588
2d6fc80017df checkin from browser
Claus Gittinger <cg@exept.de>
parents: 584
diff changeset
  3543
!
2d6fc80017df checkin from browser
Claus Gittinger <cg@exept.de>
parents: 584
diff changeset
  3544
2d6fc80017df checkin from browser
Claus Gittinger <cg@exept.de>
parents: 584
diff changeset
  3545
zoomOut:factor
2736
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3546
    "zoom out by dividing the zoom factor by the argument"
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3547
76212cf614cc comments
Claus Gittinger <cg@exept.de>
parents: 2730
diff changeset
  3548
    self zoomIn:(1.0 / factor)
588
2d6fc80017df checkin from browser
Claus Gittinger <cg@exept.de>
parents: 584
diff changeset
  3549
2134
1bb04fefce04 zoomIn/Out confusion fixed
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  3550
    "Created: / 27.4.1996 / 10:09:19 / cg"
1bb04fefce04 zoomIn/Out confusion fixed
Claus Gittinger <cg@exept.de>
parents: 2072
diff changeset
  3551
    "Modified: / 10.2.2000 / 21:10:52 / cg"
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3552
! !
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3553
961
1b65b39c5079 aligningMove was undefined.
Claus Gittinger <cg@exept.de>
parents: 839
diff changeset
  3554
!ObjectView class methodsFor:'documentation'!
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3555
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3556
version
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  3557
    ^ '$Header$'
3951
1726c8891c34 changed: #setInitialDocumentFormat
Claus Gittinger <cg@exept.de>
parents: 3916
diff changeset
  3558
!
1726c8891c34 changed: #setInitialDocumentFormat
Claus Gittinger <cg@exept.de>
parents: 3916
diff changeset
  3559
1726c8891c34 changed: #setInitialDocumentFormat
Claus Gittinger <cg@exept.de>
parents: 3916
diff changeset
  3560
version_CVS
5624
a93aea30f0fb #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 5234
diff changeset
  3561
    ^ '$Header$'
216
d35b116e03a6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 215
diff changeset
  3562
! !
4625
ff8daa46e92f class: ObjectView
Claus Gittinger <cg@exept.de>
parents: 4439
diff changeset
  3563